Modified the table back-end to merge the sub-modules [MenhirInterpreter]

and [Inspection].

demos/calc-incremental/calc.ml

@@ -30,7 +30,7 @@ let height env =
 (* Printing a symbol. *)
 
 let print_symbol symbol =
-  let open Parser.Inspection in
+  let open I in
   match symbol with
   | X (T T_TIMES) ->
       "*"
@@ -56,10 +56,7 @@ let print_symbol symbol =
       "error"
 
 module P =
-  Printers.Make(struct
-    include Parser.MenhirInterpreter
-    include Parser.Inspection
-  end) (struct
+  Printers.Make(I) (struct
     let arrow = " -> "
     let dot = "."
     let space = " "
@@ -71,12 +68,12 @@ module P =
 let print_element e =
   match e with
   | I.Element (s, v, _, _) ->
-    print_symbol (Parser.Inspection.X (Parser.Inspection.incoming_symbol s))
+    print_symbol (I.X (I.incoming_symbol s))
 
 let print_element e : string =
   match e with
   | I.Element (s, v, _, _) ->
-      let open Parser.Inspection in
+      let open I in
       match incoming_symbol s with
       | T T_TIMES ->
           "*"
@@ -121,7 +118,7 @@ let dump env =
       ()
   | I.Cons (I.Element (current, _, _, _), _) ->
       Printf.fprintf stderr "Current state: %d\n%!" (Obj.magic current);
-      let items = Parser.Inspection.items current in
+      let items = I.items current in
       Printf.fprintf stderr "#Items: %d\n%!" (List.length items);
       List.iter (fun item ->
         Printf.fprintf stderr "%s\n%!" (P.print_item item)

src/interface.ml

@@ -34,27 +34,12 @@ let interpreter =
 let result t =
   TypApp (interpreter ^ ".result", [ t ])
 
-let raw_lr1state =
-  "lr1state"
-
 let lr1state =
-  interpreter ^ "." ^ raw_lr1state
+  "lr1state"
 
 let tlr1state a : typ =
   TypApp (lr1state, [a])
 
-(* This interface item is a re-definition of the type [lr1state] as
-   an abbreviation for [MenhirInterpreter.lr1state]. *)
-
-let lr1state_redef =
-  let a = "a" in
-  IITypeDecls [{
-    typename = raw_lr1state;
-    typeparams = [ a ];
-    typerhs = TAbbrev (tlr1state (TypVar a));
-    typeconstraint = None
-  }]
-
 (* -------------------------------------------------------------------------- *)
 
 (* The name of the sub-module that contains the incremental entry points. *)
@@ -98,6 +83,35 @@ let monolithic_api grammar =
 
 (* -------------------------------------------------------------------------- *)
 
+(* The inspection API. *)
+
+let inspection_api grammar () =
+
+  let a = "a" in
+
+  (* Define the types [terminal] and [nonterminal]. *)
+
+  TokenType.tokengadtdef grammar @
+  NonterminalType.nonterminalgadtdef grammar @
+
+  (* Include the signature that lists the inspection functions, with
+     appropriate type instantiations. *)
+
+  IIComment "The inspection API." ::
+  IIInclude (
+    with_types WKDestructive
+      "MenhirLib.IncrementalEngine.INSPECTION" [
+        [ a ], "lr1state", tlr1state (TypVar a);
+        [], "production", TypApp ("production", []);
+        [ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
+        [ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a)
+      ]
+  ) ::
+
+  []
+
+(* -------------------------------------------------------------------------- *)
+
 (* The incremental API. *)
 
 let incremental_engine () : module_type =
@@ -129,56 +143,22 @@ let incremental_api grammar () : interface =
     MTSigEnd (
       IIComment "The incremental API." ::
       IIInclude (incremental_engine()) ::
-      []
+      listiflazy Settings.inspection (inspection_api grammar)
     )
   ) ::
 
+  (* The entry points must come after the incremental API, because
+     their type refers to the type [result]. *)
   incremental_entry_points grammar
 
 (* -------------------------------------------------------------------------- *)
 
-(* The inspection API. *)
-
-let inspection_api grammar () =
-
-  let a = "a" in
-
-  IIComment "The inspection API." ::
-  IIModule (inspection, MTSigEnd (
-
-    (* Define the types [terminal] and [nonterminal]. *)
-
-    TokenType.tokengadtdef grammar @
-    NonterminalType.nonterminalgadtdef grammar @
-
-    (* Include the signature that lists the inspection functions, with
-       appropriate type instantiations. *)
-
-    IIComment "The inspection functions." ::
-    IIInclude (
-      with_types WKDestructive
-        "MenhirLib.IncrementalEngine.INSPECTION" [
-          [ a ], "lr1state", tlr1state (TypVar a);
-          [], "production", TypApp ("MenhirInterpreter.production", []);
-          [ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
-          [ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a)
-        ]
-    ) ::
-
-    []
-
-  )) ::
-  []
-
-(* -------------------------------------------------------------------------- *)
-
 (* The complete interface of the generated parser. *)
 
 let interface grammar = [
   IIFunctor (grammar.parameters,
     monolithic_api grammar @
-    listiflazy Settings.table (incremental_api grammar) @
-    listiflazy Settings.inspection (inspection_api grammar)
+    listiflazy Settings.table (incremental_api grammar)
   )
 ]
 

src/interface.mli

@@ -18,12 +18,6 @@ val interpreter: string
 
 val result: IL.typ -> IL.typ
 
-(* The type ['a lr1state], defined by the interpreter sub-module. *)
-
-val lr1state: string
-val tlr1state: IL.typ -> IL.typ
-val lr1state_redef: IL.interface_item
-
 (* The name of the sub-module that contains the incremental entry points. *)
 
 val incremental: string

src/tableBackend.ml

@@ -16,11 +16,8 @@ module Run (T : sig end) = struct
 let menhirlib =
   "MenhirLib"
 
-let tableInterpreter =
-  menhirlib ^ ".TableInterpreter"
-
-let make =
-  tableInterpreter ^ ".Make"
+let make_engine =
+  menhirlib ^ ".TableInterpreter.Make"
 
 let make_symbol =
   menhirlib ^ ".InspectionTableInterpreter.Symbols"
@@ -64,14 +61,22 @@ let entry =
 let start =
   interpreter ^ ".start"
 
+(* The following are names of internal sub-modules. *)
+
 let basics =
-  "Basics" (* name of an internal sub-module *)
+  "Basics"
 
 let tables =
-  "Tables" (* name of an internal sub-module *)
+  "Tables"
+
+let symbols =
+  "Symbols"
+
+let shared =
+  "Shared"
 
-let more =
-  "More" (* name of an internal sub-module *)
+let ti =
+  "TI"
 
 (* ------------------------------------------------------------------------ *)
 
@@ -934,11 +939,23 @@ let program =
 
     (* Define the tables. *)
 
+    SIModuleDef (shared,
+      MStruct [
+        SIValDefs (false, [
+          lhs;
+        ])
+      ]
+    ) ::
+
     SIModuleDef (tables,
       MStruct [
         (* The internal sub-module [basics] contains the definitions of the
            exception [Error] and of the type [token]. *)
         SIInclude (MVar basics);
+        (* The internal sub-module [shared] contains the tables that are
+           used both in normal mode and in [--inspection] mode. *)
+        SIInclude (MVar shared);
+
         (* This is a non-recursive definition, so none of the names
            defined here are visible in the semantic actions. *)
         SIValDefs (false, [
@@ -949,7 +966,7 @@ let program =
           error;
           start_def;
           action;
-          lhs;
+          (* [lhs] is part of [shared] *)
           goto;
           semantic_action;
           trace;
@@ -957,43 +974,40 @@ let program =
       ]
     ) ::
 
-    (* Apply the functor [TableInterpreter.Make] to the tables. *)
+    SIModuleDef (interpreter, MStruct (
 
-    SIModuleDef (interpreter,
-      MApp (MVar make, MVar tables)
-    ) ::
+      (* Apply the functor [TableInterpreter.Make] to the tables. *)
+      SIModuleDef (ti, MApp (MVar make_engine, MVar tables)) ::
+      SIInclude (MVar ti) ::
 
-    listiflazy Settings.inspection (fun () -> [
-      SIModuleDef (inspection, MStruct (
+      listiflazy Settings.inspection (fun () ->
 
-        (* Define the internal sub-module [more], which contains type
+        (* Define the internal sub-module [symbols], which contains type
            definitions. Then, include this sub-module. This sub-module is used
            again below, as part of the application of the functor
            [TableInterpreter.MakeInspection]. *)
 
-        SIModuleDef (more, MStruct (
+        SIModuleDef (symbols, MStruct (
           interface_to_structure (
             tokengadtdef grammar @
             nonterminalgadtdef grammar
           )
         )) ::
 
-        SIInclude (MVar more) ::
+        SIInclude (MVar symbols) ::
 
         SIInclude (MApp (MVar make_inspection, MStruct (
           (* This module must satisfy [InspectionTableFormat.TABLES]. *)
           (* [lr1state] *)
-          interface_to_structure [
-            lr1state_redef;
-          ] @
+          SIInclude (MVar ti) ::
           (* [terminal], [nonterminal]. *)
-          SIInclude (MVar more) ::
+          SIInclude (MVar symbols) ::
           (* This functor application builds the types [symbol] and [xsymbol]
              in terms of the types [terminal] and [nonterminal]. This saves
              us the trouble of generating these definitions. *)
-          SIInclude (MApp (MVar make_symbol, MVar more)) ::
+          SIInclude (MApp (MVar make_symbol, MVar symbols)) ::
           (* [lhs] *)
-          SIInclude (MVar tables) ::
+          SIInclude (MVar shared) ::
           SIValDefs (false,
             terminal() ::
             nonterminal() ::
@@ -1008,9 +1022,9 @@ let program =
 
         []
 
-      ))
+      )
 
-    ]) @
+    )) ::
 
     SIValDefs (false, monolithic_api) ::