Cleanup. Removed a few horrible functions in [Interface] that were used

to insert comments a posteriori. Now done a priori where appropriate.

src/codeBackend.ml

@@ -1624,19 +1624,22 @@ let initenvdef =
 (* ------------------------------------------------------------------------ *)
 (* Here is complete code for the parser. *)
 
+let grammar =
+  Front.grammar
+
 let program = {
 
   paramdefs =
-    Front.grammar.UnparameterizedSyntax.parameters;
+    grammar.UnparameterizedSyntax.parameters;
 
   prologue =
-    Front.grammar.UnparameterizedSyntax.preludes;
+    grammar.UnparameterizedSyntax.preludes;
 
   excdefs =
     [ excdef ];
 
   typedefs =
-    tokentypedefs Front.grammar @
+    filter_typedefs (tokentypedefs grammar) @
     [ envtypedef; statetypedef ];
 
   nonrecvaldefs =
@@ -1662,7 +1665,7 @@ let program = {
     [];
 	
   postlogue =
-    Front.grammar.UnparameterizedSyntax.postludes
+    grammar.UnparameterizedSyntax.postludes
 
 } 
 

src/codeBits.ml

@@ -150,3 +150,15 @@ let tvprefix name =
     name
   else
     "ttv_" ^ name
+
+(* ------------------------------------------------------------------------ *)
+
+let filter_typedefs (items : interface_item list) : typedef list =
+  List.flatten (List.map (fun item ->
+    match item with
+    | IITypeDecls defs ->
+        defs
+    | _ ->
+        []
+  ) items)
+

src/codeBits.mli

@@ -53,3 +53,8 @@ val marrow: typ list -> typ -> typ
 val prefix: string -> string
 val dataprefix: string -> string
 val tvprefix: string -> string
+
+(* Projecting interface items to typedefs. Any interface items other
+   than typedefs are lost. *)
+val filter_typedefs: interface_item list -> typedef list
+

src/infer.ml

@@ -184,7 +184,7 @@ let program grammar =
     paramdefs = grammar.parameters;
     prologue = grammar.preludes;
     excdefs = [];
-    typedefs = tokentypedefs grammar;
+    typedefs = filter_typedefs (tokentypedefs grammar);
     nonrecvaldefs = [ begindef; def; enddef ];
     moduledefs = [];
     valdefs = [];

src/interface.ml

@@ -43,42 +43,6 @@ let entrytypescheme_incremental grammar symbol =
   let t = TypTextual (ocamltype_of_start_symbol grammar symbol) in
   type2scheme (marrow [ tunit ] (result t))
 
-(* Inserting comments into the definitions of the types of tokens. Not pretty. *)
-
-let tokentypedefs grammar =
-  let defs = TokenType.tokentypedefs grammar in
-  match defs with
-  | [] ->
-      []
-  | [_] ->
-      [ IIComment "The type of tokens."; IITypeDecls defs ]
-  | def1 :: def2 :: _ ->
-      [ IIComment "The type of tokens.";
-        IITypeDecls [def1];
-        IIComment "The indexed type of terminal symbols.";
-        IITypeDecls [def2];
-      ]
-
-let nonterminalgadtdef grammar =
-  let defs = NonterminalType.nonterminalgadtdef grammar in
-  match defs with
-  | [] ->
-      []
-  | def :: _ ->
-      [ IIComment "The indexed type of nonterminal symbols.";
-        IITypeDecls [def]
-      ]
-
-let symbolgadtdef grammar =
-  let defs = SymbolType.symbolgadtdef grammar in
-  match defs with
-  | [] ->
-      []
-  | def :: _ ->
-      [ IIComment "The indexed type of (terminal and nonterminal) symbols.";
-        IITypeDecls [def]
-      ]
-
 (* This is the interface of the generated parser -- only the part
    that is specific of the table back-end. *)
 
@@ -106,9 +70,9 @@ let table_interface grammar =
 
 let interface grammar = [
   IIFunctor (grammar.parameters,
-    tokentypedefs grammar @
-    nonterminalgadtdef grammar @
-    symbolgadtdef grammar @ [
+    TokenType.tokentypedefs grammar @
+    NonterminalType.nonterminalgadtdef grammar @
+    SymbolType.symbolgadtdef grammar @ [
     IIComment "This exception is raised by the monolithic API functions.";
     IIExcDecls [ excdef ];
     IIComment "The monolithic API.";

src/nonterminalType.ml

@@ -40,12 +40,15 @@ let nonterminalgadtdef grammar =
           } :: defs
         ) [] (nonterminals grammar)
       in
-      [{
-        typename = tcnonterminalgadt;
-        typeparams = [ "_" ];
-        typerhs = TDefSum datadefs;
-        typeconstraint = None
-      }]
+      [
+        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. *)

src/nonterminalType.mli

@@ -13,7 +13,7 @@ val tnonterminalgadt: IL.typ -> IL.typ
    information, or because [--infer] has been set and inference has been
    performed already. This definition is produced only in [--table] mode. *)
 
-val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.typedef list
+val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface_item list
 
 (* When in [--(raw-)depend] mode, we are asked to produce a mock [.mli] file
    before [--infer] has run, which means that we are usually not able to

src/symbolType.ml

@@ -41,10 +41,11 @@ let symbolgadtdef grammar =
         } ::
         []
       in
-      [{
-        typename = tcsymbolgadt;
-        typeparams = [ a ];
-        typerhs = TDefSum datadefs;
-        typeconstraint = None
-      }]
-
+      [ IIComment "The indexed type of terminal and nonterminal symbols.";
+        IITypeDecls [{
+          typename = tcsymbolgadt;
+          typeparams = [ a ];
+          typerhs = TDefSum datadefs;
+          typeconstraint = None
+        }]
+      ]

src/symbolType.mli

@@ -5,5 +5,5 @@ val tsymbolgadt: IL.typ -> IL.typ
 (* 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.typedef list
+val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.interface_item list
 

src/tableBackend.ml

@@ -763,9 +763,9 @@ let program = {
     [ excdef ];
 
   typedefs =
-    tokentypedefs grammar @
-    nonterminalgadtdef grammar @
-    symbolgadtdef grammar @
+    filter_typedefs (tokentypedefs grammar) @
+    filter_typedefs (nonterminalgadtdef grammar) @
+    filter_typedefs (symbolgadtdef grammar) @
     [ tokendef1 ];
 
   nonrecvaldefs =

src/tokenType.ml

@@ -53,12 +53,15 @@ let tokentypedef grammar =
 	defs
     ) grammar.tokens []
   in
-  {
-    typename = tctoken;
-    typeparams = [];
-    typerhs = TDefSum datadefs;
-    typeconstraint = None
-  }
+  [
+    IIComment "The type of tokens.";
+    IITypeDecls [{
+      typename = tctoken;
+      typeparams = [];
+      typerhs = TDefSum datadefs;
+      typeconstraint = None
+    }]
+  ]
 
 (* This is the definition of the token GADT. Here, the data
    constructors have no value argument, but have a type index. *)
@@ -83,12 +86,15 @@ let tokengadtdef grammar =
 	defs
     ) grammar.tokens []
   in
-  {
-    typename = tctokengadt;
-    typeparams = [ "_" ];
-    typerhs = TDefSum datadefs;
-    typeconstraint = None
-  }
+  [
+    IIComment "The indexed type of terminal symbols.";
+    IITypeDecls [{
+      typename = tctokengadt;
+      typeparams = [ "_" ];
+      typerhs = TDefSum datadefs;
+      typeconstraint = None
+    }]
+  ]
 
 (* The token type is always needed. The token GADT is needed only in
    [--table] mode. This ensures that, when [--table] is off, we remain
@@ -96,9 +102,9 @@ let tokengadtdef grammar =
 
 let typedefs grammar =
   if Settings.table then
-    [ tokentypedef grammar; tokengadtdef grammar ]
+    tokentypedef grammar @ tokengadtdef grammar
   else
-    [ tokentypedef grammar ]
+    tokentypedef grammar
 
 (* If we were asked to only produce a type definition, then
    do so and stop. *)
@@ -111,7 +117,7 @@ let produce_tokentypes grammar =
 	 necessary by the fact that the two can be different
 	 when there are functor parameters. *)
 
-      let decls = typedefs grammar in
+      let items = typedefs grammar in
 
       let module P = 
 	Printer.Make (struct 
@@ -121,9 +127,7 @@ let produce_tokentypes grammar =
 		      end) 
       in
       P.interface [
-        IIFunctor (grammar.parameters, [
-	  IITypeDecls decls
-        ])
+        IIFunctor (grammar.parameters, items)
       ];
       let module P = 
 	Printer.Make (struct 
@@ -136,7 +140,7 @@ let produce_tokentypes grammar =
         paramdefs = grammar.parameters;
         prologue = [];
         excdefs = [];
-	typedefs = decls;
+	typedefs = filter_typedefs items;
         nonrecvaldefs = [];
 	valdefs = [];
 	moduledefs = [];

src/tokenType.mli

@@ -38,7 +38,7 @@ val tokenprefix: string -> string
    the type [token] when not in [--table] mode, and the types [token] and
    [terminal] when in [--table] mode. *)
 
-val tokentypedefs: UnparameterizedSyntax.grammar -> IL.typedef list
+val tokentypedefs: UnparameterizedSyntax.grammar -> IL.interface_item list
 
 (* If [--only-tokens] is set, then [produce_tokentypes] writes the type
    definitions to the [.ml] and [.mli] files and stops Menhir. Otherwise,