Commit d8ab9093 authored by POTTIER Francois's avatar POTTIER Francois

Removed the old implementation of [incoming_symbol].

parent 05863900
* Clean up Lr1.incoming_symbol by going through Lr0.
* Possibly re-implement the function [symbol] using a packed
int array (going through [terminal] or [nonterminal] later).
Also, go through lr0 core first.
* Generate default printers for terminal and nonterminal.
Define printers for productions and items, parameterized
over printers for terminal and nonterminal.
......
......@@ -5,12 +5,13 @@
module type TABLES = sig
(* These types are used in the types of the functions that follow.
In the generated [.ml] file, ['a lr1state] will be implemented
e.g. as [int], whereas the types ['a symbol] and [xsymbol] are
(generated) algebraic data types. *)
(* The type ['a lr1state] describes an LR(1) state and will be defined
internally as [int]. The types ['a symbol] and [xsymbol] are (generated)
algebraic data types. These types must appear here because they serve to
describe the argument and/or result of [InspectionTableInterpreter.Make]. *)
type 'a lr1state
type 'a symbol
type xsymbol =
......@@ -23,10 +24,6 @@ module type TABLES = sig
val terminal: int -> xsymbol
val nonterminal: int -> xsymbol
(* A mapping of every (non-initial) state to its incoming symbol. *)
val incoming_symbol: 'a lr1state -> 'a symbol
(* The left-hand side of every production. (Same as in [TableFormat.TABLES].) *)
val lhs: PackedIntArray.t
......
......@@ -15,7 +15,7 @@ module Make (
(* This auxiliary function decodes a symbol. The encoding was done by
[encode_symbol] or [encode_symbol_option] in the table back-end. *)
let decode_symbol symbol =
let decode_symbol (symbol : int) : T.xsymbol =
(* If [symbol] is 0, then we have no symbol. This could mean e.g.
that the function [incoming_symbol] has been applied to an
initial state. In principle, this cannot happen. *)
......@@ -28,20 +28,20 @@ module Make (
else
T.nonterminal symbol
(* The function [incoming_symbol] is generated by the table back-end.
We just expose it. *)
(* The function [incoming_symbol] goes through the tables [lr0_core] and
[lr0_incoming]. This yields a representation of type [xsymbol], out of
which we strip the [X] quantifier, so as to get a naked symbol. This last
step is ill-typed and potentially dangerous. It is safe only because this
function is used at type ['a lr1state -> 'a symbol], which forces an
appropriate choice of ['a]. *)
let new_incoming_symbol (s : 'a T.lr1state) : 'a T.symbol =
match decode_symbol (PackedIntArray.get T.lr0_incoming (PackedIntArray.get T.lr0_core s)) with
let incoming_symbol (s : 'a T.lr1state) : 'a T.symbol =
let core = PackedIntArray.get T.lr0_core s in
let symbol = decode_symbol (PackedIntArray.get T.lr0_incoming core) in
match symbol with
| T.X symbol ->
Obj.magic symbol
let incoming_symbol (s : int) =
let answer1 = T.incoming_symbol s in
let answer2 = new_incoming_symbol s in
assert (answer1 = answer2);
answer1
(* The function [lhs] reads the table [lhs] and uses [T.nonterminal]
to decode the symbol. *)
......
......@@ -853,60 +853,6 @@ let lr0_incoming () =
(* ------------------------------------------------------------------------ *)
(* Produce a function [incoming_symbol] that maps a state of type ['a lr1state]
(represented as an integer value) to a value of type ['a symbol]. *)
(* The type [MenhirInterpreter.lr1state] is known (to us) to be an alias for
[int], so we can pattern match on it. To the user, though, it will be an
abstract type. *)
let incoming_symbol () =
assert Settings.inspection;
define (
"incoming_symbol",
EAnnot (
EFun ([ PVar state ],
EMatch (EVar state,
(* A default branch is used to ensure exhaustiveness. *)
let default =
{ branchpat =
PWildcard;
branchbody =
EComment ("This state does not exist.",
EApp (EVar "assert", [ efalse ])
)
}
in
(* One branch per LR(1) state. *)
Lr1.fold (fun branches node ->
let branchpat =
pint (Lr1.number node)
in
let branchbody =
match Lr1.incoming_symbol node with
| None ->
(* This function must not be applied to an initial state.
We will be careful not to expose the initial states
as inhabitants of the type ['a lr1state]. *)
EComment ("This is an initial state.",
EApp (EVar "assert", [ efalse ])
)
| Some symbol ->
(* To a non-initial state, we associate a representation
of its incoming symbol. *)
EMagic (esymbol symbol)
in
{ branchpat; branchbody } :: branches
) [default]
)
),
let a = TypVar "a" in
type2scheme (arrow (tlr1state a) (tsymbolgadt a))
)
)
(* ------------------------------------------------------------------------ *)
(* A table that maps a production (i.e., an integer index) to the production's
right-hand side. In principle, we use this table for ordinary productions
only, as opposed to the start productions, whose existence is not exposed
......@@ -1057,7 +1003,6 @@ let program =
SIValDefs (false,
terminal() ::
nonterminal() ::
incoming_symbol() ::
lr0_incoming() ::
rhs() ::
lr0_core() ::
......
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