CodeBits: replaced [filter_types] with [interface_to_structure], which is

more general and correct (the old code could change a set of nonrecursive
type definitions into a set of recursive type definitions).

TODO

-* filter_typedefs
+* simplify Printer.functorparams
 
 * Introduce a submodule Incremental for the incremental entry
   points. Clean up IL to make it more general.

src/codeBackend.ml

@@ -1631,18 +1631,19 @@ let grammar =
 
 let program =
 
-  [ SIFunctor (grammar.parameters, [
+  [ SIFunctor (grammar.parameters,
 
-    SIExcDefs [ excdef ];
+    SIExcDefs [ excdef ] ::
 
-    SITypeDefs (
-      filter_typedefs (tokentypedefs grammar) @
-        [ envtypedef; statetypedef ]
-    );
+    interface_to_structure (
+      tokentypedefs grammar
+    ) @
 
-    SIStretch grammar.preludes;
+    SITypeDefs [ envtypedef; statetypedef ] ::
 
-    SIValDefs (false, [ excvaldef ]);
+    SIStretch grammar.preludes ::
+
+    SIValDefs (false, [ excvaldef ]) ::
 
     SIValDefs (true,
       ProductionMap.fold (fun _ s defs ->
@@ -1659,11 +1660,11 @@ let program =
         else
           defs
       ) [ discarddef; initenvdef; printtokendef; assertfalsedef; errorcasedef ])))
-    );
+    ) ::
 
-    SIStretch grammar.postludes;
+    SIStretch grammar.postludes ::
 
-  ])]
+  [])]
 
 (* ------------------------------------------------------------------------ *)
 (* We are done! *)

src/codeBits.ml

@@ -153,14 +153,21 @@ let tvprefix name =
 
 (* ------------------------------------------------------------------------ *)
 
-let filter_typedefs (items : interface_item list) : typedef list =
-  (* TEMPORARY ideally, should not flatten, as this turns a nonrecursive
-     definition into a recursive one *)
-  List.flatten (List.map (fun item ->
-    match item with
-    | IITypeDecls defs ->
-        defs
-    | _ ->
-        []
-  ) items)
+(* Converting an interface to a structure. Only exception and type definitions
+   go through. *)
+
+let interface_item_to_structure_item = function
+  | IIExcDecls defs ->
+      [ SIExcDefs defs ]
+  | IITypeDecls defs ->
+      [ SITypeDefs defs ]
+  | IIFunctor (_, _)
+  | IIValDecls _
+  | IIInclude _ 
+  | IIModule (_, _)
+  | IIComment _ ->
+      []
+
+let interface_to_structure i =
+  List.flatten (List.map interface_item_to_structure_item i)
 

src/codeBits.mli

@@ -54,7 +54,7 @@ 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
+(* Converting an interface to a structure. Only exception and type definitions
+   go through. *)
+val interface_to_structure: interface -> structure
 

src/infer.ml

@@ -180,12 +180,12 @@ let program grammar =
      tokens, because, in principle, the semantic actions may refer to
      it or to its data constructors. *)
 
-  [ SIFunctor (grammar.parameters, [
-    SITypeDefs (filter_typedefs (tokentypedefs grammar));
-    SIStretch grammar.preludes;
-    SIValDefs (false, [ begindef; def; enddef ]);
-    SIStretch grammar.postludes;
-  ])]
+  [ SIFunctor (grammar.parameters,
+    interface_to_structure (tokentypedefs grammar) @
+    SIStretch grammar.preludes ::
+    SIValDefs (false, [ begindef; def; enddef ]) ::
+    SIStretch grammar.postludes ::
+  [])]
 
 (* ------------------------------------------------------------------------- *)
 (* Writing the program associated with a grammar to a file. *)

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.interface_item list
+val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface
 
 (* 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.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.interface_item list
+val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.interface
 

src/tableBackend.ml

@@ -745,28 +745,29 @@ let grammar =
 
 let program =
  
-  [ SIFunctor (grammar.parameters, [
+  [ SIFunctor (grammar.parameters,
 
-    SIExcDefs [ excdef ];
+    SIExcDefs [ excdef ] ::
 
-    SITypeDefs (
-      filter_typedefs (tokentypedefs grammar) @
-      filter_typedefs (nonterminalgadtdef grammar) @
-      filter_typedefs (symbolgadtdef grammar) @
-      [ tokendef1 ]
-    );
+    interface_to_structure (
+      tokentypedefs grammar @
+      nonterminalgadtdef grammar @
+      symbolgadtdef grammar
+    ) @
 
-    SIStretch grammar.preludes;
+    SITypeDefs [ tokendef1 ] ::
 
-    SIValDefs (false, [ excvaldef ]);
+    SIStretch grammar.preludes ::
 
-    SIModuleDef (interpreter, application);
+    SIValDefs (false, [ excvaldef ]) ::
 
-    SIValDefs (false, api);
+    SIModuleDef (interpreter, application) ::
 
-    SIStretch grammar.postludes;
+    SIValDefs (false, api) ::
 
-  ])]
+    SIStretch grammar.postludes ::
+
+  [])]
 
 let () =
   Time.tick "Producing abstract syntax"

src/tokenType.ml

@@ -117,7 +117,7 @@ let produce_tokentypes grammar =
 	 necessary by the fact that the two can be different
 	 when there are functor parameters. *)
 
-      let items = typedefs grammar in
+      let i = typedefs grammar in
 
       let module P = 
 	Printer.Make (struct 
@@ -127,7 +127,7 @@ let produce_tokentypes grammar =
 		      end) 
       in
       P.interface [
-        IIFunctor (grammar.parameters, items)
+        IIFunctor (grammar.parameters, i)
       ];
       let module P = 
 	Printer.Make (struct 
@@ -137,9 +137,9 @@ let produce_tokentypes grammar =
 		      end) 
       in
       P.program [
-        SIFunctor (grammar.parameters, [
-          SITypeDefs (filter_typedefs items)
-        ])
+        SIFunctor (grammar.parameters,
+          interface_to_structure i
+        )
       ];
       exit 0
 

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.interface_item list
+val tokentypedefs: UnparameterizedSyntax.grammar -> IL.interface
 
 (* If [--only-tokens] is set, then [produce_tokentypes] writes the type
    definitions to the [.ml] and [.mli] files and stops Menhir. Otherwise,