Commit 40334621 authored by POTTIER Francois's avatar POTTIER Francois

Cleanup. Comments.

parent 5a9d6760
* Split TableFormat and TableInterpreter? * Split TableFormat and TableInterpreter?
Add LinearizedArray to MenhirLib if needed.
* Possibly re-implement the function [symbol] using a packed * Possibly re-implement the function [symbol] using a packed
int array (going through [terminal] or [nonterminal] later). int array (going through [terminal] or [nonterminal] later).
Re-implement [production_defs], etc.
* Generate default printers for terminal and nonterminal. * Generate default printers for terminal and nonterminal.
Define printers for productions and items, parameterized Define printers for productions and items, parameterized
......
...@@ -33,7 +33,7 @@ let print_element e : string = ...@@ -33,7 +33,7 @@ let print_element e : string =
match e with match e with
| I.Element (s, v, _, _) -> | I.Element (s, v, _, _) ->
let open Parser.Inspection in let open Parser.Inspection in
match symbol s with match incoming_symbol s with
| T T_TIMES -> | T T_TIMES ->
"*" "*"
| T T_RPAREN -> | T T_RPAREN ->
......
...@@ -102,7 +102,7 @@ module type INSPECTION = sig ...@@ -102,7 +102,7 @@ module type INSPECTION = sig
type xsymbol type xsymbol
val symbol: 'a lr1state -> 'a symbol val incoming_symbol: 'a lr1state -> 'a symbol
val lhs: production -> xsymbol val lhs: production -> xsymbol
......
...@@ -828,17 +828,17 @@ let nonterminal () = ...@@ -828,17 +828,17 @@ let nonterminal () =
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
(* Produce a function [symbol] that maps a state of type ['a lr1state] (* 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]. *) (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 (* 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 [int], so we can pattern match on it. To the user, though, it will be an
abstract type. *) abstract type. *)
let incoming_symbol_def () = let incoming_symbol () =
assert Settings.inspection; assert Settings.inspection;
define ( define (
"symbol", "incoming_symbol",
EAnnot ( EAnnot (
EFun ([ PVar state ], EFun ([ PVar state ],
EMatch (EVar state, EMatch (EVar state,
...@@ -1020,18 +1020,19 @@ let program = ...@@ -1020,18 +1020,19 @@ let program =
SIInclude (MVar more) :: SIInclude (MVar more) ::
SIInclude (MApp (MVar make_inspection, MStruct ( SIInclude (MApp (MVar make_inspection, MStruct (
SIInclude (MVar more) :: (* This module must satisfy [INSPECTION_TABLES]. *)
(* [lr1state] *)
interface_to_structure [ interface_to_structure [
lr1state_redef; lr1state_redef;
] @ ] @
SIInclude (MVar tables) :: (* only for [lhs] *) (* [symbol], [xsymbol]. *)
SIInclude (MVar more) ::
(* [lhs] *)
SIInclude (MVar tables) ::
SIValDefs (false, SIValDefs (false,
terminal() :: terminal() ::
nonterminal() :: nonterminal() ::
[] incoming_symbol() ::
) ::
SIValDefs (false,
incoming_symbol_def() ::
rhs() :: rhs() ::
lr0_core() :: lr0_core() ::
lr0_items() :: lr0_items() ::
......
...@@ -119,22 +119,31 @@ end ...@@ -119,22 +119,31 @@ end
addition to the above) when [--inspection] is enabled. It is used as an addition to the above) when [--inspection] is enabled. It is used as an
argument to [TableInterpreter.Inspection]. *) argument to [TableInterpreter.Inspection]. *)
(* TEMPORARY comment/document *)
module type INSPECTION_TABLES = sig module type INSPECTION_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. *)
type 'a lr1state type 'a lr1state
type 'a symbol type 'a symbol
type xsymbol type xsymbol
val lhs: PackedIntArray.t (* or: could include TABLES *) (* Some of the tables that follow use encodings of (terminal and
nonterminal) symbols as integers. So, we need functions that
map the integer encoding of a symbol to its algebraic encoding. *)
val terminal: int -> xsymbol val terminal: int -> xsymbol
val nonterminal: int -> xsymbol val nonterminal: int -> xsymbol
(* A mapping of every (non-initial) state to its incoming symbol. *) (* A mapping of every (non-initial) state to its incoming symbol. *)
val symbol: 'a lr1state -> 'a symbol val incoming_symbol: 'a lr1state -> 'a symbol
(* A left-hand side of every production. (Same as in [TABLES].) *)
val lhs: PackedIntArray.t
(* The right-hand side of every production. This a linearized array (* The right-hand side of every production. This a linearized array
of arrays of integers, whose [data] and [entry] components have of arrays of integers, whose [data] and [entry] components have
......
...@@ -171,28 +171,42 @@ end) ...@@ -171,28 +171,42 @@ end)
module MakeInspection (T : TableFormat.INSPECTION_TABLES) = struct module MakeInspection (T : TableFormat.INSPECTION_TABLES) = struct
let symbol = (* This auxiliary function decodes a packed linearized array, as created by
T.symbol [TableBackend.linearize_and_marshal1]. Here, we read a row all at once. *)
let read_packed_linearized ((data, entry) : PackedIntArray.t * PackedIntArray.t) (i : int) : int list =
LinearizedArray.read_row_via
(PackedIntArray.get data)
(PackedIntArray.get entry)
i
(* The function [incoming_symbol] is generated by the table back-end.
We just expose it. *)
let incoming_symbol =
T.incoming_symbol
(* The function [lhs] reads the table [lhs] and uses [T.nonterminal]
to decode the symbol. *)
let lhs prod = let lhs prod =
let nt : int = PackedIntArray.get T.lhs prod in T.nonterminal (PackedIntArray.get T.lhs prod)
T.nonterminal nt
(* 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 decode_symbol symbol =
let kind = symbol land 1 in let kind = symbol land 1 in
(if kind = 0 then T.terminal else T.nonterminal) (symbol lsr 1) (if kind = 0 then T.terminal else T.nonterminal) (symbol lsr 1)
let rhs prod = let rhs prod =
let (data, entry) = T.rhs in List.map decode_symbol (read_packed_linearized T.rhs prod)
let rhs : int list =
LinearizedArray.read_row_via
(PackedIntArray.get data)
(PackedIntArray.get entry)
prod
in
List.map decode_symbol rhs
(* This is a copy of [Item.export]. *) (* The function [items] maps the LR(1) state [s] to its LR(0) core,
then uses [core] as an index into the table [lr0_items]. The
items are then decoded by the function [export] below, which is
essentially a copy of [Item.export]. *)
let export t = let export t =
(t lsr 7, t mod 128) (t lsr 7, t mod 128)
...@@ -201,13 +215,6 @@ module MakeInspection (T : TableFormat.INSPECTION_TABLES) = struct ...@@ -201,13 +215,6 @@ module MakeInspection (T : TableFormat.INSPECTION_TABLES) = struct
(* Map [s] to its LR(0) core. *) (* Map [s] to its LR(0) core. *)
let core = PackedIntArray.get T.lr0_core s in let core = PackedIntArray.get T.lr0_core s in
(* Now use [core] to look up the [lr0_items] table. *) (* Now use [core] to look up the [lr0_items] table. *)
let (data, entry) = T.lr0_items in List.map export (read_packed_linearized T.lr0_items core)
let items : int list =
LinearizedArray.read_row_via
(PackedIntArray.get data)
(PackedIntArray.get entry)
core
in
List.map export items
end end
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