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
17b988b3
Commit
17b988b3
authored
Jun 26, 2014
by
Pietro Abate
Browse files
Add interface for tpyes/var.ml and tight up boolVar interface
parent
31208ef3
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
Makefile.distrib
View file @
17b988b3
...
@@ -239,7 +239,8 @@ ALL_OBJECTS = $(OBJECTS) \
...
@@ -239,7 +239,8 @@ ALL_OBJECTS = $(OBJECTS) \
parser/cduce_netclient.cmo
\
parser/cduce_netclient.cmo
\
runtime/cduce_expat.cmo runtime/cduce_pxp.cmo
runtime/cduce_expat.cmo runtime/cduce_pxp.cmo
ALL_INTERFACES
=
schema/schema_types.mli
ALL_INTERFACES
=
schema/schema_types.mli
#types/var.mli types/boolVar.mli
DEPEND
=
$(ALL_OBJECTS:.cmo=.ml)
$(ALL_OBJECTS:.cmo=.mli)
$(ALL_INTERFACES)
DEPEND
=
$(ALL_OBJECTS:.cmo=.ml)
$(ALL_OBJECTS:.cmo=.mli)
$(ALL_INTERFACES)
...
...
Makefile.types
View file @
17b988b3
...
@@ -12,6 +12,8 @@ ML_SRC= \
...
@@ -12,6 +12,8 @@ ML_SRC= \
cduce/types/atoms.ml
\
cduce/types/atoms.ml
\
cduce/misc/bool.ml
\
cduce/misc/bool.ml
\
cduce/types/chars.ml
\
cduce/types/chars.ml
\
cduce/types/var.ml
\
cduce/types/boolVar.ml
\
cduce/types/ident.ml
\
cduce/types/ident.ml
\
cduce/types/intervals.ml
\
cduce/types/intervals.ml
\
cduce/misc/inttbl.ml
\
cduce/misc/inttbl.ml
\
...
@@ -46,7 +48,6 @@ cduce_types.p.cmx: cduce_types.cmx
...
@@ -46,7 +48,6 @@ cduce_types.p.cmx: cduce_types.cmx
CDUCE_INCLUDES
=
$
(
DIRS:%
=
-I
%
)
CDUCE_INCLUDES
=
$
(
DIRS:%
=
-I
%
)
.SUFFIXES
:
.ml .mli .cmo .cmi .cmx
.SUFFIXES
:
.ml .mli .cmo .cmi .cmx
.ml.cmo
:
.ml.cmo
:
...
@@ -65,8 +66,6 @@ compute_depend:
...
@@ -65,8 +66,6 @@ compute_depend:
include
cduce/types_depend
include
cduce/types_depend
clean
:
clean
:
for
i
in
$(DIRS)
;
do
\
for
i
in
$(DIRS)
;
do
\
(
cd
$$
i
;
rm
-f
*
.cmi
*
.cmo
*
.cma
*
.cmx
*
.o
*
.a
*
.cmxa
*
~
)
;
\
(
cd
$$
i
;
rm
-f
*
.cmi
*
.cmo
*
.cma
*
.cmx
*
.o
*
.a
*
.cmxa
*
~
)
;
\
...
...
_tags
View file @
17b988b3
...
@@ -15,6 +15,3 @@ true: -traverse
...
@@ -15,6 +15,3 @@ true: -traverse
<schema/**>: package(pcre), package(netstring)
<schema/**>: package(pcre), package(netstring)
<runtime/**>: package(pcre), package(netstring)
<runtime/**>: package(pcre), package(netstring)
<tests/libtest/*Test.*>: package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
<tests/libtest/*Test.*>: package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
<tests/eval/src/main.*>: pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
<kim*.native>: pp(camlp4orf.opt), package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
depend
View file @
17b988b3
This diff is collapsed.
Click to expand it.
misc/upool.ml
View file @
17b988b3
...
@@ -18,9 +18,12 @@ module type S = sig
...
@@ -18,9 +18,12 @@ module type S = sig
val
from_int
:
int
->
t
val
from_int
:
int
->
t
end
end
module
HInt
=
Hashtbl
.
Make
(
struct
type
t
=
int
module
HInt
=
let
hash
x
=
x
Hashtbl
.
Make
(
struct
let
equal
x
y
=
x
==
y
end
)
type
t
=
int
let
hash
x
=
x
let
equal
x
y
=
x
==
y
end
)
module
Make
(
X
:
Custom
.
T
)
=
struct
module
Make
(
X
:
Custom
.
T
)
=
struct
type
token
type
token
...
...
tests/lambda/src/compute.ml
View file @
17b988b3
...
@@ -7,7 +7,7 @@ module Locals = Map.Make(String)
...
@@ -7,7 +7,7 @@ module Locals = Map.Make(String)
(* To throw in case of an unbound name *)
(* To throw in case of an unbound name *)
exception
Error
exception
Error
let
polyvar
=
Types
.
var
(
`Var
(
Var
.
make_id
"A"
)
)
let
polyvar
=
Types
.
var
(
Var
.
mk
"A"
)
let
type_of_string
s
=
match
s
with
let
type_of_string
s
=
match
s
with
|
"Int"
->
Builtin_defs
.
int
|
"Int"
->
Builtin_defs
.
int
...
@@ -115,7 +115,7 @@ and make_sigma s =
...
@@ -115,7 +115,7 @@ and make_sigma s =
and
type_of_ptype
=
and
type_of_ptype
=
let
open
Types
in
function
let
open
Types
in
function
|
Type
(
t
)
->
type_of_string
t
|
Type
(
t
)
->
type_of_string
t
|
PType
(
t
)
->
var
(
`Var
(
Var
.
make_id
t
)
)
|
PType
(
t
)
->
var
(
Var
.
mk
t
)
|
TPair
(
t1
,
t2
)
->
times
(
cons
(
type_of_ptype
t1
))
(
cons
(
type_of_ptype
t2
))
|
TPair
(
t1
,
t2
)
->
times
(
cons
(
type_of_ptype
t1
))
(
cons
(
type_of_ptype
t2
))
|
TUnion
(
t1
,
t2
)
->
cup
(
type_of_ptype
t1
)
(
type_of_ptype
t2
)
|
TUnion
(
t1
,
t2
)
->
cup
(
type_of_ptype
t1
)
(
type_of_ptype
t2
)
|
TInter
(
t1
,
t2
)
->
cap
(
type_of_ptype
t1
)
(
type_of_ptype
t2
)
|
TInter
(
t1
,
t2
)
->
cap
(
type_of_ptype
t1
)
(
type_of_ptype
t2
)
...
...
types/boolVar.ml
View file @
17b988b3
...
@@ -4,7 +4,7 @@ let (=) : int -> int -> bool = (=)
...
@@ -4,7 +4,7 @@ let (=) : int -> int -> bool = (=)
(* this is the the of the Constructor container *)
(* this is the the of the Constructor container *)
module
type
E
=
sig
module
type
E
=
sig
type
elem
type
elem
include
Custom
.
T
include
Custom
.
T
val
empty
:
t
val
empty
:
t
...
@@ -19,20 +19,8 @@ end
...
@@ -19,20 +19,8 @@ end
module
type
S
=
sig
module
type
S
=
sig
type
s
type
s
module
T
:
sig
include
E
val
is_empty
:
s
->
bool
val
is_full
:
s
->
bool
end
type
elem
=
s
Var
.
pairvar
type
elem
=
s
Var
.
pairvar
type
'
a
bdd
=
include
Custom
.
T
[
`True
|
`False
|
`Split
of
int
*
'
a
*
(
'
a
bdd
)
*
(
'
a
bdd
)
*
(
'
a
bdd
)
]
include
Custom
.
T
with
type
t
=
elem
bdd
(* returns the union of all leaves in the BDD *)
(* returns the union of all leaves in the BDD *)
val
leafconj
:
t
->
s
val
leafconj
:
t
->
s
...
@@ -48,14 +36,13 @@ module type S = sig
...
@@ -48,14 +36,13 @@ module type S = sig
val
cap
:
t
->
t
->
t
val
cap
:
t
->
t
->
t
val
diff
:
t
->
t
->
t
val
diff
:
t
->
t
->
t
val
atom
:
elem
->
t
val
atom
:
elem
->
t
(* val neg_atom : elem -> t *)
val
trivially_disjoint
:
t
->
t
->
bool
val
trivially_disjoint
:
t
->
t
->
bool
(* vars a : return a bdd that is ( Any ^ Var a ) *)
(* vars a : return a bdd that is ( Any ^ Var a ) *)
val
vars
:
Var
.
var
->
t
val
vars
:
Var
.
var
->
t
val
iter
:
(
elem
->
unit
)
->
t
->
unit
val
iter
:
(
elem
->
unit
)
->
t
->
unit
val
compute
:
empty
:
'
b
->
full
:
'
b
->
cup
:
(
'
b
->
'
b
->
'
b
)
val
compute
:
empty
:
'
b
->
full
:
'
b
->
cup
:
(
'
b
->
'
b
->
'
b
)
->
cap
:
(
'
b
->
'
b
->
'
b
)
->
diff
:
(
'
b
->
'
b
->
'
b
)
->
->
cap
:
(
'
b
->
'
b
->
'
b
)
->
diff
:
(
'
b
->
'
b
->
'
b
)
->
...
@@ -72,9 +59,7 @@ module type S = sig
...
@@ -72,9 +59,7 @@ module type S = sig
*)
*)
end
end
(*
module
type
MAKE
=
functor
(
T
:
E
)
->
S
with
type
s
=
T
.
t
module type MAKE = functor (T : E) -> S with type elem = T.t Custom.pairvar
*)
(* ternary BDD
(* ternary BDD
* where the nodes are Atm of X.t | Var of String.t
* where the nodes are Atm of X.t | Var of String.t
...
@@ -94,22 +79,16 @@ module type MAKE = functor (T : E) -> S with type elem = T.t Custom.pairvar
...
@@ -94,22 +79,16 @@ module type MAKE = functor (T : E) -> S with type elem = T.t Custom.pairvar
*
*
* *)
* *)
module
Make
(
T
:
E
)
:
S
with
type
s
=
T
.
t
=
module
Make
(
T
:
E
)
:
S
with
type
s
=
T
.
t
=
struct
struct
(* ternary decision trees . cf section 11.3.3 Frish PhD *)
(* ternary decision trees . cf section 11.3.3 Frish PhD *)
(* plus variables *)
(* plus variables *)
(* `Atm are containers (Atoms, Chars, Intervals, Pairs ... )
(* `Atm are containers (Atoms, Chars, Intervals, Pairs ... )
* `Var are String
* `Var are String
*)
*)
module
T
=
struct
include
T
let
is_empty
t
=
(
empty
==
t
)
let
is_full
t
=
(
full
==
t
)
end
type
s
=
T
.
t
type
s
=
T
.
t
module
X
=
Var
.
Make
(
T
)
type
elem
=
s
Var
.
pairvar
type
elem
=
s
Var
.
pairvar
module
X
:
Custom
.
T
with
type
t
=
elem
=
Var
.
Make
(
T
)
type
'
a
bdd
=
type
'
a
bdd
=
[
`True
[
`True
|
`False
|
`False
...
@@ -167,6 +146,9 @@ struct
...
@@ -167,6 +146,9 @@ struct
`Split
(
h
,
x
,
`True
,
`False
,
`False
)
`Split
(
h
,
x
,
`True
,
`False
,
`False
)
let
vars
v
=
let
vars
v
=
let
compute_hash
x
p
i
n
=
(
Var
.
hash
x
)
+
17
*
(
hash
p
)
+
257
*
(
hash
i
)
+
16637
*
(
hash
n
)
in
let
a
=
atom
(
`Atm
T
.
full
)
in
let
a
=
atom
(
`Atm
T
.
full
)
in
let
h
=
compute_hash
v
a
`False
`False
in
let
h
=
compute_hash
v
a
`False
`False
in
(
`Split
(
h
,
v
,
a
,
`False
,
`False
)
:>
t
)
(
`Split
(
h
,
v
,
a
,
`False
,
`False
)
:>
t
)
...
...
types/types.ml
View file @
17b988b3
...
@@ -138,7 +138,6 @@ module BoolIntervals : BoolVar.S with
...
@@ -138,7 +138,6 @@ module BoolIntervals : BoolVar.S with
module
BoolChars
:
BoolVar
.
S
with
module
BoolChars
:
BoolVar
.
S
with
type
s
=
Chars
.
t
=
BoolVar
.
Make
(
Chars
)
type
s
=
Chars
.
t
=
BoolVar
.
Make
(
Chars
)
module
TLV
=
struct
module
TLV
=
struct
module
Set
=
struct
module
Set
=
struct
...
...
types/types.mli
View file @
17b988b3
...
@@ -85,10 +85,14 @@ include Custom.T
...
@@ -85,10 +85,14 @@ include Custom.T
module
Node
:
Custom
.
T
module
Node
:
Custom
.
T
module
Pair
:
Bool
.
S
with
type
elem
=
(
Node
.
t
*
Node
.
t
)
module
Pair
:
Bool
.
S
with
type
elem
=
(
Node
.
t
*
Node
.
t
)
module
BoolPair
:
BoolVar
.
S
with
type
s
=
Pair
.
t
and
type
elem
=
Pair
.
t
Var
.
pairvar
module
BoolPair
:
BoolVar
.
S
with
type
s
=
Pair
.
t
and
type
elem
=
Pair
.
t
Var
.
pairvar
module
Rec
:
Bool
.
S
with
type
elem
=
bool
*
Node
.
t
Ident
.
label_map
module
Rec
:
Bool
.
S
with
type
elem
=
bool
*
Node
.
t
Ident
.
label_map
module
BoolRec
:
BoolVar
.
S
with
type
s
=
Rec
.
t
and
type
elem
=
Rec
.
t
Var
.
pairvar
module
BoolRec
:
BoolVar
.
S
with
type
s
=
Rec
.
t
and
type
elem
=
Rec
.
t
Var
.
pairvar
type
descr
=
t
type
descr
=
t
...
...
types/var.ml
View file @
17b988b3
type
t
=
{
module
V
=
struct
fresh
:
bool
;
type
t
=
{
fresh
:
bool
;
id
:
string
;
}
id
:
string
;
let
make_id
?
(
fresh
=
false
)
id
=
{
id
=
id
;
fresh
=
fresh
}
}
let
dump
ppf
t
=
Format
.
fprintf
ppf
"{id=%s;fresh=%b}"
t
.
id
t
.
fresh
let
make_id
?
(
fresh
=
false
)
id
=
let
compare
x
y
=
Pervasives
.
compare
x
.
id
y
.
id
{
id
=
id
;
fresh
=
fresh
}
let
equal
x
y
=
Pervasives
.
compare
x
.
id
y
.
id
=
0
let
hash
x
=
Hashtbl
.
hash
x
.
id
let
dump
ppf
t
=
Format
.
fprintf
ppf
"{id=%s;fresh=%b}"
t
.
id
t
.
fresh
end
let
compare
x
y
=
Pervasives
.
compare
x
.
id
y
.
id
let
equal
x
y
=
Pervasives
.
compare
x
.
id
y
.
id
=
0
let
hash
x
=
Hashtbl
.
hash
x
.
id
type
var
=
[
`Var
of
t
]
type
var
=
[
`Var
of
V
.
t
]
type
'
a
pairvar
=
[
`Atm
of
'
a
|
var
]
type
'
a
pairvar
=
[
`Atm
of
'
a
|
var
]
let
dump
ppf
(
`Var
x
)
=
Format
.
fprintf
ppf
"%a"
dump
x
let
dump
ppf
(
`Var
x
)
=
Format
.
fprintf
ppf
"%a"
V
.
dump
x
let
print
ppf
(
`Var
x
)
=
Format
.
fprintf
ppf
"'%s"
x
.
id
let
print
ppf
(
`Var
x
)
=
Format
.
fprintf
ppf
"'%s"
x
.
V
.
id
let
compare
(
`Var
x
)
(
`Var
y
)
=
compare
x
y
let
compare
(
`Var
x
)
(
`Var
y
)
=
V
.
compare
x
y
let
equal
v1
v2
=
(
compare
v1
v2
)
=
0
let
equal
v1
v2
=
(
compare
v1
v2
)
=
0
let
hash
(
`Var
x
)
=
V
.
hash
x
let
mk
?
fresh
id
=
`Var
(
V
.
make_id
?
fresh
id
)
let
fresh
:
?
pre
:
string
->
unit
->
[
>
var
]
=
let
counter
=
ref
0
in
fun
?
(
pre
=
"_fresh_"
)
->
fun
_
->
let
id
=
(
Printf
.
sprintf
"%s%d"
pre
!
counter
)
in
let
v
=
mk
~
fresh
:
true
id
in
incr
counter
;
v
;;
let
id
(
`Var
t
)
=
t
.
id
let
id
(
`Var
t
)
=
t
.
V
.
id
let
is_fresh
(
`Var
t
)
=
t
.
fresh
let
is_fresh
(
`Var
t
)
=
t
.
V
.
fresh
module
Set
=
struct
module
Set
=
struct
include
Set
.
Make
(
struct
type
t
=
var
let
compare
=
compare
end
)
include
Set
.
Make
(
struct
type
t
=
var
let
compare
=
compare
end
)
let
aux_print
sep
printer
ppf
s
=
let
aux_print
sep
printer
ppf
s
=
let
rec
aux
ppf
=
function
let
rec
aux
ppf
=
function
|
[]
->
()
|
[]
->
()
...
@@ -39,9 +48,11 @@ module Set = struct
...
@@ -39,9 +48,11 @@ module Set = struct
let
from_list
l
=
List
.
fold_left
(
fun
acc
x
->
add
x
acc
)
empty
l
let
from_list
l
=
List
.
fold_left
(
fun
acc
x
->
add
x
acc
)
empty
l
end
end
module
type
MAKE
=
functor
(
X
:
Custom
.
T
)
->
Custom
.
T
with
type
t
=
X
.
t
pairvar
module
Make
(
X
:
Custom
.
T
)
=
struct
module
Make
(
X
:
Custom
.
T
)
=
struct
type
t
=
X
.
t
pairvar
type
t
=
X
.
t
pairvar
let
hash
=
function
`Atm
t
->
X
.
hash
t
|
`Var
x
->
hash
x
let
hash
=
function
`Atm
t
->
X
.
hash
t
|
`Var
x
->
V
.
hash
x
let
check
=
function
`Atm
t
->
X
.
check
t
|
`Var
_
->
()
let
check
=
function
`Atm
t
->
X
.
check
t
|
`Var
_
->
()
let
compare
t1
t2
=
let
compare
t1
t2
=
match
t1
,
t2
with
match
t1
,
t2
with
...
@@ -56,15 +67,3 @@ module Make (X : Custom.T) = struct
...
@@ -56,15 +67,3 @@ module Make (X : Custom.T) = struct
|
`Atm
x
->
X
.
dump
ppf
x
|
`Atm
x
->
X
.
dump
ppf
x
|
`Var
x
->
dump
ppf
(
`Var
x
)
|
`Var
x
->
dump
ppf
(
`Var
x
)
end
end
let
mk
?
fresh
id
=
`Var
(
make_id
?
fresh
id
)
let
fresh
:
?
pre
:
string
->
unit
->
[
>
var
]
=
let
counter
=
ref
0
in
fun
?
(
pre
=
"_fresh_"
)
->
fun
_
->
let
id
=
(
Printf
.
sprintf
"%s%d"
pre
!
counter
)
in
let
v
=
mk
~
fresh
:
true
id
in
incr
counter
;
v
types/var.mli
0 → 100644
View file @
17b988b3
module
V
:
sig
type
t
val
make_id
:
?
fresh
:
bool
->
string
->
t
val
dump
:
Format
.
formatter
->
t
->
unit
val
compare
:
t
->
t
->
int
val
equal
:
t
->
t
->
bool
val
hash
:
t
->
int
end
type
var
=
[
`Var
of
V
.
t
]
val
dump
:
Format
.
formatter
->
var
->
unit
val
print
:
Format
.
formatter
->
var
->
unit
val
compare
:
var
->
var
->
int
val
equal
:
var
->
var
->
bool
val
hash
:
var
->
int
val
mk
:
?
fresh
:
bool
->
string
->
var
val
fresh
:
?
pre
:
string
->
unit
->
var
val
id
:
var
->
string
val
is_fresh
:
var
->
bool
module
Set
:
sig
include
Set
.
S
with
type
elt
=
var
val
dump
:
Format
.
formatter
->
t
->
unit
val
print
:
Format
.
formatter
->
t
->
unit
val
is_empty
:
t
->
bool
val
from_list
:
elt
list
->
t
end
type
'
a
pairvar
=
[
`Atm
of
'
a
|
var
]
module
type
MAKE
=
functor
(
X
:
Custom
.
T
)
->
Custom
.
T
with
type
t
=
X
.
t
pairvar
module
Make
:
MAKE
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