From c4284a6ff3ac813b1f1c9201be79d0ce63293712 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Pottier?= Date: Fri, 26 Dec 2014 09:37:03 +0100 Subject: [PATCH] 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 | 11 +++++++---- src/codeBits.ml | 12 ++++++++++++ src/codeBits.mli | 5 +++++ src/infer.ml | 2 +- src/interface.ml | 42 +++-------------------------------------- src/nonterminalType.ml | 15 +++++++++------ src/nonterminalType.mli | 2 +- src/symbolType.ml | 15 ++++++++------- src/symbolType.mli | 2 +- src/tableBackend.ml | 6 +++--- src/tokenType.ml | 42 ++++++++++++++++++++++------------------- src/tokenType.mli | 2 +- 12 files changed, 74 insertions(+), 82 deletions(-) diff --git a/src/codeBackend.ml b/src/codeBackend.ml index 3dd4beb9..cc9c5837 100644 --- a/src/codeBackend.ml +++ b/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 } diff --git a/src/codeBits.ml b/src/codeBits.ml index d9bfdd60..7622dc3e 100644 --- a/src/codeBits.ml +++ b/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) + diff --git a/src/codeBits.mli b/src/codeBits.mli index 92ca0d5c..3f0f9cbf 100644 --- a/src/codeBits.mli +++ b/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 + diff --git a/src/infer.ml b/src/infer.ml index a4cfb65c..a900360a 100644 --- a/src/infer.ml +++ b/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 = []; diff --git a/src/interface.ml b/src/interface.ml index 74166e39..a3487d32 100644 --- a/src/interface.ml +++ b/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."; diff --git a/src/nonterminalType.ml b/src/nonterminalType.ml index c54545db..337f3a34 100644 --- a/src/nonterminalType.ml +++ b/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. *) diff --git a/src/nonterminalType.mli b/src/nonterminalType.mli index 462ca26b..fc1dd808 100644 --- a/src/nonterminalType.mli +++ b/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 diff --git a/src/symbolType.ml b/src/symbolType.ml index dfd338d1..4afd795d 100644 --- a/src/symbolType.ml +++ b/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 + }] + ] diff --git a/src/symbolType.mli b/src/symbolType.mli index 11eb0b09..c30059a6 100644 --- a/src/symbolType.mli +++ b/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 diff --git a/src/tableBackend.ml b/src/tableBackend.ml index bfb9d1ee..c164c44e 100644 --- a/src/tableBackend.ml +++ b/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 = diff --git a/src/tokenType.ml b/src/tokenType.ml index 490f368d..d63a1527 100644 --- a/src/tokenType.ml +++ b/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 = []; diff --git a/src/tokenType.mli b/src/tokenType.mli index 75a842e3..c880f603 100644 --- a/src/tokenType.mli +++ b/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, -- GitLab