diff --git a/examples/in_progress/why3_logic/term.mlw b/examples/in_progress/why3_logic/term.mlw
index ffa32365394dbbfbd2197aa6f9205b5b392573d5..0e3ebb2b6392337d8905170ad4fde1ac6ac9d00b 100644
--- a/examples/in_progress/why3_logic/term.mlw
+++ b/examples/in_progress/why3_logic/term.mlw
@@ -264,7 +264,7 @@ module Term
function ct_d (t_ctx 'vs) : term -> bool
function ct_m (t_ctx 'vs) : term -> D.term 'vs
axiom t_ctx_inv : forall c,x:'vs. c.ct_vs.c_ldom x ->
- ty_vars_in c.ct_ty.cty_tv.c_ldom c.ct_ty.cty_sym.d_tys (c.ct_vty x)
+ ty_vars_in c.ct_ty.cty_tv.c_ldom c.ct_ty.cty_sym.d_tys (c.ct_vty x)
function ct_tv (ct:t_ctx 'vs) : context ident_name int = ct.ct_ty.cty_tv
function ct_sym (ct:t_ctx 'vs) : sym_ctx = ct.ct_ty.cty_sym
@@ -287,6 +287,11 @@ module Term
function ctp_mty (ctp:pat_ctx) : pattern -> D.ty =
\p. ctp.ct_ty.cty_m p.pat_ty
+ (* Type of variable symbols in contexts. *)
+ val ghost ct_vs_tys (ct:t_ctx 'vs) (vs:vsymbol) : unit
+ requires { ct.ct_vs.c_pdom vs.vs_idn }
+ ensures { ct.ct_ty.cty_d vs.vs_ty }
+ ensures { ct.ct_vty (ct.ct_vs.c_ptl vs.vs_idn) = ct.ct_ty.cty_m vs.vs_ty }
(* Contexts bounds. *)
val ghost ct_ubounds (ct:t_ctx 'vs) : unit
ensures { subset ct.ct_vs.c_pdom ids.ids }
@@ -551,6 +556,10 @@ module Term
type trigger = list (list term)
+ predicate br_ty_are (ct:t_ctx 'vs) (bty:D.ty) (oty:D.ty) (tbr:term_branch) =
+ ct.ct_ty.cty_m tbr.tbr_bty = bty /\
+ ct.ct_ty.cty_m tbr.tbr_ty = oty
+
(* Binding predicates. *)
predicate bound_env (x:vsymbol) (c:t_ctx unit) =
c.ct_vs.c_ldom = all /\
@@ -611,6 +620,7 @@ module Term
ensures { co.ctb_d result }
ensures { co.ctb_m result = ct.ct_m t }
ensures { co.ct_ty.cty_m result.tb_ty = ct.ct_mty t }
+ ensures { ct.ct_ty.cty_d vs.vs_ty }
ensures { co.ct_ty.cty_m result.tb_bty = ct.ct_ty.cty_m vs.vs_ty
= ct.ct_vty (ct.ct_vs.c_ptl vs.vs_idn) }
@@ -650,6 +660,7 @@ module Term
let vs = r.tbo_vs in let cb = r.tbo_cb in
cn.ct_d t /\ fused ct cb cn /\ bound_env vs cb /\
cn.ct_m t = ct.ctb_m tb /\ cn.ct_mty t = ct.ct_ty.cty_m tb.tb_ty /\
+ cn.ct_ty.cty_d vs.vs_ty /\
cn.ct_ty.cty_m vs.vs_ty = cn.ct_vty (cn.ct_vs.c_ptl vs.vs_idn)
= ct.ct_ty.cty_m tb.tb_bty }
@@ -688,23 +699,179 @@ module Term
ct.ctq_m tq = D.TImplies (trigger cn tr) (cn.ct_m t) /\
tq.tq_qty = map vs_ty vsl /\
vsl <> Nil /\ cn.ct_ty.cty_m t.t_ty = ty_prop }
- (*
+
val t_node (ghost ct:t_ctx 'vs) (t:term) : term_node
requires { ct.ct_d t }
returns { Tvar vs -> ct.ct_m t = D.TVar (ct.ct_vs.c_ptl vs.vs_idn) /\
ct.ct_vs.c_pdom vs.vs_idn /\
+ ct.ct_ty.cty_d vs.vs_ty /\
ct.ct_mty t = ct.ct_ty.cty_m vs.vs_ty
- = ct.ct_vty (ct.ct_vs.ct_ptl vs.vs_idn)
+ = ct.ct_vty (ct.ct_vs.c_ptl vs.vs_idn)
| Tconst cst -> ct.ct_m t = D.TApp cst.cst_m Nil Nil /\
ct.ct_mty t = ty_ret global_sig.sig_m cst.cst_m Nil
- | Tapp f tyl tl -> for_all ct.ct_d tl /\
+ | Tapp f tyl tl -> for_all ct.ct_d tl /\ ct.ct_sym.d_ls f.ls_m /\
ct.ct_m t = D.TApp f.ls_m tyl (map ct.ct_m tl) /\
- ct.ct_mty t = ty_subst_ret f.ls_args tyl /\
- map ct.ct_mty tl = ty_subst_args f.ls_ret tyl
+ ct.ct_mty t = ty_subst_ret tyl f.ls_ret /\
+ map ct.ct_mty tl = ty_subst_args tyl f.ls_args
| Tif b th el -> ct.ct_d b /\ ct.ct_d th /\ ct.ct_d el /\
ct.ct_m t = D.TIf (ct.ct_m b) (ct.ct_m th) (ct.ct_m el) /\
- ct.ct_mty b = ty_prop /\ ct.ct_mty th = ct.ct_mty
- }*)
+ ct.ct_mty b = ty_prop /\ ct.ct_mty th = ct.ct_mty el = ct.ct_mty t
+ | Tlet u v -> ct.ct_d u /\ ct.ctb_d v /\
+ ct.ct_m t = D.TLet (ct.ct_m u) (ct.ctb_m v) /\
+ ct.ct_ty.cty_m v.tb_bty = ct.ct_mty u /\
+ ct.ct_ty.cty_m v.tb_ty = ct.ct_mty t
+ | Tcase u brl -> ct.ct_d u /\ for_all ct.ctbr_d brl /\
+ for_all (br_ty_are ct (ct.ct_mty u) (ct.ct_mty t)) brl /\
+ ct.ct_m t = D.TCase (ct.ct_m u) (map ct.ctbr_m brl)
+ | Teps u -> ct.ctb_d u /\ ct.ct_m t = D.TEps (ct.ct_mty t) (ct.ctb_m u) /\
+ ct.ct_ty.cty_m u.tb_bty = ct.ct_mty t /\
+ ct.ct_ty.cty_m u.tb_ty = ty_prop
+ | Tquant q tq -> ct.ctq_d tq /\ ct.ct_mty t = ty_prop /\
+ tq.tq_qty <> Nil /\ let tyl = map ct.ct_ty.cty_m tq.tq_qty in
+ match q with
+ | Tforall -> ct.ct_m t = D.TForall tyl (ct.ctq_m tq)
+ | Texists -> ct.ct_m t = D.TExists tyl (ct.ctq_m tq)
+ end
+ | Tbinop bp a b -> ct.ct_d a /\ ct.ct_d b /\
+ ct.ct_mty a = ct.ct_mty b = ct.ct_mty t = ty_prop /\
+ let tm = ct.ct_m t in let am = ct.ct_m a in let bm = ct.ct_m b in
+ match bp with
+ | Tand -> tm = D.TAnd am bm
+ | Tor -> tm = D.TOr am bm
+ | Timplies -> tm = D.TImplies am bm
+ | Tiff -> tm = D.TIff am bm
+ end
+ | Tnot u -> ct.ct_d u /\ ct.ct_mty t = ct.ct_mty u = ty_prop /\
+ ct.ct_m t = D.TNot (ct.ct_m u)
+ | Ttrue -> ct.ct_m t = D.TTrue /\ ct.ct_mty t = ty_prop
+ | Tfalse -> ct.ct_m t = D.TFalse /\ ct.ct_mty t = ty_prop
+ }
+
+ val t_var (ghost ct:t_ctx 'vs) (vs:vsymbol) : term
+ requires { ct.ct_vs.c_pdom vs.vs_idn }
+ ensures { ct.ct_d result }
+ ensures { ct.ct_m result = D.TVar (ct.ct_vs.c_ptl vs.vs_idn) }
+ ensures { ct.ct_ty.cty_d vs.vs_ty }
+ ensures { ct.ct_mty result = ct.ct_ty.cty_m vs.vs_ty
+ = ct.ct_vty (ct.ct_vs.c_ptl vs.vs_idn) }
+
+ val t_const (ghost ct:t_ctx 'vs) (cst:const) : term
+ ensures { ct.ct_d result /\ ct.ct_m result = D.TApp cst.cst_m Nil Nil }
+ ensures { ct.ct_mty result = ty_ret global_sig.sig_m cst.cst_m Nil }
+
+ val t_app (ghost ct:t_ctx 'vs) (ls:lsymbol) (ghost tyl:list D.ty)
+ (tl:list term) (tyo:option ty) : term
+ requires { for_all ct.ct_d tl /\ ct.ct_sym.d_ls ls.ls_m }
+ requires { map ct.ct_mty tl = ty_subst_args tyl ls.ls_args }
+ requires { match tyo with
+ | None -> ty_subst_ret tyl ls.ls_ret = ty_prop
+ | Some u -> ty_subst_ret tyl ls.ls_ret = ct.ct_ty.cty_m u
+ end }
+ ensures { ct.ct_d result }
+ ensures { ct.ct_m result = D.TApp ls.ls_m tyl (map ct.ct_m tl) }
+ ensures { ct.ct_mty result = ty_subst_ret tyl ls.ls_ret }
+
+ val t_if (ghost ct:t_ctx 'vs) (b:term) (th:term) (el:term) : term
+ requires { ct.ct_d b /\ ct.ct_d th /\ ct.ct_d el }
+ requires { ct.ct_mty th = ct.ct_mty el /\ ct.ct_mty b = ty_prop }
+ ensures { ct.ct_d result }
+ ensures { ct.ct_m result = D.TIf (ct.ct_m b) (ct.ct_m th) (ct.ct_m el) }
+ ensures { ct.ct_mty result = ct.ct_mty th }
+
+ val t_let (ghost ct:t_ctx 'vs) (u:term) (v:term_bound) : term
+ requires { ct.ct_d u /\ ct.ctb_d v }
+ requires { ct.ct_ty.cty_m v.tb_bty = ct.ct_mty u }
+ ensures { ct.ct_d result }
+ ensures { ct.ct_m result = D.TLet (ct.ct_m u) (ct.ctb_m v) }
+ ensures { ct.ct_mty result = ct.ct_ty.cty_m v.tb_ty }
+
+ val t_case (ghost ct:t_ctx 'vs) (ghost oty:D.ty)
+ (u:term) (brl:list term_branch) : term
+ requires { ct.ct_d u /\ for_all ct.ctbr_d brl }
+ requires { for_all (br_ty_are ct (ct.ct_mty u) oty) brl }
+ ensures { ct.ct_d result }
+ ensures { ct.ct_m result = D.TCase (ct.ct_m u) (map ct.ctbr_m brl) }
+ ensures { ct.ct_mty result = oty }
+
+ val t_eps (ghost ct:t_ctx 'vs) (u:term_bound) : term
+ requires { ct.ctb_d u /\ ct.ct_ty.cty_m u.tb_ty = ty_prop }
+ ensures { ct.ct_d result }
+ ensures { ct.ct_m result = D.TEps (ct.ct_mty result) (ct.ctb_m u) }
+ ensures { ct.ct_mty result = ct.ct_ty.cty_m u.tb_bty }
+
+ val t_quant (ghost ct:t_ctx 'vs) (q:quant) (tq:term_quant) : term
+ requires { ct.ctq_d tq }
+ ensures { ct.ct_d result }
+ ensures { let tyl = map ct.ct_ty.cty_m tq.tq_qty in
+ match q with
+ | Tforall -> ct.ct_m result = D.TForall tyl (ct.ctq_m tq)
+ | Texists -> ct.ct_m result = D.TExists tyl (ct.ctq_m tq)
+ end }
+ ensures { ct.ct_mty result = ty_prop }
+
+ val t_forall (ghost ct:t_ctx 'vs) (tq:term_quant) : term
+ requires { ct.ctq_d tq }
+ ensures { ct.ct_d result }
+ ensures { let tyl = map ct.ct_ty.cty_m tq.tq_qty in
+ ct.ct_m result = D.TForall tyl (ct.ctq_m tq) }
+ ensures { ct.ct_mty result = ty_prop }
+
+ val t_exists (ghost ct:t_ctx 'vs) (tq:term_quant) : term
+ requires { ct.ctq_d tq }
+ ensures { ct.ct_d result }
+ ensures { let tyl = map ct.ct_ty.cty_m tq.tq_qty in
+ ct.ct_m result = D.TExists tyl (ct.ctq_m tq) }
+ ensures { ct.ct_mty result = ty_prop }
+
+ val t_binary (ghost ct:t_ctx 'vs) (bp:binop) (a b:term) : term
+ requires { ct.ct_d a /\ ct.ct_d b }
+ requires { ct.ct_mty a = ty_prop = ct.ct_mty b }
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures {
+ let am = ct.ct_m a in let bm = ct.ct_m b in let rm = ct.ct_m result in
+ match bp with
+ | Tand -> rm = D.TAnd am bm
+ | Tor -> rm = D.TOr am bm
+ | Timplies -> rm = D.TImplies am bm
+ | Tiff -> rm = D.TIff am bm
+ end }
+
+ val t_and (ghost ct:t_ctx 'vs) (a b:term) : term
+ requires { ct.ct_d a /\ ct.ct_d b }
+ requires { ct.ct_mty a = ty_prop = ct.ct_mty b }
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TAnd (ct.ct_m a) (ct.ct_m b) }
+
+ val t_or (ghost ct:t_ctx 'vs) (a b:term) : term
+ requires { ct.ct_d a /\ ct.ct_d b }
+ requires { ct.ct_mty a = ty_prop = ct.ct_mty b }
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TOr (ct.ct_m a) (ct.ct_m b) }
+
+ val t_implies (ghost ct:t_ctx 'vs) (a b:term) : term
+ requires { ct.ct_d a /\ ct.ct_d b }
+ requires { ct.ct_mty a = ty_prop = ct.ct_mty b }
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TImplies (ct.ct_m a) (ct.ct_m b) }
+
+ val t_iff (ghost ct:t_ctx 'vs) (a b:term) : term
+ requires { ct.ct_d a /\ ct.ct_d b }
+ requires { ct.ct_mty a = ty_prop = ct.ct_mty b }
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TIff (ct.ct_m a) (ct.ct_m b) }
+
+ val t_not (ghost ct:t_ctx 'vs) (a:term) : term
+ requires { ct.ct_d a /\ ct.ct_mty a = ty_prop }
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TNot (ct.ct_m a) }
+
+ val t_true (ghost ct:t_ctx 'vs) : term
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TTrue }
+
+ val t_false (ghost ct:t_ctx 'vs) : term
+ ensures { ct.ct_d result /\ ct.ct_mty result = ty_prop }
+ ensures { ct.ct_m result = D.TFalse }
end
diff --git a/examples/in_progress/why3_logic/term/why3session.xml b/examples/in_progress/why3_logic/term/why3session.xml
index 0d6fc7f64c088ea37e415d69521969dbd5a39c93..720c8b5cd4506d9a1baa6712807726f2fc78a3f0 100644
--- a/examples/in_progress/why3_logic/term/why3session.xml
+++ b/examples/in_progress/why3_logic/term/why3session.xml
@@ -9,7 +9,7 @@
-
+
diff --git a/examples/in_progress/why3_logic/term/why3shapes.gz b/examples/in_progress/why3_logic/term/why3shapes.gz
index 513ee53d37b177ed87e377b33cf14b1834bad399..e15287a322b4f137edce3673d82286b15b46aa81 100644
Binary files a/examples/in_progress/why3_logic/term/why3shapes.gz and b/examples/in_progress/why3_logic/term/why3shapes.gz differ
diff --git a/examples/in_progress/why3_logic/ty.mlw b/examples/in_progress/why3_logic/ty.mlw
index 2425dc59adfcc3dd7365ee8bc19b252282886139..bcff33cbbce40229f4a58b4f4ebe57b74ddc5042 100644
--- a/examples/in_progress/why3_logic/ty.mlw
+++ b/examples/in_progress/why3_logic/ty.mlw
@@ -295,7 +295,7 @@ module Ty
ensures { equalizer s.Mtv.domain s.Mtv.bindings result.Mtv.bindings }
(* Invariant. *)
ensures { forall x. result.Mtv.domain x ->
- ty1.cty_d (result.Mtv.bindings x) }
+ cty1.cty_d (result.Mtv.bindings x) }
(* Failure. *)
raises { TypeMismatch _ -> forall f.
(forall x. s.Mtv.domain x ->
diff --git a/examples/in_progress/why3_logic/ty/why3session.xml b/examples/in_progress/why3_logic/ty/why3session.xml
index bd50b6548a133494a2ce529318e109b4c80bd782..71594df2d509dbab723f427141f7d06331a8c08f 100644
--- a/examples/in_progress/why3_logic/ty/why3session.xml
+++ b/examples/in_progress/why3_logic/ty/why3session.xml
@@ -7,7 +7,7 @@
-
+
@@ -29,10 +29,10 @@
-
+
-
+
diff --git a/examples/in_progress/why3_logic/ty/why3shapes.gz b/examples/in_progress/why3_logic/ty/why3shapes.gz
index 0d35003c4de3b23997d11007989861b61b7135da..3253cc0d7c311f93739d35b14035c966549f4d07 100644
Binary files a/examples/in_progress/why3_logic/ty/why3shapes.gz and b/examples/in_progress/why3_logic/ty/why3shapes.gz differ