Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
cduce
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
19
Issues
19
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
cduce
cduce
Commits
355dbbf1
Commit
355dbbf1
authored
Apr 02, 2015
by
Kim Nguyễn
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove the need for the crazy formatter hack in pp_type.
parent
3cbad2b5
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
25 additions
and
51 deletions
+25
-51
intervals.ml
types/intervals.ml
+5
-2
intervals.mli
types/intervals.mli
+2
-0
types.ml
types/types.ml
+18
-49
No files found.
types/intervals.ml
View file @
355dbbf1
...
...
@@ -243,7 +243,7 @@ let single = function
|
[]
->
raise
Not_found
|
_
->
raise
Exit
let
print
=
let
print
l
=
List
.
map
(
fun
x
ppf
->
match
x
with
|
Any
->
...
...
@@ -262,11 +262,14 @@ let print =
(
string_of_big_int
a
)
(
string_of_big_int
b
)
)
l
let
(
+
)
=
add_big_int
let
(
*
)
=
mult_big_int
let
is_bounded
l
=
List
.
for_all
(
function
Left
_
|
Any
->
false
|
_
->
true
)
l
,
List
.
for_all
(
function
Right
_
|
Any
->
false
|
_
->
true
)
l
let
add_inter
i1
i2
=
match
(
i1
,
i2
)
with
...
...
types/intervals.mli
View file @
355dbbf1
...
...
@@ -50,6 +50,8 @@ val right : V.t -> t
val
atom
:
V
.
t
->
t
val
is_bounded
:
t
->
bool
*
bool
val
disjoint
:
t
->
t
->
bool
val
is_empty
:
t
->
bool
val
contains
:
V
.
t
->
t
->
bool
...
...
types/types.ml
View file @
355dbbf1
...
...
@@ -1926,6 +1926,7 @@ module Print = struct
|
Display
of
string
|
Regexp
of
nd
Pretty
.
regexp
|
Atomic
of
(
Format
.
formatter
->
unit
)
|
Interval
of
Intervals
.
t
|
Pair
of
nd
*
nd
|
Char
of
Chars
.
V
.
t
|
Xml
of
[
`Tag
of
(
Format
.
formatter
->
unit
)
|
`Type
of
nd
]
*
nd
*
nd
...
...
@@ -2072,9 +2073,10 @@ module Print = struct
acc
let
print_ints
acc
tt
=
List
.
fold_right
(
fun
x
acc
->
(
Atomic
x
)
::
acc
)
(
Intervals
.
print
(
VarIntervals
.(
leafconj
(
proj
tt
))))
acc
let
ints
=
VarIntervals
.(
leafconj
(
proj
tt
))
in
if
Intervals
.
is_empty
ints
then
acc
else
(
Interval
ints
)
::
acc
let
print_atoms
acc
tt
=
...
...
@@ -2446,7 +2448,7 @@ module Print = struct
and
assign_name_rec
=
function
|
Neg
t
->
assign_name
t
|
Abs
t
->
assign_name
t
|
Name
_
|
Char
_
|
Atomic
_
|
Display
_
->
()
|
Name
_
|
Char
_
|
Atomic
_
|
Display
_
|
Interval
_
->
()
|
Regexp
r
->
assign_name_regexp
r
|
Pair
(
t1
,
t2
)
->
assign_name
t1
;
assign_name
t2
|
Intersection
l
->
List
.
iter
assign_name
l
...
...
@@ -2510,7 +2512,7 @@ module Print = struct
let
cpar
ppf
~
level
(
pri
:
Level
.
t
)
=
if
Pervasives
.(
level
<
pri
)
then
Format
.
fprintf
ppf
")@]"
let
do_print_list
empty
pri
op
pri_op
pr_e
ppf
l
=
let
do_print_list
empty
pri
op
pri_op
pr_e
ppf
l
=
let
rec
loop
l
=
match
l
with
[]
->
()
...
...
@@ -2548,6 +2550,17 @@ module Print = struct
|
Char
c
->
Chars
.
V
.
print
ppf
c
|
Regexp
r
->
Format
.
fprintf
ppf
"@[[ %a ]@]"
(
do_print_regexp
lv_min
)
r
|
Atomic
a
->
a
ppf
|
Interval
i
->
begin
match
List
.
rev_map
(
fun
x
->
Atomic
x
)
(
Intervals
.
print
i
)
with
|
[
]
->
assert
false
|
[
a
]
->
do_print
pri
ppf
a
|
lst
->
opar
ppf
~
level
:
lv_alt
pri
;
if
Pervasives
.(
lv_alt
<
pri
)
&&
(
not
(
fst
(
Intervals
.
is_bounded
i
)))
then
Format
.
fprintf
ppf
" "
;
do_print_slot_real
lv_alt
ppf
lst
;
cpar
ppf
~
level
:
lv_alt
pri
end
|
Diff
(
a
,
b
)
->
opar
ppf
~
level
:
lv_diff
pri
;
Format
.
fprintf
ppf
"@[%a@]
\\
@[%a@]"
(
do_print_slot
lv_ldiff
)
a
...
...
@@ -2695,50 +2708,6 @@ module Print = struct
named
:=
old_named
;
named_xml
:=
old_named_xml
let
wrap_formatter
ppf
=
let
out_fun
,
flush_fun
=
Format
.
pp_get_formatter_output_functions
ppf
()
in
let
buffer
=
Buffer
.
create
16
in
let
prev_char
=
"
\000
"
in
let
new_out_fun
str
start
len
=
for
i
=
start
to
start
+
len
-
1
do
let
c
=
str
.
[
i
]
in
if
c
==
'
*
'
&&
prev_char
.
[
0
]
==
'
(
'
then
Buffer
.
add_char
buffer
'
'
else
if
c
==
'
)
'
&&
prev_char
.
[
0
]
==
'
*
'
then
Buffer
.
add_char
buffer
'
'
;
prev_char
.
[
0
]
<-
c
;
Buffer
.
add_char
buffer
c
;
done
;
let
new_str
=
Buffer
.
contents
buffer
in
Buffer
.
clear
buffer
;
out_fun
new_str
0
(
String
.
length
new_str
)
in
let
new_flush_fun
()
=
let
new_str
=
Buffer
.
contents
buffer
in
let
len
=
String
.
length
new_str
in
if
len
>
0
then
begin
Buffer
.
clear
buffer
;
out_fun
new_str
0
len
;
end
;
flush_fun
()
;
in
Format
.
pp_set_formatter_output_functions
ppf
new_out_fun
new_flush_fun
;
fun
()
->
Format
.
pp_print_flush
ppf
()
;
Format
.
pp_set_formatter_output_functions
ppf
out_fun
flush_fun
let
wrap_formatter
_
=
fun
()
->
()
let
pp_type
ppf
t
=
let
reset
=
wrap_formatter
ppf
in
pp_type
ppf
t
;
reset
()
let
pp_noname
ppf
t
=
let
reset
=
wrap_formatter
ppf
in
pp_noname
ppf
t
;
reset
()
let
pp_node
ppf
n
=
pp_type
ppf
(
descr
n
)
let
()
=
forward_print
:=
pp_type
...
...
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