Commit e4d938ef authored by Pietro Abate's avatar Pietro Abate

[r2005-07-07 08:58:53 by afrisch] Empty log message

Original author: afrisch
Date: 2005-07-07 08:58:53+00:00
parent a3e37e9c
......@@ -33,7 +33,7 @@ and state = {
arity : int array;
mutable actions: actions;
mutable fail_code: int;
mutable expected_type: Types.t
mutable expected_type: string;
}
......
......@@ -33,7 +33,7 @@ and state = {
arity : int array;
mutable actions: actions;
mutable fail_code: int;
mutable expected_type: Types.t
mutable expected_type: string;
}
......
......@@ -9,13 +9,6 @@ let ops = Hashtbl.create 13
let register_op = Hashtbl.add ops
let eval_op = Hashtbl.find ops
let print_to_string f x =
let b = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer b in
f ppf x;
Buffer.contents b
(* To write tail-recursive map-like iteration *)
let make_accu () = Value.Pair(nil,Absent)
......
......@@ -4,21 +4,22 @@ open Auto_pat
open Encodings
type t = (Value.t * Types.t) list
type t = (Value.t * string) list
let rec print ppf = function
| [] -> ()
| (v, t) :: l ->
print ppf l;
Format.fprintf ppf
"Value @[%a@] does not match type @[%a@]@."
"Value @[%a@] does not match type @[%s@]@."
Value.print v
Types.Print.print t
t
let print_to_string f x =
let b = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer b in
f ppf x;
Format.pp_print_flush ppf ();
Buffer.contents b
let to_string e =
......@@ -133,14 +134,6 @@ let explain d v =
try check d v; None
with Failed p -> Some p
let print_to_string f x =
let b = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer b in
f ppf x;
Buffer.contents b
let do_check d v =
try check d v; v
with Failed p ->
......
type t = (Value.t * Types.t) list
type t = (Value.t * string) list
exception Failed of t
......
......@@ -978,7 +978,7 @@ module Compile = struct
arity = Array.map (fun (_,ar,_) -> ar) codes;
actions = dummy_actions;
fail_code = (-1);
expected_type = Types.empty
expected_type = "";
} in
let disp = {
id = !cur_id;
......@@ -1244,10 +1244,12 @@ module Compile = struct
assert(state.fail_code == fail);
) else (
state.fail_code <- fail;
let expect = ref Types.empty in
Array.iteri
(fun i (t,_,_) ->
if i != fail then state.expected_type <- Types.cup t state.expected_type)
if i != fail then expect := Types.cup t !expect)
(Hashtbl.find dispatcher_of_state state.uid).codes;
state.expected_type <- Types.Print.to_string !expect;
prepare_checker_actions fail state.actions
)
and prepare_checker_actions fail = function
......
......@@ -1517,6 +1517,16 @@ struct
let print_node ppf n = print ppf (descr n)
let () = forward_print := print
let print_to_string f x =
let b = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer b in
f ppf x;
Format.pp_print_flush ppf ();
Buffer.contents b
let to_string t = print_to_string print t
end
module Positive =
......
......@@ -272,6 +272,8 @@ sig
(* Don't try to find a global name at toplevel *)
val print_noname: Format.formatter -> t -> unit
val to_string: t -> string
end
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