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
d3b48589
Commit
d3b48589
authored
May 16, 2014
by
Pietro Abate
Browse files
Better type printer (wip)
parent
a909f7aa
Changes
1
Hide whitespace changes
Inline
Side-by-side
types/types.ml
View file @
d3b48589
...
...
@@ -456,6 +456,7 @@ let no_var t = TLV.no_variables t.toplvars
let
has_tlv
t
=
TLV
.
has_toplevel
t
.
toplvars
let
all_vars
t
=
t
.
toplvars
.
TLV
.
fv
let
all_tlv
t
=
t
.
toplvars
.
TLV
.
tlv
(* XXX this function could be potentially costly. There should be
* better way to take trace of top level variables in a type *)
...
...
@@ -1635,18 +1636,24 @@ struct
let
prepare_boolvar
displayvars
displayatoms
get
is_full
print
tlv
bdd
=
List
.
iter
(
fun
(
p
,
n
)
->
let
l1
=
let
tlv_only
=
ref
true
in
List
.
fold_left
(
fun
acc
->
function
|
(
`Var
v
)
as
x
->
if
displayvars
||
not
(
TLV
.
mem
(
x
,
true
)
tlv
)
then
if
not
(
TLV
.
mem
(
x
,
true
)
tlv
)
then
begin
tlv_only
:=
false
;
(
Atomic
(
fun
ppf
->
Var
.
print
ppf
x
))
::
acc
else
acc
|
`Atm
bdd
->
if
displayatoms
then
(
print
bdd
)
@
acc
else
acc
end
else
acc
(* the bdd is printed if there one var that is not a tlv var or it
* is not empty . It is not printed if it is full and there are only
* tlv variables or it is empty *)
|
`Atm
bdd
when
(
is_full
bdd
)
&&
!
tlv_only
->
acc
|
`Atm
bdd
->
print
bdd
)
[]
p
in
let
l2
=
List
.
fold_left
(
fun
acc
->
function
|
(
`Var
v
)
as
x
->
if
displayvars
||
not
(
TLV
.
mem
(
x
,
true
)
tlv
)
then
if
not
(
TLV
.
mem
(
x
,
true
)
tlv
)
then
(
Atomic
(
fun
ppf
->
Format
.
fprintf
ppf
"~ %a"
Var
.
print
x
))
::
acc
else
acc
|
`Atm
bdd
->
assert
false
...
...
@@ -1660,22 +1667,32 @@ struct
if
(
non_empty
seq
)
then
add
(
Regexp
(
decompile
seq
));
let
displayatoms
=
true
in
let
displayvars
=
TLV
.
has_toplevel
not_seq
.
toplvars
in
(* base types *)
prepare_boolvar
displayvars
displayatoms
BoolIntervals
.
get
(
Intervals
.
equal
Intervals
.
full
)
(
fun
bdd
->
List
.
map
(
fun
x
->
(
Atomic
x
))
(
Intervals
.
print
bdd
)
)
not_seq
.
toplvars
not_seq
.
ints
;
if
has_tlv
not_seq
then
begin
let
l
=
TLV
.
Set
.
fold
(
fun
((
`Var
v
)
as
x
,
p
)
acc
->
let
s
=
if
p
then
(
Atomic
(
fun
ppf
->
Var
.
print
ppf
x
))
else
(
Atomic
(
fun
ppf
->
Format
.
fprintf
ppf
"~ %a"
Var
.
print
x
))
in
s
::
acc
)
(
all_tlv
not_seq
)
[]
in
add
(
Intersection
(
alloc
l
))
end
;
let
displayatoms
=
true
in
let
displayvars
=
false
in
(* base types *)
prepare_boolvar
displayvars
displayatoms
BoolChars
.
get
(
Chars
.
equal
Chars
.
full
)
(
fun
bdd
->
match
Chars
.
is_char
bdd
with
|
Some
c
->
[(
Char
c
)]
|
None
->
List
.
map
(
fun
x
->
(
Atomic
x
))
(
Chars
.
print
bdd
)
)
not_seq
.
toplvars
not_seq
.
chars
;
prepare_boolvar
displayvars
displayatoms
BoolIntervals
.
get
(
Intervals
.
equal
Intervals
.
full
)
(
fun
bdd
->
List
.
map
(
fun
x
->
(
Atomic
x
))
(
Intervals
.
print
bdd
)
)
not_seq
.
toplvars
not_seq
.
ints
;
let
bool
=
Atoms
.
cup
(
Atoms
.
atom
(
Atoms
.
V
.
mk_ascii
"false"
))
...
...
@@ -1692,7 +1709,6 @@ struct
(
Pair
(
prepare
t1
,
prepare
t2
))
)
(
Product
.
partition
any
x
))
not_seq
.
toplvars
not_seq
.
times
;
(* xml pairs *)
prepare_boolvar
displayvars
displayatoms
BoolPair
.
get
(
Pair
.
equal
Pair
.
full
)
(
fun
x
->
List
.
flatten
(
...
...
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