Moved [has_default_reduction] out of [Invariant] and into a new module, [Default].

src/LRijkstra.ml

@@ -139,7 +139,7 @@ let reductions_on s z : Production.index list =
 
 let has_reduction s z : Production.index option =
   assert (Terminal.real z);
-  match Invariant.has_default_reduction s with
+  match Default.has_default_reduction s with
   | Some (prod, _) ->
       Some prod
   | None ->
@@ -155,7 +155,7 @@ let has_reduction s z : Production.index option =
    reduction). *)
 
 let can_reduce s prod =
-  match Invariant.has_default_reduction s with
+  match Default.has_default_reduction s with
   | Some (prod', _) when prod = prod' ->
       true
   | _ ->
@@ -170,7 +170,7 @@ let can_reduce s prod =
 
 let causes_an_error s z : bool =
   assert (Terminal.real z);
-  match Invariant.has_default_reduction s with
+  match Default.has_default_reduction s with
   | Some _ ->
       false
   | None ->
@@ -189,7 +189,7 @@ let foreach_terminal =
    [causes_an_error]. This implementation is significantly more efficient. *)
 
 let foreach_terminal_not_causing_an_error s f =
-  match Invariant.has_default_reduction s with
+  match Default.has_default_reduction s with
   | Some _ ->
       (* There is a default reduction. No symbol causes an error. *)
       foreach_terminal f
@@ -1087,7 +1087,7 @@ let new_fact fact =
        [prod, z] such that the [current] state can reduce [prod] on [z]
        and [position] accepts [prod]. *)
 
-    match Invariant.has_default_reduction current with
+    match Default.has_default_reduction current with
     | Some (prod, _) ->
         if Trie.accepts prod position then
           (* [new_edge] does not accept [any] as its 4th parameter, so we
@@ -1390,4 +1390,3 @@ let () =
 (* ------------------------------------------------------------------------ *)
 
 end
-

src/codeBackend.ml

@@ -369,7 +369,7 @@ let gotopushes : Nonterminal.t -> bool =
     not (
       Lr1.targets (fun accu _ target ->
         accu &&
-        match Invariant.has_default_reduction target with
+        match Default.has_default_reduction target with
         | Some (prod, _) ->
             Production.length prod > 0
         | None -> false
@@ -440,7 +440,7 @@ let (shiftreduce : Production.index -> bool), shiftreducecount =
        default reduction. *)
 
     Invariant.fold_reduced (fun s accu ->
-      accu && (match Invariant.has_default_reduction s with None -> false | Some _ -> true)
+      accu && (match Default.has_default_reduction s with None -> false | Some _ -> true)
            && (runpushes s)
     ) prod true
 
@@ -474,7 +474,7 @@ let () =
       else
         Lr1.targets (fun accu _ target ->
           accu &&
-          match Invariant.has_default_reduction target with
+          match Default.has_default_reduction target with
           | Some (prod, _) ->
               shiftreduce prod
           | None ->
@@ -1059,7 +1059,7 @@ let initiate s =
 
 let rundef s : valdef =
 
-  match Invariant.has_default_reduction s with
+  match Default.has_default_reduction s with
   | Some (prod, toks) as defred ->
 
       (* Perform reduction without looking ahead.

src/coqBackend.ml

@@ -38,7 +38,7 @@ module Run (T: sig end) = struct
             | Stretch.Inferred _ -> assert false (* We cannot infer coq types *)
 
   let is_final_state node =
-    match Invariant.has_default_reduction node with
+    match Default.has_default_reduction node with
       | Some (prod, _) -> Production.is_start prod
       | None -> false
 
@@ -277,7 +277,7 @@ module Run (T: sig end) = struct
     fprintf f "  match state with\n";
     lr1_iter_nonfinal (fun node ->
       fprintf f "  | %s => " (print_st node);
-      match Invariant.has_default_reduction node with
+      match Default.has_default_reduction node with
         | Some (prod, _) ->
           fprintf f "Default_reduce_act %s\n" (print_prod prod)
         | None ->

src/default.ml

+open Grammar
+module C = Conflict (* artificial dependency; ensures that [Conflict] runs first *)
+
+(* Here is how we check whether state [s] should have a default reduction.
+
+   We check whether [s] has no outgoing shift transitions and only has
+   one possible reduction action. In that case, we produce a default
+   reduction action, that is, we perform reduction without consulting
+   the lookahead token. This saves code, but can alter the parser's
+   behavior in the presence of errors.
+
+   The check for default actions subsumes the check for the case where
+   [s] admits a reduce action with lookahead symbol "#". In that case,
+   it must be the only possible action -- see
+   [Lr1.default_conflict_resolution]. That is, we have reached a point
+   where we have recognized a well-formed input and are now expecting
+   an end-of-stream. In that case, performing reduction without
+   looking at the next token is the right thing to do, since there
+   should in fact be none. The state that we reduce to will also have
+   the same property, and so on, so we will in fact end up rewinding
+   the entire stack and accepting the input when the stack becomes
+   empty.
+
+   (New as of 2012/01/23.) A state where a shift/reduce conflict was
+   solved in favor of neither (due to a use of the %nonassoc
+   directive) must not perform a default reduction. Indeed, this would
+   effectively mean that the failure that was requested by the user is
+   forgotten and replaced with a reduction. This surprising behavior
+   is present in ocamlyacc and was present in earlier versions of
+   Menhir. See e.g. http://caml.inria.fr/mantis/view.php?id=5462
+
+   There is a chance that we might run into trouble if the ideas
+   described in the above two paragraphs collide, that is, if we
+   forbid a default reduction (due to a shift/reduce conflict solved
+   by %nonassoc) in a node where we would like to have default
+   reduction on "#". This situation seems unlikely to arise, so I will
+   not do anything about it for the moment. (Furthermore, someone who
+   uses precedence declarations is looking for trouble anyway.)
+
+   Between 2012/05/25 and 2015/09/25, if [--canonical] has been specified,
+   then we disallow default reductions on a normal token, because we do not
+   want to introduce any spurious actions into the automaton. We do still
+   allow default reductions on "#", since they are needed for the automaton to
+   terminate properly. From 2015/09/25 on, we again always allow default
+   reductions, as they seem to be beneficial when explaining syntax errors. *)
+
+let has_default_reduction, count =
+  Misc.tabulateo Lr1.number Lr1.fold Lr1.n (fun s ->
+
+    if Lr1.forbid_default_reduction s then
+      None
+    else
+
+      let reduction = ProductionMap.is_singleton (Lr1.invert (Lr1.reductions s)) in
+      match reduction with
+      | Some _ ->
+          if SymbolMap.purelynonterminal (Lr1.transitions s)
+          then reduction
+          else None
+      | None ->
+          reduction
+
+  )
+
+let () =
+  Error.logC 1 (fun f ->
+    Printf.fprintf f
+       "%d out of %d states have a default reduction.\n"
+       count Lr1.n)
+
+let () =
+  Time.tick "Computing default reductions"

src/default.mli

+open Grammar
+
+(* [has_default_reduction s] tells whether state [s] has a default reduction,
+   and, if so, upon which set of tokens. *)
+
+val has_default_reduction : Lr1.node -> (Production.index * TerminalSet.t) option

src/interpret.ml

@@ -11,7 +11,8 @@
 (*                                                                            *)
 (******************************************************************************)
 
-module I = Invariant (* artificial dependency; ensures that [Invariant] runs first *)
+module I = Invariant (* artificial dependency *)
+module D = Default   (* artificial dependency *)
 
 (* --------------------------------------------------------------------------- *)
 
@@ -774,4 +775,3 @@ let () =
 
     exit 0
   )
-

src/invariant.ml

@@ -849,75 +849,6 @@ let errorpeekers =
 let errorpeeker node =
   Lr1.NodeSet.mem node errorpeekers
 
-(* ------------------------------------------------------------------------ *)
-(* Here is how we check whether state [s] should have a default
-   reduction.
-
-   We check whether [s] has no outgoing shift transitions and only has
-   one possible reduction action. In that case, we produce a default
-   reduction action, that is, we perform reduction without consulting
-   the lookahead token. This saves code, but can alter the parser's
-   behavior in the presence of errors.
-
-   The check for default actions subsumes the check for the case where
-   [s] admits a reduce action with lookahead symbol "#". In that case,
-   it must be the only possible action -- see
-   [Lr1.default_conflict_resolution]. That is, we have reached a point
-   where we have recognized a well-formed input and are now expecting
-   an end-of-stream. In that case, performing reduction without
-   looking at the next token is the right thing to do, since there
-   should in fact be none. The state that we reduce to will also have
-   the same property, and so on, so we will in fact end up rewinding
-   the entire stack and accepting the input when the stack becomes
-   empty.
-
-   (New as of 2012/01/23.) A state where a shift/reduce conflict was
-   solved in favor of neither (due to a use of the %nonassoc
-   directive) must not perform a default reduction. Indeed, this would
-   effectively mean that the failure that was requested by the user is
-   forgotten and replaced with a reduction. This surprising behavior
-   is present in ocamlyacc and was present in earlier versions of
-   Menhir. See e.g. http://caml.inria.fr/mantis/view.php?id=5462
-
-   There is a chance that we might run into trouble if the ideas
-   described in the above two paragraphs collide, that is, if we
-   forbid a default reduction (due to a shift/reduce conflict solved
-   by %nonassoc) in a node where we would like to have default
-   reduction on "#". This situation seems unlikely to arise, so I will
-   not do anything about it for the moment. (Furthermore, someone who
-   uses precedence declarations is looking for trouble anyway.)
-
-   Between 2012/05/25 and 2015/09/25, if [--canonical] has been specified,
-   then we disallow default reductions on a normal token, because we do not
-   want to introduce any spurious actions into the automaton. We do still
-   allow default reductions on "#", since they are needed for the automaton to
-   terminate properly. From 2015/09/25 on, we again always allow default
-   reductions, as they seem to be beneficial when explaining syntax errors. *)
-
-let (has_default_reduction : Lr1.node -> (Production.index * TerminalSet.t) option), hdrcount =
-  Misc.tabulateo Lr1.number Lr1.fold Lr1.n (fun s ->
-
-    if Lr1.forbid_default_reduction s then
-      None
-    else
-
-      let reduction = ProductionMap.is_singleton (Lr1.invert (Lr1.reductions s)) in
-      match reduction with
-      | Some _ ->
-          if SymbolMap.purelynonterminal (Lr1.transitions s)
-          then reduction
-          else None
-      | None ->
-          reduction
-
-  )
-
-let () =
-  Error.logC 1 (fun f ->
-    Printf.fprintf f
-       "%d out of %d states have a default reduction.\n"
-       hdrcount Lr1.n)
-
 (* ------------------------------------------------------------------------ *)
 
 let () =
@@ -925,9 +856,7 @@ let () =
 
 (* ------------------------------------------------------------------------ *)
 
-(* If any fatal error was signaled up to this point, stop now. This may include
-   errors signaled in the modules [lr1] and [invariant] by calling the function
-   [Error.grammar_warning]. *)
+(* If any fatal error was signaled up to this point, stop now. *)
 
 let () =
   if Error.errors() then

src/invariant.mli

@@ -129,14 +129,6 @@ val ever_reduced: Production.index -> bool
 
 val fold_reduced: (Lr1.node -> 'a -> 'a) -> Production.index -> 'a -> 'a
 
-(* ------------------------------------------------------------------------- *)
-(* Information about default reductions. *)
-
-(* [has_default_reduction s] tells whether state [s] has a default reduction,
-   and, if so, upon which set of tokens. *)
-
-val has_default_reduction : Lr1.node -> (Production.index * TerminalSet.t) option
-
 (* ------------------------------------------------------------------------- *)
 (* Miscellaneous. *)
 

src/lr1.ml

@@ -926,8 +926,13 @@ let () =
   else if !reduce_reduce > 1 then
     Error.grammar_warning [] "%d states have reduce/reduce conflicts." !reduce_reduce
 
-(* There is a global check for errors at the end of [Invariant], so we do
-   not need to check & stop here. *)
+(* ------------------------------------------------------------------------ *)
+
+(* If any fatal error was signaled up to this point, stop now. *)
+
+let () =
+  if Error.errors() then
+    exit 1
 
 (* ------------------------------------------------------------------------ *)
 (* When requested by the code generator, apply default conflict

src/referenceInterpreter.ml

@@ -61,7 +61,7 @@ module T = struct
   let find_production  = Production.i2p
 
   let default_reduction (s : state) defred nodefred env =
-    match Invariant.has_default_reduction s with
+    match Default.has_default_reduction s with
     | Some (prod, _) ->
         defred env prod
     | None ->
@@ -79,7 +79,7 @@ module T = struct
          [ShiftNoDiscard], depending on the existence of a default
          reduction on [#] at [s']. *)
 
-      match Invariant.has_default_reduction s' with
+      match Default.has_default_reduction s' with
       | Some (_, toks) when TerminalSet.mem Terminal.sharp toks ->
           shift env false tok value s'
       | _ ->

src/tableBackend.ml

@@ -488,7 +488,7 @@ let marshal2 name m n (matrix : int list list) =
 (* The action table. *)
 
 let action node t =
-  match Invariant.has_default_reduction node with
+  match Default.has_default_reduction node with
   | Some _ ->
 
       (* [node] has a default reduction; in that case, the action
@@ -504,7 +504,7 @@ let action node t =
         (* [node] has a transition to [target]. If [target] has a default
            reduction on [#], use [ShiftNoDiscard], otherwise [ShiftDiscard]. *)
 
-        match Invariant.has_default_reduction target with
+        match Default.has_default_reduction target with
         | Some (_, toks) when TerminalSet.mem Terminal.sharp toks ->
             assert (TerminalSet.cardinal toks = 1);
             encode_ShiftNoDiscard target
@@ -555,7 +555,7 @@ let error node t =
 (* The default reductions table. *)
 
 let default_reduction node =
-  match Invariant.has_default_reduction node with
+  match Default.has_default_reduction node with
   | Some (prod, _) ->
       encode_DefRed prod
   | None ->

test/good/JSParse.exp

@@ -427,10 +427,10 @@ The grammar is not SLR(1) -- 12 states have a conflict.
 Built an LR(1) automaton with 660 states.
 Warning: one state has shift/reduce conflicts.
 Warning: one shift/reduce conflict was arbitrarily resolved.
+239 out of 660 states have a default reduction.
 224 out of 660 states are represented.
 0 out of 257 symbols keep track of their start position.
 0 out of 257 symbols keep track of their end position.
-239 out of 660 states have a default reduction.
 188 out of 362 productions exploit shiftreduce optimization.
 0 out of 660 states can peek at an error.
 1805 functions before inlining, 237 functions after inlining.

test/good/K3Parser.exp

@@ -207,6 +207,7 @@ Warning: 3 states have reduce/reduce conflicts.
 Warning: 576 shift/reduce conflicts were arbitrarily resolved.
 Warning: 142 reduce/reduce conflicts were arbitrarily resolved.
 Warning: 266 states have an end-of-stream conflict.
+445 out of 1441 states have a default reduction.
 File "K3Parser.mly", line 399, characters 0-4:
 Warning: symbol expr is never accepted.
 File "K3Parser.mly", line 760, characters 6-26:
@@ -221,7 +222,6 @@ Warning: in total, 5 productions are never reduced.
 639 out of 1441 states are represented.
 0 out of 179 symbols keep track of their start position.
 0 out of 179 symbols keep track of their end position.
-445 out of 1441 states have a default reduction.
 220 out of 307 productions exploit shiftreduce optimization.
 297 out of 1441 states can peek at an error.
 3246 functions before inlining, 579 functions after inlining.

test/good/albatross.exp

@@ -337,6 +337,7 @@ Warning: the precedence level assigned to UMINUS is never useful.
 File "albatross.mly", line 440, characters 23-34:
 Warning: this %prec declaration is never useful.
 Warning: 117 states have an end-of-stream conflict.
+166 out of 428 states have a default reduction.
 File "albatross.mly", line 202, characters 2-25:
 Warning: production file -> use_block optsemi decls is never reduced.
 File "albatross.mly", line 203, characters 2-7:
@@ -347,7 +348,6 @@ Warning: in total, 3 productions are never reduced.
 198 out of 428 states are represented.
 0 out of 188 symbols keep track of their start position.
 0 out of 188 symbols keep track of their end position.
-166 out of 428 states have a default reduction.
 130 out of 250 productions exploit shiftreduce optimization.
 0 out of 428 states can peek at an error.
 1201 functions before inlining, 203 functions after inlining.

test/good/alphaCaml-demos-interactive.exp

@@ -11,10 +11,10 @@ Built an LR(0) automaton with 11 states.
 The grammar is not SLR(1) -- 1 states have a conflict.
 Built an LR(1) automaton with 11 states.
 One shift/reduce conflict was silently solved.
+6 out of 11 states have a default reduction.
 2 out of 11 states are represented.
 0 out of 11 symbols keep track of their start position.
 0 out of 11 symbols keep track of their end position.
-6 out of 11 states have a default reduction.
 5 out of 6 productions exploit shiftreduce optimization.
 0 out of 11 states can peek at an error.
 36 functions before inlining, 7 functions after inlining.

test/good/alphaCaml-demos-mixins.exp

@@ -43,10 +43,10 @@ follow(atomic_expression) = VAL RPAREN RCURLY PLUS IN EOF END DOT AND
 Built an LR(0) automaton with 68 states.
 The grammar is SLR(1).
 Built an LR(1) automaton with 68 states.
+27 out of 68 states have a default reduction.
 15 out of 68 states are represented.
 0 out of 41 symbols keep track of their start position.
 0 out of 41 symbols keep track of their end position.
-27 out of 68 states have a default reduction.
 18 out of 32 productions exploit shiftreduce optimization.
 0 out of 68 states can peek at an error.
 187 functions before inlining, 26 functions after inlining.

test/good/alphaCaml-demos-poplmark.exp

@@ -61,10 +61,10 @@ follow(ATerm) = SEMI RPAREN RCURLY LSQUARE LPAREN LCURLY LCID IN DOT COMMA
 Built an LR(0) automaton with 97 states.
 The grammar is SLR(1).
 Built an LR(1) automaton with 97 states.
+34 out of 97 states have a default reduction.
 32 out of 97 states are represented.
 0 out of 44 symbols keep track of their start position.
 0 out of 44 symbols keep track of their end position.
-34 out of 97 states have a default reduction.
 24 out of 47 productions exploit shiftreduce optimization.
 0 out of 97 states can peek at an error.
 266 functions before inlining, 45 functions after inlining.

test/good/alphaCaml.exp

@@ -85,10 +85,10 @@ follow(container) = error TYPE STAR SORT SEMICOLON RBRACE RANGLE IDENTIFIER EOF
 Built an LR(0) automaton with 139 states.
 The grammar is SLR(1).
 Built an LR(1) automaton with 143 states.
+74 out of 143 states have a default reduction.
 35 out of 143 states are represented.
 0 out of 61 symbols keep track of their start position.
 0 out of 61 symbols keep track of their end position.
-74 out of 143 states have a default reduction.
 66 out of 85 productions exploit shiftreduce optimization.
 9 out of 143 states can peek at an error.
 404 functions before inlining, 74 functions after inlining.

test/good/alphaprolog.exp

@@ -107,10 +107,10 @@ Built an LR(0) automaton with 259 states.
 The grammar is not SLR(1) -- 54 states have a conflict.
 Built an LR(1) automaton with 259 states.
 1418 shift/reduce conflicts were silently solved.
+79 out of 259 states have a default reduction.
 87 out of 259 states are represented.
 0 out of 116 symbols keep track of their start position.
 0 out of 116 symbols keep track of their end position.
-79 out of 259 states have a default reduction.
 66 out of 142 productions exploit shiftreduce optimization.
 0 out of 259 states can peek at an error.
 701 functions before inlining, 133 functions after inlining.

test/good/amalthea.exp

@@ -46,10 +46,10 @@ follow(atom) = Lstring Lsemi Lrpar Lperiod Llpar Llambda Lint Lident Lend
 Built an LR(0) automaton with 71 states.
 The grammar is SLR(1).
 Built an LR(1) automaton with 71 states.
+29 out of 71 states have a default reduction.
 24 out of 71 states are represented.
 0 out of 34 symbols keep track of their start position.
 0 out of 34 symbols keep track of their end position.
-29 out of 71 states have a default reduction.
 19 out of 36 productions exploit shiftreduce optimization.
 0 out of 71 states can peek at an error.
 198 functions before inlining, 33 functions after inlining.