Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
8717969c
Commit
8717969c
authored
Oct 05, 2007
by
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
cdef194c
Changes
1
Hide whitespace changes
Inline
Side-by-side
types/types.ml
View file @
8717969c
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment