The generation of the inspection API is now subject to --inspection.

demos/calc-incremental/Makefile

@@ -9,7 +9,7 @@ endif
 # We assume that menhirLib has been installed in such a
 # way that ocamlfind knows about it.
 
-MENHIRFLAGS     := --infer --table
+MENHIRFLAGS     := --infer --table --inspection
 
 OCAMLBUILD      := ocamlbuild -use-ocamlfind -use-menhir -menhir "$(MENHIR) $(MENHIRFLAGS)" -package menhirLib
 

src/interface.ml

@@ -2,7 +2,9 @@ open UnparameterizedSyntax
 open IL
 open CodeBits
 
-(* This is the [Error] exception. *)
+(* -------------------------------------------------------------------------- *)
+
+(* The [Error] exception. *)
 
 let excname =
   "Error"
@@ -16,12 +18,16 @@ let excredef = {
   excdef with exceq = Some excname
 }
 
+(* -------------------------------------------------------------------------- *)
+
 (* The type of the monolithic entry point for the start symbol [symbol]. *)
 
 let entrytypescheme grammar symbol =
   let typ = TypTextual (ocamltype_of_start_symbol grammar symbol) in
   type2scheme (marrow [ arrow tlexbuf TokenType.ttoken; tlexbuf ] typ)
 
+(* -------------------------------------------------------------------------- *)
+
 (* When the table back-end is active, the generated parser contains,
    as a sub-module, an application of [Engine.Make]. This sub-module
    is named as follows. *)
@@ -32,6 +38,8 @@ let interpreter =
 let result t =
   TypApp (interpreter ^ ".result", [ t ])
 
+(* -------------------------------------------------------------------------- *)
+
 (* The name of the incremental entry point for the start symbol [symbol]. *)
 
 let incremental symbol =
@@ -46,67 +54,89 @@ let entrytypescheme_incremental grammar symbol =
   let t = TypTextual (ocamltype_of_start_symbol grammar symbol) in
   type2scheme (marrow [ tunit ] (result t))
 
-(* This is the interface of the generated parser. *)
+(* -------------------------------------------------------------------------- *)
 
-let interface grammar = [
-  IIFunctor (grammar.parameters,
+(* The monolithic (traditional) API: the type [token], the exception [Error],
+   and the parser's entry points. *)
+
+let monolithic_api grammar =
+
+  TokenType.tokentypedef grammar @
+
+  IIComment "This exception is raised by the monolithic API functions." ::
+  IIExcDecls [ excdef ] ::
+
+  IIComment "The monolithic API." ::
+  IIValDecls (
+    StringSet.fold (fun symbol decls ->
+      (Misc.normalize symbol, entrytypescheme grammar symbol) :: decls
+    ) grammar.start_symbols []
+  ) ::
+
+  []
+
+(* -------------------------------------------------------------------------- *)
+
+(* The incremental API. *)
+
+let incremental_api grammar () =
 
-    (* The monolithic (traditional) API: the type [token], the exception
-       [Error], and the parser's entry points. *)
-
-    TokenType.tokentypedef grammar @
-
-    IIComment "This exception is raised by the monolithic API functions." ::
-    IIExcDecls [ excdef ] ::
-
-    IIComment "The monolithic API." ::
-    IIValDecls (
-      StringSet.fold (fun symbol decls ->
-        (Misc.normalize symbol, entrytypescheme grammar symbol) :: decls
-      ) grammar.start_symbols []
-    ) ::
-
-    (* The incremental engine and API. *)
-
-    listiflazy Settings.table (fun () -> [
-      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
-        )
-      );
-      IIComment "The entry point(s) to the incremental API.";
-      IIValDecls (
-        StringSet.fold (fun symbol decls ->
-          (incremental symbol, entrytypescheme_incremental grammar symbol) :: decls
-        ) grammar.start_symbols []
-      )
-    ]) @
-
-    (* The inspection API. *)
-
-    listiflazy Settings.table (fun () ->
-      TokenType.tokengadtdef grammar @
-      NonterminalType.nonterminalgadtdef grammar @
-      SymbolType.symbolgadtdef grammar @
-      (* TEMPORARY emit a comment *)
-      IIValDecls [
-        let ty =
-          arrow (TypApp (interpreter ^ ".lr1state", [ TypVar "a" ]))
-                (TypApp ("symbol", [ TypVar "a" ]))
-        in
-        (* TEMPORARY code sharing with tableBackend *)
-        "symbol", type2scheme ty
-      ] ::
-      []
+  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
     )
+  ) ::
+
+  IIComment "The entry point(s) to the incremental API." ::
+  IIValDecls (
+    StringSet.fold (fun symbol decls ->
+      (incremental symbol, entrytypescheme_incremental grammar symbol) :: decls
+    ) grammar.start_symbols []
+  ) ::
+
+  []
+
+(* -------------------------------------------------------------------------- *)
+
+(* The inspection API. *)
+
+let inspection_api grammar () =
+
+  TokenType.tokengadtdef grammar @
+  NonterminalType.nonterminalgadtdef grammar @
+  SymbolType.symbolgadtdef() @
+
+  (* TEMPORARY emit a comment *)
+  IIValDecls [
+    let ty =
+      arrow (TypApp (interpreter ^ ".lr1state", [ TypVar "a" ]))
+            (TypApp ("symbol", [ TypVar "a" ]))
+    in
+    (* TEMPORARY code sharing with tableBackend *)
+    "symbol", type2scheme ty
+  ] ::
+
+  []
+
+(* -------------------------------------------------------------------------- *)
+
+(* 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)
   )
 ]
 
+(* -------------------------------------------------------------------------- *)
+
 (* Writing the interface to a file. *)
 
 let write grammar () =

src/nonterminalType.ml

@@ -22,9 +22,10 @@ let tnonterminalgadtdata nt =
 exception MissingOCamlType
 
 let nonterminalgadtdef grammar =
-  assert Settings.table;
-  try
-    let datadefs =
+  assert Settings.inspection;
+  let comment, datadefs =
+    try
+      "The indexed type of nonterminal symbols.",
       List.fold_left (fun defs nt ->
         let index =
           match ocamltype_of_symbol grammar nt with
@@ -39,17 +40,21 @@ let nonterminalgadtdef grammar =
           datatypeparams = Some [ index ]
         } :: defs
       ) [] (nonterminals grammar)
-    in
-    [
-      IIComment "The indexed type of nonterminal symbols.";
-      IITypeDecls [{
-        typename = tcnonterminalgadt;
-        typeparams = [ "_" ];
-        typerhs = TDefSum datadefs;
-        typeconstraint = None
-      }]
-    ]
-  with MissingOCamlType ->
-    (* If the type of some nonterminal symbol is unknown, give up
-       on the whole thing. *)
-    []
+    with MissingOCamlType ->
+      (* If the type of some nonterminal symbol is unknown, give up
+         and define ['a nonterminal] as an abstract type. This is
+         useful when we are in [--(raw)-depend] mode and we do not
+         wish to fail. Instead, we produce a mock [.mli] file that
+         is an approximation of the real [.mli] file. *)
+      "The indexed type of nonterminal symbols (mock!).",
+      []
+  in
+  [
+    IIComment comment;
+    IITypeDecls [{
+      typename = tcnonterminalgadt;
+      typeparams = [ "_" ];
+      typerhs = TDefSum datadefs;
+      typeconstraint = None
+    }]
+  ]

src/nonterminalType.mli

@@ -16,7 +16,8 @@ val tnonterminalgadtdata: string -> string
    generators. This definition can be constructed only if the type of every
    nonterminal symbol is known, either because the user has provided this
    information, or because [--infer] has been set and inference has been
-   performed already. This definition is produced only in [--table] mode. *)
+   performed already. This definition is produced only in [--inspection]
+   mode. *)
 
 val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface
 

src/settings.ml

@@ -173,7 +173,7 @@ let options = Arg.align [
   "--follow-construction", Arg.Set follow, " (undocumented)";
   "--graph", Arg.Set graph, " Write grammar's dependency graph to <basename>.dot";
   "--infer", Arg.Set infer, " Invoke ocamlc for ahead of time type inference";
-  "--inspection", Arg.Set inspection, " Generate an inspection API (requires --table)";
+  "--inspection", Arg.Set inspection, " Generate the inspection API (requires --table)";
   "--interpret", Arg.Set interpret, " Interpret the sentences provided on stdin";
   "--interpret-show-cst", Arg.Set interpret_show_cst, " Show a concrete syntax tree upon acceptance";
   "--log-automaton", Arg.Set_int logA, "<level> Log information about the automaton";

src/settings.mli

@@ -131,6 +131,11 @@ val interpret_show_cst : bool
 
 val table : bool
 
+(* Whether to generate the inspection API (which requires GADTs, and
+   requires producing more tables). *)
+
+val inspection : bool
+
 (* Whether to generate a coq description of the grammar and automaton. *)
 
 val coq : bool

src/symbolType.ml

@@ -20,33 +20,27 @@ let dataN =
 
 (* The definition of the symbol GADT. *)
 
-let symbolgadtdef grammar =
-  assert Settings.table;
-  (* This definition can be produced only if we are successfully able
-     to construct the nonterminal GADT. *)
-  match NonterminalType.nonterminalgadtdef grammar with
-  | [] ->
-      []
-  | _ :: _ ->
-      let a = "a" in
-      let datadefs =
-        {
-          dataname = dataT;
-          datavalparams = [ TokenType.ttokengadt (TypVar a) ];
-          datatypeparams = Some [ TypVar a ]
-        } ::
-        {
-          dataname = dataN;
-          datavalparams = [ NonterminalType.tnonterminalgadt (TypVar a) ];
-          datatypeparams = Some [ TypVar a ]
-        } ::
-        []
-      in
-      [ IIComment "The indexed type of terminal and nonterminal symbols.";
-        IITypeDecls [{
-          typename = tcsymbolgadt;
-          typeparams = [ a ];
-          typerhs = TDefSum datadefs;
-          typeconstraint = None
-        }]
-      ]
+let symbolgadtdef () =
+  assert Settings.inspection;
+  let a = "a" in
+  let datadefs =
+    {
+      dataname = dataT;
+      datavalparams = [ TokenType.ttokengadt (TypVar a) ];
+      datatypeparams = Some [ TypVar a ]
+    } ::
+    {
+      dataname = dataN;
+      datavalparams = [ NonterminalType.tnonterminalgadt (TypVar a) ];
+      datatypeparams = Some [ TypVar a ]
+    } ::
+    []
+  in
+  [ IIComment "The indexed type of terminal and nonterminal symbols.";
+    IITypeDecls [{
+      typename = tcsymbolgadt;
+      typeparams = [ a ];
+      typerhs = TDefSum datadefs;
+      typeconstraint = None
+    }]
+  ]

src/symbolType.mli

@@ -10,5 +10,5 @@ val dataN: string
 (* The definition of the symbol GADT. This definition can be produced only if
    we are successfully able to construct the nonterminal GADT first. *)
 
-val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.interface
+val symbolgadtdef: unit -> IL.interface
 

src/tableBackend.ml

@@ -778,8 +778,6 @@ let tlr1state a : typ =
 (* Produce a function [symbol] that maps a state of type ['a lr1state]
    (represented as an integer value) to a value of type ['a symbol]. *)
 
-(* TEMPORARY maybe subject to a switch, so as to reduce table size *)
-
 let incoming_symbol_def = {
   valpublic = true;
   valpat = PVar "symbol";
@@ -858,13 +856,19 @@ let program =
 
     SIValDefs (false, api) ::
 
-    interface_to_structure (
-      tokengadtdef grammar @
-      nonterminalgadtdef grammar @
-      symbolgadtdef grammar
-    ) @
+    listiflazy Settings.inspection (fun () ->
+
+      interface_to_structure (
+        tokengadtdef grammar @
+        nonterminalgadtdef grammar @
+        symbolgadtdef()
+      ) @
 
-    SIValDefs (false, [incoming_symbol_def]) ::
+      SIValDefs (false, [incoming_symbol_def]) ::
+
+      []
+
+    ) @
 
     SIStretch grammar.postludes ::
 

src/tokenType.ml

@@ -66,12 +66,12 @@ let tokentypedef grammar =
 (* This is the definition of the token GADT. Here, the data
    constructors have no value argument, but have a type index. *)
 
-(* The token GADT is produced only in [--table] mode. This ensures that, when
-   [--table] is off, we remain compatible with old versions of OCaml, without
-   GADTs. *)
+(* The token GADT is produced only when [Settings.inspection] is true. Thus,
+   when [Settings.inspection] is false, we remain compatible with old versions
+   of OCaml, without GADTs. *)
 
 let tokengadtdef grammar =
-  assert Settings.table;
+  assert Settings.inspection;
   let datadefs =
     StringMap.fold (fun token properties defs ->
       if properties.tk_is_declared then
@@ -114,7 +114,7 @@ let produce_tokentypes grammar =
 
       let i =
         tokentypedef grammar @
-        listiflazy Settings.table (fun () ->
+        listiflazy Settings.inspection (fun () ->
           tokengadtdef grammar
         )
       in

src/tokenType.mli

@@ -5,9 +5,9 @@
    which describes the tokens. A token contains a tag (a terminal symbol)
    and possibly a semantic value. *)
 
-(* In addition to that, in [--table] mode only, we produce a GADT which
-   describes the terminal symbols. A terminal symbol is just a tag; it
-   does not carry a semantic value. *)
+(* In addition to that, in [--inspection] mode only, we produce a GADT which
+   describes the terminal symbols. A terminal symbol is just a tag; it does
+   not carry a semantic value. *)
 
 (* In this module, we also deal with [--only-tokens] and [--external-tokens].
    If [--only-tokens] is specified on the command line, [produce_tokentypes]
@@ -41,8 +41,8 @@ val tokengadtdata: string -> string
 (* The definitions of the token type and of the token GADT, for use by the
    code generators. Each of these lists may define zero or one type. Indeed,
    both lists are empty when [--external-tokens] is set. Otherwise, only the
-   type [token] is defined when not in [--table] mode, and both [token] and
-   [terminal] are defined when in [--table] mode. *)
+   type [token] is defined always, and the type [terminal] is defined only in
+   [--inspection] mode. *)
 
 val tokentypedef: UnparameterizedSyntax.grammar -> IL.interface
 val tokengadtdef: UnparameterizedSyntax.grammar -> IL.interface