The beginning of a second layer of tables and functors,

  to support --inspection.
The signature IncrementalEngine.INSPECTION documents what the user sees.
The signature TableFormat.INSPECTION_TABLES documents what we generate.
The functor TableInterpreter.MakeInspection bridges the gap.

TODO

+* Generation: cleanup Interface.
+  symbol and xsymbol could be constructed by the library instead
+  of being generated?
+
 * IncrementalEngine: document [lr1state], [element], [view].
 
 * Define MenhirLib.Stream?

src/IncrementalEngine.ml

@@ -89,3 +89,18 @@ module type INCREMENTAL_ENGINE = sig
   val view: env -> element stream
 
 end
+
+(* TEMPORARY comment/document *)
+
+module type INSPECTION = sig
+
+  type xsymbol
+
+  type production
+
+  val lhs: production -> xsymbol
+
+  val rhs: production -> xsymbol list
+
+end
+

src/codeBits.ml

@@ -213,3 +213,11 @@ let interface_item_to_structure_item = function
 let interface_to_structure i =
   List.flatten (List.map interface_item_to_structure_item i)
 
+(* Constructing a named module type together with a list of "with type"
+   constraints. *)
+
+let with_types wk name tys =
+  List.fold_left (fun mt (name, ty) ->
+    MTWithType (mt, name, wk, ty)
+  ) (MTNamedModuleType name) tys
+

src/codeBits.mli

@@ -82,3 +82,7 @@ val tvprefix: string -> string
    go through. *)
 val interface_to_structure: interface -> structure
 
+(* Constructing a named module type together with a list of "with type"
+   constraints. *)
+val with_types: IL.with_kind -> string -> (string * IL.typ) list -> IL.module_type
+

src/interface.ml

@@ -84,12 +84,12 @@ let incremental_api grammar () =
   IIComment "The incremental API." ::
   IIModule (
     interpreter,
-    MTWithType (
-      MTNamedModuleType "MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE",
-      "token", (* NOT [tctoken], which is qualified if [--external-tokens] is used *)
-      WKDestructive,
-      TokenType.ttoken
-    )
+    with_types WKDestructive
+      "MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE"
+      [
+        "token", (* NOT [tctoken], which is qualified if [--external-tokens] is used *)
+        TokenType.ttoken
+      ]
   ) ::
 
   IIComment "The entry point(s) to the incremental API." ::
@@ -127,6 +127,14 @@ let inspection_api grammar () =
       "symbol", type2scheme ty
     ] ::
 
+    IIInclude (
+      with_types WKDestructive
+        "MenhirLib.IncrementalEngine.INSPECTION" [
+          "xsymbol", TypApp ("xsymbol", []); (* TEMPORARY *)
+          "production", tint (* TEMPORARY *)
+        ]
+    ) ::
+
     []
 
   )) ::

src/tableBackend.ml

@@ -23,6 +23,9 @@ let tableInterpreter =
 let make =
   tableInterpreter ^ ".Make"
 
+let make_inspection =
+  tableInterpreter ^ ".MakeInspection"
+
 let accept =
   tableInterpreter ^ ".Accept"
 
@@ -68,6 +71,9 @@ let lr1state =
 let basics =
   "Basics" (* name of an internal sub-module *)
 
+let more =
+  "More" (* name of an internal sub-module *)
+
 (* ------------------------------------------------------------------------ *)
 
 (* Code generation for semantic actions. *)
@@ -899,18 +905,33 @@ let program =
     listiflazy Settings.inspection (fun () -> [
       SIModuleDef (inspection, MStruct (
 
-        interface_to_structure (
-          tokengadtdef grammar @
-          nonterminalgadtdef grammar @
-          symbolgadtdef() @
-          xsymboldef()
-        ) @
+        (* Define the internal sub-module [more], 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 (
+          interface_to_structure (
+            tokengadtdef grammar @
+            nonterminalgadtdef grammar @
+            symbolgadtdef() @
+            xsymboldef()
+          )
+        )) ::
+
+        SIInclude (MVar more) ::
 
         SIValDefs (false, [
-          incoming_symbol_def();
-          production_defs()
+          incoming_symbol_def()
         ]) ::
 
+        SIInclude (MApp (MVar make_inspection, MStruct [
+          SIInclude (MVar more);
+          SIValDefs (false, [
+            production_defs()
+          ])
+        ])) ::
+
         []
 
       ))

src/tableFormat.ml

 (* This signature defines the format of the parse tables. It is used as
-   an argument to [TableInterpreter]. *)
+   an argument to [TableInterpreter.Make]. *)
 
 module type TABLES = sig
 
@@ -115,3 +115,18 @@ module type TABLES = sig
 
 end
 
+(* This signature defines the format of the tables that are produced (in
+   addition to the above) when [--inspection] is enabled. It is used as an
+   argument to [TableInterpreter.Inspection]. *)
+
+module type INSPECTION_TABLES = sig
+
+  type xsymbol
+
+  (* The definition (i.e. left-hand side and right-hand side) of every
+     (non-start) production. *)
+
+  val production_defs: (xsymbol * xsymbol list) option array
+
+end
+

src/tableInterpreter.ml

@@ -166,3 +166,26 @@ module Make (T : TableFormat.TABLES)
   end
   
 end)
+
+(* This functor constructs the inspection API. *)
+
+module MakeInspection (T : TableFormat.INSPECTION_TABLES) = struct
+
+  let production_def prod =
+    assert (0 <= prod && prod < Array.length T.production_defs);
+    match T.production_defs.(prod) with
+    | None ->
+        (* should not happen; means [prod] is a start production *)
+        assert false
+    | Some data ->
+        data
+
+  let lhs prod =
+    let lhs, _ = production_def prod in
+    lhs
+
+  let rhs prod =
+    let _, rhs = production_def prod in
+    rhs
+
+end

src/tableInterpreter.mli

@@ -17,3 +17,12 @@ module Make (T : TableFormat.TABLES)
                            and type token = T.token
 			   and type semantic_value = Obj.t
 
+(* This functor is also invoked inside the generated parser. It
+   constructs the inspection API on top of the inspection tables. *)
+
+module MakeInspection (T : TableFormat.INSPECTION_TABLES)
+
+: IncrementalEngine.INSPECTION
+  with type xsymbol := T.xsymbol
+   and type production := int
+