Commit d9d21bee authored by POTTIER Francois's avatar POTTIER Francois

Update and cleanup in [Printers].

parent 697cf750
......@@ -13,6 +13,7 @@ module Make
let newline = "\n"
open User
open I
(* Printing a list of symbols. An optional dot is printed at offset
[i] into the list [symbols], if this offset lies between [0] and
......@@ -38,8 +39,8 @@ module Make
let print_element_as_symbol element =
match element with
| I.Element (s, _, _, _) ->
print_symbol (I.X (I.incoming_symbol s))
| Element (s, _, _, _) ->
print_symbol (X (incoming_symbol s))
(* Some of the functions that follow need an element printer. They use
[print_element] if provided by the user; otherwise they use
......@@ -55,17 +56,18 @@ module Make
(* Printing a stack as a list of symbols. *)
let print_stack stack =
I.foldr (fun element () ->
MenhirLib.General.foldr (fun element () ->
print_element element;
print space
) stack ()
) stack ();
print newline
(* Printing an item. *)
let print_item (prod, i) =
print_symbol (I.lhs prod);
print_symbol (lhs prod);
print arrow;
print_symbols i (I.rhs prod);
print_symbols i (rhs prod);
print newline
(* Printing a list of symbols (public version). *)
......@@ -78,52 +80,23 @@ module Make
let print_production prod =
print_item (prod, -1)
(* The past of an LR(0) item is the first part of the right-hand side,
up to the point. We represent it as a reversed list, right to left.
Thus, the past corresponds to a prefix of the stack. *)
let rec take n xs =
match n, xs with
| 0, _ ->
| _, [] ->
(* [n] is too large *)
assert false
| _, x :: xs ->
x :: take (n - 1) xs
let past (prod, index) =
let rhs = I.rhs prod in
List.rev (take index rhs)
(* The LR(0) items that form the core of an LR(1) state have compatible
pasts. If we pick the one with the longest past, we obtain the past
of this state, i.e., the longest statically known prefix of the stack
in this state. *)
let past s =
let (max_index, max_past) =
List.fold_left (fun ((max_index, max_past) as accu) ((_, index) as item) ->
if max_index < index then
index, past item
) (0, []) (I.items s)
(* Printing the current LR(1) state. *)
let print_current_state env =
print "Current LR(1) state: ";
match Lazy.force (I.stack env) with
| I.Nil ->
match Lazy.force (stack env) with
| MenhirLib.General.Nil ->
print "<some initial state>";
print newline
| I.Cons (I.Element (current, _, _, _), _) ->
| MenhirLib.General.Cons (Element (current, _, _, _), _) ->
print (string_of_int (Obj.magic current)); (* TEMPORARY safe conversion needed *)
print newline;
List.iter print_item (I.items current)
List.iter print_item (items current)
let print_env env =
print_stack (stack env);
print_current_state env;
print newline
......@@ -22,37 +22,41 @@ module Make
: sig
open I
(* Printing a list of symbols. *)
val print_symbols: I.xsymbol list -> unit
val print_symbols: xsymbol list -> unit
(* Printing an element as a symbol. This prints just the symbol
that this element represents; nothing more. *)
val print_element_as_symbol: I.element -> unit
val print_element_as_symbol: element -> unit
(* Printing a stack as a list of elements. This function needs an element
printer. It uses [print_element] if provided by the user; otherwise
it uses [print_element_as_symbol]. *)
it uses [print_element_as_symbol]. (Ending with a newline.) *)
val print_stack: I.stack -> unit
val print_stack: stack -> unit
(* Printing an item. (Ending with a newline.) *)
val print_item: I.item -> unit
val print_item: item -> unit
(* Printing a production. (Ending with a newline.) *)
val print_production: I.production -> unit
val print_production: production -> unit
(* Printing the current LR(1) state. The current state is first displayed
as a number; then the list of its LR(0) items is printed. (Ending with
a newline.) *)
val print_current_state: I.env -> unit
val print_current_state: env -> unit
(* Printing a summary of the stack and current state. This function just
calls [print_stack] and [print_current_state] in succession. *)
(* TEMPORARY move and document *)
val past: 'a I.lr1state -> I.xsymbol list
val print_env: env -> unit
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