Commit 2aff803b authored by POTTIER Francois's avatar POTTIER Francois
Browse files

Add [first] to the inspection API.

parent ee536645
* Add ways of iterating over all symbols.
* Add left-recursive lists to the standard library. * Add left-recursive lists to the standard library.
* Define [print_result]. * Define [print_result].
......
...@@ -194,6 +194,12 @@ module type INSPECTION = sig ...@@ -194,6 +194,12 @@ module type INSPECTION = sig
val nullable: 'a nonterminal -> bool 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] enumerates the terminal symbols, including [error].
[foreach_terminal_but_error] enumerates the terminal symbols, excluding [foreach_terminal_but_error] enumerates the terminal symbols, excluding
[error]. *) [error]. *)
......
...@@ -52,5 +52,10 @@ module type TABLES = sig ...@@ -52,5 +52,10 @@ module type TABLES = sig
(* This is a packed int array of bit width 1. It can be read (* This is a packed int array of bit width 1. It can be read
using [PackedIntArray.get1]. *) 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 end
...@@ -63,17 +63,23 @@ module Make ...@@ -63,17 +63,23 @@ module Make
else else
T.nonterminal symbol T.nonterminal symbol
(* This auxiliary function converts a nonterminal symbol to its integer (* These auxiliary functions convert a symbol to its integer code. For speed
code. For speed and for convenience, we use an unsafe type cast. This and for convenience, we use an unsafe type cast. This relies on the fact
relies on the fact that the data constructors of the [nonterminal] GADT that the data constructors of the [terminal] and [nonterminal] GADTs are
are declared in an order that reflects their internal code. We add declared in an order that reflects their internal code. In the case of
[start] to account for the presence of the start symbols. *) nonterminal symbols, we add [start] to account for the presence of the
start symbols. *)
let n2i (nt : 'a T.nonterminal) : int = let n2i (nt : 'a T.nonterminal) : int =
let answer = B.start + Obj.magic nt in let answer = B.start + Obj.magic nt in
assert (T.nonterminal answer = X (N nt)); (* TEMPORARY roundtrip *) assert (T.nonterminal answer = X (N nt)); (* TEMPORARY roundtrip *)
answer 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 (* The function [incoming_symbol] goes through the tables [T.lr0_core] and
[T.lr0_incoming]. This yields a representation of type [xsymbol], out of [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 which we strip the [X] quantifier, so as to get a naked symbol. This last
...@@ -121,8 +127,18 @@ module Make ...@@ -121,8 +127,18 @@ module Make
integer code, which it uses to look up the array [T.nullable]. 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. *) 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 = 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 (* The function [foreach_terminal] exploits the fact that the
first component of [B.error] is [Terminal.n - 1], i.e., 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 = ...@@ -183,3 +183,12 @@ let get ((k, s) : t) (i : int) : int =
let j = 4 * i in 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) (((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 ...@@ -34,3 +34,11 @@ val get: t -> int -> int
val get1: string -> 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 ...@@ -381,6 +381,11 @@ let encode_symbol_option = function
| Some symbol -> | Some symbol ->
encode_symbol symbol encode_symbol symbol
(* Encoding a Boolean as an integer value. *)
let encode_bool b =
if b then 1 else 0
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
(* Table compression. *) (* Table compression. *)
...@@ -434,7 +439,18 @@ let linearize_and_marshal1 (table : int array array) = ...@@ -434,7 +439,18 @@ let linearize_and_marshal1 (table : int array array) =
let data, entry = MenhirLib.LinearizedArray.make table in let data, entry = MenhirLib.LinearizedArray.make table in
ETuple [ marshal1 data; marshal1 entry ] 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 marshal2 name m n (matrix : int list list) =
let matrix : int array array = let matrix : int array array =
...@@ -571,18 +587,13 @@ let goto = ...@@ -571,18 +587,13 @@ let goto =
let error = let error =
define_and_measure ( define_and_measure (
"error", "error",
ETuple [ flatten_and_marshal11_list (
EIntConst (Terminal.n - 1); Lr1.map (fun node ->
marshal11_list ( Terminal.mapx (fun t ->
List.flatten ( error node t
Lr1.map (fun node -> )
Terminal.mapx (fun t ->
error node t
)
)
)
) )
] )
) )
let default_reduction = let default_reduction =
...@@ -909,14 +920,31 @@ let lr0_items () = ...@@ -909,14 +920,31 @@ let lr0_items () =
let nullable () = let nullable () =
assert Settings.inspection; assert Settings.inspection;
let nullable : int list =
Nonterminal.map (fun nt ->
if Analysis.nullable nt then 1 else 0
)
in
define_and_measure ( define_and_measure (
"nullable", "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 = ...@@ -1022,6 +1050,7 @@ let program =
lr0_core() :: lr0_core() ::
lr0_items() :: lr0_items() ::
nullable() :: nullable() ::
first() ::
[] []
) :: ) ::
[] []
......
...@@ -52,11 +52,8 @@ module Make (T : TableFormat.TABLES) ...@@ -52,11 +52,8 @@ module Make (T : TableFormat.TABLES)
(* This auxiliary function helps access a flattened, two-dimensional (* This auxiliary function helps access a flattened, two-dimensional
matrix, like the error bitmap. *) 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 = 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 -> | 1 ->
let action = unmarshal2 T.action state terminal in let action = unmarshal2 T.action state terminal in
let opcode = action land 0b11 let opcode = action land 0b11
......
...@@ -67,6 +67,12 @@ let tokengadtdef grammar = ...@@ -67,6 +67,12 @@ let tokengadtdef grammar =
(* the [error] token has a semantic value of type [unit] *) (* the [error] token has a semantic value of type [unit] *)
} in } in
let datadefs = 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 :: errordata ::
List.map (fun (token, typo) -> { List.map (fun (token, typo) -> {
dataname = ttokengadtdata token; 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