Commit 80304e58 authored by Pietro Abate's avatar Pietro Abate
Browse files

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

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