Commit 15fa6d5a authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-05-18 13:56:14 by cvscast] Pretty-printer for sample values

Original author: cvscast
Date: 2003-05-18 13:56:14+00:00
parent 47806e1f
......@@ -1410,33 +1410,36 @@ and sample_rec_record_aux memo (labels,(oleft,left),rights) =
let get x = try sample_rec Assumptions.empty x with Not_found -> Other
let get x = try sample_rec Assumptions.empty x with Not_found -> Other
let rec print_sep f sep ppf = function
| [] -> ()
| [x] -> f ppf x
| x::rem -> f ppf x; Format.fprintf ppf "%s" sep; print_sep f sep ppf rem
let rec is_seq = function
| Atom a -> a == Print.nil_atom
| Pair (_,y) -> is_seq y
| _ -> false
let rec print ppf = function
let rec print ppf s =
if is_seq s then
Format.fprintf ppf "@[[@ %a]@]" print_seq s
else match s with
| Int i -> Intervals.print_v ppf i
| Atom a -> Atoms.print_v ppf a
| Char c -> Chars.print_v ppf c
| Pair (x1,x2) -> Format.fprintf ppf "(%a,%a)" print x1 print x2
| Xml (Atom tag, Pair (Record (o,r), child)) ->
Format.fprintf ppf "<%s%a>%a" (Atoms.value tag) print_rec r
print child
| Xml (Atom tag, Pair (attr, child)) ->
Format.fprintf ppf "<%s %a>%a" (Atoms.value tag) print attr print child
| Xml (x1,x2) -> Format.fprintf ppf "XML(%a,%a)" print x1 print x2
| Record (o,r) ->
Format.fprintf ppf "{ %a%s }"
(print_sep
(fun ppf (l,x) ->
Format.fprintf ppf "%s = %a"
(LabelPool.value l)
print x
)
" ; "
) r
Format.fprintf ppf "{%a%s }"
print_rec r
(if o then "; ..." else "")
| Fun iface ->
Format.fprintf ppf "(fun ( %a ) x -> ...)"
......@@ -1449,6 +1452,17 @@ let get x = try sample_rec Assumptions.empty x with Not_found -> Other
) iface
| Other ->
Format.fprintf ppf "[cannot determine value]"
and print_rec ppf r =
print_sep
(fun ppf (l,x) ->
Format.fprintf ppf " %s = %a"
(LabelPool.value l)
print x
)
" ;" ppf r
and print_seq ppf = function
| Pair(x,y) -> print ppf x; Format.fprintf ppf "@ "; print_seq ppf y
| _ -> ()
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