Moved [production_where] from [Invariant] to [Lr1].

src/codeBackend.ml

@@ -439,7 +439,7 @@ let (shiftreduce : Production.index -> bool), shiftreducecount =
     (* Check that all call sites push a stack cell and have a
        default reduction. *)
 
-    Invariant.fold_reduced (fun s accu ->
+    Lr1.fold_reduced (fun s accu ->
       accu && (match Default.has_default_reduction s with None -> false | Some _ -> true)
            && (runpushes s)
     ) prod true
@@ -1665,7 +1665,7 @@ let program =
       Nonterminal.foldx (fun nt defs ->
         gotodef nt :: defs
       ) (Production.fold (fun prod defs ->
-        if Invariant.ever_reduced prod then
+        if Lr1.ever_reduced prod then
           reducedef prod :: defs
         else
           defs

src/invariant.ml

@@ -236,43 +236,6 @@ let stack_states (node : Lr1.node) : StateVector.property =
   | NonBottom v ->
       v
 
-(* ------------------------------------------------------------------------ *)
-(* For each production, compute where (that is, in which states) this
-   production can be reduced. *)
-
-let production_where : Lr1.NodeSet.t ProductionMap.t =
-  Lr1.fold (fun accu node ->
-    TerminalMap.fold (fun _ prods accu ->
-      let prod = Misc.single prods in
-      let nodes =
-        try
-          ProductionMap.lookup prod accu
-        with Not_found ->
-          Lr1.NodeSet.empty
-      in
-      ProductionMap.add prod (Lr1.NodeSet.add node nodes) accu
-    ) (Lr1.reductions node) accu
-  ) ProductionMap.empty
-
-let production_where (prod : Production.index) : Lr1.NodeSet.t =
-  try
-    (* Production [prod] may be reduced at [nodes]. *)
-    let nodes = ProductionMap.lookup prod production_where in
-    assert (not (Lr1.NodeSet.is_empty nodes));
-    nodes
-  with Not_found ->
-    (* The production [prod] is never reduced. *)
-    Lr1.NodeSet.empty
-
-let may_reduce node prod =
-  Lr1.NodeSet.mem node (production_where prod)
-
-let ever_reduced prod =
-  not (Lr1.NodeSet.is_empty (production_where prod))
-
-let fold_reduced f prod accu =
-  Lr1.NodeSet.fold f (production_where prod) accu
-
 (* ------------------------------------------------------------------------ *)
 (* Warn about productions that are never reduced. *)
 
@@ -286,7 +249,7 @@ let fold_reduced f prod accu =
 let () =
   let count = ref 0 in
   Production.iter (fun prod ->
-    if Lr1.NodeSet.is_empty (production_where prod) then
+    if Lr1.NodeSet.is_empty (Lr1.production_where prod) then
       match Production.classify prod with
       | Some nt ->
           incr count;
@@ -312,7 +275,7 @@ let () =
 
 let production_states : Production.index -> StateLattice.property =
   Production.tabulate (fun prod ->
-    let nodes = production_where prod in
+    let nodes = Lr1.production_where prod in
     let height = Production.length prod in
     Lr1.NodeSet.fold (fun node accu ->
       join accu
@@ -439,7 +402,7 @@ let () =
       | Bottom ->
           ()
       | NonBottom v ->
-          let sites = production_where prod in
+          let sites = Lr1.production_where prod in
           let length = Production.length prod in
           if length = 0 then
             Lr1.NodeSet.iter represent sites

src/invariant.mli

@@ -113,22 +113,6 @@ val endp: Symbol.t -> bool
 
 val errorpeeker: Lr1.node -> bool
 
-(* ------------------------------------------------------------------------- *)
-(* Information about which productions are reduced and where. *)
-
-(* [may_reduce s prod] tells whether state [s] may reduce production [prod]. *)
-
-val may_reduce: Lr1.node -> Production.index -> bool
-
-(* [ever_reduced prod] tells whether production [prod] is ever reduced. *)
-
-val ever_reduced: Production.index -> bool
-
-(* [fold_reduced prod] folds over all states that can reduce
-   production [prod]. *)
-
-val fold_reduced: (Lr1.node -> 'a -> 'a) -> Production.index -> 'a -> 'a
-
 (* ------------------------------------------------------------------------- *)
 (* Miscellaneous. *)
 

src/lr1.ml

@@ -934,6 +934,56 @@ let () =
   if Error.errors() then
     exit 1
 
+(* ------------------------------------------------------------------------ *)
+
+(* For each production, compute where (that is, in which states) this
+   production can be reduced. This computation is done AFTER default conflict
+   resolution (see below). It is an error to call the accessor functions
+   [may_reduce], [ever_reduced], [fold_reduced] before conflict resolution. *)
+
+let production_where : NodeSet.t ProductionMap.t option ref =
+  ref None
+
+let initialize_production_where () =
+  production_where := Some (
+    fold (fun accu node ->
+      TerminalMap.fold (fun _ prods accu ->
+        let prod = Misc.single prods in
+        let nodes =
+          try
+            ProductionMap.lookup prod accu
+          with Not_found ->
+            NodeSet.empty
+        in
+        ProductionMap.add prod (NodeSet.add node nodes) accu
+      ) (reductions node) accu
+    ) ProductionMap.empty
+  )
+
+let production_where (prod : Production.index) : NodeSet.t =
+  match !production_where with
+  | None ->
+      (* It is an error to call this function before conflict resolution. *)
+      assert false
+  | Some production_where ->
+      try
+        (* Production [prod] may be reduced at [nodes]. *)
+        let nodes = ProductionMap.lookup prod production_where in
+        assert (not (NodeSet.is_empty nodes));
+        nodes
+      with Not_found ->
+        (* The production [prod] is never reduced. *)
+        NodeSet.empty
+
+let may_reduce node prod =
+  NodeSet.mem node (production_where prod)
+
+let ever_reduced prod =
+  not (NodeSet.is_empty (production_where prod))
+
+let fold_reduced f prod accu =
+  NodeSet.fold f (production_where prod) accu
+
 (* ------------------------------------------------------------------------ *)
 (* When requested by the code generator, apply default conflict
    resolution to ensure that the automaton is deterministic. *)
@@ -1084,7 +1134,10 @@ let default_conflict_resolution () =
   if !ambiguities = 1 then
     Error.grammar_warning [] "one state has an end-of-stream conflict."
   else if !ambiguities > 1 then
-    Error.grammar_warning [] "%d states have an end-of-stream conflict." !ambiguities
+    Error.grammar_warning [] "%d states have an end-of-stream conflict." !ambiguities;
+
+  (* We can now compute where productions are reduced. *)
+  initialize_production_where()
 
 (* ------------------------------------------------------------------------ *)
 (* Extra reductions. *)

src/lr1.mli

@@ -176,3 +176,25 @@ val default_conflict_resolution: unit -> unit
 
 val extra_reductions: unit -> unit
 
+(* ------------------------------------------------------------------------- *)
+(* Information about which productions are reduced and where. It is an error
+   to call one of these functions before default conflict resolution has taken
+   place. *)
+
+(* [production_where prod] is the set of all states [s] where production
+   [prod] might be reduced. *)
+
+val production_where: Production.index -> NodeSet.t
+
+(* [may_reduce s prod] tells whether state [s] may reduce production [prod]. *)
+
+val may_reduce: node -> Production.index -> bool
+
+(* [ever_reduced prod] tells whether production [prod] is ever reduced. *)
+
+val ever_reduced: Production.index -> bool
+
+(* [fold_reduced prod] folds over all states that can reduce
+   production [prod]. *)
+
+val fold_reduced: (node -> 'a -> 'a) -> Production.index -> 'a -> 'a

src/referenceInterpreter.ml

@@ -195,7 +195,7 @@ module T = struct
       }
 
   let may_reduce =
-    Invariant.may_reduce
+    Lr1.may_reduce
 
   (* The logging functions that follow are called only if [log] is [true]. *)