Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit e20e5c7e authored by POTTIER Francois's avatar POTTIER Francois
Browse files

New module [Printers], for now in calc-incremental.

parent cbf1d8dc
module Make
(I : MenhirLib.IncrementalEngine.INSPECTION)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
val space: string
val print_symbol: I.xsymbol -> string
end)
= struct
open User
let out =
Buffer.add_string
(* 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 =
if i = 0 then begin
out b dot;
out b space;
buffer_symbols b (-1) symbols
end
else begin
match symbols with
| [] ->
()
| symbol :: symbols ->
out b (print_symbol symbol);
out b space;
buffer_symbols b (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)
(* Printing a production (without a dot). *)
let buffer_production b prod =
buffer_item b (prod, -1)
let with_buffer f x =
let b = Buffer.create 128 in
f b x;
Buffer.contents b
let print_item =
with_buffer buffer_item
let print_production =
with_buffer buffer_production
end
module Make
(I : MenhirLib.IncrementalEngine.INSPECTION)
(User : sig
val arrow: string (* should include space on both sides *)
val dot: string
val space: string
val print_symbol: I.xsymbol -> string
end)
: sig
(* Printing an item. *)
val buffer_item: Buffer.t -> I.item -> unit
val print_item: I.item -> string
(* Printing a production. *)
val buffer_production: Buffer.t -> I.production -> unit
val print_production: I.production -> string
end
......@@ -55,68 +55,24 @@ let print_symbol symbol =
| X (T T_error) ->
"error"
(* Printing a list of symbols. An optional dot is printed at offset
[dot] into the list [symbols], if this offset lies between [0] and
the length of the list (included). *)
let rec print_symbols print_symbol print_dot dot symbols =
let rec loop dot symbols =
if dot = 0 then begin
print_dot();
loop (-1) symbols
end
else begin
match symbols with
| [] ->
()
| symbol :: symbols ->
print_symbol symbol;
loop (dot - 1) symbols
end
in
loop dot symbols
(* Printing a production. *)
let print_production print_symbol print_arrow print_dot dot (lhs, rhs) =
print_symbol lhs;
print_arrow();
print_symbols print_symbol print_dot dot rhs
(* Printing an item. *)
let print_item print_symbol print_arrow print_dot (prod, dot) =
let open Parser.Inspection in
print_production print_symbol print_arrow print_dot dot (lhs prod, rhs prod)
let print_production print_symbol print_arrow prod =
let print_dot () = () in
print_item print_symbol print_arrow print_dot (prod, -1)
(* B. *)
let wrap b f x =
Buffer.add_string b (f x)
let with_buffer print_symbol print_arrow print_dot f x =
let b = Buffer.create 128 in
f (wrap b print_symbol) (wrap b print_arrow) (wrap b print_dot) x;
Buffer.contents b
let print_item print_symbol print_arrow print_dot item =
with_buffer print_symbol print_arrow print_dot print_item item
let print_arrow () =
" ->"
let print_dot () =
" ."
let print_item =
print_item print_symbol print_arrow print_dot
module P =
Printers.Make(struct
include Parser.MenhirInterpreter
include Parser.Inspection
end) (struct
let arrow = " -> "
let dot = "."
let space = " "
let print_symbol = print_symbol
end)
(* Printing an element. *)
let print_element e =
match e with
| I.Element (s, v, _, _) ->
print_symbol (Parser.Inspection.X (Parser.Inspection.incoming_symbol s))
let print_element e : string =
match e with
| I.Element (s, v, _, _) ->
......@@ -155,9 +111,7 @@ let print env : string =
) (I.view env) ();
Buffer.contents b
(* Define the loop which drives the parser. At each iteration,
we analyze a result produced by the parser, and act in an
appropriate manner. *)
(* Debugging. *)
let dump env =
Printf.fprintf stderr "Stack height: %d\n%!" (height env);
......@@ -167,17 +121,21 @@ let dump env =
()
| I.Cons (I.Element (current, _, _, _), _) ->
Printf.fprintf stderr "Current state: %d\n%!" (Obj.magic current);
let items : Parser.Inspection.item list = Parser.Inspection.items current in
let items = Parser.Inspection.items current in
Printf.fprintf stderr "#Items: %d\n%!" (List.length items);
List.iter (fun item ->
Printf.fprintf stderr "%s\n" (print_item item)
Printf.fprintf stderr "%s\n%!" (P.print_item item)
) items
end
end;
print_newline()
(* Define the loop which drives the parser. At each iteration,
we analyze a result produced by the parser, and act in an
appropriate manner. *)
let rec loop linebuf (result : int I.result) =
match result with
| I.InputNeeded env ->
(* TEMPORARY *)
dump env;
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
......
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