Added experimental --lalr switch. Untested!

src/invariant.ml

@@ -792,7 +792,8 @@ let (has_default_reduction : Lr1.node -> (Production.index * TerminalSet.t) opti
 	    | Settings.ModeCanonical ->
 	        None
 	    | Settings.ModeInclusionOnly
-	    | Settings.ModePager ->
+	    | Settings.ModePager
+            | Settings.ModeLALR ->
 	        reduction
 	  end
 

src/lr1.ml

@@ -299,6 +299,8 @@ let materialize (source : node) (symbol : Symbol.t) (target : Lr0.lr1state) : un
     (* 20120525: the manner in which this check is performed depends on
        [Settings.construction_mode]. There are now three modes. *)
 
+    (* 20150204: there are now four modes. *)
+
     begin match Settings.construction_mode with
     | Settings.ModeCanonical ->
 
@@ -327,6 +329,9 @@ let materialize (source : node) (symbol : Symbol.t) (target : Lr0.lr1state) : un
 	    raise (Subsumed node)
 	) similar
 
+    | Settings.ModeLALR ->
+        ()
+
     end;
 
     begin match Settings.construction_mode with
@@ -352,6 +357,15 @@ let materialize (source : node) (symbol : Symbol.t) (target : Lr0.lr1state) : un
 	    raise (Compatible node)
 	) similar
 
+    | Settings.ModeLALR ->
+
+        (* In LALR mode, as soon as there is one similar state -- i.e. one
+           state that shares the same LR(0) core -- we merge the new state
+           into the existing one. *)
+	List.iter (fun node ->
+	  raise (Compatible node)
+	) similar
+
     end;
 
     (* The above checks have failed. Create a new node. Two states that are in
@@ -376,7 +390,7 @@ let materialize (source : node) (symbol : Symbol.t) (target : Lr0.lr1state) : un
 	 that all transition decisions made so far are explicit. *)
 
       node.state <- Lr0.union target node.state;
-      follow_state "Joining and growing existing state (Pager says, fine)" node true;
+      follow_state "Joining and growing existing state" node true;
       source.transitions <- SymbolMap.add symbol node source.transitions;
       grow_successors node
 

src/settings.ml

@@ -31,6 +31,8 @@ type construction_mode =
 			              relationship, default reductions are used *)
   | ModePager         (* normal mode: states are merged as per Pager's criterion,
 			              default reductions are used *)
+  | ModeLALR          (* --lalr     : states are merged as in an LALR generator,
+                                      i.e. as soon as they have the same LR(0) core *)
 
 (* Note that --canonical overrides --no-pager. If both are specified, the result
    is a canonical automaton. *)
@@ -176,6 +178,7 @@ let options = Arg.align [
   "--inspection", Arg.Set inspection, " Generate the inspection API (requires --table)";
   "--interpret", Arg.Set interpret, " Interpret the sentences provided on stdin";
   "--interpret-show-cst", Arg.Set interpret_show_cst, " Show a concrete syntax tree upon acceptance";
+  "--lalr", Arg.Unit (fun () -> construction_mode := ModeLALR), " Construct an LALR(1) automaton";
   "--log-automaton", Arg.Set_int logA, "<level> Log information about the automaton";
   "--log-code", Arg.Set_int logC, "<level> Log information about the generated code";
   "--log-grammar", Arg.Set_int logG, "<level> Log information about the grammar";

src/settings.mli

@@ -21,6 +21,8 @@ type construction_mode =
 			              relationship, default reductions are used *)
   | ModePager         (* normal mode: states are merged as per Pager's criterion,
 			              default reductions are used *)
+  | ModeLALR          (* --lalr     : states are merged as in an LALR generator,
+                                      i.e. as soon as they have the same LR(0) core *)
 
 val construction_mode: construction_mode