Commit 2aff803b by POTTIER Francois

Add [first] to the inspection API.

parent ee536645
* Add ways of iterating over all symbols.
* Add left-recursive lists to the standard library.
* Define [print_result].
......
......@@ -194,6 +194,12 @@ module type INSPECTION = sig
val nullable: 'a nonterminal -> bool
(* [first nt t] tells whether the FIRST set of the nonterminal symbol [nt]
contains the terminal symbol [t]. That is, it is true if and only if
[nt] produces a word that begins with [t]. *)
val first: 'a nonterminal -> 'b terminal -> bool
(* [foreach_terminal] enumerates the terminal symbols, including [error].
[foreach_terminal_but_error] enumerates the terminal symbols, excluding
[error]. *)
......
......@@ -52,5 +52,10 @@ module type TABLES = sig
(* This is a packed int array of bit width 1. It can be read
using [PackedIntArray.get1]. *)
(* A two-table dimensional table, indexed by a nonterminal symbol and
by a terminal symbol (other than [#]), encodes the FIRST sets. *)
val first: int (* width of the bitmap *) * string (* second component of [PackedIntArray.t] *)
end
......@@ -63,17 +63,23 @@ module Make
else
T.nonterminal symbol
(* This auxiliary function converts a nonterminal symbol to its integer
code. For speed and for convenience, we use an unsafe type cast. This
relies on the fact that the data constructors of the [nonterminal] GADT
are declared in an order that reflects their internal code. We add
[start] to account for the presence of the start symbols. *)
(* These auxiliary functions convert a symbol to its integer code. For speed
and for convenience, we use an unsafe type cast. This relies on the fact
that the data constructors of the [terminal] and [nonterminal] GADTs are
declared in an order that reflects their internal code. In the case of
nonterminal symbols, we add [start] to account for the presence of the
start symbols. *)
let n2i (nt : 'a T.nonterminal) : int =
let answer = B.start + Obj.magic nt in
assert (T.nonterminal answer = X (N nt)); (* TEMPORARY roundtrip *)
answer
let t2i (t : 'a T.terminal) : int =
let answer = Obj.magic t in
assert (T.terminal answer = X (T t)); (* TEMPORARY roundtrip *)
answer
(* The function [incoming_symbol] goes through the tables [T.lr0_core] and
[T.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
......@@ -121,8 +127,18 @@ module Make
integer code, which it uses to look up the array [T.nullable].
This yields 0 or 1, which we map back to a Boolean result. *)
let decode_bool i =
assert (i = 0 || i = 1);
i = 1
let nullable nt =
PackedIntArray.get1 T.nullable (n2i nt) = 1
decode_bool (PackedIntArray.get1 T.nullable (n2i nt))
(* The function [first] maps the symbols [nt] and [t] to their integer
codes, which it uses to look up the matrix [T.first]. *)
let first nt t =
decode_bool (PackedIntArray.unflatten1 T.first (n2i nt) (t2i t))
(* The function [foreach_terminal] exploits the fact that the
first component of [B.error] is [Terminal.n - 1], i.e., the
......
......@@ -183,3 +183,12 @@ let get ((k, s) : t) (i : int) : int =
let j = 4 * i in
(((read s j lsl 8) + read s (j + 1)) lsl 8 + read s (j + 2)) lsl 8 + read s (j + 3)
(* [unflatten1 (n, data) i j] accesses the two-dimensional bitmap
represented by [(n, data)] at indices [i] and [j]. The integer
[n] is the width of the bitmap; the string [data] is the second
component of the packed array obtained by encoding the table as
a one-dimensional array. *)
let unflatten1 (n, data) i j =
get1 data (n * i + j)
......@@ -34,3 +34,11 @@ val get: t -> int -> int
val get1: string -> int -> int
(* [unflatten1 (n, data) i j] accesses the two-dimensional bitmap
represented by [(n, data)] at indices [i] and [j]. The integer
[n] is the width of the bitmap; the string [data] is the second
component of the packed array obtained by encoding the table as
a one-dimensional array. *)
val unflatten1: int * string -> int -> int -> int
......@@ -381,6 +381,11 @@ let encode_symbol_option = function
| Some symbol ->
encode_symbol symbol
(* Encoding a Boolean as an integer value. *)
let encode_bool b =
if b then 1 else 0
(* ------------------------------------------------------------------------ *)
(* Table compression. *)
......@@ -434,7 +439,18 @@ let linearize_and_marshal1 (table : int array array) =
let data, entry = MenhirLib.LinearizedArray.make table in
ETuple [ marshal1 data; marshal1 entry ]
(* [marshal2] marshals a two-dimensional table. *)
(* [flatten_and_marshal11_list] marshals a two-dimensional bitmap,
whose width (for now) is assumed to be [Terminal.n - 1]. *)
let flatten_and_marshal11_list (table : int list list) =
ETuple [
(* Store the table width. *)
EIntConst (Terminal.n - 1);
(* View the table as a one-dimensional array, and marshal it. *)
marshal11_list (List.flatten table)
]
(* [marshal2] marshals a two-dimensional table, with row displacement. *)
let marshal2 name m n (matrix : int list list) =
let matrix : int array array =
......@@ -571,18 +587,13 @@ let goto =
let error =
define_and_measure (
"error",
ETuple [
EIntConst (Terminal.n - 1);
marshal11_list (
List.flatten (
Lr1.map (fun node ->
Terminal.mapx (fun t ->
error node t
)
)
)
flatten_and_marshal11_list (
Lr1.map (fun node ->
Terminal.mapx (fun t ->
error node t
)
)
]
)
)
let default_reduction =
......@@ -909,14 +920,31 @@ let lr0_items () =
let nullable () =
assert Settings.inspection;
let nullable : int list =
Nonterminal.map (fun nt ->
if Analysis.nullable nt then 1 else 0
)
in
define_and_measure (
"nullable",
marshal11_list nullable
marshal11_list (
Nonterminal.map (fun nt ->
encode_bool (Analysis.nullable nt)
)
)
)
(* ------------------------------------------------------------------------ *)
(* A two-dimensional bitmap, indexed first by nonterminal symbols, then by
terminal symbols, encodes the FIRST sets. *)
let first () =
assert Settings.inspection;
define_and_measure (
"first",
flatten_and_marshal11_list (
Nonterminal.map (fun nt ->
Terminal.mapx (fun t ->
encode_bool (TerminalSet.mem t (Analysis.first nt))
)
)
)
)
(* ------------------------------------------------------------------------ *)
......@@ -1022,6 +1050,7 @@ let program =
lr0_core() ::
lr0_items() ::
nullable() ::
first() ::
[]
) ::
[]
......
......@@ -52,11 +52,8 @@ module Make (T : TableFormat.TABLES)
(* This auxiliary function helps access a flattened, two-dimensional
matrix, like the error bitmap. *)
let unflatten (n, data) i j =
PackedIntArray.get1 data (n * i + j)
let action state terminal value shift reduce fail env =
match unflatten T.error state terminal with
match PackedIntArray.unflatten1 T.error state terminal with
| 1 ->
let action = unmarshal2 T.action state terminal in
let opcode = action land 0b11
......
......@@ -67,6 +67,12 @@ let tokengadtdef grammar =
(* the [error] token has a semantic value of type [unit] *)
} in
let datadefs =
(* The ordering of this list matters. We want the data constructors
to respect the internal ordering (as determined by [typed_tokens]
in [UnparameterizedSyntax]) of the terminal symbols. This may be
exploited in the table back-end to allow an unsafe conversion
of a data constructor to an integer code. See [t2i] in
[InspectionTableInterpreter]. *)
errordata ::
List.map (fun (token, typo) -> {
dataname = ttokengadtdata 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