Make AssocTable cache initial capacity configurable (#54)

RELEASE_NOTES.md

@@ -1,5 +1,7 @@
-#### 11.3.0 - Unreleased
+#### 11.4.0 - Unreleased
 * Add Fable support to FsLexYacc.Runtime.
+* Make the AssocTable lookup cache initial capacity configurable to avoid pre-allocating 2000 entries per parse #54
+* Add `--assoc-cache-capacity` option for fsyacc to set the generated parser's AssocTable cache capacity from the command line #54
 
 #### 11.2.0 - 12 May, 2023
 * Add `--open` option for fslex.

src/FsLexYacc.Runtime/Parsing.fs

@@ -117,7 +117,15 @@ module Flags =
     let mutable debug = false
 #endif
 
-module Implementation = 
+/// Settings that tune the parser runtime.
+module ParseSettings =
+    /// Initial capacity of the per-AssocTable lookup cache allocated on each parse. The default
+    /// (2000) preserves historical behaviour. Set to 0 to grow the cache on demand, which greatly
+    /// reduces allocation for parsers invoked over many small inputs (issue #54), at the cost of a
+    /// few dictionary resizes for very large single parses. Set once at startup, before parsing.
+    let mutable AssocTableCacheInitialCapacity = 2000
+
+module Implementation =
 
     // Definitions shared with fsyacc 
     let anyMarker = 0xffff
@@ -133,8 +141,12 @@ module Implementation =
     //-------------------------------------------------------------------------
     // Read the tables written by FSYACC.  
 
-    type AssocTable(elemTab:uint16[], offsetTab:uint16[]) =
-        let cache = Dictionary<_,_>(2000)
+    type AssocTable(elemTab:uint16[], offsetTab:uint16[], initialCacheCapacity:int) =
+        // Cache capacity is configurable (issue #54): two AssocTables are constructed per Interpret
+        // call, so the historical fixed 2000-capacity dominated allocation for parsers run over many
+        // small inputs. The capacity is supplied by the caller (Tables.Interpret), defaulting to
+        // ParseSettings.AssocTableCacheInitialCapacity (2000) unless an explicit value is passed.
+        let cache = Dictionary<_,_>(initialCacheCapacity)
 
         member t.readAssoc (minElemNum,maxElemNum,defaultValueOfAssoc,keyToFind) =     
             // do a binary chop on the table 
@@ -203,7 +215,7 @@ module Implementation =
 
         new(value,startPos,endPos) = { value=value; startPos=startPos; endPos=endPos }
 
-    let interpret (tables: Tables<'tok>) lexer (lexbuf : LexBuffer<_>) initialState =                                                                      
+    let interpret (tables: Tables<'tok>) lexer (lexbuf : LexBuffer<_>) initialState (assocCacheInitialCapacity: int) =
         let localStore = Dictionary<string,obj>() in
         localStore.["LexBuffer"] <- lexbuf
 #if __DEBUG
@@ -247,8 +259,8 @@ module Implementation =
         let lhsPos        = (Array.zeroCreate 2 : Position[])                                            
 
         let reductions = tables.reductions
-        let actionTable = AssocTable(tables.actionTableElements, tables.actionTableRowOffsets)
-        let gotoTable = AssocTable(tables.gotos, tables.sparseGotoTableRowOffsets)
+        let actionTable = AssocTable(tables.actionTableElements, tables.actionTableRowOffsets, assocCacheInitialCapacity)
+        let gotoTable = AssocTable(tables.gotos, tables.sparseGotoTableRowOffsets, assocCacheInitialCapacity)
         let stateToProdIdxsTable = IdxToIdxListTable(tables.stateToProdIdxsTableElements, tables.stateToProdIdxsTableRowOffsets)
 
         let parseState =                                                                                            
@@ -494,8 +506,10 @@ module Implementation =
         valueStack.Peep().value
 
 type Tables<'tok> with
-    member tables.Interpret (lexer,lexbuf,startState) = 
-        Implementation.interpret tables lexer lexbuf startState
+    member tables.Interpret (lexer,lexbuf,startState) =
+        Implementation.interpret tables lexer lexbuf startState ParseSettings.AssocTableCacheInitialCapacity
+    member tables.Interpret (lexer,lexbuf,startState,assocTableCacheInitialCapacity) =
+        Implementation.interpret tables lexer lexbuf startState assocTableCacheInitialCapacity
 
 module ParseHelpers = 
     let parse_error (_s:string) = ()

src/FsLexYacc.Runtime/Parsing.fsi

@@ -113,11 +113,25 @@ type Tables<'tok> =
     /// Returns an object indicating the final synthesized value for the parse.
     member Interpret: lexer: (LexBuffer<'char> -> 'tok) * lexbuf: LexBuffer<'char> * startState: int -> obj
 
+    /// As Interpret, but with an explicit initial capacity for the per-parse AssocTable lookup caches
+    /// (issue #54); 0 grows them on demand. Overrides ParseSettings.AssocTableCacheInitialCapacity for
+    /// this parser. fsyacc emits a call to this overload when --assoc-cache-capacity is passed.
+    member Interpret:
+        lexer: (LexBuffer<'char> -> 'tok) * lexbuf: LexBuffer<'char> * startState: int * assocTableCacheInitialCapacity: int -> obj
+
 /// Indicates an accept action has occured
 exception Accept of obj
 /// Indicates a parse error has occured and parse recovery is in progress
 exception RecoverableParseError
 
+/// Settings that tune the parser runtime.
+module ParseSettings =
+    /// Initial capacity of the per-AssocTable lookup cache allocated on each parse. The default
+    /// (2000) preserves historical behaviour. Set to 0 to grow the cache on demand, which greatly
+    /// reduces allocation for parsers invoked over many small inputs (issue #54), at the cost of a
+    /// few dictionary resizes for very large single parses. Set once at startup, before parsing.
+    val mutable AssocTableCacheInitialCapacity: int
+
 #if __DEBUG
 module internal Flags =
     val mutable debug: bool

src/FsYacc.Core/fsyaccdriver.fs

@@ -178,6 +178,10 @@ type GeneratorState =
         map_action_to_int: Action -> int
         anyMarker: int
         bufferTypeArgument: string
+        /// When set, the generated parser passes this initial capacity to the runtime's per-parse
+        /// AssocTable lookup caches (issue #54); 0 grows them on demand. None emits the default call,
+        /// which uses ParseSettings.AssocTableCacheInitialCapacity at runtime.
+        assocCacheCapacity: int option
     }
 
     static member Default =
@@ -196,6 +200,7 @@ type GeneratorState =
             map_action_to_int = actionCoding
             anyMarker = anyMarker
             bufferTypeArgument = "'cty"
+            assocCacheCapacity = None
         }
 
 let writeSpecToFile (generatorState: GeneratorState) (spec: ParserSpec) (compiledSpec: CompiledSpec) =
@@ -649,7 +654,10 @@ let writeSpecToFile (generatorState: GeneratorState) (spec: ParserSpec) (compile
 
     writer.WriteLine "    numTerminals = %d;" (Array.length compiledSpec.actionTable.[0])
     writer.WriteLine "    productionToNonTerminalTable = _fsyacc_productionToNonTerminalTable  }"
-    writer.WriteLine "let engine lexer lexbuf startState = tables.Interpret(lexer, lexbuf, startState)"
+
+    match generatorState.assocCacheCapacity with
+    | Some n -> writer.WriteLine "let engine lexer lexbuf startState = tables.Interpret(lexer, lexbuf, startState, %d)" n
+    | None -> writer.WriteLine "let engine lexer lexbuf startState = tables.Interpret(lexer, lexbuf, startState)"
 
     for id, startState in List.zip spec.StartSymbols compiledSpec.startStates do
         if not (types.ContainsKey id) then

src/FsYacc/fsyacc.fs

@@ -23,6 +23,7 @@ let mutable inputCodePage = None
 let mutable lexlib = "FSharp.Text.Lexing"
 let mutable parslib = "FSharp.Text.Parsing"
 let mutable bufferTypeArgument = "'cty"
+let mutable assocCacheCapacity = None
 
 let usage =
     [
@@ -59,6 +60,11 @@ let usage =
             "Assume input lexer specification file is encoded with the given codepage."
         )
         ArgInfo("--buffer-type-argument", ArgType.String(fun s -> bufferTypeArgument <- s), "Generic type argument of the LexBuffer type.")
+        ArgInfo(
+            "--assoc-cache-capacity",
+            ArgType.Int(fun i -> assocCacheCapacity <- Some i),
+            "Initial capacity of the generated parser's per-parse AssocTable lookup caches (0 grows on demand). Omit to use the runtime default (2000). See FsLexYacc issue #54."
+        )
     ]
 
 let _ =
@@ -118,6 +124,7 @@ let main () =
             parslib = parslib
             compat = compat
             bufferTypeArgument = bufferTypeArgument
+            assocCacheCapacity = assocCacheCapacity
         }
 
     writeSpecToFile generatorState spec compiledSpec

tests/FsYacc.Core.Tests/AssocCacheCapacity.fs

@@ -0,0 +1,65 @@
+module FsYacc.Core.Tests.AssocCacheCapacity
+
+open System.IO
+open Expecto
+open FsLexYacc.FsYacc.Driver
+
+// Generates a parser from a minimal grammar and returns the generated source text,
+// so we can assert on the `engine` line that invokes the runtime interpreter.
+let private generateParser (capacity: int option) =
+    let grammar =
+        "%token <int> NUM\n\
+         %token EOF\n\
+         %start start\n\
+         %type <int> start\n\
+         %%\n\
+         start: NUM EOF { $1 }\n"
+    let input = Path.GetTempFileName()
+    let output = Path.GetTempFileName()
+    File.WriteAllText(input, grammar)
+    try
+        let spec =
+            match readSpecFromFile input None with
+            | Ok s -> s
+            | Result.Error(e, line, col) -> failwithf "grammar failed to parse (%d,%d): %s" line col e.Message
+        use logger = new NullLogger() :> Logger
+        let compiled = compileSpec spec logger
+        let state =
+            { GeneratorState.Default with
+                input = input
+                output = Some output
+                modname = Some "TestParser"
+                parslib = "FSharp.Text.Parsing"
+                lexlib = "FSharp.Text.Lexing"
+                assocCacheCapacity = capacity }
+        writeSpecToFile state spec compiled
+        File.ReadAllText output
+    finally
+        File.Delete input
+        if File.Exists output then File.Delete output
+
+// fsyacc's spec compiler carries process-global mutable state, so the two generation
+// runs must not execute concurrently with each other or with the rest of the suite.
+[<Tests>]
+let assocCacheCapacityTests =
+    testSequenced
+    <| testList "fsyacc --assoc-cache-capacity" [
+        test "explicit capacity emits the 4-arg Interpret overload" {
+            let generated = generateParser (Some 0)
+            Expect.stringContains
+                generated
+                "tables.Interpret(lexer, lexbuf, startState, 0)"
+                "generated engine should pass the configured capacity to Interpret"
+        }
+
+        test "no capacity emits the default 3-arg Interpret" {
+            let generated = generateParser None
+            Expect.stringContains
+                generated
+                "tables.Interpret(lexer, lexbuf, startState)"
+                "generated engine should use the parameterless Interpret overload"
+            Expect.isFalse
+                (generated.Contains "tables.Interpret(lexer, lexbuf, startState,")
+                "generated engine should not include a capacity argument when the flag is absent"
+        }
+    ]

tests/FsYacc.Core.Tests/FsYacc.Core.Tests.fsproj

@@ -8,6 +8,7 @@
 
   <ItemGroup>
     <Compile Include="Sample.fs" />
+    <Compile Include="AssocCacheCapacity.fs" />
     <Compile Include="Main.fs" />
   </ItemGroup>
 

tests/JsonLexAndYaccExample/Program.fs

@@ -1,6 +1,7 @@
 
 module Program
 open FSharp.Text.Lexing
+open FSharp.Text.Parsing
 open JsonParsing
 
 [<EntryPoint>]
@@ -30,7 +31,36 @@ let main argv =
     complexJson |> parse |> ignore
 
 
-    //test lexing error 
+    // Capacity-invariance check (issue #54): the AssocTable cache initial capacity is a pure
+    // allocation-tuning knob and must never change parse results. The generated `Parser.start`
+    // reads ParseSettings.AssocTableCacheInitialCapacity, so setting it here drives the runtime
+    // interpreter that both the default and the --assoc-cache-capacity code paths funnel into.
+    // Parse each input at the historical default and at a range of capacities; results must match.
+    let parseWith capacity json =
+        ParseSettings.AssocTableCacheInitialCapacity <- capacity
+        parse json
+
+    let baselineCapacity = 2000
+    let capacitiesUnderTest = [ 0; 1; 64; 100000 ]
+    let invarianceInputs = [ simpleJson; simpleJson2; complexJson ]
+
+    let mismatches =
+        [ for json in invarianceInputs do
+            let baseline = parseWith baselineCapacity json
+            for capacity in capacitiesUnderTest do
+                if parseWith capacity json <> baseline then
+                    yield capacity ]
+
+    ParseSettings.AssocTableCacheInitialCapacity <- baselineCapacity
+
+    if List.isEmpty mismatches then
+        printfn "Capacity-invariance OK across capacities %A" (baselineCapacity :: capacitiesUnderTest)
+    else
+        eprintfn "Capacity-invariance FAILED: parse results differed at capacities %A" (List.distinct mismatches)
+        exit 1
+
+
+    //test lexing error
     try
         let simpleJson = "{\"f\"\n" + "\n" + ";"
         let parseResult = simpleJson |> parse