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

of [incoming_symbol] are equivalent.

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
 

src/inspectionTableInterpreter.ml

-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)

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() ::