Commit d92bfe7f authored by POTTIER Francois's avatar POTTIER Francois

Removed the weird type [IL.program], now redefined as an alias for

[IL.structure]. This makes the IL more reasonable and flexible. In
principle, the generated code is unchanged.
parent db42fd1c
* filter_typedefs
* Introduce a submodule Incremental for the incremental entry
points. Clean up IL to make it more general.
......
(* Abstract syntax of the language used for code production. *)
type program = {
(* The structure of programs is pretty ad hoc: the following components
must be printed in this order -- so there is no way for a module
definition to follow a recursive value definition, for instance.
This is tolerable for the time being, but may have to change in the
future. *)
(* Functor parameters. *)
paramdefs: Stretch.t list;
(* Raw Objective Caml prologue. *)
prologue: Stretch.t list;
(* Exception definitions. *)
excdefs: excdef list;
(* Algebraic data type definitions (mutually recursive). *)
typedefs: typedef list;
(* Value definitions (not mutually recursive). *)
nonrecvaldefs: valdef list;
(* Module definitions. *)
moduledefs: moduledef list;
(* Function definitions (mutually recursive). *)
valdefs: valdef list;
(* Raw Objective Caml postlogue. *)
postlogue: Stretch.t list;
}
and interface =
type interface =
interface_item list
and interface_item =
......@@ -255,20 +221,6 @@ and pattern =
(* Type annotation. *)
| PAnnot of pattern * typ
(* Module definitions. *)
and moduledef = {
(* The name of the module that is being defined. *)
modulename: string;
(* The module expression to which it is being bound. *)
modulerhs: modexpr;
}
(* Module expressions. *)
and modexpr =
......@@ -278,6 +230,9 @@ and modexpr =
(* Structures. *)
and program =
structure
and structure =
structure_item list
......@@ -294,3 +249,4 @@ and structure_item =
| SIStretch of Stretch.t list
(* Sub-module definition. *)
| SIModuleDef of string * modexpr
......@@ -1624,50 +1624,46 @@ let initenvdef =
(* ------------------------------------------------------------------------ *)
(* Here is complete code for the parser. *)
open UnparameterizedSyntax
let grammar =
Front.grammar
let program = {
let program =
paramdefs =
grammar.UnparameterizedSyntax.parameters;
[ SIFunctor (grammar.parameters, [
prologue =
grammar.UnparameterizedSyntax.preludes;
SIExcDefs [ excdef ];
excdefs =
[ excdef ];
SITypeDefs (
filter_typedefs (tokentypedefs grammar) @
[ envtypedef; statetypedef ]
);
typedefs =
filter_typedefs (tokentypedefs grammar) @
[ envtypedef; statetypedef ];
SIStretch grammar.preludes;
nonrecvaldefs =
[ excvaldef ];
SIValDefs (false, [ excvaldef ]);
valdefs =
ProductionMap.fold (fun _ s defs ->
entrydef s :: defs
) Lr1.entry (
Lr1.fold (fun defs s ->
rundef s :: errordef s :: defs
) (
Nonterminal.foldx (fun nt defs ->
gotodef nt :: defs
) (Production.fold (fun prod defs ->
if Invariant.ever_reduced prod then
reducedef prod :: defs
else
defs
) [ discarddef; initenvdef; printtokendef; assertfalsedef; errorcasedef ])));
SIValDefs (true,
ProductionMap.fold (fun _ s defs ->
entrydef s :: defs
) Lr1.entry (
Lr1.fold (fun defs s ->
rundef s :: errordef s :: defs
) (
Nonterminal.foldx (fun nt defs ->
gotodef nt :: defs
) (Production.fold (fun prod defs ->
if Invariant.ever_reduced prod then
reducedef prod :: defs
else
defs
) [ discarddef; initenvdef; printtokendef; assertfalsedef; errorcasedef ])))
);
moduledefs =
[];
postlogue =
grammar.UnparameterizedSyntax.postludes
SIStretch grammar.postludes;
}
])]
(* ------------------------------------------------------------------------ *)
(* We are done! *)
......
......@@ -180,16 +180,12 @@ let program grammar =
tokens, because, in principle, the semantic actions may refer to
it or to its data constructors. *)
{
paramdefs = grammar.parameters;
prologue = grammar.preludes;
excdefs = [];
typedefs = filter_typedefs (tokentypedefs grammar);
nonrecvaldefs = [ begindef; def; enddef ];
moduledefs = [];
valdefs = [];
postlogue = grammar.postludes
}
[ SIFunctor (grammar.parameters, [
SITypeDefs (filter_typedefs (tokentypedefs grammar));
SIStretch grammar.preludes;
SIValDefs (false, [ begindef; def; enddef ]);
SIStretch grammar.postludes;
])]
(* ------------------------------------------------------------------------- *)
(* Writing the program associated with a grammar to a file. *)
......
......@@ -18,7 +18,7 @@ end
(* Here is the inliner. *)
let inline ({ valdefs = defs } as p : program) =
let inline_valdefs (defs : valdef list) : valdef list =
(* Create a table of all global definitions. *)
......@@ -267,10 +267,41 @@ let inline ({ valdefs = defs } as p : program) =
Time.tick "Inlining";
{ p with valdefs = valdefs }
valdefs
(* Dumb recursive traversal. *)
let rec inline_structure_item item =
match item with
| SIValDefs (true, defs) ->
(* A nest of recursive definitions. Act on it. *)
SIValDefs (true, inline_valdefs defs)
| SIFunctor (params, s) ->
SIFunctor (params, inline_structure s)
| SIModuleDef (name, e) ->
SIModuleDef (name, inline_modexpr e)
| SIExcDefs _
| SITypeDefs _
| SIValDefs (false, _)
| SIStretch _ ->
item
and inline_structure s =
List.map inline_structure_item s
and inline_modexpr = function
| MVar x ->
MVar x
| MStruct s ->
MStruct (inline_structure s)
| MApp (e1, e2) ->
MApp (inline_modexpr e1, inline_modexpr e2)
(* The external entry point. *)
let inline p =
if Settings.code_inlining then inline p else p
let inline (p : program) : program =
if Settings.code_inlining then
inline_structure p
else
p
......@@ -658,10 +658,10 @@ and modexpr f = function
| MApp (e1, e2) ->
fprintf f "%a (%a)" modexpr e1 modexpr e2
let moduledef f d =
fprintf f "module %s = %a%t%t" d.modulename modexpr d.modulerhs nl nl
(* TEMPORARY
let program f p =
functorparams false program p X.f p.paramdefs;
fprintf f "%a%a"
(excdefs false) p.excdefs
typedefs p.typedefs;
......@@ -671,6 +671,7 @@ let program f p =
(list moduledef nothing) p.moduledefs
(valdefs true) p.valdefs;
List.iter (stretch false f) p.postlogue
*)
let valdecl f (x, ts) =
fprintf f "val %s: %a%t%t" x typ ts.body nl nl
......@@ -718,8 +719,8 @@ and interface_item f = function
and interface f i =
list interface_item nothing f i
let program p =
functorparams false program p X.f p.paramdefs;
let program s =
structure X.f s;
flush X.f
let interface i =
......
......@@ -658,12 +658,8 @@ let tokendef2 = {
exception [Error], which is defined at toplevel, is re-defined
within the functor argument: [exception Error = Error]. *)
let application = {
let application =
modulename =
interpreter;
modulerhs =
MApp (
MVar make,
MStruct [
......@@ -682,9 +678,7 @@ let application = {
trace;
])
]
);
}
)
(* ------------------------------------------------------------------------ *)
......@@ -744,39 +738,35 @@ let api : IL.valdef list =
(* Let's put everything together. *)
open UnparameterizedSyntax
let grammar =
Front.grammar
let program = {
paramdefs =
grammar.UnparameterizedSyntax.parameters;
let program =
[ SIFunctor (grammar.parameters, [
prologue =
grammar.UnparameterizedSyntax.preludes;
SIExcDefs [ excdef ];
excdefs =
[ excdef ];
SITypeDefs (
filter_typedefs (tokentypedefs grammar) @
filter_typedefs (nonterminalgadtdef grammar) @
filter_typedefs (symbolgadtdef grammar) @
[ tokendef1 ]
);
typedefs =
filter_typedefs (tokentypedefs grammar) @
filter_typedefs (nonterminalgadtdef grammar) @
filter_typedefs (symbolgadtdef grammar) @
[ tokendef1 ];
SIStretch grammar.preludes;
nonrecvaldefs =
[ excvaldef ];
SIValDefs (false, [ excvaldef ]);
moduledefs =
[ application ];
SIModuleDef (interpreter, application);
valdefs =
api;
SIValDefs (false, api);
postlogue =
grammar.UnparameterizedSyntax.postludes
SIStretch grammar.postludes;
}
])]
let () =
Time.tick "Producing abstract syntax"
......
......@@ -136,16 +136,11 @@ let produce_tokentypes grammar =
let locate_stretches = None
end)
in
P.program {
paramdefs = grammar.parameters;
prologue = [];
excdefs = [];
typedefs = filter_typedefs items;
nonrecvaldefs = [];
valdefs = [];
moduledefs = [];
postlogue = [];
};
P.program [
SIFunctor (grammar.parameters, [
SITypeDefs (filter_typedefs items)
])
];
exit 0
| Settings.CodeOnly _
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment