From 058639009b263d8389480f0e19aa2b08cea73b3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Pottier?= Date: Fri, 9 Jan 2015 08:31:55 +0100 Subject: [PATCH] Added the table [lr0_incoming] and checked that the two implementations of [incoming_symbol] are equivalent. --- src/inspectionTableFormat.ml | 8 ++++- src/inspectionTableInterpreter.ml | 40 +++++++++++++++++++------ src/tableBackend.ml | 50 +++++++++++++++++++++++-------- 3 files changed, 76 insertions(+), 22 deletions(-) diff --git a/src/inspectionTableFormat.ml b/src/inspectionTableFormat.ml index 44be6c50..b58b4d97 100644 --- a/src/inspectionTableFormat.ml +++ b/src/inspectionTableFormat.ml @@ -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 diff --git a/src/inspectionTableInterpreter.ml b/src/inspectionTableInterpreter.ml index f62e56ef..e099a025 100644 --- a/src/inspectionTableInterpreter.ml +++ b/src/inspectionTableInterpreter.ml @@ -1,4 +1,7 @@ -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) diff --git a/src/tableBackend.ml b/src/tableBackend.ml index 37bea3c7..1239d79c 100644 --- a/src/tableBackend.ml +++ b/src/tableBackend.ml @@ -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() :: -- GitLab