Commit 05863900 authored by POTTIER Francois's avatar POTTIER Francois

Added the table [lr0_incoming] and checked that the two implementations

of [incoming_symbol] are equivalent.
parent cba1eba2
......@@ -12,7 +12,9 @@ module type TABLES = sig
type 'a lr1state
type 'a symbol
type xsymbol
type xsymbol =
| X : 'a symbol -> xsymbol
(* Some of the tables that follow use encodings of (terminal and
nonterminal) symbols as integers. So, we need functions that
......@@ -47,5 +49,9 @@ module type TABLES = sig
val lr0_items: PackedIntArray.t * PackedIntArray.t
(* A mapping of every LR(0) state to its incoming symbol, if it has one. *)
val lr0_incoming: PackedIntArray.t
end
module Make (T : InspectionTableFormat.TABLES) = struct
module Make (
T : InspectionTableFormat.TABLES
with type 'a lr1state = int
) = struct
(* This auxiliary function decodes a packed linearized array, as created by
[TableBackend.linearize_and_marshal1]. Here, we read a row all at once. *)
......@@ -9,11 +12,35 @@ module Make (T : InspectionTableFormat.TABLES) = struct
(PackedIntArray.get entry)
i
(* 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 =
(* 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. *)
assert (symbol > 0);
(* The low-order bit distinguishes terminal and nonterminal symbols. *)
let kind = symbol land 1 in
let symbol = symbol lsr 1 in
if kind = 0 then
T.terminal (symbol - 1)
else
T.nonterminal symbol
(* The function [incoming_symbol] is generated by the table back-end.
We just expose it. *)
let incoming_symbol =
T.incoming_symbol
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
| 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. *)
......@@ -22,12 +49,7 @@ module Make (T : InspectionTableFormat.TABLES) = struct
T.nonterminal (PackedIntArray.get T.lhs prod)
(* The function [rhs] reads the table [rhs] and uses [decode_symbol]
to decode the symbol. The encoding was done by [encode_symbol] in
the table back-end. *)
let decode_symbol symbol =
let kind = symbol land 1 in
(if kind = 0 then T.terminal else T.nonterminal) (symbol lsr 1)
to decode the symbol. *)
let rhs prod =
List.map decode_symbol (read_packed_linearized T.rhs prod)
......
......@@ -317,11 +317,14 @@ let encode_NoError = (* 1 *)
(* Encodings of terminal and nonterminal symbols in the production table. *)
let encode_no_symbol =
0 (* 0 | 0 *)
let encode_terminal tok =
(Terminal.t2i tok) lsl 1 (* t | 0 *)
(Terminal.t2i tok + 1) lsl 1 (* t + 1 | 0 *)
let encode_nonterminal nt =
(Nonterminal.n2i nt) lsl 1 lor 1 (* nt | 1 *)
((Nonterminal.n2i nt) lsl 1) lor 1 (* nt | 1 *)
let encode_symbol = function
| Symbol.T tok ->
......@@ -329,6 +332,12 @@ let encode_symbol = function
| Symbol.N nt ->
encode_nonterminal nt
let encode_symbol_option = function
| None ->
encode_no_symbol
| Some symbol ->
encode_symbol symbol
(* ------------------------------------------------------------------------ *)
(* Statistics. *)
......@@ -415,6 +424,14 @@ let marshal11 (table : int array) =
assert (bits = 1);
EStringConst text
(* List-based versions of the above functions. *)
let marshal1_list (table : int list) =
marshal1 (Array.of_list table)
let marshal11_list (table : int list) =
marshal11 (Array.of_list table)
(* [linearize_and_marshal1] marshals an array of integer arrays (of possibly
different lengths). *)
......@@ -450,12 +467,6 @@ let marshal2 name m n (matrix : int list list) =
marshal1 data;
]
let marshal1 (table : int list) =
marshal1 (Array.of_list table)
let marshal11 (table : int list) =
marshal11 (Array.of_list table)
(* ------------------------------------------------------------------------ *)
(* Table generation. *)
......@@ -567,7 +578,7 @@ let error =
"error",
ETuple [
EIntConst (Terminal.n - 1);
marshal11 (
marshal11_list (
List.flatten (
Lr1.map (fun node ->
Terminal.mapx (fun t ->
......@@ -582,7 +593,7 @@ let error =
let default_reduction =
define_and_measure (
"default_reduction",
marshal1 (
marshal1_list (
Lr1.map (fun node ->
default_reduction node
)
......@@ -593,7 +604,7 @@ let lhs =
define_and_measure (
"lhs",
marshal1 (
Production.map (fun prod ->
Production.amap (fun prod ->
Nonterminal.n2i (Production.nt prod)
)
)
......@@ -828,6 +839,20 @@ let nonterminal () =
(* ------------------------------------------------------------------------ *)
(* Produce a mapping of every LR(0) state to its incoming symbol (encoded as
an integer value). (Note that the initial states do not have one.) *)
let lr0_incoming () =
assert Settings.inspection;
define_and_measure (
"lr0_incoming",
marshal1 (Array.init Lr0.n (fun node ->
encode_symbol_option (Lr0.incoming_symbol node)
))
)
(* ------------------------------------------------------------------------ *)
(* 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]. *)
......@@ -908,7 +933,7 @@ let lr0_core () =
assert Settings.inspection;
define_and_measure (
"lr0_core",
marshal1 (Lr1.map (fun (node : Lr1.node) ->
marshal1_list (Lr1.map (fun (node : Lr1.node) ->
Lr0.core (Lr1.state node)
))
)
......@@ -1033,6 +1058,7 @@ let program =
terminal() ::
nonterminal() ::
incoming_symbol() ::
lr0_incoming() ::
rhs() ::
lr0_core() ::
lr0_items() ::
......
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