Skip to content

GitLab

why3
why3
Commit b67464fe authored by Jean-Christophe Filliâtre's avatar Jean-Christophe Filliâtre
Browse files
Options

programs: typing programs first, then annotations

parent 10d709b6
Hide whitespace changes
Inline Side-by-side
Showing with 287 additions and 176 deletions
examples/programs/vacid_0_build_maze.mlw
View file @ b67464fe
......@@ -89,7 +89,7 @@ parameter add_edge :
path (old graph) x b and path (old graph) a y)
}
let add_edge_and_union (u:ref uf) (a:int) (b:int) =
let add_edge_and_union u (a:int) (b:int) =
{ 0 <= a < size u and 0 <= b < size u and
not same u a b and not path graph a b and
forall x y:int.
......
examples/programs/vacid_0_red_black_trees.mlw
View file @ b67464fe
......@@ -46,7 +46,7 @@ parameter add :
let (d, t) = r in
memt t k v or (v = d and forall v':value. not (memt t k v'))
let create d =
let create (d : int) =
{ }
let x = (d, Leaf) in ref x (* BUG: ref (d, Leaf) *)
{ default result = d and
......
examples/programs/vacid_0_union_find.mlw
View file @ b67464fe
......@@ -91,7 +91,7 @@ parameter ghost_find : u:ref uf -> x:int ->
int reads u
{ repr !u x result }
let increment (u : ref uf) (r : int) =
let increment u r =
{ inv !u and 0 <= r < size !u }
let i = ref 0 in
let d = ref (dist !u) in
......@@ -108,7 +108,7 @@ let increment (u : ref uf) (r : int) =
{ forall i:int. 0 <= i < size !u ->
result#i = (dist !u)#i + if repr !u i r then 1 else 0 }
let union (u:ref uf) (a b:int) =
let union u a b =
{ inv !u and
0 <= a < size !u and 0 <= b < size !u and not same !u a b }
let ra = find u a in
......
src/programs/pgm_ttree.ml
View file @ b67464fe
......@@ -46,12 +46,7 @@ type deffect = {
de_raises : esymbol list;
}
type dpre = Denv.dfmla
type dpost_fmla = Denv.dty * Denv.dfmla
type dexn_post_fmla = Denv.dty option * Denv.dfmla
type dpost = dpost_fmla * (Term.lsymbol * dexn_post_fmla) list
(* specialized type_v *)
type dtype_v =
| DTpure of Denv.dty
| DTarrow of dbinder list * dtype_c
......@@ -59,15 +54,35 @@ type dtype_v =
and dtype_c =
{ dc_result_type : dtype_v;
dc_effect : deffect;
dc_pre : dpre;
dc_post : dpost; }
dc_pre : Denv.dfmla;
dc_post : (Denv.dty * Denv.dfmla) *
(Term.lsymbol * (Denv.dty option * Denv.dfmla)) list; }
and dbinder = ident * Denv.dty * dtype_v
type dvariant = Denv.dterm * Term.lsymbol option
(* user type_v *)
type dpre = Ptree.pre
type dpost_fmla = Ptree.lexpr
type dexn_post_fmla = Ptree.lexpr
type dpost = dpost_fmla * (Term.lsymbol * dexn_post_fmla) list
type dutype_v =
| DUTpure of Denv.dty
| DUTarrow of dubinder list * dutype_c
and dutype_c =
{ duc_result_type : dutype_v;
duc_effect : deffect;
duc_pre : Ptree.lexpr;
duc_post : Ptree.lexpr * (Term.lsymbol * Ptree.lexpr) list; }
and dubinder = ident * Denv.dty * dutype_v
type dvariant = Ptree.lexpr * Term.lsymbol option
type dloop_annotation = {
dloop_invariant : Denv.dfmla option;
dloop_invariant : Ptree.lexpr option;
dloop_variant : dvariant option;
}
......@@ -84,7 +99,7 @@ and dexpr_desc =
| DEglobal of psymbol * dtype_v
| DElogic of Term.lsymbol
| DEapply of dexpr * dexpr
| DEfun of dbinder list * dtriple
| DEfun of dubinder list * dtriple
| DElet of ident * dexpr * dexpr
| DEletrec of drecfun list * dexpr
......@@ -96,13 +111,13 @@ and dexpr_desc =
| DEabsurd
| DEraise of esymbol * dexpr option
| DEtry of dexpr * (esymbol * string option * dexpr) list
| DEfor of ident * dexpr * for_direction * dexpr * Denv.dfmla option * dexpr
| DEfor of ident * dexpr * for_direction * dexpr * Ptree.lexpr option * dexpr
| DEassert of assertion_kind * Denv.dfmla
| DEassert of assertion_kind * Ptree.lexpr
| DElabel of string * dexpr
| DEany of dtype_c
| DEany of dutype_c
and drecfun = (ident * Denv.dty) * dbinder list * dvariant option * dtriple
and drecfun = (ident * Denv.dty) * dubinder list * dvariant option * dtriple
and dtriple = dpre * dexpr * dpost
......@@ -111,15 +126,18 @@ and dtriple = dpre * dexpr * dpost
type variant = Term.term * Term.lsymbol option
type reference = R.t
type loop_annotation = {
loop_invariant : Term.fmla option;
loop_variant : variant option;
}
type pre = T.pre
type ipre = T.pre
type post = T.post
type ipost = T.post
(* each program variable is materialized by two logic variables (vsymbol):
one for typing programs and another for typing annotations *)
type ivsymbol = {
type ivsymbol (* = Term.vsymbol *) = {
i_pgm : Term.vsymbol; (* in programs *)
i_logic : Term.vsymbol; (* in annotations *)
}
......@@ -141,16 +159,11 @@ type itype_v =
and itype_c =
{ ic_result_type : itype_v;
ic_effect : ieffect;
ic_pre : pre;
ic_post : post; }
ic_pre : T.pre;
ic_post : T.post; }
and ibinder = ivsymbol * itype_v
type loop_annotation = {
loop_invariant : Term.fmla option;
loop_variant : variant option;
}
type label = Term.vsymbol
type irec_variant = ivsymbol * Term.term * Term.lsymbol option
......@@ -160,7 +173,7 @@ type ipattern = {
ipat_node : ipat_node;
}
and ipat_node =
and ipat_node =
| IPwild
| IPvar of ivsymbol
| IPapp of Term.lsymbol * ipattern list
......@@ -199,12 +212,18 @@ and iexpr_desc =
and irecfun = ivsymbol * ibinder list * irec_variant option * itriple
and itriple = pre * iexpr * post
and itriple = ipre * iexpr * ipost
(*****************************************************************************)
(* phase 3: effect inference *)
type reference = R.t
type pre = T.pre
type post = T.post
type rec_variant = pvsymbol * Term.term * Term.lsymbol option
type pattern = {
......
src/programs/pgm_types.ml
View file @ b67464fe
......@@ -68,6 +68,10 @@ let ts_arrow =
let v = List.map (fun s -> create_tvsymbol (Ident.id_fresh s)) ["a"; "b"] in
Ty.create_tysymbol (Ident.id_fresh "arrow") v None
let make_arrow_type tyl ty =
let arrow ty1 ty2 = Ty.ty_app ts_arrow [ty1; ty2] in
List.fold_right arrow tyl ty
module Sexn = Term.Sls
module rec T : sig
......@@ -182,10 +186,6 @@ end = struct
let purify ty = try model_type ty with NotMutable -> ty
let make_arrow_type tyl ty =
let arrow ty1 ty2 = Ty.ty_app ts_arrow [ty1; ty2] in
List.fold_right arrow tyl ty
let rec uncurry_type ?(logic=false) = function
| Tpure ty when not logic ->
[], ty
......
src/programs/pgm_types.mli
View file @ b67464fe
......@@ -29,6 +29,7 @@ val is_mutable_ts : tysymbol -> bool
val is_mutable_ty : ty -> bool
val ts_arrow : tysymbol
val make_arrow_type : ty list -> ty -> ty
val ts_exn : tysymbol
val ty_exn : ty
......
src/programs/pgm_typing.ml
View file @ b67464fe
......@@ -75,7 +75,7 @@ let dty_label uc = dty_app (find_ts uc "label_", [])
type denv = {
uc : uc;
locals: Denv.dty Mstr.t;
denv : Typing.denv;
denv : Typing.denv; (* for user type variables only *)
}
let create_denv uc =
......@@ -113,35 +113,35 @@ let loc_of_ls ls = match ls.ls_name.id_origin with
| User loc -> Some loc
| _ -> None (* FIXME: loc for recursive functions *)
let dmodel_type dty = match view_dty dty with
| Tyapp (ts, tyl) ->
let mt = get_mtsymbol ts in
begin match mt.mt_model with
| None ->
dty
| Some ty ->
let h = Htv.create 17 in
List.iter2 (Htv.add h) mt.mt_args tyl;
let rec inst ty = match ty.ty_node with
| Ty.Tyvar tv -> Htv.find h tv
| Ty.Tyapp (ts, tyl) -> Denv.tyapp (ts, List.map inst tyl)
in
inst ty
end
| Tyvar _ ->
dty
let dpurify ty = try dmodel_type ty with NotMutable -> ty
(* let dmodel_type dty = match view_dty dty with *)
(* | Tyapp (ts, tyl) -> *)
(* let mt = get_mtsymbol ts in *)
(* begin match mt.mt_model with *)
(* | None -> *)
(* dty *)
(* | Some ty -> *)
(* let h = Htv.create 17 in *)
(* List.iter2 (Htv.add h) mt.mt_args tyl; *)
(* let rec inst ty = match ty.ty_node with *)
(* | Ty.Tyvar tv -> Htv.find h tv *)
(* | Ty.Tyapp (ts, tyl) -> Denv.tyapp (ts, List.map inst tyl) *)
(* in *)
(* inst ty *)
(* end *)
(* | Tyvar _ -> *)
(* dty *)
(* let dpurify ty = try dmodel_type ty with NotMutable -> ty *)
let dcurrying tyl ty =
let make_arrow_type ty1 ty2 = dty_app (ts_arrow, [ty1; ty2]) in
List.fold_right make_arrow_type tyl ty
let rec dpurify_type_v ?(logic=false) = function
let rec dpurify_type_v (* ?(logic=false) *) = function
| DTpure ty ->
if logic then dpurify ty else ty
(* if logic then dpurify ty else *) ty
| DTarrow (bl, c) ->
dcurrying (List.map (fun (_,ty,_) -> if logic then dpurify ty else ty) bl)
dcurrying (List.map (fun (_,ty,_) -> (* if logic then dpurify ty else *) ty) bl)
(dpurify_type_v c.dc_result_type)
let rec specialize_type_v ~loc htv = function
......@@ -228,10 +228,10 @@ let dreference env = function
(* TODO check_reference_type env.uc loc ty; *)
DRglobal s
let dexception env qid =
let dexception uc qid =
let sl = Typing.string_list_of_qualid [] qid in
let loc = Typing.qloc qid in
let _, _, ty as r = specialize_exception loc sl env.uc in
let _, _, ty as r = specialize_exception loc sl uc in
let ty_exn = dty_app (ts_exn, []) in
if not (Denv.unify ty ty_exn) then
errorm ~loc
......@@ -243,58 +243,62 @@ let deffect env e =
{ de_reads = List.map (dreference env) e.Ptree.pe_reads;
de_writes = List.map (dreference env) e.Ptree.pe_writes;
de_raises =
List.map (fun id -> let ls,_,_ = dexception env id in ls)
List.map (fun id -> let ls,_,_ = dexception env.uc id in ls)
e.Ptree.pe_raises; }
let dterm env l = Typing.dterm ~localize:true env l
let dfmla env l = Typing.dfmla ~localize:true env l
let dpost env ty (q, ql) =
let dpost uc (q, ql) =
let dexn (id, l) =
let s, tyl, _ = dexception env id in
let ty, denv = match tyl with
| [] ->
None, env.denv
| [ty] ->
let ty = dpurify ty in
Some ty, add_pure_var id_result ty env.denv
| _ -> assert false
in
s, (ty, dfmla denv l)
let s, _tyl, _ = dexception uc id in
(* let ty, denv = match tyl with *)
(* | [] -> *)
(* None, env.denv *)
(* | [ty] -> *)
(* let ty = dpurify ty in *)
(* Some ty, add_pure_var id_result ty env.denv *)
(* | _ -> assert false *)
(* in *)
s, ((* ty, dfmla denv *) l)
in
let ty = dpurify ty in
let denv = add_pure_var id_result ty env.denv in
(ty, dfmla denv q), List.map dexn ql
(* let ty = dpurify ty in *)
(* let denv = add_pure_var id_result ty env.denv in *)
((* ty, dfmla denv *) q), List.map dexn ql
let add_local_top env x tyv =
{ env with locals = Mstr.add x tyv env.locals }
let add_local env x ty =
{ env with locals = Mstr.add x ty env.locals;
denv = add_pure_var x (dpurify ty) env.denv }
(* denv = add_pure_var x (dpurify ty) env.denv *) }
let rec dpurify_utype_v (* ?(logic=false) *) = function
| DUTpure ty ->
(* if logic then dpurify ty else *) ty
| DUTarrow (bl, c) ->
dcurrying (List.map (fun (_,ty,_) -> (* if logic then dpurify ty else *) ty) bl)
(dpurify_utype_v c.duc_result_type)
let rec dtype_v env = function
let rec dutype_v env = function
| Ptree.Tpure pt ->
DTpure (pure_type env pt)
DUTpure (pure_type env pt)
| Ptree.Tarrow (bl, c) ->
let env, bl = map_fold_left dbinder env bl in
let c = dtype_c env c in
DTarrow (bl, c)
and dtype_c env c =
let ty = dtype_v env c.Ptree.pc_result_type in
{ dc_result_type = ty;
dc_effect = deffect env c.Ptree.pc_effect;
dc_pre = dfmla env.denv c.Ptree.pc_pre;
dc_post = dpost env (dpurify_type_v ty) c.Ptree.pc_post;
let env, bl = map_fold_left dubinder env bl in
let c = dutype_c env c in
DUTarrow (bl, c)
and dutype_c env c =
let ty = dutype_v env c.Ptree.pc_result_type in
{ duc_result_type = ty;
duc_effect = deffect env c.Ptree.pc_effect;
duc_pre = (* dfmla env.denv *) c.Ptree.pc_pre;
duc_post = dpost env.uc (* (dpurify_type_v ty) *) c.Ptree.pc_post;
}
and dbinder env ({id=x; id_loc=loc} as id, v) =
and dubinder env ({id=x; id_loc=loc} as id, v) =
let v = match v with
| Some v -> dtype_v env v
| None -> DTpure (create_type_var loc)
| Some v -> dutype_v env v
| None -> DUTpure (create_type_var loc)
in
let ty = dpurify_type_v v in
let ty = dpurify_utype_v v in
add_local env x ty, (id, ty, v)
let rec add_local_pat env p = match p.dp_node with
......@@ -305,26 +309,37 @@ let rec add_local_pat env p = match p.dp_node with
| Denv.Por (p, q) -> add_local_pat (add_local_pat env p) q
let dvariant env (l, p) =
let t = dterm env.denv l in
match p with
| None ->
if not (Denv.unify t.dt_ty (dty_int env.uc)) then
errorm ~loc:l.pp_loc "variant should have type int";
t, None
| Some p ->
let s, _ = Typing.specialize_psymbol p (theory_uc env.uc) in
let loc = Typing.qloc p in
begin match s.ls_args with
| [t1; t2] when Ty.ty_equal t1 t2 ->
()
| _ ->
errorm ~loc "predicate %s should be a binary relation"
s.ls_name.id_string
end;
t, Some s
let relation p =
let s, _ = Typing.specialize_psymbol p (theory_uc env.uc) in
let loc = Typing.qloc p in
match s.ls_args with
| [t1; t2] when Ty.ty_equal t1 t2 ->
s
| _ ->
errorm ~loc "predicate %s should be a binary relation"
s.ls_name.id_string
in
l, option_map relation p
(* let t = dterm env.denv l in *)
(* match p with *)
(* | None -> *)
(* if not (Denv.unify t.dt_ty (dty_int env.uc)) then *)
(* errorm ~loc:l.pp_loc "variant should have type int"; *)
(* t, None *)
(* | Some p -> *)
(* let s, _ = Typing.specialize_psymbol p (theory_uc env.uc) in *)
(* let loc = Typing.qloc p in *)
(* begin match s.ls_args with *)
(* | [t1; t2] when Ty.ty_equal t1 t2 -> *)
(* () *)
(* | _ -> *)
(* errorm ~loc "predicate %s should be a binary relation" *)
(* s.ls_name.id_string *)
(* end; *)
(* t, Some s *)
let dloop_annotation env a =
{ dloop_invariant = option_map (dfmla env.denv) a.Ptree.loop_invariant;
{ dloop_invariant = a.Ptree.loop_invariant;
dloop_variant = option_map (dvariant env) a.Ptree.loop_variant; }
(* [dexpr] translates ptree into dexpr *)
......@@ -374,7 +389,7 @@ and dexpr_desc env loc = function
expected_type e2 ty2;
DEapply (e1, e2), ty
| Ptree.Efun (bl, t) ->
let env, bl = map_fold_left dbinder env bl in
let env, bl = map_fold_left dubinder env bl in
let (_,e,_) as t = dtriple env t in
let tyl = List.map (fun (_,ty,_) -> ty) bl in
let ty = dcurrying tyl e.dexpr_type in
......@@ -445,7 +460,7 @@ and dexpr_desc env loc = function
| Ptree.Eabsurd ->
DEabsurd, create_type_var loc
| Ptree.Eraise (qid, e) ->
let ls, tyl, _ = dexception env qid in
let ls, tyl, _ = dexception env.uc qid in
let e = match e, tyl with
| None, [] ->
None
......@@ -465,7 +480,7 @@ and dexpr_desc env loc = function
| Ptree.Etry (e1, hl) ->
let e1 = dexpr env e1 in
let handler (id, x, h) =
let ls, tyl, _ = dexception env id in
let ls, tyl, _ = dexception env.uc id in
let x, env = match x, tyl with
| Some _, [] ->
errorm ~loc "expection %a has no argument" print_qualid id
......@@ -490,13 +505,13 @@ and dexpr_desc env loc = function
let e2 = dexpr env e2 in
expected_type e2 (dty_int env.uc);
let env = add_local env x.id (dty_int env.uc) in
let inv = option_map (dfmla env.denv) inv in
(* let inv = option_map (dfmla env.denv) inv in *)
let e3 = dexpr env e3 in
expected_type e3 (dty_unit env.uc);
DEfor (x, e1, d, e2, inv, e3), dty_unit env.uc
| Ptree.Eassert (k, le) ->
DEassert (k, dfmla env.denv le), dty_unit env.uc
DEassert (k, (* dfmla env.denv *) le), dty_unit env.uc
| Ptree.Elabel ({id=s}, e1) ->
if Typing.mem_var s env.denv then
errorm ~loc "clash with previous label %s" s;
......@@ -510,8 +525,8 @@ and dexpr_desc env loc = function
expected_type e1 ty;
e1.dexpr_desc, ty
| Ptree.Eany c ->
let c = dtype_c env c in
DEany c, dpurify_type_v c.dc_result_type
let c = dutype_c env c in
DEany c, dpurify_utype_v c.duc_result_type
and dletrec env dl =
(* add all functions into environment *)
......@@ -523,7 +538,7 @@ and dletrec env dl =
let env, dl = map_fold_left add_one env dl in
(* then type-check all of them and unify *)
let type_one ((id, tyres), bl, v, t) =
let env, bl = map_fold_left dbinder env bl in
let env, bl = map_fold_left dubinder env bl in
let v = option_map (dvariant env) v in
let (_,e,_) as t = dtriple env t in
let tyl = List.map (fun (_,ty,_) -> ty) bl in
......@@ -537,27 +552,49 @@ and dletrec env dl =
env, List.map type_one dl
and dtriple env (p, e, q) =
let p = dfmla env.denv p in
(* let p = dfmla env.denv p in *)
let e = dexpr env e in
let ty = e.dexpr_type in
let q = dpost env ty q in
(* let ty = e.dexpr_type in *)
let q = dpost env.uc (* ty *) q in
(p, e, q)
(* phase 2: remove destructive types and type annotations *****************)
let create_ivsymbol id ty =
let dterm env l = Typing.dterm ~localize:true env l
let dfmla env l = Typing.dfmla ~localize:true env l
type ienv = {
i_uc : uc;
i_denv : Typing.denv;
i_locals : ivsymbol Mstr.t;
i_logics : vsymbol Mstr.t;
}
(* let create_ivsymbol = create_vsymbol *)
let create_ivsymbol id ty =
let vs = create_vsymbol id ty in
let ty' = purify ty in
if ty_equal ty ty' then { i_pgm = vs; i_logic = vs }
if ty_equal ty ty' then { i_pgm = vs; i_logic = vs }
else { i_pgm = vs; i_logic = create_vsymbol id ty'; }
let rec dty_of_ty denv ty = match ty.ty_node with
| Ty.Tyvar v ->
Denv.tyvar (Typing.find_user_type_var v.tv_name.id_string denv)
| Ty.Tyapp (ts, tyl) ->
Denv.tyapp (ts, List.map (dty_of_ty denv) tyl)
let iadd_local env x ty =
let v = create_ivsymbol (id_user x.id x.id_loc) ty in
let env = Mstr.add x.id v env in
let v = create_ivsymbol x ty in
let s = v.i_pgm.vs_name.id_string in
let dty = dty_of_ty env.i_denv v.i_logic.vs_ty in
let env = { env with i_denv = add_pure_var s dty env.i_denv;
i_locals = Mstr.add s v env.i_locals;
i_logics = Mstr.add s v.i_logic env.i_logics; }
in
env, v
let ireference env = function
| DRlocal x -> IRlocal (Mstr.find x env)
| DRlocal x -> IRlocal (Mstr.find x env.i_locals)
| DRglobal ls -> IRglobal ls
let ieffect env e = {
......@@ -566,12 +603,10 @@ let ieffect env e = {
ie_raises = e.de_raises;
}
let lenv = Mstr.map (fun x -> x.i_logic)
let pre env = Denv.fmla (lenv env)
let pre env = Denv.fmla env.i_logics
let post env ((ty, f), ql) =
let env = lenv env in
let env = env.i_logics in
let exn (ls, (ty, f)) =
let v, env = match ty with
| None ->
......@@ -588,8 +623,12 @@ let post env ((ty, f), ql) =
let env = Mstr.add id_result v_result env in
(v_result, Denv.fmla env f), List.map exn ql
let variant loc env (t, ps) =
let t = Denv.term env t in
let iterm env l =
let t = dterm env.i_denv l in
Denv.term env.i_logics t
let ivariant loc env (t, ps) =
let t = iterm env t in
match ps with
| None ->
t, ps
......@@ -618,7 +657,57 @@ and itype_c gl env c =
and ibinder gl env (x, ty, tyv) =
let tyv = itype_v gl env tyv in
let ty = Denv.ty_of_dty ty in
let env, v = iadd_local env x ty in
let env, v = iadd_local env (id_user x.id x.id_loc) ty in
env, (v, tyv)
let ifmla env l =
let f = dfmla env.i_denv l in
Denv.fmla env.i_logics f
let id_result loc = id_user id_result loc
let iupost env ty (q, ql) =
let dexn (s, l) =
let v, env = match s.ls_args with
| [] ->
None, env
| [ty] ->
let env, v = iadd_local env (id_result l.pp_loc) ty in
Some v.i_logic, env
| _ -> assert false
in
s, (v, ifmla env l)
in
let env, v = iadd_local env (id_result q.pp_loc) ty in
(v.i_logic, ifmla env q), List.map dexn ql
let rec purify_itype_v = function
| ITpure ty ->
ty
| ITarrow (bl, c) ->
make_arrow_type
(List.map (fun (v,_) -> v.i_pgm.vs_ty) bl)
(purify_itype_v c.ic_result_type)
let rec iutype_v gl env = function
| DUTpure ty ->
ITpure (Denv.ty_of_dty ty)
| DUTarrow (bl, c) ->
let env, bl = map_fold_left (iubinder gl) env bl in
ITarrow (bl, iutype_c gl env c)
and iutype_c gl env c =
let tyv = iutype_v gl env c.duc_result_type in
let ty = purify_itype_v tyv in
{ ic_result_type = tyv;
ic_effect = ieffect env c.duc_effect;
ic_pre = ifmla env c.duc_pre;
ic_post = iupost env ty c.duc_post; }
and iubinder gl env (x, ty, tyv) =
let tyv = iutype_v gl env tyv in
let ty = Denv.ty_of_dty ty in
let env, v = iadd_local env (id_user x.id x.id_loc) ty in
env, (v, tyv)
let mk_iexpr loc ty d = { iexpr_desc = d; iexpr_loc = loc; iexpr_type = ty }
......@@ -694,10 +783,7 @@ let rec ipattern env p =
and ipattern_node env p =
let add1 env vs =
(* TODO: incorrect when vs is not pure ? *)
let i =
{ i_pgm = create_vsymbol (id_clone vs.vs_name) vs.vs_ty; i_logic = vs }
in
Mstr.add vs.vs_name.id_string i env