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
3e105c5e
Commit
3e105c5e
authored
Mar 31, 2015
by
Kim Nguyễn
Browse files
Further refactoring of the tallying code.
parent
b17ef0fc
Changes
9
Expand all
Hide whitespace changes
Inline
Side-by-side
compile/lambda.ml
View file @
3e105c5e
...
...
@@ -26,7 +26,7 @@ type iface = (Types.descr * Types.descr) list
type
sigma
=
|
Identity
(* this is basically as Types.Tallying.CS.sat *)
|
List
of
Type_tallying
.
C
S
.
sl
|
List
of
Type_tallying
.
C
onstr
.
sl
|
Comp
of
(
sigma
*
sigma
)
|
Sel
of
(
var_loc
*
iface
*
sigma
)
...
...
@@ -104,7 +104,7 @@ module Print = struct
)
ppf
in
function
|
List
ll
->
Type_tallying
.
C
S
.
pp_sl
ppf
ll
|
List
ll
->
Type_tallying
.
C
onstr
.
pp_sl
ppf
ll
|
Comp
(
s1
,
s2
)
->
Format
.
fprintf
ppf
"Comp(%a,%a)"
pp_sigma
s1
pp_sigma
s2
|
Sel
(
x
,
iface
,
s
)
->
Format
.
fprintf
ppf
"Sel(%a,%a,%a)"
pp_vloc
x
pp_aux
iface
pp_sigma
s
|
Identity
->
Format
.
fprintf
ppf
"Id"
...
...
compile/lambda.mli
View file @
3e105c5e
...
...
@@ -26,7 +26,7 @@ type iface = (Types.t * Types.t) list
type
sigma
=
|
Identity
|
List
of
Type_tallying
.
C
S
.
sl
|
List
of
Type_tallying
.
C
onstr
.
sl
|
Comp
of
(
sigma
*
sigma
)
|
Sel
of
(
var_loc
*
iface
*
sigma
)
...
...
runtime/value.ml
View file @
3e105c5e
...
...
@@ -3,7 +3,7 @@ open Encodings
type
iface
=
(
Types
.
t
*
Types
.
t
)
list
type
sigma
=
|
List
of
Type_tallying
.
C
S
.
sl
|
List
of
Type_tallying
.
C
onstr
.
sl
|
Comp
of
(
sigma
*
sigma
)
|
Sel
of
(
int
*
iface
*
sigma
)
|
Identity
...
...
@@ -313,7 +313,7 @@ module Print = struct
)
ppf
in
function
|
List
ll
->
Type_tallying
.
C
S
.
pp_sl
ppf
ll
|
List
ll
->
Type_tallying
.
C
onstr
.
pp_sl
ppf
ll
|
Comp
(
s1
,
s2
)
->
Format
.
fprintf
ppf
"Comp(%a,%a)"
pp_sigma
s1
pp_sigma
s2
|
Sel
(
x
,
iface
,
s
)
->
Format
.
fprintf
ppf
"Sel(%d,%a,%a)"
x
pp_aux
iface
pp_sigma
s
|
Identity
->
Format
.
fprintf
ppf
"Id"
...
...
runtime/value.mli
View file @
3e105c5e
...
...
@@ -3,7 +3,7 @@ open Encodings
type
iface
=
(
Types
.
t
*
Types
.
t
)
list
type
sigma
=
|
List
of
Type_tallying
.
C
S
.
sl
|
List
of
Type_tallying
.
C
onstr
.
sl
|
Comp
of
(
sigma
*
sigma
)
|
Sel
of
(
int
*
iface
*
sigma
)
|
Identity
...
...
types/sortedList.ml
View file @
3e105c5e
...
...
@@ -32,6 +32,7 @@ sig
type
'
a
map
external
get
:
'
a
map
->
(
Elem
.
t
*
'
a
)
list
=
"%identity"
val
add
:
Elem
.
t
->
'
a
->
'
a
map
->
'
a
map
val
replace
:
Elem
.
t
->
'
a
->
'
a
map
->
'
a
map
val
mem
:
Elem
.
t
->
'
a
map
->
bool
val
length
:
'
a
map
->
int
val
domain
:
'
a
map
->
t
...
...
@@ -320,6 +321,14 @@ module Make(X : Custom.T) = struct
|
(
l1
,
[]
)
->
l1
let
add
x
v
=
union_disj
[(
x
,
v
)]
let
rec
replace
x
v
m
=
match
m
with
[]
->
[
(
x
,
v
)
]
|
((
y
,
w
)
as
t
)
::
q
->
let
c
=
Elem
.
compare
x
y
in
if
c
==
0
then
(
x
,
v
)
::
q
else
if
c
>
0
then
t
::
(
replace
x
v
q
)
else
(* c < 0 *)
(
x
,
v
)
::
m
let
rec
mem
x
l
=
match
l
with
...
...
types/sortedList.mli
View file @
3e105c5e
...
...
@@ -32,6 +32,7 @@ sig
type
'
a
map
external
get
:
'
a
map
->
(
Elem
.
t
*
'
a
)
list
=
"%identity"
val
add
:
Elem
.
t
->
'
a
->
'
a
map
->
'
a
map
val
replace
:
Elem
.
t
->
'
a
->
'
a
map
->
'
a
map
val
mem
:
Elem
.
t
->
'
a
map
->
bool
val
length
:
'
a
map
->
int
val
domain
:
'
a
map
->
t
...
...
types/type_tallying.ml
View file @
3e105c5e
This diff is collapsed.
Click to expand it.
types/type_tallying.mli
View file @
3e105c5e
...
...
@@ -8,15 +8,14 @@ exception UnSatConstr of string
exception
Step1Fail
exception
Step2Fail
module
CS
:
sig
module
M
:
sig
type
key
=
Var
.
t
module
Constr
:
sig
module
Line
:
sig
type
t
val
compare
:
t
->
t
->
int
val
empty
:
t
val
add
:
Var
.
Set
.
t
->
key
->
descr
*
descr
->
t
->
t
val
singleton
:
key
->
descr
*
descr
->
t
val
p
p
:
Format
.
formatter
->
t
->
unit
val
add
:
Var
.
Set
.
t
->
Var
.
t
->
descr
*
descr
->
t
->
t
val
singleton
:
Var
.
t
->
descr
*
descr
->
t
val
p
rint
:
Format
.
formatter
->
t
->
unit
val
inter
:
Var
.
Set
.
t
->
t
->
t
->
t
end
module
E
:
sig
...
...
@@ -28,18 +27,18 @@ module CS : sig
val
pp
:
Format
.
formatter
->
t
->
unit
end
module
S
:
sig
type
t
=
M
.
t
list
type
t
=
Line
.
t
list
val
empty
:
t
val
add
:
M
.
t
->
t
->
t
val
singleton
:
M
.
t
->
t
val
add
:
Line
.
t
->
t
->
t
val
singleton
:
Line
.
t
->
t
val
union
:
t
->
t
->
t
val
elements
:
t
->
M
.
t
list
val
fold
:
(
M
.
t
->
'
b
->
'
b
)
->
M
.
t
list
->
'
b
->
'
b
val
elements
:
t
->
Line
.
t
list
val
fold
:
(
Line
.
t
->
'
b
->
'
b
)
->
Line
.
t
list
->
'
b
->
'
b
val
pp
:
Format
.
formatter
->
t
->
unit
end
type
s
=
S
.
t
type
m
=
M
.
t
type
m
=
Line
.
t
type
es
=
ES
.
t
type
sigma
=
t
E
.
t
type
sl
=
sigma
list
...
...
@@ -57,21 +56,21 @@ module CS : sig
val
prod
:
Var
.
Set
.
t
->
s
->
s
->
s
end
val
norm
:
Var
.
Set
.
t
->
t
->
C
S
.
s
val
merge
:
Var
.
Set
.
t
->
C
S
.
m
->
C
S
.
s
val
solve
:
Var
.
Set
.
t
->
C
S
.
s
->
C
S
.
es
val
unify
:
C
S
.
sigma
->
C
S
.
sigma
val
norm
:
Var
.
Set
.
t
->
t
->
C
onstr
.
s
val
merge
:
Var
.
Set
.
t
->
C
onstr
.
m
->
C
onstr
.
s
val
solve
:
Var
.
Set
.
t
->
C
onstr
.
s
->
C
onstr
.
es
val
unify
:
C
onstr
.
sigma
->
C
onstr
.
sigma
(* [s1 ... sn] . si is a solution for tallying problem
if si # delta and for all (s,t) in C si @ s < si @ t *)
val
tallying
:
Var
.
Set
.
t
->
(
t
*
t
)
list
->
C
S
.
sl
val
tallying
:
Var
.
Set
.
t
->
(
t
*
t
)
list
->
C
onstr
.
sl
val
(
>>
)
:
t
->
C
S
.
sigma
->
t
val
(
>>
)
:
t
->
C
onstr
.
sigma
->
t
(** Symbolic Substitution Set *)
type
symsubst
=
|
I
(** Identity *)
|
S
of
C
S
.
sigma
(** Substitution *)
|
S
of
C
onstr
.
sigma
(** Substitution *)
|
A
of
(
symsubst
*
symsubst
)
(** Composition si (sj t) *)
(** Cartesian Product of two symbolic substitution sets *)
...
...
@@ -80,16 +79,16 @@ val ( ++ ) : symsubst list -> symsubst list -> symsubst list
(** Evaluation of a substitution *)
val
(
@@
)
:
t
->
symsubst
->
t
val
domain
:
C
S
.
sl
->
Var
.
Set
.
t
val
codomain
:
C
S
.
sl
->
Var
.
Set
.
t
val
is_identity
:
C
S
.
sl
->
bool
val
identity
:
C
S
.
sl
val
filter
:
(
Var
.
t
->
bool
)
->
C
S
.
sl
->
C
S
.
sl
val
domain
:
C
onstr
.
sl
->
Var
.
Set
.
t
val
codomain
:
C
onstr
.
sl
->
Var
.
Set
.
t
val
is_identity
:
C
onstr
.
sl
->
bool
val
identity
:
C
onstr
.
sl
val
filter
:
(
Var
.
t
->
bool
)
->
C
onstr
.
sl
->
C
onstr
.
sl
(** Square Subtype relation. [squaresubtype delta s t] .
True if there exists a substitution such that s < t only
considering variables that are not in delta *)
val
squaresubtype
:
Var
.
Set
.
t
->
t
->
t
->
C
S
.
sl
val
squaresubtype
:
Var
.
Set
.
t
->
t
->
t
->
C
onstr
.
sl
val
is_squaresubtype
:
Var
.
Set
.
t
->
t
->
t
->
bool
(** apply_raw s t returns the 4-tuple (subst,ss, tt, res) where
...
...
@@ -98,6 +97,6 @@ val is_squaresubtype : Var.Set.t -> t -> t -> bool
and res is the type of the result of the application *)
val
apply_full
:
Var
.
Set
.
t
->
t
->
t
->
t
val
apply_raw
:
Var
.
Set
.
t
->
t
->
t
->
C
S
.
sl
*
t
*
t
*
t
val
apply_raw
:
Var
.
Set
.
t
->
t
->
t
->
C
onstr
.
sl
*
t
*
t
*
t
val
squareapply
:
Var
.
Set
.
t
->
t
->
t
->
(
C
S
.
sl
*
t
)
val
squareapply
:
Var
.
Set
.
t
->
t
->
t
->
(
C
onstr
.
sl
*
t
)
typing/typed.ml
View file @
3e105c5e
...
...
@@ -15,7 +15,7 @@ open Ident
type
tpat
=
Patterns
.
node
type
ttyp
=
Types
.
Node
.
t
type
sigma
=
Type_tallying
.
C
S
.
sl
type
sigma
=
Type_tallying
.
C
onstr
.
sl
type
texpr
=
{
exp_loc
:
loc
;
...
...
@@ -108,7 +108,7 @@ module Print = struct
and
pp_aux
ppf
e
=
match
e
.
exp_descr
with
|
Subst
(
e
,
sl
)
->
Format
.
fprintf
ppf
"%a @@ %a"
pp
e
Type_tallying
.
C
S
.
pp_sl
sl
|
Subst
(
e
,
sl
)
->
Format
.
fprintf
ppf
"%a @@ %a"
pp
e
Type_tallying
.
C
onstr
.
pp_sl
sl
|
Forget
(
e
,
_
)
->
Format
.
fprintf
ppf
"Forget(%a)"
pp
e
|
Check
(
_
,
e
,
_
)
->
Format
.
fprintf
ppf
"Check(%a)"
pp
e
|
TVar
(
id
,
name
)
->
...
...
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