Commit b508805d authored by POTTIER Francois's avatar POTTIER Francois

Modified the table back-end to merge the sub-modules [MenhirInterpreter]

and [Inspection].
parent a3ce6eee
...@@ -30,7 +30,7 @@ let height env = ...@@ -30,7 +30,7 @@ let height env =
(* Printing a symbol. *) (* Printing a symbol. *)
let print_symbol symbol = let print_symbol symbol =
let open Parser.Inspection in let open I in
match symbol with match symbol with
| X (T T_TIMES) -> | X (T T_TIMES) ->
"*" "*"
...@@ -56,10 +56,7 @@ let print_symbol symbol = ...@@ -56,10 +56,7 @@ let print_symbol symbol =
"error" "error"
module P = module P =
Printers.Make(struct Printers.Make(I) (struct
include Parser.MenhirInterpreter
include Parser.Inspection
end) (struct
let arrow = " -> " let arrow = " -> "
let dot = "." let dot = "."
let space = " " let space = " "
...@@ -71,12 +68,12 @@ module P = ...@@ -71,12 +68,12 @@ module P =
let print_element e = let print_element e =
match e with match e with
| I.Element (s, v, _, _) -> | I.Element (s, v, _, _) ->
print_symbol (Parser.Inspection.X (Parser.Inspection.incoming_symbol s)) print_symbol (I.X (I.incoming_symbol s))
let print_element e : string = let print_element e : string =
match e with match e with
| I.Element (s, v, _, _) -> | I.Element (s, v, _, _) ->
let open Parser.Inspection in let open I in
match incoming_symbol s with match incoming_symbol s with
| T T_TIMES -> | T T_TIMES ->
"*" "*"
...@@ -121,7 +118,7 @@ let dump env = ...@@ -121,7 +118,7 @@ let dump env =
() ()
| I.Cons (I.Element (current, _, _, _), _) -> | I.Cons (I.Element (current, _, _, _), _) ->
Printf.fprintf stderr "Current state: %d\n%!" (Obj.magic current); Printf.fprintf stderr "Current state: %d\n%!" (Obj.magic current);
let items = Parser.Inspection.items current in let items = I.items current in
Printf.fprintf stderr "#Items: %d\n%!" (List.length items); Printf.fprintf stderr "#Items: %d\n%!" (List.length items);
List.iter (fun item -> List.iter (fun item ->
Printf.fprintf stderr "%s\n%!" (P.print_item item) Printf.fprintf stderr "%s\n%!" (P.print_item item)
......
...@@ -34,27 +34,12 @@ let interpreter = ...@@ -34,27 +34,12 @@ let interpreter =
let result t = let result t =
TypApp (interpreter ^ ".result", [ t ]) TypApp (interpreter ^ ".result", [ t ])
let raw_lr1state =
"lr1state"
let lr1state = let lr1state =
interpreter ^ "." ^ raw_lr1state "lr1state"
let tlr1state a : typ = let tlr1state a : typ =
TypApp (lr1state, [a]) TypApp (lr1state, [a])
(* This interface item is a re-definition of the type [lr1state] as
an abbreviation for [MenhirInterpreter.lr1state]. *)
let lr1state_redef =
let a = "a" in
IITypeDecls [{
typename = raw_lr1state;
typeparams = [ a ];
typerhs = TAbbrev (tlr1state (TypVar a));
typeconstraint = None
}]
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* The name of the sub-module that contains the incremental entry points. *) (* The name of the sub-module that contains the incremental entry points. *)
...@@ -98,6 +83,35 @@ let monolithic_api grammar = ...@@ -98,6 +83,35 @@ let monolithic_api grammar =
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* The inspection API. *)
let inspection_api grammar () =
let a = "a" in
(* Define the types [terminal] and [nonterminal]. *)
TokenType.tokengadtdef grammar @
NonterminalType.nonterminalgadtdef grammar @
(* Include the signature that lists the inspection functions, with
appropriate type instantiations. *)
IIComment "The inspection API." ::
IIInclude (
with_types WKDestructive
"MenhirLib.IncrementalEngine.INSPECTION" [
[ a ], "lr1state", tlr1state (TypVar a);
[], "production", TypApp ("production", []);
[ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
[ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a)
]
) ::
[]
(* -------------------------------------------------------------------------- *)
(* The incremental API. *) (* The incremental API. *)
let incremental_engine () : module_type = let incremental_engine () : module_type =
...@@ -129,56 +143,22 @@ let incremental_api grammar () : interface = ...@@ -129,56 +143,22 @@ let incremental_api grammar () : interface =
MTSigEnd ( MTSigEnd (
IIComment "The incremental API." :: IIComment "The incremental API." ::
IIInclude (incremental_engine()) :: IIInclude (incremental_engine()) ::
[] listiflazy Settings.inspection (inspection_api grammar)
) )
) :: ) ::
(* The entry points must come after the incremental API, because
their type refers to the type [result]. *)
incremental_entry_points grammar incremental_entry_points grammar
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* The inspection API. *)
let inspection_api grammar () =
let a = "a" in
IIComment "The inspection API." ::
IIModule (inspection, MTSigEnd (
(* Define the types [terminal] and [nonterminal]. *)
TokenType.tokengadtdef grammar @
NonterminalType.nonterminalgadtdef grammar @
(* Include the signature that lists the inspection functions, with
appropriate type instantiations. *)
IIComment "The inspection functions." ::
IIInclude (
with_types WKDestructive
"MenhirLib.IncrementalEngine.INSPECTION" [
[ a ], "lr1state", tlr1state (TypVar a);
[], "production", TypApp ("MenhirInterpreter.production", []);
[ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
[ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a)
]
) ::
[]
)) ::
[]
(* -------------------------------------------------------------------------- *)
(* The complete interface of the generated parser. *) (* The complete interface of the generated parser. *)
let interface grammar = [ let interface grammar = [
IIFunctor (grammar.parameters, IIFunctor (grammar.parameters,
monolithic_api grammar @ monolithic_api grammar @
listiflazy Settings.table (incremental_api grammar) @ listiflazy Settings.table (incremental_api grammar)
listiflazy Settings.inspection (inspection_api grammar)
) )
] ]
......
...@@ -18,12 +18,6 @@ val interpreter: string ...@@ -18,12 +18,6 @@ val interpreter: string
val result: IL.typ -> IL.typ val result: IL.typ -> IL.typ
(* The type ['a lr1state], defined by the interpreter sub-module. *)
val lr1state: string
val tlr1state: IL.typ -> IL.typ
val lr1state_redef: IL.interface_item
(* The name of the sub-module that contains the incremental entry points. *) (* The name of the sub-module that contains the incremental entry points. *)
val incremental: string val incremental: string
......
...@@ -16,11 +16,8 @@ module Run (T : sig end) = struct ...@@ -16,11 +16,8 @@ module Run (T : sig end) = struct
let menhirlib = let menhirlib =
"MenhirLib" "MenhirLib"
let tableInterpreter = let make_engine =
menhirlib ^ ".TableInterpreter" menhirlib ^ ".TableInterpreter.Make"
let make =
tableInterpreter ^ ".Make"
let make_symbol = let make_symbol =
menhirlib ^ ".InspectionTableInterpreter.Symbols" menhirlib ^ ".InspectionTableInterpreter.Symbols"
...@@ -64,14 +61,22 @@ let entry = ...@@ -64,14 +61,22 @@ let entry =
let start = let start =
interpreter ^ ".start" interpreter ^ ".start"
(* The following are names of internal sub-modules. *)
let basics = let basics =
"Basics" (* name of an internal sub-module *) "Basics"
let tables = let tables =
"Tables" (* name of an internal sub-module *) "Tables"
let symbols =
"Symbols"
let shared =
"Shared"
let more = let ti =
"More" (* name of an internal sub-module *) "TI"
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
...@@ -934,11 +939,23 @@ let program = ...@@ -934,11 +939,23 @@ let program =
(* Define the tables. *) (* Define the tables. *)
SIModuleDef (shared,
MStruct [
SIValDefs (false, [
lhs;
])
]
) ::
SIModuleDef (tables, SIModuleDef (tables,
MStruct [ MStruct [
(* The internal sub-module [basics] contains the definitions of the (* The internal sub-module [basics] contains the definitions of the
exception [Error] and of the type [token]. *) exception [Error] and of the type [token]. *)
SIInclude (MVar basics); SIInclude (MVar basics);
(* The internal sub-module [shared] contains the tables that are
used both in normal mode and in [--inspection] mode. *)
SIInclude (MVar shared);
(* This is a non-recursive definition, so none of the names (* This is a non-recursive definition, so none of the names
defined here are visible in the semantic actions. *) defined here are visible in the semantic actions. *)
SIValDefs (false, [ SIValDefs (false, [
...@@ -949,7 +966,7 @@ let program = ...@@ -949,7 +966,7 @@ let program =
error; error;
start_def; start_def;
action; action;
lhs; (* [lhs] is part of [shared] *)
goto; goto;
semantic_action; semantic_action;
trace; trace;
...@@ -957,43 +974,40 @@ let program = ...@@ -957,43 +974,40 @@ let program =
] ]
) :: ) ::
(* Apply the functor [TableInterpreter.Make] to the tables. *) SIModuleDef (interpreter, MStruct (
SIModuleDef (interpreter, (* Apply the functor [TableInterpreter.Make] to the tables. *)
MApp (MVar make, MVar tables) SIModuleDef (ti, MApp (MVar make_engine, MVar tables)) ::
) :: SIInclude (MVar ti) ::
listiflazy Settings.inspection (fun () -> [ listiflazy Settings.inspection (fun () ->
SIModuleDef (inspection, MStruct (
(* Define the internal sub-module [more], which contains type (* Define the internal sub-module [symbols], which contains type
definitions. Then, include this sub-module. This sub-module is used definitions. Then, include this sub-module. This sub-module is used
again below, as part of the application of the functor again below, as part of the application of the functor
[TableInterpreter.MakeInspection]. *) [TableInterpreter.MakeInspection]. *)
SIModuleDef (more, MStruct ( SIModuleDef (symbols, MStruct (
interface_to_structure ( interface_to_structure (
tokengadtdef grammar @ tokengadtdef grammar @
nonterminalgadtdef grammar nonterminalgadtdef grammar
) )
)) :: )) ::
SIInclude (MVar more) :: SIInclude (MVar symbols) ::
SIInclude (MApp (MVar make_inspection, MStruct ( SIInclude (MApp (MVar make_inspection, MStruct (
(* This module must satisfy [InspectionTableFormat.TABLES]. *) (* This module must satisfy [InspectionTableFormat.TABLES]. *)
(* [lr1state] *) (* [lr1state] *)
interface_to_structure [ SIInclude (MVar ti) ::
lr1state_redef;
] @
(* [terminal], [nonterminal]. *) (* [terminal], [nonterminal]. *)
SIInclude (MVar more) :: SIInclude (MVar symbols) ::
(* This functor application builds the types [symbol] and [xsymbol] (* This functor application builds the types [symbol] and [xsymbol]
in terms of the types [terminal] and [nonterminal]. This saves in terms of the types [terminal] and [nonterminal]. This saves
us the trouble of generating these definitions. *) us the trouble of generating these definitions. *)
SIInclude (MApp (MVar make_symbol, MVar more)) :: SIInclude (MApp (MVar make_symbol, MVar symbols)) ::
(* [lhs] *) (* [lhs] *)
SIInclude (MVar tables) :: SIInclude (MVar shared) ::
SIValDefs (false, SIValDefs (false,
terminal() :: terminal() ::
nonterminal() :: nonterminal() ::
...@@ -1008,9 +1022,9 @@ let program = ...@@ -1008,9 +1022,9 @@ let program =
[] []
)) )
]) @ )) ::
SIValDefs (false, monolithic_api) :: SIValDefs (false, monolithic_api) ::
......
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