Commit 235c1b47 authored by POTTIER Francois's avatar POTTIER Francois

Simplification in [Printers].

parent 837b9b6d
module Make
(I : MenhirLib.IncrementalEngine.EVERYTHING)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
val space: string
val print_symbol: I.xsymbol -> string
val print_element: (I.element -> string) option
val print: string -> unit
val print_symbol: I.xsymbol -> unit
val print_element: (I.element -> unit) option
end)
= struct
open User
(* Buffer and string utilities. *)
let out =
Buffer.add_string
let with_buffer f x =
let b = Buffer.create 128 in
f b x;
Buffer.contents b
let arrow = " -> "
let dot = "."
let space = " "
let into_buffer f b x =
out b (f x)
open User
(* Printing a list of symbols. An optional dot is printed at offset
[i] into the list [symbols], if this offset lies between [0] and
the length of the list (included). *)
let rec buffer_symbols b i symbols =
let rec print_symbols i symbols =
if i = 0 then begin
out b dot;
out b space;
buffer_symbols b (-1) symbols
print dot;
print space;
print_symbols (-1) symbols
end
else begin
match symbols with
| [] ->
()
| symbol :: symbols ->
out b (print_symbol symbol);
out b space;
buffer_symbols b (i - 1) symbols
print_symbol symbol;
print space;
print_symbols (i - 1) symbols
end
(* Printing an item. *)
let buffer_item b (prod, i) =
out b (print_symbol (I.lhs prod));
out b arrow;
buffer_symbols b i (I.rhs prod)
let print_item (prod, i) =
print_symbol (I.lhs prod);
print arrow;
print_symbols i (I.rhs prod)
(* Printing a production (without a dot). *)
let buffer_production b prod =
buffer_item b (prod, -1)
let print_item =
with_buffer buffer_item
let print_production =
with_buffer buffer_production
let print_production prod =
print_item (prod, -1)
(* Printing an element as a symbol. *)
......@@ -69,9 +52,6 @@ module Make
| I.Element (s, _, _, _) ->
print_symbol (I.X (I.incoming_symbol s))
let buffer_element_as_symbol =
into_buffer print_element_as_symbol
(* Some of the functions that follow need an element printer. They use
[print_element] if provided by the user; otherwise they use
[print_element_as_symbol]. *)
......@@ -83,25 +63,13 @@ module Make
| None ->
print_element_as_symbol
let buffer_element =
into_buffer print_element
(* Printing a stack or an environment. *)
(* Printing a stack as a list of symbols. *)
let buffer_stack b stack =
let print_stack stack =
I.foldr (fun element () ->
buffer_element b element;
out b space
print_element element;
print space
) stack ()
let buffer_env b env =
buffer_stack b (I.stack env)
let print_stack stack =
with_buffer buffer_stack stack
let print_env env =
with_buffer buffer_env env
end
module Make
(I : MenhirLib.IncrementalEngine.EVERYTHING)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
val space: string
val print_symbol: I.xsymbol -> string
val print_element: (I.element -> string) option
(* [print s] is supposed to send the string [s] to some output channel. *)
val print: string -> unit
(* [print_symbol s] is supposed to print a representation of the symbol [s]. *)
val print_symbol: I.xsymbol -> unit
(* [print_element e] is supposed to print a representation of the element [e].
This function is optional; if it is not provided, [print_element_as_symbol]
(defined below) is used instead. *)
val print_element: (I.element -> unit) option
end)
: sig
(* Printing an element as a symbol. This prints just the symbol
that this element represents; nothing more. *)
val buffer_element_as_symbol: Buffer.t -> I.element -> unit
val print_element_as_symbol: I.element -> string
(* Printing a stack or an environment. These functions need an element
printer. They use [print_element] if provided by the user; otherwise
they use [print_element_as_symbol]. *)
val print_element_as_symbol: I.element -> unit
val buffer_stack: Buffer.t -> I.stack -> unit
val print_stack: I.stack -> string
(* 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]. *)
val buffer_env: Buffer.t -> I.env -> unit
val print_env: I.env -> string
val print_stack: I.stack -> unit
(* Printing an item. *)
val buffer_item: Buffer.t -> I.item -> unit
val print_item: I.item -> string
val print_item: I.item -> unit
(* Printing a production. *)
val buffer_production: Buffer.t -> I.production -> unit
val print_production: I.production -> string
val print_production: I.production -> unit
end
......@@ -65,17 +65,16 @@ let print_element e : string =
module P =
Printers.Make(I) (struct
let arrow = " -> "
let dot = "."
let space = " "
let print_symbol = print_symbol
let print_element = Some print_element
let print s = Printf.fprintf stderr "%s" s
let print_symbol s = print (print_symbol s)
let print_element = Some (fun s -> print (print_element s))
end)
(* Debugging. *)
let dump env =
Printf.fprintf stderr "Stack:\n%s\n%!" (P.print_env env);
P.print_stack (I.stack env);
Printf.fprintf stderr "\n%!";
begin match Lazy.force (I.stack env) with
| I.Nil ->
()
......@@ -83,7 +82,8 @@ let dump env =
Printf.fprintf stderr "Current state: %d\n%!" (Obj.magic current);
let items = I.items current in
List.iter (fun item ->
Printf.fprintf stderr "%s\n%!" (P.print_item item)
P.print_item item;
Printf.fprintf stderr "\n%!"
) items
end;
print_newline()
......
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