Commit e95b420b authored by POTTIER Francois's avatar POTTIER Francois

Added (temporary) printers in calc-incremental.

parent 45a7b2cd
......@@ -27,6 +27,94 @@ let rec foldr f xs accu =
let height env =
length (I.view env)
(* Printing a symbol. *)
let print_symbol symbol =
let open Parser.Inspection in
match symbol with
| X (T T_TIMES) ->
"*"
| X (T T_RPAREN) ->
")"
| X (T T_PLUS) ->
"+"
| X (T T_MINUS) ->
"-"
| X (T T_LPAREN) ->
"("
| X (T T_INT) ->
"INT"
| X (N N_expr) ->
"expr"
| X (N N_main) ->
"main"
| X (T T_EOL) ->
"EOL"
| X (T T_DIV) ->
"/"
| 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
(* Printing an element. *)
let print_element e : string =
......@@ -71,28 +159,26 @@ let print env : string =
we analyze a result produced by the parser, and act in an
appropriate manner. *)
let dump env =
Printf.fprintf stderr "Stack height: %d\n%!" (height env);
Printf.fprintf stderr "Stack view:\n%s\n%!" (print env);
begin match Lazy.force (I.view env) with
| I.Nil ->
()
| 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
Printf.fprintf stderr "#Items: %d\n%!" (List.length items);
List.iter (fun item ->
Printf.fprintf stderr "%s\n" (print_item item)
) items
end
let rec loop linebuf (result : int I.result) =
match result with
| I.InputNeeded env ->
(* TEMPORARY *)
if true then begin
Printf.fprintf stderr "Stack height: %d\n%!" (height env);
Printf.fprintf stderr "Stack view:\n%s\n%!" (print env);
begin match Lazy.force (I.view env) with
| I.Nil ->
()
| 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
Printf.fprintf stderr "#Items: %d\n%!" (List.length items);
List.iter (fun (prod, index) ->
let _lhs : Parser.Inspection.xsymbol = Parser.Inspection.lhs prod in
let _rhs : Parser.Inspection.xsymbol list = Parser.Inspection.rhs prod in
(* TEMPORARY print item *)
()
) items
end
end;
dump env;
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
result. Then, repeat. *)
......@@ -101,7 +187,8 @@ let rec loop linebuf (result : int I.result) =
and endp = linebuf.Lexing.lex_curr_p in
let result = I.offer result (token, startp, endp) in
loop linebuf result
| I.AboutToReduce _ ->
| I.AboutToReduce (env, prod) ->
dump env;
let result = I.resume result in
loop linebuf result
| I.HandlingError env ->
......
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