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
2a116016
Commit
2a116016
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-03-08 03:46:23 by cvscast] Empty log message
Original author: cvscast Date: 2003-03-08 03:46:23+00:00
parent
1826e985
Changes
11
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
2a116016
...
...
@@ -13,8 +13,7 @@ PARSER = parser/lexer.cmo parser/location.cmo \
TYPING
=
typing/typed.cmo typing/typer.cmo
TYPES
=
types/recursive.cmo
\
types/recursive_share.cmo types/recursive_noshare.cmo
\
TYPES
=
\
types/sortedList.cmo types/sortedMap.cmo types/boolean.cmo
\
types/intervals.cmo types/chars.cmo types/atoms.cmo
\
types/normal.cmo
\
...
...
depend
View file @
2a116016
...
...
@@ -26,10 +26,10 @@ typing/typer.cmo: parser/ast.cmo types/builtin.cmo types/intervals.cmi \
typing/typer.cmx: parser/ast.cmx types/builtin.cmx types/intervals.cmx \
parser/location.cmx types/patterns.cmx types/sequence.cmx \
types/sortedList.cmx typing/typed.cmx types/types.cmx typing/typer.cmi
types/atoms.cmo: types/sortedList.cmi types/atoms.cmi
types/atoms.cmx: types/sortedList.cmx types/atoms.cmi
types/boolean.cmo:
types/recursive.cmo
types/sortedList.cmi types/boolean.cmi
types/boolean.cmx:
types/recursive.cmx
types/sortedList.cmx types/boolean.cmi
types/atoms.cmo:
misc/pool.cmi
types/sortedList.cmi types/atoms.cmi
types/atoms.cmx:
misc/pool.cmx
types/sortedList.cmx types/atoms.cmi
types/boolean.cmo: types/sortedList.cmi types/boolean.cmi
types/boolean.cmx: types/sortedList.cmx types/boolean.cmi
types/builtin.cmo: types/atoms.cmi types/chars.cmi types/sequence.cmi \
types/types.cmi
types/builtin.cmx: types/atoms.cmx types/chars.cmx types/sequence.cmx \
...
...
@@ -56,36 +56,36 @@ types/sortedMap.cmo: types/sortedMap.cmi
types/sortedMap.cmx: types/sortedMap.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmo
types/type_bool.cmx: types/boolean.cmx types/recursive.cmx
types/types.cmo: types/atoms.cmi types/b
oolean
.cm
i
types/
chars
.cmi \
types/intervals.cmi types/normal.cmi misc/pool.cmi
types/recursive.cmo
\
types/recursive
_noshare
.cmo types/sortedList.cmi types/sortedMap.cmi \
types/types.cmo: types/atoms.cmi types/b
dd
.cm
o
types/
boolean
.cmi \
types/chars.cmi
types/intervals.cmi types/normal.cmi misc/pool.cmi \
types/recursive.cmo types/sortedList.cmi types/sortedMap.cmi \
misc/state.cmi types/types.cmi
types/types.cmx: types/atoms.cmx types/b
oolean
.cmx types/
chars
.cmx \
types/intervals.cmx types/normal.cmx misc/pool.cmx
types/recursive.cmx
\
types/recursive
_noshare
.cmx types/sortedList.cmx types/sortedMap.cmx \
types/types.cmx: types/atoms.cmx types/b
dd
.cmx types/
boolean
.cmx \
types/chars.cmx
types/intervals.cmx types/normal.cmx misc/pool.cmx \
types/recursive.cmx types/sortedList.cmx types/sortedMap.cmx \
misc/state.cmx types/types.cmi
runtime/eval.cmo:
runtime/load_xml.cmi parser/location
.cmi \
runtime/print_xml.cmo runtime/run_dispatch.cmi
misc/state.cmi
\
typing/typed.cmo
types/types.cmi
runtime/value.cmi runtime/eval.cmi
runtime/eval.cmx:
runtime/load_xml.cmx parser/location
.cmx \
runtime/print_xml.cmx runtime/run_dispatch.cmx
misc/state.cmx
\
typing/typed
.cmx typ
es
/type
s
.cmx runtime/value.cmx runtime/eval.cmi
runtime/load_xml.cmo: parser/location.cmi types/sortedMap.cmi
types/types.cmi
\
runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: parser/location.cmx types/sortedMap.cmx
types/types.cmx
\
runtime/value.cmx runtime/load_xml.cmi
runtime/print_xml.cmo: types/chars.cmi types/sequence.cmi
types/types.cmi
\
runtime/value.cmi
runtime/print_xml.cmx: types/chars.cmx types/sequence.cmx
types/types.cmx
\
runtime/value.cmx
runtime/eval.cmo:
types/atoms.cmi types/intervals.cmi runtime/load_xml
.cmi \
parser/location.cmi
runtime/print_xml.cmo runtime/run_dispatch.cmi \
misc/state.cmi
typing/typed.cmo runtime/value.cmi runtime/eval.cmi
runtime/eval.cmx:
types/atoms.cmx types/intervals.cmx runtime/load_xml
.cmx \
parser/location.cmx
runtime/print_xml.cmx runtime/run_dispatch.cmx \
misc/state
.cmx typ
ing
/type
d
.cmx runtime/value.cmx runtime/eval.cmi
runtime/load_xml.cmo:
types/atoms.cmi
parser/location.cmi types/sortedMap.cmi \
types/types.cmi
runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx:
types/atoms.cmx
parser/location.cmx types/sortedMap.cmx \
types/types.cmx
runtime/value.cmx runtime/load_xml.cmi
runtime/print_xml.cmo:
types/atoms.cmi
types/chars.cmi types/sequence.cmi \
types/types.cmi
runtime/value.cmi
runtime/print_xml.cmx:
types/atoms.cmx
types/chars.cmx types/sequence.cmx \
types/types.cmx
runtime/value.cmx
runtime/run_dispatch.cmo: types/patterns.cmi types/types.cmi \
runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/patterns.cmx types/types.cmx \
runtime/value.cmx runtime/run_dispatch.cmi
runtime/value.cmo: types/
char
s.cmi types/
sequence
.cmi types/
sortedMap
.cmi \
types/types.cmi runtime/value.cmi
runtime/value.cmx: types/
char
s.cmx types/
sequence
.cmx types/
sortedMap
.cmx \
types/types.cmx runtime/value.cmi
runtime/value.cmo: types/
atom
s.cmi types/
chars
.cmi types/
intervals
.cmi \
types/sequence.cmi types/sortedMap.cmi
types/types.cmi runtime/value.cmi
runtime/value.cmx: types/
atom
s.cmx types/
chars
.cmx types/
intervals
.cmx \
types/sequence.cmx types/sortedMap.cmx
types/types.cmx runtime/value.cmi
driver/cduce.cmo: parser/ast.cmo types/builtin.cmo runtime/eval.cmi \
parser/location.cmi parser/parser.cmi types/patterns.cmi misc/state.cmi \
typing/typed.cmo typing/typer.cmi types/types.cmi runtime/value.cmi \
...
...
@@ -94,8 +94,10 @@ driver/cduce.cmx: parser/ast.cmx types/builtin.cmx runtime/eval.cmx \
parser/location.cmx parser/parser.cmx types/patterns.cmx misc/state.cmx \
typing/typed.cmx typing/typer.cmx types/types.cmx runtime/value.cmx \
parser/wlexer.cmx driver/cduce.cmi
driver/run.cmo: driver/cduce.cmi parser/location.cmi misc/state.cmi
driver/run.cmx: driver/cduce.cmx parser/location.cmx misc/state.cmx
driver/run.cmo: driver/cduce.cmi parser/location.cmi misc/state.cmi \
types/types.cmi
driver/run.cmx: driver/cduce.cmx parser/location.cmx misc/state.cmx \
types/types.cmx
driver/webiface.cmo: driver/cduce.cmi driver/examples.cmo parser/location.cmi \
misc/state.cmi
driver/webiface.cmx: driver/cduce.cmx driver/examples.cmx parser/location.cmx \
...
...
@@ -107,7 +109,7 @@ typing/typer.cmi: parser/ast.cmo typing/typed.cmo types/types.cmi
types/boolean.cmi: types/sortedList.cmi
types/normal.cmi: types/boolean.cmi
types/patterns.cmi: types/sortedList.cmi types/sortedMap.cmi types/types.cmi
types/sequence.cmi: types/types.cmi
types/sequence.cmi:
types/atoms.cmi
types/types.cmi
types/sortedMap.cmi: types/sortedList.cmi
types/syntax.cmi: types/patterns.cmi types/types.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
...
...
@@ -115,5 +117,6 @@ types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
runtime/eval.cmi: typing/typed.cmo runtime/value.cmi
runtime/load_xml.cmi: runtime/value.cmi
runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi
runtime/value.cmi: types/chars.cmi types/sortedMap.cmi types/types.cmi
runtime/value.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sortedMap.cmi types/types.cmi
driver/cduce.cmi: runtime/eval.cmi typing/typer.cmi
driver/cduce.ml
View file @
2a116016
...
...
@@ -83,6 +83,12 @@ let rec print_exn ppf = function
*)
let
debug
ppf
=
function
|
`Subtype
(
t1
,
t2
)
->
Format
.
fprintf
ppf
"[DEBUG:subtype]@
\n
"
;
let
t1
=
Types
.
descr
(
Typer
.
typ
!
glb_env
t1
)
and
t2
=
Types
.
descr
(
Typer
.
typ
!
glb_env
t2
)
in
Format
.
fprintf
ppf
"%a <= %a : %b@
\n
"
print_norm
t1
print_norm
t2
(
Types
.
subtype
t1
t2
)
|
`Filter
(
t
,
p
)
->
Format
.
fprintf
ppf
"[DEBUG:filter]@
\n
"
;
let
t
=
Typer
.
typ
!
glb_env
t
...
...
parser/ast.ml
View file @
2a116016
...
...
@@ -18,6 +18,7 @@ and debug_directive =
|
`Compile
of
ppat
*
ppat
list
|
`Normal_record
of
ppat
|
`Compile2
of
ppat
*
ppat
list
|
`Subtype
of
ppat
*
ppat
]
...
...
parser/parser.ml
View file @
2a116016
...
...
@@ -78,6 +78,7 @@ EXTEND
|
LIDENT
"compile"
;
t
=
pat
;
p
=
LIST1
pat
->
`Compile
(
t
,
p
)
|
LIDENT
"normal_record"
;
t
=
pat
->
`Normal_record
t
|
LIDENT
"compile2"
;
t
=
pat
;
p
=
LIST1
pat
->
`Compile2
(
t
,
p
)
|
LIDENT
"subtype"
;
t1
=
pat
;
t2
=
pat
->
`Subtype
(
t1
,
t2
)
]
];
...
...
types/atoms.ml
View file @
2a116016
...
...
@@ -10,7 +10,14 @@ type v = AtomPool.t
let
value
=
AtomPool
.
value
let
mk
=
AtomPool
.
mk
type
t
=
Finite
of
v
list
|
Cofinite
of
v
list
module
SList
=
SortedList
.
Make
(
struct
type
'
a
t
=
v
let
compare
=
AtomPool
.
compare
let
hash
=
AtomPool
.
hash
let
equal
=
AtomPool
.
equal
end
)
type
t
=
Finite
of
unit
SList
.
t
|
Cofinite
of
unit
SList
.
t
let
empty
=
Finite
[]
let
any
=
Cofinite
[]
...
...
@@ -19,28 +26,28 @@ let atom x = Finite [x]
let
cup
s
t
=
match
(
s
,
t
)
with
|
(
Finite
s
,
Finite
t
)
->
Finite
(
S
orted
List
.
cup
s
t
)
|
(
Finite
s
,
Cofinite
t
)
->
Cofinite
(
S
orted
List
.
diff
t
s
)
|
(
Cofinite
s
,
Finite
t
)
->
Cofinite
(
S
orted
List
.
diff
s
t
)
|
(
Cofinite
s
,
Cofinite
t
)
->
Cofinite
(
S
orted
List
.
cap
s
t
)
|
(
Finite
s
,
Finite
t
)
->
Finite
(
SList
.
cup
s
t
)
|
(
Finite
s
,
Cofinite
t
)
->
Cofinite
(
SList
.
diff
t
s
)
|
(
Cofinite
s
,
Finite
t
)
->
Cofinite
(
SList
.
diff
s
t
)
|
(
Cofinite
s
,
Cofinite
t
)
->
Cofinite
(
SList
.
cap
s
t
)
let
cap
s
t
=
match
(
s
,
t
)
with
|
(
Finite
s
,
Finite
t
)
->
Finite
(
S
orted
List
.
cap
s
t
)
|
(
Finite
s
,
Cofinite
t
)
->
Finite
(
S
orted
List
.
diff
s
t
)
|
(
Cofinite
s
,
Finite
t
)
->
Finite
(
S
orted
List
.
diff
t
s
)
|
(
Cofinite
s
,
Cofinite
t
)
->
Cofinite
(
S
orted
List
.
cup
s
t
)
|
(
Finite
s
,
Finite
t
)
->
Finite
(
SList
.
cap
s
t
)
|
(
Finite
s
,
Cofinite
t
)
->
Finite
(
SList
.
diff
s
t
)
|
(
Cofinite
s
,
Finite
t
)
->
Finite
(
SList
.
diff
t
s
)
|
(
Cofinite
s
,
Cofinite
t
)
->
Cofinite
(
SList
.
cup
s
t
)
let
diff
s
t
=
match
(
s
,
t
)
with
|
(
Finite
s
,
Cofinite
t
)
->
Finite
(
S
orted
List
.
cap
s
t
)
|
(
Finite
s
,
Finite
t
)
->
Finite
(
S
orted
List
.
diff
s
t
)
|
(
Cofinite
s
,
Cofinite
t
)
->
Finite
(
S
orted
List
.
diff
t
s
)
|
(
Cofinite
s
,
Finite
t
)
->
Cofinite
(
S
orted
List
.
cup
s
t
)
|
(
Finite
s
,
Cofinite
t
)
->
Finite
(
SList
.
cap
s
t
)
|
(
Finite
s
,
Finite
t
)
->
Finite
(
SList
.
diff
s
t
)
|
(
Cofinite
s
,
Cofinite
t
)
->
Finite
(
SList
.
diff
t
s
)
|
(
Cofinite
s
,
Finite
t
)
->
Cofinite
(
SList
.
cup
s
t
)
let
contains
x
=
function
|
Finite
s
->
S
orted
List
.
mem
s
x
|
Cofinite
s
->
not
(
S
orted
List
.
mem
s
x
)
|
Finite
s
->
SList
.
mem
s
x
|
Cofinite
s
->
not
(
SList
.
mem
s
x
)
let
is_empty
=
function
|
Finite
[]
->
true
...
...
@@ -74,6 +81,8 @@ let print = function
List
.
iter
(
fun
x
->
Format
.
fprintf
ppf
" |@ %a"
print_v
x
)
t
;
Format
.
fprintf
ppf
")@]"
]
(* TODO: clean what follow to re-use SList operations *)
let
rec
hash_seq
accu
=
function
|
t
::
rem
->
hash_seq
(
accu
*
17
+
t
)
rem
|
[]
->
accu
...
...
@@ -93,3 +102,4 @@ let equal t1 t2 = match (t1,t2) with
|
(
Cofinite
l1
,
Cofinite
l2
)
->
equal_rec
l1
l2
|
_
->
false
types/boolean.ml
View file @
2a116016
type
'
a
t
=
(
'
a
list
*
'
a
list
)
list
module
type
S
=
sig
type
'
a
elem
type
'
a
t
val
equal
:
'
a
t
->
'
a
t
->
bool
val
compare
:
'
a
t
->
'
a
t
->
int
val
hash
:
'
a
t
->
int
external
get
:
'
a
t
->
(
'
a
elem
list
*
'
a
elem
list
)
list
=
"%identity"
val
empty
:
'
a
t
val
full
:
'
a
t
val
cup
:
'
a
t
->
'
a
t
->
'
a
t
val
cap
:
'
a
t
->
'
a
t
->
'
a
t
val
diff
:
'
a
t
->
'
a
t
->
'
a
t
val
atom
:
'
a
elem
->
'
a
t
val
map
:
(
'
a
elem
->
'
b
elem
)
->
'
a
t
->
'
b
t
val
iter
:
(
'
a
elem
->
unit
)
->
'
a
t
->
unit
val
compute
:
empty
:
'
d
->
full
:
'
c
->
cup
:
(
'
d
->
'
c
->
'
d
)
->
cap
:
(
'
c
->
'
b
->
'
c
)
->
diff
:
(
'
c
->
'
b
->
'
c
)
->
atom
:
(
'
a
elem
->
'
b
)
->
'
a
t
->
'
d
val
compute_bool
:
(
'
a
elem
->
'
b
t
)
->
'
a
t
->
'
b
t
val
print
:
string
->
(
Format
.
formatter
->
'
a
elem
->
unit
)
->
'
a
t
->
(
Format
.
formatter
->
unit
)
list
val
check
:
'
a
t
->
unit
end
module
Make
(
X
:
SortedList
.
ARG
)
=
struct
type
'
a
elem
=
'
a
X
.
t
module
SList
=
SortedList
.
Make
(
X
)
module
SSList
=
SortedList
.
Make
(
struct
type
'
a
t
=
'
a
SList
.
t
*
'
a
SList
.
t
let
compare
(
x1
,
y1
)
(
x2
,
y2
)
=
let
c
=
SList
.
compare
x1
x2
in
if
c
<>
0
then
c
else
SList
.
compare
y1
y2
let
equal
(
x1
,
y1
)
(
x2
,
y2
)
=
(
SList
.
equal
x1
x2
)
&&
(
SList
.
equal
y1
y2
)
let
hash
(
x
,
y
)
=
SList
.
hash
x
+
17
*
SList
.
hash
y
end
)
type
'
a
t
=
'
a
SSList
.
t
let
hash
=
SSList
.
hash
let
compare
=
SSList
.
compare
let
equal
=
SSList
.
equal
external
get
:
'
a
t
->
(
'
a
elem
list
*
'
a
elem
list
)
list
=
"%identity"
let
empty
=
[
]
...
...
@@ -7,7 +59,7 @@ let full = [ ([],[]) ]
let
atom
x
=
[
([
x
]
,
[]
)
]
let
may_remove
(
p1
,
n1
)
(
p2
,
n2
)
=
(
S
orted
List
.
subset
p2
p1
)
&&
(
S
orted
List
.
subset
n2
n1
)
(
SList
.
subset
p2
p1
)
&&
(
SList
.
subset
n2
n1
)
let
cup
t
s
=
if
t
==
s
then
t
...
...
@@ -18,7 +70,7 @@ let cup t s =
List
.
filter
(
fun
(
p
,
n
)
->
not
(
List
.
exists
(
may_remove
(
p
,
n
))
t
))
s
in
let
t
=
List
.
filter
(
fun
(
p
,
n
)
->
not
(
List
.
exists
(
may_remove
(
p
,
n
))
s
))
t
in
S
orted
List
.
cup
s
t
S
S
List
.
cup
s
t
let
tot
=
ref
0
let
clean
accu
t
=
...
...
@@ -30,7 +82,7 @@ let clean accu t =
else
aux
((
p
,
n
)
::
accu
)
rem
|
[]
->
accu
in
S
orted
List
.
from_list
(
aux
accu
t
)
S
S
List
.
from_list
(
aux
accu
t
)
...
...
@@ -50,10 +102,10 @@ let cap s t =
else
if
t
==
full
then
s
else
if
(
s
==
empty
)
||
(
t
==
empty
)
then
empty
else
let
(
lines1
,
common
,
lines2
)
=
S
orted
List
.
split
s
t
in
let
(
lines1
,
common
,
lines2
)
=
S
S
List
.
split
s
t
in
let
rec
aux
lines
(
p1
,
n1
)
(
p2
,
n2
)
=
if
(
S
orted
List
.
disjoint
p1
n2
)
&&
(
S
orted
List
.
disjoint
p2
n1
)
then
(
S
orted
List
.
cup
p1
p2
,
S
orted
List
.
cup
n1
n2
)
::
lines
if
(
SList
.
disjoint
p1
n2
)
&&
(
SList
.
disjoint
p2
n1
)
then
(
SList
.
cup
p1
p2
,
SList
.
cup
n1
n2
)
::
lines
else
lines
in
clean
common
(
fold2
aux
[]
lines1
lines2
)
...
...
@@ -62,11 +114,11 @@ let diff c1 c2 =
if
c2
==
full
then
empty
else
if
(
c1
==
empty
)
||
(
c2
==
empty
)
then
c1
else
let
c1
=
S
orted
List
.
diff
c1
c2
in
let
c1
=
S
S
List
.
diff
c1
c2
in
let
line
(
p
,
n
)
=
let
acc
=
List
.
fold_left
(
fun
acc
a
->
([]
,
[
a
])
::
acc
)
[]
p
in
let
acc
=
List
.
fold_left
(
fun
acc
a
->
([
a
]
,
[]
)
::
acc
)
acc
n
in
S
orted
List
.
from_list
acc
S
S
List
.
from_list
acc
in
List
.
fold_left
(
fun
c1
l
->
cap
c1
(
line
l
))
c1
c2
...
...
@@ -75,12 +127,12 @@ let rec map f t =
let
lines
=
List
.
fold_left
(
fun
lines
(
p
,
n
)
->
let
p
=
S
orted
List
.
map
f
p
and
n
=
S
orted
List
.
map
f
n
in
if
(
S
orted
List
.
disjoint
p
n
)
then
(
p
,
n
)
::
lines
else
lines
)
let
p
=
SList
.
map
f
p
and
n
=
SList
.
map
f
n
in
if
(
SList
.
disjoint
p
n
)
then
(
p
,
n
)
::
lines
else
lines
)
[]
t
in
S
orted
List
.
from_list
lines
S
S
List
.
from_list
lines
let
iter
f
t
=
List
.
iter
(
fun
(
p
,
n
)
->
List
.
iter
f
p
;
List
.
iter
f
n
)
t
...
...
@@ -119,12 +171,21 @@ let print any f =
)
let
check
b
=
S
orted
List
.
check
b
;
S
S
List
.
check
b
;
List
.
iter
(
fun
(
p
,
n
)
->
S
orted
List
.
check
p
;
S
orted
List
.
check
n
;
assert
(
S
orted
List
.
disjoint
p
n
)
SList
.
check
p
;
SList
.
check
n
;
assert
(
SList
.
disjoint
p
n
)
)
b
end
include
Make
(
struct
type
'
a
t
=
'
a
let
hash
=
Hashtbl
.
hash
let
equal
x
y
=
x
=
y
let
compare
=
compare
end
)
types/boolean.mli
View file @
2a116016
...
...
@@ -10,26 +10,38 @@
(w.r.t Pervasives.compare).
*)
type
'
a
t
=
(
'
a
SortedList
.
t
*
'
a
SortedList
.
t
)
SortedList
.
t
val
empty
:
'
a
t
val
full
:
'
a
t
val
cup
:
'
a
t
->
'
a
t
->
'
a
t
val
cap
:
'
a
t
->
'
a
t
->
'
a
t
val
diff
:
'
a
t
->
'
a
t
->
'
a
t
val
atom
:
'
a
->
'
a
t
val
map
:
(
'
a
->
'
b
)
->
'
a
t
->
'
b
t
val
iter
:
(
'
a
->
unit
)
->
'
a
t
->
unit
val
compute
:
empty
:
'
d
->
full
:
'
c
->
cup
:
(
'
d
->
'
c
->
'
d
)
->
cap
:
(
'
c
->
'
b
->
'
c
)
->
diff
:
(
'
c
->
'
b
->
'
c
)
->
atom
:
(
'
a
->
'
b
)
->
'
a
t
->
'
d
val
compute_bool
:
(
'
a
->
'
b
t
)
->
'
a
t
->
'
b
t
val
print
:
string
->
(
Format
.
formatter
->
'
a
->
unit
)
->
'
a
t
->
(
Format
.
formatter
->
unit
)
list
val
check
:
'
a
t
->
unit
module
type
S
=
sig
type
'
a
elem
type
'
a
t
val
equal
:
'
a
t
->
'
a
t
->
bool
val
compare
:
'
a
t
->
'
a
t
->
int
val
hash
:
'
a
t
->
int
external
get
:
'
a
t
->
(
'
a
elem
list
*
'
a
elem
list
)
list
=
"%identity"
val
empty
:
'
a
t
val
full
:
'
a
t
val
cup
:
'
a
t
->
'
a
t
->
'
a
t
val
cap
:
'
a
t
->
'
a
t
->
'
a
t
val
diff
:
'
a
t
->
'
a
t
->
'
a
t
val
atom
:
'
a
elem
->
'
a
t
val
map
:
(
'
a
elem
->
'
b
elem
)
->
'
a
t
->
'
b
t
val
iter
:
(
'
a
elem
->
unit
)
->
'
a
t
->
unit
val
compute
:
empty
:
'
d
->
full
:
'
c
->
cup
:
(
'
d
->
'
c
->
'
d
)
->
cap
:
(
'
c
->
'
b
->
'
c
)
->
diff
:
(
'
c
->
'
b
->
'
c
)
->
atom
:
(
'
a
elem
->
'
b
)
->
'
a
t
->
'
d
val
compute_bool
:
(
'
a
elem
->
'
b
t
)
->
'
a
t
->
'
b
t
val
print
:
string
->
(
Format
.
formatter
->
'
a
elem
->
unit
)
->
'
a
t
->
(
Format
.
formatter
->
unit
)
list
val
check
:
'
a
t
->
unit
end
module
Make
(
X
:
SortedList
.
ARG
)
:
S
with
type
'
a
elem
=
'
a
X
.
t
include
S
with
type
'
a
elem
=
'
a
and
type
'
a
t
=
(
'
a
list
*
'
a
list
)
list
types/sortedList.ml
View file @
2a116016
type
'
a
t
=
'
a
list
module
type
ARG
=
sig
type
'
a
t
val
equal
:
'
a
t
->
'
a
t
->
bool
val
hash
:
'
a
t
->
int
val
compare
:
'
a
t
->
'
a
t
->
int
end
module
type
S
=
sig
type
'
a
elem
type
'
a
t
val
equal
:
'
a
t
->
'
a
t
->
bool
val
hash
:
'
a
t
->
int
val
compare
:
'
a
t
->
'
a
t
->
int
val
from_list
:
'
a
elem
list
->
'
a
t
val
add
:
'
a
elem
->
'
a
t
->
'
a
t
val
disjoint
:
'
a
t
->
'
a
t
->
bool
val
cup
:
'
a
t
->
'
a
t
->
'
a
t
val
split
:
'
a
t
->
'
a
t
->
'
a
t
*
'
a
t
*
'
a
t
(* split l1 l2 = (l1 \ l2, l1 & l2, l2 \ l1) *)
val
cap
:
'
a
t
->
'
a
t
->
'
a
t
val
diff
:
'
a
t
->
'
a
t
->
'
a
t
val
subset
:
'
a
t
->
'
a
t
->
bool
val
map
:
(
'
a
elem
->
'
b
elem
)
->
'
a
t
->
'
b
t
val
mem
:
'
a
t
->
'
a
elem
->
bool
val
check
:
'
a
elem
list
->
unit
end
module
Make
(
X
:
ARG
)
=
struct
type
'
a
t
=
'
a
X
.
t
list
type
'
a
elem
=
'
a
X
.
t
let
rec
equal
l1
l2
=
(
l1
==
l2
)
||
match
(
l1
,
l2
)
with
|
x1
::
l1
,
x2
::
l2
->
(
X
.
equal
x1
x2
)
&&
(
equal
l1
l2
)
|
_
->
false
let
rec
hash
accu
=
function
|
[]
->
1
+
accu
|
x
::
l
->
hash
(
17
*
accu
+
X
.
hash
x
)
l
let
hash
l
=
hash
1
l
let
rec
compare
l1
l2
=
if
l1
==
l2
then
0
else
match
(
l1
,
l2
)
with
|
x1
::
l1
,
x2
::
l2
->
let
c
=
X
.
compare
x1
x2
in
if
c
<>
0
then
c
else
compare
l1
l2
|
[]
,_
->
-
1
|
_
->
1
let
rec
disjoint
l1
l2
=
match
(
l1
,
l2
)
with
|
(
t1
::
q1
,
t2
::
q2
)
->
let
c
=
compare
t1
t2
in
let
c
=
X
.
compare
t1
t2
in
if
c
<
0
then
disjoint
q1
l2
else
if
c
>
0
then
disjoint
l1
q2
else
false
...
...
@@ -12,7 +67,7 @@ let rec disjoint l1 l2 =
let
rec
cup
l1
l2
=
match
(
l1
,
l2
)
with
|
(
t1
::
q1
,
t2
::
q2
)
->
let
c
=
compare
t1
t2
in
let
c
=
X
.
compare
t1
t2
in
if
c
=
0
then
t1
::
(
cup
q1
q2
)
else
if
c
<
0
then
t1
::
(
cup
q1
l2
)
else
t2
::
(
cup
l1
q2
)
...
...
@@ -24,7 +79,7 @@ let add x l = cup [x] l
let
rec
split
l1
l2
=
match
(
l1
,
l2
)
with
|
(
t1
::
q1
,
t2
::
q2
)
->
let
c
=
compare
t1
t2
in
let
c
=
X
.
compare
t1
t2
in
if
c
=
0
then
let
(
l1
,
i
,
l2
)
=
split
q1
q2
in
(
l1
,
t1
::
i
,
l2
)
else
if
c
<
0
then
let
(
l1
,
i
,
l2
)
=
split
q1
l2
in
(
t1
::
l1
,
i
,
l2
)
else
let
(
l1
,
i
,
l2
)
=
split
l1
q2
in
(
l1
,
i
,
t2
::
l2
)
...
...
@@ -34,7 +89,7 @@ let rec split l1 l2 =
let
rec
diff
l1
l2
=
match
(
l1
,
l2
)
with
|
(
t1
::
q1
,
t2
::
q2
)
->
let
c
=
compare
t1
t2
in
let
c
=
X
.
compare
t1
t2
in
if
c
=
0
then
diff
q1
q2
else
if
c
<
0
then
t1
::
(
diff
q1
l2
)
else
diff
l1
q2
...
...
@@ -43,7 +98,7 @@ let rec diff l1 l2 =
let
rec
cap
l1
l2
=
match
(
l1
,
l2
)
with
|
(
t1
::
q1
,
t2
::
q2
)
->
let
c
=
compare
t1
t2
in
let
c
=
X
.
compare
t1
t2
in
if
c
=
0
then
t1
::
(
cap
q1
q2
)
else
if
c
<
0
then
cap
q1
l2
else
cap
l1
q2
...
...
@@ -53,7 +108,7 @@ let rec cap l1 l2 =
let
rec
subset
l1
l2
=
match
(
l1
,
l2
)
with
|
(
t1
::
q1
,
t2
::
q2
)
->
let
c
=
compare
t1
t2
in
let
c
=
X
.
compare
t1
t2
in
if
c
=
0
then
subset
q1
q2
else
if
c
<
0
then
false
else
subset
l1
q2
...
...
@@ -82,9 +137,20 @@ let rec mem l x =
match
l
with
|
[]
->
false
|
t
::
q
->
let
c
=
compare
x
t
in
let
c
=
X
.
compare
x
t
in
(
c
=
0
)
||
((
c
>
0
)
&&
(
mem
q
x
))
let
rec
check
=
function
|
a
::
(
b
::_
as
t
)
->
assert
(
a
<
b
);
check
t
|
a
::
(
b
::_
as
t
)
->
assert
(
X
.
compare
a
b
<
0
);
check
t
|
_
->
()
end
include
Make
(
struct
type
'
a
t
=
'
a
let
hash
=
Hashtbl
.
hash
let
equal
x
y
=
x
=
y
let
compare
=
compare
end
)
types/sortedList.mli
View file @
2a116016
(* Sorted list without duplicates.
Comparisons between elements are done by Pervasives.compare *)
type
'
a
t
=
'
a
list
val
from_list
:
'
a
list
->
'
a
t
val
add
:
'
a
->
'
a
t
->
'
a
t
val
disjoint
:
'
a
t
->
'
a
t
->
bool
val
cup
:
'
a
t
->
'
a
t
->
'
a
t
val
split
:
'
a
t
->
'
a
t
->
'
a
t
*
'
a
t
*
'
a
t
module
type
ARG
=
sig
type
'
a
t
val
equal
:
'
a
t
->
'
a
t
->
bool
val
hash
:
'
a
t
->
int
val
compare
:
'
a
t
->
'
a
t
->
int
end
module
type
S
=
sig
type
'
a
elem
type
'
a
t
val
equal
:
'
a
t
->
'
a
t
->
bool
val
hash
:
'
a
t
->
int
val
compare
:
'
a
t
->
'
a
t
->
int
val
from_list
:
'
a
elem
list
->
'
a
t
val
add
:
'
a
elem
->
'
a
t
->
'
a
t
val
disjoint
:
'
a
t
->
'
a
t
->
bool
val
cup
:
'
a
t
->
'
a
t
->
'
a
t
val
split
:
'
a
t
->
'
a
t
->
'
a
t
*
'
a
t
*
'
a
t
(* split l1 l2 = (l1 \ l2, l1 & l2, l2 \ l1) *)
val
cap
:
'
a
t
->
'
a
t
->
'
a
t
val
diff
:
'
a
t
->
'
a
t
->
'
a
t
val
subset
:
'
a
t
->
'
a
t
->
bool
val
map
:
(
'
a
->
'
b
)
->
'
a
t
->
'
b
t
val
mem
:
'
a
t
->
'
a
->
bool
val
cap
:
'
a
t
->
'
a
t
->
'
a
t
val
diff
:
'
a
t
->
'
a
t
->
'
a
t