Commit 7d18dd12 authored by POTTIER Francois's avatar POTTIER Francois Committed by POTTIER Francois
Browse files

Drastic simplification in LALR.

parent 7e0c2114
......@@ -26,245 +26,158 @@ module Run () = struct
(* -------------------------------------------------------------------------- *)
(* Nodes. *)
(* Since the LALR automaton has exactly the same states as the LR(0)
automaton, up to lookahead information, we can use the same state
numbers. *)
type node = {
type node =
(* An internal node number assigned during construction. This number
appears in Menhir's output when [--follow-construction] is set.
This number is also exposed to the client so as to allow building
efficient maps over nodes. It otherwise has no use. *)
number: int;
(* Each node is associated with a state. This state can change during
construction as nodes are merged. *)
mutable state: lr1state;
(* Each node carries information about its outgoing transitions towards
other nodes. *)
let n =
mutable transitions: node SymbolMap.t;
(* Each node is associated with a state. This state can change during
construction as nodes are merged. *)
let states : lr1state option array =
Array.make n None
(* -------------------------------------------------------------------------- *)
(* Output debugging information if [--follow-construction] is enabled. *)
let print_state (state : lr1state) =
Lr0.print_closure "" state
let print_ostate (ostate : lr1state option) =
match ostate with
| None ->
| Some state ->
print_state state
let follow_transition
(again : bool) (source : node) (symbol : Symbol.t) (state : lr1state)
(source : node) (symbol : Symbol.t) (target : node) (state : lr1state)
if Settings.follow then
Printf.fprintf stderr
"%s transition out of state r%d along symbol %s.\n\
"Examining transition out of state %d along symbol %s to state %d.\n\
Proposed target state:\n%s"
(if again then "Re-examining" else "Examining")
(Symbol.print symbol)
(Lr0.print_closure "" state)
(print_state state)
let follow_state (msg : string) (node : node) (print : bool) =
if Settings.follow then
Printf.fprintf stderr
"%s: r%d.\n%s\n"
"%s: %d.\n%s\n"
(if print then Lr0.print_closure "" node.state else "")
(if print then print_ostate states.(node) else "")
(* -------------------------------------------------------------------------- *)
(* The following two mutually recursive functions are invoked when the state
associated with an existing node grows. The node's descendants are examined
and grown until a fixpoint is reached. *)
(* [grow node state] grows the existing node [node], if necessary, so that its
associated state subsumes [state]. If this represents an actual (strict)
growth, then [node]'s descendants are grown as well. *)
let rec grow node state =
if Lr0.subsume state node.state then
follow_state "Target state is unaffected" node false
else begin
(* Grow [node]. *)
node.state <- Lr0.union state node.state;
follow_state "Growing existing state" node true;
(* Grow [node]'s successors. *)
grow_successors node
(* A queue of pending nodes, whose outgoing transitions must be reexamined. *)
(* [grow_successors node] grows [node]'s successors. *)
(* Note that, if there is a cycle in the graph, [grow_successors] can be
invoked several times at a single node [node], with [node.state] taking on
a new value every time. In such a case, this code should be correct,
although probably not very efficient. *)
and grow_successors node =
SymbolMap.iter (fun symbol (successor_node : node) ->
let successor_state = Lr0.transition symbol node.state in
follow_transition true node symbol successor_state;
grow successor_node successor_state
) node.transitions
(* -------------------------------------------------------------------------- *)
(* Data structures maintained during the construction of the automaton. *)
(* A queue of pending nodes, whose outgoing transitions have not yet
been built. *)
(* Invariant: if a node is in the queue, then [states.(node)] is not [None]. *)
let queue : node Queue.t =
(* A mapping of LR(0) node numbers to at most one node. This allows us to
efficiently find the unique node (if it exists) that is core-compatible
with a newly found state. *)
let map : node option array =
Array.make Lr0.n None
(* A counter that allows assigning raw numbers to nodes. *)
let num =
ref 0
(* A (reversed) list of all nodes that we have allocated. At the end of the
process, this list is turned into an array, and allows us to expose an
efficient mapping of node numbers back to nodes. *)
let nodes =
ref []
let schedule node =
Queue.add node queue
(* -------------------------------------------------------------------------- *)
(* [create state] creates a new node that stands for the state [state].
It is expected that [state] does not subsume, and is not subsumed by,
any existing state. *)
let create (state : lr1state) : node =
(* Allocate a new node. *)
(* [examine] examines a node that has just been taken out of the queue. Its
outgoing transitions are inspected. If a successor node is newly discovered
or updated, then it is scheduled or rescheduled for examination. *)
let node = {
state = state;
transitions = SymbolMap.empty;
number = Misc.postincrement num;
} in
nodes := node :: !nodes;
(* Update the mapping of LR(0) cores to lists of nodes. *)
let k = Lr0.core state in
assert (k < Lr0.n);
assert (map.(k) = None);
map.(k) <- Some node;
(* Enqueue this node for further examination. *)
Queue.add node queue;
(* Debugging output. *)
follow_state "Creating a new state" node false;
let rec examine node =
(* Fetch the LR(1) state currently associated with this node. *)
let state : lr1state = Option.force states.(node) in
(* Inspect the node's outgoing transitions. *)
SymbolMap.iter (fun symbol (successor_node : node) ->
let successor_state : lr1state = Lr0.transition symbol state in
follow_transition node symbol successor_node successor_state;
inspect successor_node successor_state
) (Lr0.outgoing_edges node)
(* Return the freshly created node. *)
(* [inspect node state] ensures that the state currently associated with
[node] is at least [state]. If this requires an update of [states.(node)],
then [node] is (re)scheduled for examination. *)
and inspect node state =
match states.(node) with
| None ->
(* [node] is newly discovered. *)
follow_state "Target state is newly discovered" node true;
states.(node) <- Some state;
schedule node
| Some current ->
(* [node] has been discovered earlier. *)
if Lr0.subsume state current then begin
(* It is unaffected. *)
follow_state "Target state is unaffected" node false
else begin
(* It is affected and must itself be scheduled. *)
states.(node) <- Some (Lr0.union state current);
follow_state "Growing existing state" node true;
schedule node
(* -------------------------------------------------------------------------- *)
(* Materializing a transition turns its target state into a (fresh or
existing) node. There are two scenarios: the proposed new state may
or may not be subsumed by an existing state. *)
(* The actual construction process. *)
let materialize (source : node) (symbol : Symbol.t) (target : lr1state) : unit =
(* Populate the queue with the entry nodes. *)
(* Debugging output. *)
let () =
ProductionMap.iter (fun _prod node ->
states.(node) <- Some (Lr0.start node);
schedule node
) Lr0.entry
follow_transition false source symbol target;
(* As a long as the queue is nonempty, examine the nodes in it. *)
(* Find all existing core-compatible states. *)
let () =
Misc.qiter examine queue
let k = Lr0.core target in
assert (k < Lr0.n);
(* -------------------------------------------------------------------------- *)
(* Check whether we must create a new node or reuse an existing one. *)
(* Expose the mapping of nodes to LR(1) states. *)
(* 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. *)
let states : lr1state array = Option.force states
match map.(k) with
| None ->
(* There is no similar state. Create a new node. *)
source.transitions <- SymbolMap.add symbol (create target) source.transitions
| Some node ->
(* There is an existing node. Join it and grow it if necessary. *)
source.transitions <- SymbolMap.add symbol node source.transitions;
grow node target
let state : node -> lr1state =
Array.get states
(* -------------------------------------------------------------------------- *)
(* The actual construction process. *)
(* Expose the entry nodes and transitions of the LALR automaton. *)
(* Populate the queue with the start nodes and store them in an array. *)
(* Because we re-use LR(0) node numbers, these are exactly the same as those
of the LR(0) automaton! *)
let entry : node ProductionMap.t = (fun k ->
create (Lr0.start k)
) Lr0.entry
(* Pick a node in the queue, that is, a node whose transitions have not yet
been built. Build these transitions, and continue. *)
(* Note that building a transition can cause existing nodes to grow, so
[node.state] is not necessarily invariant throughout the inner loop. *)
let () =
Misc.qiter (fun node ->
List.iter (fun symbol ->
materialize node symbol (Lr0.transition symbol node.state)
) (Lr0.outgoing_symbols (Lr0.core node.state))
) queue
(* Record how many nodes were constructed. *)
let n =
(* Allocate an array of all nodes. *)
let nodes =
Array.of_list (List.rev !nodes)
let () =
assert (Array.length nodes = n)
let transitions : node -> node SymbolMap.t =
(* -------------------------------------------------------------------------- *)
(* Accessors. *)
let number node =
let node i =
assert (0 <= i && i < n);
(* Expose the bijection between nodes and numbers. *)
let state node =
let number (i : node) : int =
let transitions node =
let node (i : int) : node =
(* -------------------------------------------------------------------------- *)
end (* Run *)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment