Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
843c4391
Commit
843c4391
authored
Jul 05, 2010
by
Jean-Christophe Filliâtre
Browse files
programs: type-checking match with
parent
8b4da539
Changes
3
Hide whitespace changes
Inline
Side-by-side
bench/programs/good/mutual.mlw
View file @
843c4391
...
...
@@ -4,6 +4,7 @@
logic even (x : int) = x = 2 * (div x 2)
logic odd (x : int) = x = 2 * (div x 2) + 1
}
let rec is_even x : bool variant {x} =
...
...
src/programs/pgm_typing.ml
View file @
843c4391
...
...
@@ -261,6 +261,15 @@ and dbinder env ({id=x; id_loc=loc} as id, v) =
in
add_local
env
x
v
,
(
id
,
v
)
let
rec
add_local_pat
env
p
=
match
p
.
dp_node
with
|
Pwild
->
env
|
Pvar
x
->
add_local
env
x
(
DTpure
p
.
dp_ty
)
|
Papp
(
_
,
pl
)
->
add_local_pats
env
pl
|
Pas
(
p
,
_
)
->
add_local_pat
env
p
and
add_local_pats
env
pl
=
List
.
fold_left
add_local_pat
env
pl
let
dvariant
env
(
l
,
p
)
=
let
s
,
_
=
Typing
.
specialize_psymbol
p
env
.
env
.
uc
in
let
loc
=
Typing
.
qloc
p
in
...
...
@@ -375,6 +384,7 @@ and dexpr_desc env loc = function
let
branch
(
pl
,
e
)
=
let
denv
,
pl
=
Typing
.
dpat_list
env
.
denv
tyl
pl
in
let
env
=
{
env
with
denv
=
denv
}
in
let
env
=
add_local_pats
env
pl
in
let
e
=
dexpr
env
e
in
expected_type
e
ty
;
pl
,
e
...
...
@@ -817,6 +827,15 @@ let add_local x v env = Mvs.add x v env
let
add_binder
env
(
x
,
v
)
=
add_local
x
v
env
let
add_binders
=
List
.
fold_left
add_binder
let
rec
add_local_pat
env
p
=
match
p
.
pat_node
with
|
Term
.
Pwild
->
env
|
Term
.
Pvar
x
->
add_local
x
(
Tpure
p
.
pat_ty
)
env
|
Term
.
Papp
(
_
,
pl
)
->
add_local_pats
env
pl
|
Term
.
Pas
(
p
,
_
)
->
add_local_pat
env
p
and
add_local_pats
env
pl
=
List
.
fold_left
add_local_pat
env
pl
let
make_apply
loc
e1
ty
c
=
let
x
=
create_vsymbol
(
id_fresh
"f"
)
e1
.
expr_type
in
let
v
=
c
.
c_result_type
and
ef
=
c
.
c_effect
in
...
...
@@ -956,8 +975,19 @@ and expr_desc gl env loc ty = function
Eif
(
e1
,
mk_true
loc
gl
,
e2
)
in
d
,
Tpure
ty
,
ef
|
IEmatch
_
->
assert
false
(*TODO*)
|
IEmatch
(
el
,
bl
)
->
let
add1
ef
e
=
let
e
=
expr
gl
env
e
in
E
.
union
ef
e
.
expr_effect
,
e
in
let
ef
,
el
=
map_fold_left
add1
E
.
empty
el
in
let
branch
ef
(
pl
,
e
)
=
let
env
=
add_local_pats
env
pl
in
let
e
=
expr
gl
env
e
in
let
ef
=
E
.
union
ef
e
.
expr_effect
in
ef
,
(
pl
,
e
)
in
let
ef
,
bl
=
map_fold_left
branch
ef
bl
in
Ematch
(
el
,
bl
)
,
Tpure
ty
,
ef
|
IEskip
->
Eskip
,
Tpure
ty
,
E
.
empty
|
IEabsurd
->
...
...
tests/test-pgm-jcf.mlw
View file @
843c4391
...
...
@@ -3,10 +3,13 @@
type tree 'a =
| Leaf (x : 'a)
| Node (tree 'a) (x: 'a) (tree 'a)
}
let test (t: tree int) = x t
let test (t: tree int) =
match t with
| Leaf y -> y
| Node _ y _ -> y
end
(*
Local Variables:
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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