Commit 8e5318b7 authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

Expr: let-definitions

parent 94d62349
...@@ -66,16 +66,14 @@ type ps_kind = ...@@ -66,16 +66,14 @@ type ps_kind =
let create_psymbol id ?(ghost=false) ?(kind=PKnone) c = let create_psymbol id ?(ghost=false) ?(kind=PKnone) c =
let check_effects { cty_effect = e } = let check_effects { cty_effect = e } =
(* TODO/FIXME: prove that we can indeed ignore resets. (* TODO/FIXME: prove that we can indeed ignore resets.
Normally, resets neither consult nor change the Normally, resets neither consult nor change the
external state, and do not affect the specification. *) external state, and do not affect the specification. *)
if not (eff_is_pure e) then if not (eff_is_pure e) then Loc.errorm
Loc.errorm "this function has side effects, \ "this function is stateful, it cannot be declared as pure" in
it cannot be declared as pure" in
let check_reads { cty_freeze = isb } = let check_reads { cty_freeze = isb } =
if not (Mreg.is_empty isb.isb_reg) then if not (Mreg.is_empty isb.isb_reg) then Loc.errorm
Loc.errorm "this function depends on the global state, \ "this function is stateful, it cannot be declared as pure" in
it cannot be declared as pure" in
let res_type c = ty_of_ity c.cty_result in let res_type c = ty_of_ity c.cty_result in
let arg_type c = List.map (fun a -> a.pv_vs.vs_ty) c.cty_args in let arg_type c = List.map (fun a -> a.pv_vs.vs_ty) c.cty_args in
let arg_list c = List.map (fun a -> t_var a.pv_vs) c.cty_args in let arg_list c = List.map (fun a -> t_var a.pv_vs) c.cty_args in
...@@ -108,9 +106,9 @@ let create_psymbol id ?(ghost=false) ?(kind=PKnone) c = ...@@ -108,9 +106,9 @@ let create_psymbol id ?(ghost=false) ?(kind=PKnone) c =
be used in the program, as it has lost all preconditions, be used in the program, as it has lost all preconditions,
which is why we declare it as ghost. In other words, which is why we declare it as ghost. In other words,
this pvsymbol behaves exactly as Epure of its pv_vs. *) this pvsymbol behaves exactly as Epure of its pv_vs. *)
let v = create_pvsymbol ~ghost:true id ity in let { pv_vs = v } = create_pvsymbol ~ghost:true id ity in
let t = t_func_app_l (t_var v.pv_vs) (arg_list c) in let t = t_func_app_l (t_var v) (arg_list c) in
mk_ps v.pv_vs.vs_name (add_post c t) ghost (PLvs v.pv_vs) mk_ps v.vs_name (add_post c t) ghost (PLvs v)
| PKfunc constr -> | PKfunc constr ->
check_effects c; check_reads c; check_effects c; check_reads c;
(* we don't really need to check the well-formedness of (* we don't really need to check the well-formedness of
...@@ -235,6 +233,7 @@ and expr_node = ...@@ -235,6 +233,7 @@ and expr_node =
| Eraise of xsymbol * expr | Eraise of xsymbol * expr
| Eghost of expr | Eghost of expr
| Eassert of assertion_kind * term | Eassert of assertion_kind * term
| Epure of term
| Eabsurd | Eabsurd
| Eany | Eany
...@@ -301,23 +300,37 @@ let e_nat_const n = ...@@ -301,23 +300,37 @@ let e_nat_const n =
let create_let_defn id e = let create_let_defn id e =
let ghost = e.e_ghost in let ghost = e.e_ghost in
let lv = match e.e_vty with let lv = match e.e_vty with
| VtyI ity -> ValV (create_pvsymbol id ~ghost ity) | VtyC c -> ValS (create_psymbol id ~ghost ~kind:PKnone c)
| VtyC cty -> ValS (create_psymbol id ~ghost ~kind:PKnone cty) in | VtyI i -> ValV (create_pvsymbol id ~ghost i) in
{ let_sym = lv; let_expr = e } { let_sym = lv; let_expr = e }
let create_let_defn_pv id e = let create_let_defn_pv id e =
(* let_defn * pvsymbol *) let ity = match e.e_vty with
assert false | VtyC ({ cty_args = args; cty_result = res } as c) ->
let error s = Loc.errorm
let create_let_defn_ps id ?(kind=PKnone) e = assert false "this function %s, it cannot be used as first-order" s in
if not (Mreg.is_empty c.cty_freeze.isb_reg &&
(* eff_is_empty c.cty_effect) then error "is stateful";
let create_let_defn_ps id ?(kind=PKnone) e = match e.e_vty, kind with if not (List.for_all (fun a -> ity_immutable a.pv_ity) args &&
| VtyI ity_immutable res) then error "is non-pure";
| _, PKfunc n when n > 0 -> invalid_arg "Expr.create_let_defn_ps" if not e.e_ghost && List.exists (fun a -> a.pv_ghost) args
| then error "has ghost arguments";
| _ -> if c.cty_pre <> [] then error "is partial";
let ps = create_psymbol id ~ghost:e. List.fold_right (fun a i -> ity_func a.pv_ity i) args res
(* let_defn * psymbol *) | VtyI i -> i in
assert false let pv = create_pvsymbol id ~ghost:e.e_ghost ity in
*) { let_sym = ValV pv; let_expr = e }, pv
let create_let_defn_ps id ?(kind=PKnone) e =
let cty = match e.e_vty, kind with
| _, PKfunc n when n > 0 -> invalid_arg "Expr.create_let_defn_ps"
| VtyI _, (PKnone|PKlocal|PKlemma) -> Loc.errorm
"this expression is first-order, it cannot be used as a function"
| VtyI i, (PKfunc _|PKpred) when ity_immutable i ->
(* the post will be equality to the logic constant *)
create_cty [] [] [] Mexn.empty Spv.empty eff_empty i
| VtyI _, (PKfunc _|PKpred) -> Loc.errorm
"this expression is non-pure, it cannot be used as a pure function"
| VtyC c, _ -> c in
let ps = create_psymbol id ~ghost:e.e_ghost ~kind cty in
{ let_sym = ValS ps; let_expr = e }, ps
...@@ -126,6 +126,7 @@ and expr_node = private ...@@ -126,6 +126,7 @@ and expr_node = private
| Eraise of xsymbol * expr | Eraise of xsymbol * expr
| Eghost of expr | Eghost of expr
| Eassert of assertion_kind * term | Eassert of assertion_kind * term
| Epure of term
| Eabsurd | Eabsurd
| Eany | Eany
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment