Commit a04e6224 authored by POTTIER Francois's avatar POTTIER Francois

Removed the use of a private type abbreviation in [INSPECTION] -- it did

not work.
Exposed the definition of [symbol] in terms of [terminal] and [nonterminal].
This allows removing this definition from the generated [.mli] file.
parent f839bddb
...@@ -83,7 +83,7 @@ let rec loop linebuf (result : int I.result) = ...@@ -83,7 +83,7 @@ let rec loop linebuf (result : int I.result) =
() ()
| 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 : (I.production * int) list = Parser.Inspection.items current in let items : Parser.Inspection.item list = Parser.Inspection.items current in
Printf.fprintf stderr "#Items: %d\n%!" (List.length items); Printf.fprintf stderr "#Items: %d\n%!" (List.length items);
List.iter (fun (prod, index) -> List.iter (fun (prod, index) ->
let _lhs : Parser.Inspection.xsymbol = Parser.Inspection.lhs prod in let _lhs : Parser.Inspection.xsymbol = Parser.Inspection.lhs prod in
......
...@@ -109,14 +109,19 @@ module type INSPECTION = sig ...@@ -109,14 +109,19 @@ module type INSPECTION = sig
this production. That is, if the length of [rhs prod] is [n], then [i] is this production. That is, if the length of [rhs prod] is [n], then [i] is
comprised between 0 and [n], inclusive. *) comprised between 0 and [n], inclusive. *)
type item = private type item =
production * int production * int
(* The type ['a symbol] represents a (terminal or nonterminal) symbol of the (* The type ['a symbol] represents a (terminal or nonterminal) symbol of the
grammar. It is generated. The index ['a] represents the type of the grammar. It is generated. The index ['a] represents the type of the
semantic values associated with this symbol. *) semantic values associated with this symbol. *)
type 'a symbol type 'a terminal
type 'a nonterminal
type 'a symbol =
| T : 'a terminal -> 'a symbol
| N : 'a nonterminal -> 'a symbol
(* The type [xsymbol] is an existentially quantified version of the type (* The type [xsymbol] is an existentially quantified version of the type
['a symbol]. *) ['a symbol]. *)
......
...@@ -12,7 +12,12 @@ module type TABLES = sig ...@@ -12,7 +12,12 @@ module type TABLES = sig
type 'a lr1state type 'a lr1state
type 'a symbol type 'a terminal
type 'a nonterminal
type 'a symbol =
| T : 'a terminal -> 'a symbol
| N : 'a nonterminal -> 'a symbol
type xsymbol = type xsymbol =
| X : 'a symbol -> xsymbol | X : 'a symbol -> xsymbol
......
...@@ -3,6 +3,16 @@ module Make ( ...@@ -3,6 +3,16 @@ module Make (
with type 'a lr1state = int with type 'a lr1state = int
) = struct ) = struct
type 'a symbol = 'a T.symbol =
| T : 'a T.terminal -> 'a symbol
| N : 'a T.nonterminal -> 'a symbol
(* The type [xsymbol] is an existentially quantified version of the type
['a symbol]. *)
type xsymbol = T.xsymbol =
| X : 'a symbol -> xsymbol
(* This auxiliary function decodes a packed linearized array, as created by (* This auxiliary function decodes a packed linearized array, as created by
[TableBackend.linearize_and_marshal1]. Here, we read a row all at once. *) [TableBackend.linearize_and_marshal1]. Here, we read a row all at once. *)
......
...@@ -7,7 +7,7 @@ module Make (T : InspectionTableFormat.TABLES ...@@ -7,7 +7,7 @@ module Make (T : InspectionTableFormat.TABLES
: IncrementalEngine.INSPECTION : IncrementalEngine.INSPECTION
with type 'a lr1state := 'a T.lr1state with type 'a lr1state := 'a T.lr1state
and type 'a symbol := 'a T.symbol and type 'a terminal := 'a T.terminal
and type xsymbol := T.xsymbol and type 'a nonterminal := 'a T.nonterminal
and type production := int and type production := int
...@@ -136,12 +136,10 @@ let inspection_api grammar () = ...@@ -136,12 +136,10 @@ let inspection_api grammar () =
IIComment "The inspection API." :: IIComment "The inspection API." ::
IIModule (inspection, MTSigEnd ( IIModule (inspection, MTSigEnd (
(* Define the types [terminal], [nonterminal], [symbol], [xsymbol]. *) (* Define the types [terminal] and [nonterminal]. *)
TokenType.tokengadtdef grammar @ TokenType.tokengadtdef grammar @
NonterminalType.nonterminalgadtdef grammar @ NonterminalType.nonterminalgadtdef grammar @
SymbolType.symbolgadtdef() @
SymbolType.xsymboldef() @
(* Include the signature that lists the inspection functions, with (* Include the signature that lists the inspection functions, with
appropriate type instantiations. *) appropriate type instantiations. *)
...@@ -152,8 +150,8 @@ let inspection_api grammar () = ...@@ -152,8 +150,8 @@ let inspection_api grammar () =
"MenhirLib.IncrementalEngine.INSPECTION" [ "MenhirLib.IncrementalEngine.INSPECTION" [
[ a ], "lr1state", tlr1state (TypVar a); [ a ], "lr1state", tlr1state (TypVar a);
[], "production", TypApp ("MenhirInterpreter.production", []); [], "production", TypApp ("MenhirInterpreter.production", []);
[ a ], SymbolType.tcsymbolgadt, SymbolType.tsymbolgadt (TypVar a); [ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
[], SymbolType.tcxsymbol, SymbolType.txsymbol; [ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a)
] ]
) :: ) ::
......
...@@ -5,6 +5,7 @@ ...@@ -5,6 +5,7 @@
type (i.e., it has one type parameter). Its data constructors carry zero type (i.e., it has one type parameter). Its data constructors carry zero
value arguments. *) value arguments. *)
val tcnonterminalgadt: string
val tnonterminalgadt: IL.typ -> IL.typ val tnonterminalgadt: IL.typ -> IL.typ
(* [tnonterminalgadtdata nt] is the conventional name of the data constructor (* [tnonterminalgadtdata nt] is the conventional name of the data constructor
......
...@@ -982,9 +982,7 @@ let program = ...@@ -982,9 +982,7 @@ let program =
SIModuleDef (more, MStruct ( SIModuleDef (more, MStruct (
interface_to_structure ( interface_to_structure (
tokengadtdef grammar @ tokengadtdef grammar @
nonterminalgadtdef grammar @ nonterminalgadtdef grammar
symbolgadtdef() @
xsymboldef()
) )
)) :: )) ::
...@@ -996,8 +994,13 @@ let program = ...@@ -996,8 +994,13 @@ let program =
interface_to_structure [ interface_to_structure [
lr1state_redef; lr1state_redef;
] @ ] @
(* [symbol], [xsymbol]. *) (* [terminal], [nonterminal]. *)
SIInclude (MVar more) :: SIInclude (MVar more) ::
(* [symbol], [xsymbol]. *)
interface_to_structure (
symbolgadtdef() @
xsymboldef()
) @
(* [lhs] *) (* [lhs] *)
SIInclude (MVar tables) :: SIInclude (MVar tables) ::
SIValDefs (false, SIValDefs (false,
......
...@@ -31,6 +31,7 @@ val tokendata: string -> string ...@@ -31,6 +31,7 @@ val tokendata: string -> string
carry zero value arguments. If [--external-tokens] is set, this type is carry zero value arguments. If [--external-tokens] is set, this type is
qualified. *) qualified. *)
val tctokengadt: string
val ttokengadt: IL.typ -> IL.typ val ttokengadt: IL.typ -> IL.typ
(* [tokengadtdata] maps the name of a token to a data constructor of the token (* [tokengadtdata] maps the name of a token to a data constructor of the token
......
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