Removed the old implementation of [incoming_symbol].

TODO

 * Clean up Lr1.incoming_symbol by going through Lr0.
 
-* Possibly re-implement the function [symbol] using a packed
-  int array (going through [terminal] or [nonterminal] later).
-  Also, go through lr0 core first.
-
 * Generate default printers for terminal and nonterminal.
   Define printers for productions and items, parameterized
   over printers for terminal and nonterminal.

src/inspectionTableFormat.ml

@@ -5,12 +5,13 @@
 
 module type 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. *)
+  (* The type ['a lr1state] describes an LR(1) state and will be defined
+     internally as [int]. The types ['a symbol] and [xsymbol] are (generated)
+     algebraic data types. These types must appear here because they serve to
+     describe the argument and/or result of [InspectionTableInterpreter.Make]. *)
 
   type 'a lr1state
+
   type 'a symbol
 
   type xsymbol = 
@@ -23,10 +24,6 @@ module type TABLES = sig
   val    terminal: int -> xsymbol
   val nonterminal: int -> xsymbol
 
-  (* A mapping of every (non-initial) state to its incoming symbol. *)
-
-  val incoming_symbol: 'a lr1state -> 'a symbol
-
   (* The left-hand side of every production. (Same as in [TableFormat.TABLES].) *)
 
   val lhs: PackedIntArray.t

src/inspectionTableInterpreter.ml

@@ -15,7 +15,7 @@ module Make (
   (* 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 =
+  let decode_symbol (symbol : int) : T.xsymbol =
     (* 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. *)
@@ -28,20 +28,20 @@ module Make (
     else
       T.nonterminal symbol
 
-  (* The function [incoming_symbol] is generated by the table back-end.
-     We just expose it. *)
+  (* The function [incoming_symbol] goes through the tables [lr0_core] and
+     [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
+     step is ill-typed and potentially dangerous. It is safe only because this
+     function is used at type ['a lr1state -> 'a symbol], which forces an
+     appropriate choice of ['a]. *)
 
-  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
+  let incoming_symbol (s : 'a T.lr1state) : 'a T.symbol =
+    let core = PackedIntArray.get T.lr0_core s in
+    let symbol = decode_symbol (PackedIntArray.get T.lr0_incoming core) in
+    match symbol 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. *)
 

src/tableBackend.ml

@@ -853,60 +853,6 @@ let lr0_incoming () =
 
 (* ------------------------------------------------------------------------ *)
 
-(* 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]. *)
-
-(* 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
-   abstract type. *)
-
-let incoming_symbol () =
-  assert Settings.inspection;
-  define (
-    "incoming_symbol",
-    EAnnot (
-      EFun ([ PVar state ],
-	EMatch (EVar state,
-          (* A default branch is used to ensure exhaustiveness. *)
-          let default =
-            { branchpat =
-                PWildcard;
-              branchbody =
-                EComment ("This state does not exist.",
-                  EApp (EVar "assert", [ efalse ])
-                )
-            }
-          in
-          (* One branch per LR(1) state. *)
-	  Lr1.fold (fun branches node ->
-            let branchpat =
-              pint (Lr1.number node)
-            in
-            let branchbody =
-	      match Lr1.incoming_symbol node with
-	      | None ->
-                  (* This function must not be applied to an initial state.
-                     We will be careful not to expose the initial states
-                     as inhabitants of the type ['a lr1state]. *)
-                  EComment ("This is an initial state.",
-                    EApp (EVar "assert", [ efalse ])
-                  )
-              | Some symbol ->
-                  (* To a non-initial state, we associate a representation
-                     of its incoming symbol. *)
-                  EMagic (esymbol symbol)
-            in
-	    { branchpat; branchbody } :: branches
-	  ) [default]
-	)
-      ),
-      let a = TypVar "a" in
-      type2scheme (arrow (tlr1state a) (tsymbolgadt a))
-    )
-  )
-
-(* ------------------------------------------------------------------------ *)
-
 (* A table that maps a production (i.e., an integer index) to the production's
    right-hand side. In principle, we use this table for ordinary productions
    only, as opposed to the start productions, whose existence is not exposed
@@ -1057,7 +1003,6 @@ let program =
           SIValDefs (false,
             terminal() ::
             nonterminal() ::
-            incoming_symbol() ::
             lr0_incoming() ::
             rhs() ::
             lr0_core() ::