Commit da67461f authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

examples: use pure { .. } or {..} for lsymbols

parent 12340a86
......@@ -46,14 +46,14 @@ module MonoidSumDef
let rec ghost function agg (f:'a -> t) (s:seq 'a) : M.t
variant { length s }
= if length s = 0 then zero else op (f s[0]) (agg f s[1 ..])
= if pure { length s = 0 } then {zero} else {op} (f s[0]) (agg f s[1 ..])
lemma agg_sing_core : forall s:seq 'a. length s = 1 -> s[1 ..] == empty
let rec lemma agg_cat (f:'a -> t) (s1 s2:seq 'a)
ensures { agg f (s1++s2) = op (agg f s1) (agg f s2) }
variant { length s1 }
= if length s1 <> 0 then let s3 = s1[1 ..] in agg_cat f s3 s2
= if pure { length s1 <> 0 } then let s3 = s1[1 ..] in agg_cat f s3 s2
clone MonoidSum as MS with type M.t = M.t,
constant M.zero = M.zero,
......
......@@ -216,7 +216,7 @@ module PQueue
use import seq.Occ
let ghost function to_bag (s:seq 'a) : 'a -> int =
fun x -> occ x s 0 (length s)
fun x -> pure { occ x s 0 (length s) }
let lemma to_bag_mem (x:'a) (s:seq 'a)
ensures { s.to_bag x > 0 <-> exists i. 0 <= i < length s /\ s[i] = x}
......@@ -278,7 +278,7 @@ module PQueue
ensures { forall d. 0 <= t.bag d <= t.card }
ensures { t.card >= 0 /\ (t.card > 0 -> t.bag t.minimum > 0) }
ensures { forall d. 0 < t.bag d -> CO.le t.minimum.key d.key }
= if t.m.card > 0
= if pure { t.m.card > 0 }
then let r0 = Sel.default_split () in
let _ = Sel.split r0 () t in
()
......
......@@ -135,7 +135,7 @@ module MapBase
requires { selection_possible () s /\ domain s k }
ensures { forall i. 0 <= i < length s /\ CO.eq s[i].key k -> result = s[i] }
= let j = ref 0 in
while not CO.eq s[!j].key k do
while not {CO.eq} s[!j].key k do
invariant { 0 <= !j < length s }
invariant { CO.le s[!j].key k }
variant { length s - !j }
......
......@@ -34,7 +34,7 @@ module Compile_aexpr
| Asub a1 a2 -> $ compile_aexpr a1 -- $ compile_aexpr a2 -- $ isubf ()
| Amul a1 a2 -> $ compile_aexpr a1 -- $ compile_aexpr a2 -- $ imulf ()
end in
hoare trivial_pre c (aexpr_post a c.wcode.length)
hoare {trivial_pre} c ({aexpr_post} a c.wcode.length)
(* Check that the above specification indeed implies the
natural one. *)
......@@ -83,7 +83,7 @@ module Compile_bexpr
| Bfalse -> $ if cond then inil () else ibranchf ofs
| Bnot b1 -> $ compile_bexpr b1 (not cond) ofs
| Band b1 b2 ->
let c2 = $ compile_bexpr b2 cond ofs % exec_cond b1 true in
let c2 = $ compile_bexpr b2 cond ofs % {exec_cond} b1 true in
let ofs = if cond then length c2.wcode else ofs + length c2.wcode in
$ compile_bexpr b1 false ofs -- c2
| Beq a1 a2 -> $ compile_aexpr a1 -- $ compile_aexpr a2 --
......@@ -91,8 +91,9 @@ module Compile_bexpr
| Ble a1 a2 -> $ compile_aexpr a1 -- $ compile_aexpr a2 --
$ if cond then iblef ofs else ibgtf ofs
end in
let ghost post = bexpr_post b cond (c.wcode.length + ofs) c.wcode.length in
hoare trivial_pre c post
let ghost post =
{bexpr_post} b cond (c.wcode.length + ofs) c.wcode.length in
hoare {trivial_pre} c post
(* Check that the above specification implies the natural one. *)
let compile_bexpr_natural (b:bexpr) (cond:bool) (ofs:ofs) : code
......@@ -146,11 +147,11 @@ module Compile_com
meta rewrite_def function loop_invariant
function loop_variant (c:com) (test:bexpr) : post 'a =
fun _ _ msj msi -> let VMS pj sj mj = msj in let VMS pi si mi = msi in
fun _ _ msj msi -> let VMS _pj _sj mj = msj in let VMS _pi _si mi = msi in
ceval mi c mj /\ beval mi test
lemma loop_variant_lemma : forall c test,x:'a,p msj msi.
loop_variant c test x p msj msi =
let VMS pj sj mj = msj in let VMS pi si mi = msi in
let VMS _pj _sj mj = msj in let VMS _pi _si mi = msi in
ceval mi c mj /\ beval mi test
meta rewrite lemma loop_variant_lemma
......@@ -174,20 +175,20 @@ module Compile_com
| Cif cond cmd1 cmd2 -> let code_false = compile_com cmd2 in
let code_true = $ compile_com cmd1 -- $ ibranchf code_false.code.length in
$ compile_bexpr cond false code_true.wcode.length --
(code_true % exec_cond cond true) --
($ code_false % exec_cond_old cond false)
(code_true % {exec_cond} cond true) --
($ code_false % {exec_cond_old} cond false)
| Cwhile test body ->
let code_body = compile_com body in
let body_length = length code_body.code + 1 in
let code_test = compile_bexpr test false body_length in
let ofs = length code_test.code + body_length in
let wp_while = $ code_test --
($ code_body -- $ ibranchf (- ofs)) % exec_cond test true in
let ghost inv = loop_invariant cmd in
let ghost var = loop_variant body test in
$ inil () -- make_loop wp_while inv (exec_cond test true) var
($ code_body -- $ ibranchf (- ofs)) % {exec_cond} test true in
let ghost inv = {loop_invariant} cmd in
let ghost var = {loop_variant} body test in
$ inil () -- make_loop wp_while inv ({exec_cond} test true) var
end in
hoare (com_pre cmd) res (com_post cmd res.wcode.length)
hoare ({com_pre} cmd) res ({com_post} cmd res.wcode.length)
(* Get back to natural specification for the compiler. *)
let compile_com_natural (com: com) : code
......
......@@ -69,7 +69,7 @@ module Compiler_logic
ensures { result.wcode.length --> s1.wcode.length + s2.wcode.length }
ensures { result.wp --> seq_wp s1.wcode.length s1.wp s2.wp }
= let code = s1.wcode ++ s2.wcode in
let res = { wcode = code; wp = seq_wp s1.wcode.length s1.wp s2.wp } in
let res = { wcode = code; wp = {seq_wp} s1.wcode.length s1.wp s2.wp } in
assert { forall x: 'a, p post ms. res.wp x p post ms ->
not (exists ms'. post ms' /\ contextual_irrelevance res.wcode p ms ms') ->
(forall ms'. s2.wp (x,ms) (p + s1.wcode.length) post ms' /\
......@@ -91,7 +91,7 @@ module Compiler_logic
let (%) (s:wp 'a) (ghost cond:pre {'a}) : wp 'a
ensures { result.wp --> fork_wp s.wp cond }
ensures { result.wcode.length --> s.wcode.length }
= { wcode = s.wcode; wp = fork_wp s.wp cond }
= { wcode = s.wcode; wp = {fork_wp} s.wp cond }
(* WP transformer for hoare triples. *)
function towp_wp (pr:pre 'a) (ps:post 'a) : wp_trans 'a =
......@@ -107,7 +107,7 @@ module Compiler_logic
let ($_) (c:hl 'a) : wp 'a
ensures { result.wcode.length --> c.code.length }
ensures { result.wp --> towp_wp c.pre c.post }
= { wcode = c.code; wp = towp_wp c.pre c.post }
= { wcode = c.code; wp = {towp_wp} c.pre c.post }
(* Equip code with pre/post-condition. That is here that proof happen.
(P -> wp (c,Q)). Anologous to checking function/abstract block
......@@ -156,7 +156,7 @@ module Compiler_logic
(ghost var:post {'a}) : wp 'a
ensures { result.wp --> loop_wp c.wp inv cont var }
ensures { result.wcode.length --> c.wcode.length }
= let wpt = loop_wp c.wp inv cont var in
= let wpt = pure { loop_wp c.wp inv cont var } in
assert { forall x p q ms0. wpt x p q ms0 ->
forall ms. inv x p ms -> acc (var x p) ms ->
exists ms'. contextual_irrelevance c.wcode p ms ms' /\ q ms'
......
......@@ -23,7 +23,7 @@ module VM_instr_spec
ensures { result.pre --> pre }
ensures { result.post --> ifun_post f }
ensures { result.code --> code_f }
= let res = { pre = pre; code = code_f; post = ifun_post f } in
= let res = { pre = pre; code = code_f; post = {ifun_post} f } in
assert { forall x p ms. res.pre x p ms ->
not (exists ms' : machine_state. res.post x p ms ms' /\
contextual_irrelevance res.code p ms ms') ->
......@@ -43,7 +43,9 @@ module VM_instr_spec
ensures { result.pre --> trivial_pre }
ensures { result.post --> iconst_post n }
ensures { result.code.length --> 1 }
= hoare trivial_pre ($ ifunf trivial_pre n.iconst n.iconst_fun) n.iconst_post
= hoare {trivial_pre}
($ ifunf {trivial_pre} n.iconst n.{iconst_fun})
n.{iconst_post}
(* Ivar spec *)
function ivar_post (x:id) : post 'a =
......@@ -58,7 +60,9 @@ module VM_instr_spec
ensures { result.pre --> trivial_pre }
ensures { result.post --> ivar_post x }
ensures { result.code.length --> 1 }
= hoare trivial_pre ($ ifunf trivial_pre x.ivar x.ivar_fun) x.ivar_post
= hoare {trivial_pre}
($ ifunf {trivial_pre} x.ivar x.{ivar_fun})
x.{ivar_post}
(* Binary arithmetic operators specification (Iadd, Isub, Imul)
via a generic builder. *)
......@@ -87,7 +91,9 @@ module VM_instr_spec
ensures { result.pre --> ibinop_pre }
ensures { result.post --> ibinop_post op }
ensures { result.code.length --> code_b.length }
= hoare ibinop_pre ($ ifunf ibinop_pre code_b op.ibinop_fun) op.ibinop_post
= hoare {ibinop_pre}
($ ifunf {ibinop_pre} code_b op.{ibinop_fun})
op.{ibinop_post}
constant plus : binop = fun x y -> x + y
meta rewrite_def function plus
......@@ -102,19 +108,19 @@ module VM_instr_spec
ensures { result.pre --> ibinop_pre }
ensures { result.post --> ibinop_post plus }
ensures { result.code.length --> 1 }
= create_binop iadd plus
= create_binop iadd {plus}
let isubf () : hl 'a
ensures { result.pre --> ibinop_pre }
ensures { result.post --> ibinop_post sub }
ensures { result.code.length --> 1 }
= create_binop isub sub
= create_binop isub {sub}
let imulf () : hl 'a
ensures { result.pre --> ibinop_pre }
ensures { result.post --> ibinop_post mul }
ensures { result.code.length --> 1 }
= create_binop imul mul
= create_binop imul {mul}
(* Inil spec *)
function inil_post : post 'a =
......@@ -125,7 +131,7 @@ module VM_instr_spec
ensures { result.pre --> trivial_pre }
ensures { result.post --> inil_post }
ensures { result.code.length --> 0 }
= { pre = trivial_pre; code = Nil; post = inil_post }
= { pre = {trivial_pre}; code = Nil; post = {inil_post} }
(* Ibranch specification *)
function ibranch_post (ofs: ofs) : post 'a =
......@@ -140,8 +146,8 @@ module VM_instr_spec
ensures { result.pre --> trivial_pre }
ensures { result.post --> ibranch_post ofs }
ensures { result.code.length --> 1 }
= let cf = $ ifunf trivial_pre (ibranch ofs) (ibranch_fun ofs) in
hoare trivial_pre cf (ibranch_post ofs)
= let cf = $ ifunf {trivial_pre} ofs.ibranch ofs.{ibranch_fun} in
hoare {trivial_pre} cf ofs.{ibranch_post}
(* Conditional jump specification via a generic builder. *)
type cond = int -> int -> bool
......@@ -167,8 +173,8 @@ module VM_instr_spec
ensures { result.pre --> ibinop_pre }
ensures { result.post --> icjump_post cond ofs }
ensures { result.code.length --> code_cd.length }
= let c = $ ifunf ibinop_pre code_cd (icjump_fun cond ofs) in
hoare ibinop_pre c (icjump_post cond ofs)
= let c = $ ifunf {ibinop_pre} code_cd ({icjump_fun} cond ofs) in
hoare {ibinop_pre} c ({icjump_post} cond ofs)
(* binary Boolean operators specification (Ibeq, Ibne, Ible, Ibgt) *)
constant beq : cond = fun x y -> x = y
......@@ -187,25 +193,25 @@ module VM_instr_spec
ensures { result.pre --> ibinop_pre }
ensures { result.post --> icjump_post beq ofs }
ensures { result.code.length --> 1 }
= create_cjump (ibeq ofs) beq ofs
= create_cjump (ibeq ofs) {beq} ofs
let ibnef (ofs:ofs) : hl 'a
ensures { result.pre --> ibinop_pre }
ensures { result.post --> icjump_post bne ofs }
ensures { result.code.length --> 1 }
= create_cjump (ibne ofs) bne ofs
= create_cjump (ibne ofs) {bne} ofs
let iblef (ofs:ofs) : hl 'a
ensures { result.pre --> ibinop_pre }
ensures { result.post --> icjump_post ble ofs }
ensures { result.code.length --> 1 }
= create_cjump (ible ofs) ble ofs
= create_cjump (ible ofs) {ble} ofs
let ibgtf (ofs:ofs) : hl 'a
ensures { result.pre --> ibinop_pre }
ensures { result.post --> icjump_post bgt ofs }
ensures { result.code.length --> 1 }
= create_cjump (ibgt ofs) bgt ofs
= create_cjump (ibgt ofs) {bgt} ofs
(* Isetvar specification *)
constant isetvar_pre : pre 'a =
......@@ -228,7 +234,7 @@ module VM_instr_spec
ensures { result.pre --> isetvar_pre }
ensures { result.post --> isetvar_post x }
ensures { result.code.length --> 1 }
= let c = $ ifunf isetvar_pre (isetvar x) (isetvar_fun x) in
hoare isetvar_pre c (isetvar_post x)
= let c = $ ifunf {isetvar_pre} x.isetvar x.{isetvar_fun} in
hoare {isetvar_pre} c x.{isetvar_post}
end
......@@ -57,8 +57,7 @@ module Esterel
let res = bw_or a.bv (neg a.bv) in
assert { eq_sub_bv res zeros zeros p_bv };
assert { eq_sub_bv res ones p_bv (sub size_bv p_bv) };
{ bv = res;
mdl = interval p size }
{ bv = res; mdl = pure {interval p size} }
let maxUnion (a b : s) : s (* operator [(a|b)&(a|-a)&(b|-b)] *)
......
......@@ -13,15 +13,17 @@ module Tarski
use import set.Fset
clone export relations.PartialOrder
constant a : set t
val constant a : set t
constant e : t
val constant e : t
axiom minimality: mem e a /\ forall x. mem x a -> rel e x
function f t : t
val function f t : t
axiom range: forall x. mem x a -> mem (f x) a
axiom monotone: forall x y. mem x a -> mem y a -> rel x y -> rel (f x) (f y)
val (=) (a b: t) : bool ensures { result <-> a = b }
predicate fixpoint (x:t) = mem x a /\ f x = x
end
......
......@@ -222,7 +222,7 @@ module N
res := one;
raise Break
end;
acc := !acc + power base (to_int !i) * to_int x[!i];
acc := !acc + power {base} (to_int !i) * to_int x[!i];
done;
raise Break
with Break -> !res
......
......@@ -79,7 +79,7 @@ let lemma ground_app (t1 t2 : term)
requires { ground (App t1 t2) }
ensures { ground t1 }
ensures { ground t2 }
= ground_rec_app t1 t2 no_bound
= ground_rec_app t1 t2 {no_bound}
(* substitution of [x] by [s] in [t].
......
......@@ -199,7 +199,7 @@ module Lemmas
= match st with
| Nil -> ()
| Cons E st' -> inverse_inverse st' c1 c2 c3
| Cons f st' -> if even_forest f then () else inverse_inverse st' c1 c2 c3
| Cons f st' -> if {even_forest} f then () else inverse_inverse st' c1 c2 c3
end
inductive sub stack (forest int) coloring =
......
......@@ -159,7 +159,7 @@ module N
variant {m - n}
=
if n < m then
l2i x[n] + radix * value_sub x (n+1) m
{l2i} x[n] + {radix} * value_sub x (n+1) m
else 0
function value (x:t) : int =
......@@ -340,7 +340,7 @@ module N
p2i !i <= k < p2i sz ->
(pelts x)[x.offset+k] = (pelts y)[y.offset+k] /\
(pelts x)[p2i !i+x.offset+j] = (pelts y)[p2i !i+y.offset+j] };
value_sub_frame_shift (pelts x) (pelts y) (p2i !i+x.offset) (p2i !i+y.offset) ((p2i sz) - (p2i !i));
value_sub_frame_shift x.{pelts} y.{pelts} (p2i !i+x.offset) (p2i !i+y.offset) ((p2i sz) - (p2i !i));
let ghost k = p2i !i in
i := Int32.(-) !i (Int32.of_int 1);
......@@ -349,17 +349,17 @@ module N
ly := get_ofs y !i;
if (UInt32.ne !lx !ly)
then begin
value_sub_concat (pelts x) x.offset (x.offset+k) (x.offset+ p2i sz);
value_sub_concat (pelts y) y.offset (y.offset+k) (y.offset+ p2i sz);
value_sub_concat x.{pelts} x.offset (x.offset+k) (x.offset+ p2i sz);
value_sub_concat y.{pelts} y.offset (y.offset+k) (y.offset+ p2i sz);
assert { compare_int (value_sub_shift x (p2i sz))
(value_sub_shift y (p2i sz))
= compare_int (value_sub_shift x k) (value_sub_shift y k) };
value_sub_tail (pelts x) x.offset (x.offset+k-1);
value_sub_tail (pelts y) y.offset (y.offset+k-1);
value_sub_tail x.{pelts} x.offset (x.offset+k-1);
value_sub_tail y.{pelts} y.offset (y.offset+k-1);
if UInt32.(>) !lx !ly
then begin
value_sub_upper_bound (pelts y) y.offset (y.offset+k-1);
value_sub_lower_bound (pelts x) x.offset (x.offset+k-1);
value_sub_upper_bound y.{pelts} y.offset (y.offset+k-1);
value_sub_lower_bound x.{pelts} x.offset (x.offset+k-1);
assert { value_sub_shift x k - value_sub_shift y k =
(l2i !lx - l2i !ly) * (power radix (k-1))
- ((value_sub_shift y (k-1)) - (value_sub_shift x (k-1)))
......@@ -372,8 +372,8 @@ module N
end
else begin
assert { l2i !ly > l2i !lx };
value_sub_upper_bound (pelts x) x.offset (x.offset+k-1);
value_sub_lower_bound (pelts y) y.offset (y.offset+k-1);
value_sub_upper_bound x.{pelts} x.offset (x.offset+k-1);
value_sub_lower_bound y.{pelts} y.offset (y.offset+k-1);
assert { value_sub_shift y k - value_sub_shift x k =
(l2i !ly - l2i !lx) * (power radix (k-1))
- ((value_sub_shift x (k-1)) - (value_sub_shift y (k-1)))
......@@ -388,7 +388,7 @@ module N
end
else ()
done;
value_sub_frame_shift (pelts x) (pelts y) x.offset y.offset (p2i sz);
value_sub_frame_shift x.{pelts} y.{pelts} x.offset y.offset (p2i sz);
zero
with Break32 r -> r
end
......@@ -413,9 +413,9 @@ module N
lx := get_ofs x !i;
if (UInt32.ne !lx uzero)
then begin
value_sub_concat (pelts x) x.offset (x.offset+k) (x.offset + p2i sz);
value_sub_lower_bound_tight (pelts x) x.offset (x.offset+k);
value_sub_lower_bound (pelts x) (x.offset+k) (x.offset + p2i sz);
value_sub_concat x.{pelts} x.offset (x.offset+k) (x.offset + p2i sz);
value_sub_lower_bound_tight x.{pelts} x.offset (x.offset+k);
value_sub_lower_bound x.{pelts} (x.offset+k) (x.offset + p2i sz);
raise Break32 (Int32.of_int 0)
end
else begin
......@@ -438,7 +438,7 @@ module N
variant { p2i sz - p2i !i }
invariant { value_sub_shift r (p2i !i) = 0 }
set_ofs r !i lzero;
value_sub_tail (pelts r) r.offset (r.offset + p2i !i);
value_sub_tail r.{pelts} r.offset (r.offset + p2i !i);
i := Int32.(+) !i (Int32.of_int 1);
done
......@@ -478,9 +478,9 @@ module N
c := carry;
let ghost k = p2i !i in
i := Int32.(+) !i (Int32.of_int 1);
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
let ghost m = power radix k in
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
let ghost m = power {radix} k in
assert { value_sub_shift r (p2i !i) + (power radix (p2i !i)) * l2i !c
= value_sub_shift x (p2i !i) + l2i y
by
......@@ -513,8 +513,8 @@ module N
value_sub_shift x (p2i !i) + l2i y };
let ghost k = p2i !i in
i := Int32.(+) !i (Int32.of_int 1);
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
done;
!c
end
......@@ -553,9 +553,9 @@ module N
c := carry;
let ghost k = p2i !i in
i := Int32.(+) !i (Int32.of_int 1);
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
value_sub_tail (pelts y) y.offset (y.offset + k);
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
value_sub_tail y.{pelts} y.offset (y.offset + k);
assert { value_sub_shift r (p2i !i) + (power radix (p2i !i)) * l2i !c =
value_sub_shift x (p2i !i) + value_sub_shift y (p2i !i)
by
......@@ -615,9 +615,9 @@ module N
c := carry;
let ghost k = p2i !i in
i := Int32.(+) !i (Int32.of_int 1);
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
value_sub_tail (pelts y) y.offset (y.offset + k);
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
value_sub_tail y.{pelts} y.offset (y.offset + k);
assert { value_sub_shift r (p2i !i) + (power radix (p2i !i)) * l2i !c =
value_sub_shift x (p2i !i) + value_sub_shift y (p2i !i)
by
......@@ -656,8 +656,8 @@ module N
c := carry;
let ghost k = p2i !i in
i := Int32.(+) !i (Int32.of_int 1);
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
assert { value_sub_shift r (p2i !i) + (power radix (p2i !i)) * l2i !c =
value_sub_shift x (p2i !i) + value_sub_shift y (p2i sy)
by
......@@ -704,7 +704,7 @@ module N
let rl, rh = Limb.mul_double !lx y in
let res, carry = Limb.add_with_carry rl !c limb_zero in
label BeforeWrite in
value_sub_shift_no_change (pelts r) r.offset (p2i !i) (p2i !i) res;
value_sub_shift_no_change r.{pelts} r.offset (p2i !i) (p2i !i) res;
set_ofs r !i res;
assert { value_sub_shift r (p2i !i) + (power radix (p2i !i)) * l2i !c =
value_sub_shift x (p2i !i) * l2i y };
......@@ -723,8 +723,8 @@ module N
c := Limb.(+) rh carry;
let ghost k = p2i !i in
i := Int32.(+) !i (Int32.of_int 1);
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
assert { value_sub_shift r (p2i !i) + (power radix (p2i !i)) * l2i !c =
value_sub_shift x (p2i !i) * l2i y
by
......@@ -788,9 +788,9 @@ module N
assert { l2i !lr = l2i (pelts (old r))[r.offset+ p2i !i] };
let rl, rh = Limb.mul_double !lx y in
let res, carry = Limb.add3 !lr rl !c in
value_sub_tail (pelts r) r.offset (r.offset + k);
value_sub_tail (pelts x) x.offset (x.offset + k);
value_sub_update (pelts r) (r.offset + p2i !i) r.offset (r.offset + p2i !i +1) res;
value_sub_tail r.{pelts} r.offset (r.offset + k);
value_sub_tail x.{pelts} x.offset (x.offset + k);
value_sub_update r.{pelts} (r.offset + p2i !i) r.offset (r.offset + p2i !i +1) res;
set_ofs r !i res;
assert { forall j. (p2i !i + 1) <= j < p2i sz ->
(pelts (old r))[r.offset+j] = (pelts r)[r.offset+j]
......@@ -904,7 +904,7 @@ module N
variant { p2i sz - p2i !i }
label StartLoop in
let ghost k = p2i !i in
value_sub_concat (pelts r) r.offset (r.offset + k)
value_sub_concat r.{pelts} r.offset (r.offset + k)
(r.offset + k + p2i sz);
assert { value_sub_shift r k
+ (power radix k) * value_sub (pelts r) (r.offset + k)
......@@ -925,16 +925,16 @@ module N
= (pelts r at StartLoop)[j]) };
let (res, carry) = add_with_carry c' limb_zero !c in
label BeforeCarry in
value_sub_update_no_change (pelts r) ((!rp).offset + p2i sz)
value_sub_update_no_change r.{pelts} ((!rp).offset + p2i sz)
r.offset (r.offset + p2i !i) res;
set_ofs !rp sz res;
c:= carry;
i := Int32.(+) !i one;
assert { value_sub_shift r k = value_sub_shift (r at BeforeCarry) k
= value_sub_shift (r at StartLoop) k};
value_sub_tail (pelts r) r.offset (r.offset + p2i sz + k);
value_sub_tail (pelts y) y.offset (y.offset + k);
value_sub_concat (pelts r) r.offset (r.offset + k) (r.offset + k + p2i sz);
value_sub_tail r.{pelts} r.offset (r.offset + p2i sz + k);
value_sub_tail y.{pelts} y.offset (y.offset + k);
value_sub_concat r.{pelts} r.offset (r.offset + k) (r.offset + k + p2i sz);
assert { value_sub (pelts r) (r.offset+k) (r.offset+k+p2i sz)
= value_sub_shift !rp (p2i sz) };
assert { value_sub_shift r (p2i !i + p2i sz)
......@@ -1015,13 +1015,14 @@ module N
};
rp := M.incr !rp one;
done;
value_sub_lower_bound (pelts r) r.offset (r.offset + p2i sz + p2i sz);
value_sub_upper_bound (pelts x) x.offset (x.offset + p2i sz);
value_sub_upper_bound (pelts y) y.offset (y.offset + p2i sz);
value_sub_lower_bound r.{pelts} r.offset (r.offset + p2i sz + p2i sz);
value_sub_upper_bound x.{pelts} x.offset (x.offset + p2i sz);
value_sub_upper_bound y.{pelts} y.offset (y.offset + p2i sz);
assert { 0 <= value_sub_shift x (p2i sz) < power radix (p2i sz) };
assert { 0 <= value_sub_shift y (p2i sz) < power radix (p2i sz) };
prod_compat_strict_r (value_sub_shift y (p2i sz)) (power radix (p2i sz))
(power radix (p2i sz));
prod_compat_strict_r ({value_sub_shift} y (p2i sz))
(power {radix} (p2i sz))
(power {radix} (p2i sz));
assert { l2i !c = 0 by
0 < power radix (p2i sz)
so
......@@ -1078,7 +1079,7 @@ module N
variant { p2i sz - p2i !i }
label StartLoop in
let ghost k = p2i !i in
value_sub_concat (pelts r) r.offset (r.offset + k)
value_sub_concat r.{pelts} r.offset (r.offset + k)
(r.offset + k + p2i sz);
assert { value_sub_shift r k
+ (power radix k) * value_sub (pelts r) (r.offset + k)
......@@ -1101,18 +1102,18 @@ module N
assert { l2i !lr = l2i (pelts (old r))[r.offset+ p2i !i + p2i sz] };
let (res, carry) = add_with_carry c' !lr !c in
label BeforeCarry in
value_sub_update_no_change (pelts r) ((!rp).offset + p2i sz)
r.offset (r.offset + p2i !i) res;
value_sub_update_no_change r.{pelts} ((!rp).offset + p2i sz)
r.offset (r.offset + p2i !i) res;
set_ofs !rp sz res;
assert { value_sub_shift !rp (p2i sz) = value_sub_shift (!rp at BeforeCarry) (p2i sz) };
c:= carry;
i := Int32.(+) !i one;
assert { value_sub_shift r k = value_sub_shift (r at BeforeCarry) k
= value_sub_shift (r at StartLoop) k};
value_sub_tail (pelts r) r.offset (r.offset + p2i sz + k);
value_sub_tail (pelts y) y.offset (y.offset + k);
value_sub_tail r.{pelts} r.offset (r.offset + p2i sz + k);
value_sub_tail y.{pelts} y.offset (y.offset + k);
old_tail_shift (k+p2i sz);
value_sub_concat (pelts r) r.offset (r.offset + k) (r.offset + k + p2i sz);
value_sub_concat r.{pelts} r.offset (r.offset + k) (r.offset + k + p2i sz);
assert { value_sub (pelts r) (r.offset+k) (r.offset+k+p2i sz)
= value_sub_shift !rp (p2i sz) };
assert { value_sub_shift r (p2i !i + p2i sz)
......@@ -1254,7 +1255,7 @@ module N
variant { p2i sy - p2i !i }
label StartLoop in
let ghost k = p2i !i in
value_sub_concat (pelts r) r.offset (r.offset + k)
value_sub_concat r.{pelts} r.offset (r.offset + k)
(r.offset + k + p2i sx);
assert { value_sub_shift r k
+ (power radix k) * value_sub (pelts r) (r.offset + k)
......@@ -1275,16 +1276,16 @@ module N
= (pelts r at StartLoop)[j]) };
let (res, carry) = add_with_carry c' limb_zero !c in
label BeforeCarry in
value_sub_update_no_change (pelts r) ((!rp).offset + p2i sx)
r.offset (r.offset + p2i !i) res;
value_sub_update_no_change r.{pelts} ((!rp).offset + p2i sx)
r.offset (r.offset + p2i !i) res;
set_ofs !rp sx res;
c:= carry;
i := Int32.(+) !i one;
assert { value_sub_shift r k = value_sub_shift (r at BeforeCarry) k
= value_sub_shift (r at StartLoop) k};
value_sub_tail (pelts r) r.offset (r.offset + p2i sx + k);
value_sub_tail (pelts y) y.offset (y.offset + k);
value_sub_concat (pelts r) r.offset (r.offset + k) (r.offset + k + p2i sx);
value_sub_tail r.{pelts} r.offset (r.offset + p2i sx + k);
value_sub_tail y.{pelts} y.offset (y.offset + k);
value_sub_concat r.{pelts} r.offset (r.offset + k) (r.offset + k + p2i sx);
assert { value_sub (pelts r) (r.offset+k) (r.offset+k+p2i sx)
= value_sub_shift !rp (p2i sx) };
assert { value_sub_shift r (p2i !i + p2i sx)
......@@ -1365,13 +1366,14 @@ module N
};
rp := M.incr !rp one;
done;
value_sub_lower_bound (pelts r) r.offset (r.offset + p2i sy + p2i sx);
value_sub_upper_bound (pelts x) x.offset (x.offset + p2i sx);
value_sub_upper_bound (pelts y) y.offset (y.offset + p2i sy);
value_sub_lower_bound r.{pelts} r.offset (r.offset + p2i sy + p2i sx);
value_sub_upper_bound x.{pelts} x.offset (x.offset + p2i sx);
value_sub_upper_bound y.{pelts} y.offset (y.offset + p2i sy);
assert { 0 <= value_sub_shift x (p2i sx) < power radix (p2i sx) };
assert { 0 <= value_sub_shift y (p2i sy) < power radix (p2i sy) };
prod_compat_strict_r (value_sub_shift y (p2i sy)) (power radix (p2i sy))
(power radix (p2i sx));
prod_compat_strict_r ({value_sub_shift} y (p2i sy))
(power {radix} (p2i sy))
(power {radix} (p2i sx));
assert { l2i !c = 0 by
0 < power radix (p2i sx)
so
......@@ -1429,4 +1431,4 @@ module Heap
val free ...