diff --git a/bench/bench b/bench/bench index 8c3b007e7ceeda650f0aad66cdde7e0d16d5815d..07e4a113ec3e02858a5a63c3c390956742ba3bd2 100755 --- a/bench/bench +++ b/bench/bench @@ -269,8 +269,8 @@ goods examples/avl "-L examples/avl" goods examples/verifythis_2016_matrix_multiplication "-L examples/verifythis_2016_matrix_multiplication" goods examples/double_wp "-L examples/double_wp" goods examples/ring_decision "-L examples/ring_decision" +goods examples/multiprecision "-L examples/multiprecision" goods examples/in_progress -goods examples/in_progress/multiprecision "-L examples/in_progress/multiprecision" echo "" echo "=== Checking replay (no prover) ===" @@ -290,6 +290,7 @@ replay examples/avl "-L examples/avl --merging-only" #replay examples/to_port/verifythis_2016_matrix_multiplication "-L examples/to_port/verifythis_2016_matrix_multiplication --merging-only" replay examples/double_wp "-L examples/double_wp --merging-only" replay examples/ring_decision "-L examples/ring_decision --merging-only" +replay examples/multiprecision "-L examples/multiprecision --merging-only" #replay examples/in_progress --merging-only #replay examples/in_progress/multiprecision "-L examples/in_progress/multiprecision --merging-only" echo "" diff --git a/examples/multiprecision/add.mlw b/examples/multiprecision/add.mlw new file mode 100644 index 0000000000000000000000000000000000000000..57f19fe3e2c6b9339ae47172ed9d0564230169b8 --- /dev/null +++ b/examples/multiprecision/add.mlw @@ -0,0 +1,548 @@ +module Add + + use import int.Int + use import mach.int.Int32 + use import mach.int.UInt64GMP as Limb + use import int.Power + use import ref.Ref + use import mach.c.C + use import array.Array + use import map.Map + use import types.Types + use import lemmas.Lemmas + + (** [add_limb r x y sz] adds to [x] the value of the limb [y], + writes the result in [r] and returns the carry. [r] and [x] + have size [sz]. This corresponds to the function [mpn_add_1] *) + (* r and x must be separated. This is enforced by Why3 regions in typing *) + let add_limb (r x:t) (y:limb) (sz:int32) : limb + requires { valid x sz } + requires { valid r sz } + requires { sz > 0 } (* ? GMP does the same for 0 and 1*) + ensures { value r sz + (power radix sz) * result = + value x sz + y } + ensures { 0 <= result <= 1 } + ensures { forall j. (j < offset r \/ offset r + sz <= j) + -> (pelts r)[j] = old (pelts r)[j] } + writes { r.data.elts } + = + let limb_zero = Limb.of_int 0 in + let c = ref y in + let lx = ref limb_zero in + let i = ref (Int32.of_int 0) in + while Int32.(<) !i sz && (not (Limb.(=) !c limb_zero)) do + invariant { 0 <= !i <= sz } + invariant { !i > 0 -> 0 <= !c <= 1 } + invariant { value r !i + (power radix !i) * !c = + value x !i + y } + invariant { forall j. (j < offset r \/ offset r + sz <= j) + -> (pelts r)[j] = old (pelts r)[j] } + variant { sz - !i } + label StartLoop in + lx := get_ofs x !i; + let (res, carry) = add_with_carry !lx !c limb_zero in + set_ofs r !i res; + assert { value r !i + (power radix !i) * !c = + value x !i + y }; + c := carry; + value_tail r !i; + value_tail x !i; + assert { value r (!i+1) + (power radix (!i+1)) * !c + = value x (!i+1) + y + (* by + value r !i + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix k) * radix * !c + = value r k + (power radix k) * (res + radix * !c) + = value r k + + (power radix k) * (!lx + (!c at StartLoop)) + = value r k + (power radix k) * (!c at StartLoop) + + (power radix k) * !lx + = value x k + y + (power radix k) * !lx + = value x !i + y*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + if Int32.(=) !i sz then !c + else begin + while Int32.(<) !i sz do + invariant { !c = 0 } + invariant { 0 <= !i <= sz } + invariant { value r !i + (power radix !i) * !c = + value x !i + y } + invariant { forall j. (j < offset r \/ offset r + sz <= j) + -> (pelts r)[j] = old (pelts r)[j] } + variant { sz - !i } + lx := get_ofs x !i; + set_ofs r !i !lx; + assert { value r !i + (power radix !i) * !c = + value x !i + 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); + done; + !c + end + + + (** [add_limbs r x y sz] adds [x[0..sz-1]] and [y[0..sz-1]] and writes the result in [r]. + Returns the carry, either [0] or [1]. Corresponds to the function [mpn_add_n]. *) + + let add_limbs (r x y:t) (sz:int32) : limb + requires { valid x sz } + requires { valid y sz } + requires { valid r sz } + ensures { 0 <= result <= 1 } + ensures { value r sz + (power radix sz) * result = + value x sz + value y sz } + ensures { forall j. (j < offset r \/ offset r + sz <= j) + -> (pelts r)[j] = old (pelts r)[j] } + writes { r.data.elts } + = + let limb_zero = Limb.of_int 0 in + let lx = ref limb_zero in + let ly = ref limb_zero in + let c = ref limb_zero in + let i = ref (Int32.of_int 0) in + while Int32.(<) !i sz do + variant { sz - !i } + invariant { 0 <= !i <= sz } + invariant { value r !i + (power radix !i) * !c = + value x !i + value y !i } + invariant { 0 <= !c <= 1 } + invariant { forall j. (j < offset r \/ offset r + sz <= j) + -> (pelts r)[j] = old (pelts r)[j] } + label StartLoop in + lx := get_ofs x !i; + ly := get_ofs y !i; + let res, carry = add_with_carry !lx !ly !c in + set_ofs r !i res; + assert { value r !i + (power radix !i) * !c = + value x !i + value y !i + by value r !i = (value r !i at StartLoop) }; + c := carry; + value_tail r !i; + value_tail x !i; + value_tail y !i; + assert { value r (!i+1) + (power radix (!i+1)) * !c = + value x (!i+1) + value y (!i+1) + (*by + value r !i + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix k) * radix * !c + = value r k + (power radix k) * (res + radix * !c) + = value r k + + (power radix k) * (!lx + !ly + (!c at StartLoop)) + = value r k + (power radix k) * (!c at StartLoop) + + (power radix k) * (!lx + !ly) + = value x k + value y k + + (power radix k) * (!lx + !ly) + = value x k + (power radix k) * !lx + + value y k + (power radix k) * !ly + = value x !i + + value y k + (power radix k) * !ly + = value x !i + + (value y k + (power radix k) * !ly) + = value x !i + value y !i*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + !c + + (** [add r x y sx sy] adds [(x, sx)] to [(y,sy)] and writes the + result in [(r, sx)]. [sx] must be greater than or equal to + [sy]. Returns carry, either 0 or 1. Corresponds to [mpn_add]. *) + let add (r x y:t) (sx sy:int32) : limb + requires { 0 <= sy <= sx } + requires { valid x sx } + requires { valid y sy } + requires { valid r sx } + ensures { value r sx + (power radix sx) * result = + value x sx + value y sy } + ensures { forall j. (j < offset r \/ offset r + sx <= j) + -> (pelts r)[j] = old (pelts r)[j] } + ensures { 0 <= result <= 1 } + writes { r.data.elts } + = + let limb_zero = Limb.of_int 0 in + let lx = ref limb_zero in + let ly = ref limb_zero in + let c = ref limb_zero in + let i = ref (Int32.of_int 0) in + while Int32.(<) !i sy do + variant { sy - !i } + invariant { 0 <= !i <= sy } + invariant { value r !i + (power radix !i) * !c = + value x !i + value y !i } + invariant { 0 <= !c <= 1 } + invariant { forall j. (j < offset r \/ offset r + sx <= j) + -> (pelts r)[j] = old (pelts r)[j] } + label StartLoop in + lx := get_ofs x !i; + ly := get_ofs y !i; + let res, carry = add_with_carry !lx !ly !c in + set_ofs r !i res; + assert { value r !i + (power radix !i) * !c = + value x !i + value y !i }; + c := carry; + value_tail r !i; + value_tail x !i; + value_tail y !i; + assert { value r (!i+1) + (power radix (!i+1)) * !c = + value x (!i+1) + value y (!i+1) + (*by + value r !i + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix k) * radix * !c + = value r k + (power radix k) * (res + radix * !c) + = value r k + + (power radix k) * (!lx + !ly + (!c at StartLoop)) + = value r k + (power radix k) * (!c at StartLoop) + + (power radix k) * (!lx + !ly) + = value x k + value y k + + (power radix k) * (!lx + !ly) + = value x k + (power radix k) * !lx + + value y k + (power radix k) * !ly + = value x !i + + value y k + (power radix k) * !ly + = value x !i + + (value y k + (power radix k) * !ly) + = value x !i + value y !i*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + try + begin while Int32.(<) !i sx do + variant { sx - !i } + invariant { sy <= !i <= sx } + invariant { value r !i + (power radix !i) * !c = + value x !i + value y sy } + invariant { 0 <= !c <= 1 } + invariant { forall j. (j < offset r \/ offset r + sx <= j) + -> (pelts r)[j] = old (pelts r)[j] } + (if (Limb.(=) !c (Limb.of_int 0)) then raise Break); + label StartLoop2 in + lx := get_ofs x !i; + let res, carry = add_with_carry !lx limb_zero !c in + set_ofs r !i res; + assert { value r !i + (power radix !i) * !c = + value x !i + value y sy }; + c := carry; + value_tail r !i; + value_tail x !i; + assert { value r (!i+1) + (power radix (!i+1)) * !c = + value x (!i+1) + value y sy + (*by + value r !i + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix !i) * !c + = value r k + (power radix k) * res + + (power radix k) * radix * !c + = value r k + (power radix k) * (res + radix * !c) + = value r k + + (power radix k) * (!lx + 0 + (!c at StartLoop2)) + = value r k + (power radix k) * (!c at StartLoop2) + + (power radix k) * !lx + = value x k + value y sy + + (power radix k) * !lx + = value x !i + + value y sy*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + assert { !i = sx } + end + with Break -> assert { !c = 0 } + end; + while Int32.(<) !i sx do + variant { sx - !i } + invariant { sy <= !i <= sx } + invariant { !i = sx \/ !c = 0 } + invariant { value r !i + power radix !i * !c = + value x !i + value y sy } + invariant { forall j. (j < offset r \/ offset r + sx <= j) + -> (pelts r)[j] = old (pelts r)[j] } + assert { !c = 0 by !i < sx }; + lx := get_ofs x !i; + set_ofs r !i !lx; + value_tail r !i; + value_tail x !i; + assert { value r !i = value x !i + value y sy }; (* true with this, should not be needed *) + assert { value r (!i+1) + power radix (!i+1) * !c + = value x (!i+1) + value y sy + (* + by + value r !i + power radix !i * !c + = value r !i + = value r k + power radix k * !lx + so value x !i + = value x k + power radix k * !lx + so value r k + = value r k + power radix k * !c + = value x k + value y sy*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + !c + + let add_in_place (x y:t) (sx sy:int32) : limb + requires { 0 <= sy <= sx } + requires { valid x sx } + requires { valid y sy } + ensures { value x sx + (power radix sx) * result + = value (old x) sx + value y sy } + ensures { 0 <= result <= 1 } + ensures { forall j. j < x.offset \/ x.offset + sx <= j -> + (pelts x)[j] = (pelts (old x))[j] } + writes { x.data.elts } + = + let ghost ox = { x } in + let limb_zero = Limb.of_int 0 in + let lx = ref limb_zero in + let ly = ref limb_zero in + let c = ref limb_zero in + let i = ref (Int32.of_int 0) in + while Int32.(<) !i sy do + variant { sy - !i } + invariant { 0 <= !i <= sy } + invariant { value x !i + (power radix !i) * !c = + value ox !i + value y !i } + invariant { 0 <= !c <= 1 } + invariant { forall j. !i <= j < sx -> + (pelts x)[x.offset + j] = (pelts ox)[x.offset + j] } + invariant { forall j. j < x.offset \/ x.offset + sx <= j -> + (pelts x)[j] = (pelts (old x))[j] } + label StartLoop in + lx := get_ofs x !i; + assert { !lx = (pelts ox)[ox.offset + !i] }; + ly := get_ofs y !i; + let res, carry = add_with_carry !lx !ly !c in + set_ofs x !i res; + assert { forall j. !i < j < sx -> + (pelts x)[x.offset + j] + = (pelts ox)[x.offset + j] + by (pelts x)[x.offset + j] + = (pelts (x at StartLoop))[x.offset + j] + = (pelts ox)[x.offset + j]}; + assert { value x !i + (power radix !i) * !c = value ox !i + value y !i }; + c := carry; + value_tail x !i; + value_tail ox !i; + value_tail y !i; + assert { value x (!i+1) + (power radix (!i+1)) * !c = + value ox (!i+1) + value y (!i+1) + (*by value ox k + (power radix k) * !lx + = value ox !i + so value x !i + (power radix !i) * !c + = value x k + (power radix k) * res + + (power radix !i) * !c + = value x k + (power radix k) * res + + (power radix k) * radix * !c + = value x k + (power radix k) * (res + radix * !c) + = value x k + + (power radix k) * (!lx + !ly + (!c at StartLoop)) + = value x k + (power radix k) * (!c at StartLoop) + + (power radix k) * (!lx + !ly) + = value ox k + value y k + + (power radix k) * (!lx + !ly) + = (value ox k + (power radix k) * !lx) + + (value y k + (power radix k) * !ly) + = value ox !i + + (value y k + (power radix k) * !ly) + = value ox !i + + (value y k + (power radix k) * !ly) + = value ox !i + value y !i*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + try + while Int32.(<) !i sx do + variant { sx - !i } + invariant { sy <= !i <= sx } + invariant { value x !i + (power radix !i) * !c = + value ox !i + value y sy } + invariant { 0 <= !c <= 1 } + invariant { forall j. !i <= j < sx -> + (pelts x)[x.offset + j] = (pelts ox) [x.offset + j] } + invariant { forall j. j < x.offset \/ x.offset + sx <= j -> + (pelts x)[j] = (pelts (old x))[j] } + (if (Limb.(=) !c limb_zero) then raise ReturnLimb limb_zero); + label StartLoop2 in + lx := get_ofs x !i; + assert { !lx = (pelts ox)[ox.offset + !i] }; + let res, carry = add_with_carry !lx limb_zero !c in + value_sub_update_no_change (pelts x) (x.offset + p2i !i) + (x.offset + p2i !i + 1) + (x.offset + p2i sx) res; + set_ofs x !i res; + assert { value x !i + (power radix !i) * !c = value ox !i + value y sy }; + c := carry; + assert { forall j. !i < j < sx -> + (pelts x)[x.offset + j] = (pelts ox) [x.offset + j] }; + value_tail ox !i; + value_tail x !i; + assert { value x (!i+1) + (power radix (!i+1)) * !c = + value ox (!i+1) + value y sy + (*by value ox k + (power radix k) * !lx + = value ox !i + so + value x !i + (power radix !i) * !c + = value x k + (power radix k) * res + + (power radix !i) * !c + = value x k + (power radix k) * res + + (power radix k) * radix * !c + = value x k + (power radix k) * (res + radix * !c) + = value x k + + (power radix k) * (!lx + 0 + (!c at StartLoop2)) + = value x k + (power radix k) * (!c at StartLoop2) + + (power radix k) * !lx + = value ox k + value y sy + + (power radix k) * !lx + = value ox !i + + value y sy*) }; + i := Int32.(+) !i (Int32.of_int 1); + done; + assert { !i = sx }; + !c + with ReturnLimb n -> begin + assert { n = 0 = !c }; + assert { forall j. x.offset + !i <= j < x.offset + sx + -> (pelts x)[j] = (pelts ox)[j] + by !i <= j - x.offset < sx + so (pelts x)[x.offset + (j - x.offset)] + = (pelts ox)[x.offset + (j - x.offset)] }; + value_sub_frame (pelts x) (pelts ox) (x.offset + p2i !i) (x.offset + p2i sx); + value_sub_concat (pelts x) x.offset (x.offset + p2i !i) (x.offset + p2i sx); + value_sub_concat (pelts ox) x.offset (x.offset + p2i !i) (x.offset + p2i sx); + assert { value x sx = value (old x) sx + value y sy }; + n + end + end + + use import int.EuclideanDivision + + (** [incr x y sz] adds to [x] the value of the limb [y] in place. + [x] has size [sz]. The addition must not overflow. This corresponds + to [mpn_incr] *) + let incr (x:t) (y:limb) (ghost sz:int32) : unit + requires { valid x sz } + requires { sz > 0 } + requires { value x sz + y < power radix sz } + ensures { value x sz = value (old x) sz + y } + ensures { forall j. j < x.offset \/ x.offset + sz <= j -> + (pelts x)[j] = (pelts (old x))[j] } + writes { x.data.elts } + = + let ghost ox = { x } in + let c = ref y in + let lx : ref limb = ref 0 in + let i : ref int32 = ref 0 in + while not (Limb.(=) !c 0) do + invariant { 0 <= !i <= sz } + invariant { !i = sz -> !c = 0 } + invariant { !i > 0 -> 0 <= !c <= 1 } + invariant { value x !i + (power radix !i) * !c + = value ox !i + y } + invariant { forall j. !i <= j < sz -> + (pelts x)[x.offset + j] = (pelts ox)[x.offset + j] } + invariant { forall j. j < x.offset \/ x.offset + sz <= j -> + (pelts x)[j] = (pelts ox)[j] } + variant { sz - !i } + label StartLoop in + lx := get_ofs x !i; + assert { !lx = (pelts ox)[ox.offset + !i] }; + let (res, carry) = add_with_carry !lx !c 0 in (*TODO*) + assert { res + radix * carry = !lx + !c }; (* TODO remove this *) + value_sub_update_no_change (pelts x) (x.offset + p2i !i) + (x.offset + p2i !i + 1) + (x.offset + p2i sz) res; + set_ofs x !i res; + assert { forall j. !i < j < sz -> + (pelts x)[x.offset + j] + = (pelts ox)[x.offset + j] }; + assert { value x !i + (power radix !i) * !c = value ox !i + y }; + c := carry; + value_tail x !i; + value_tail ox !i; + assert { value x (!i+1) + power radix (!i+1) * !c = + value ox (!i+1) + y }; + i := Int32.(+) !i 1; + assert { !i = sz -> !c = 0 + by value x sz + power radix sz * !c = value ox sz + y + so value ox sz + y < power radix sz + so 0 <= !c <= 1}; + done; + value_concat x !i sz; + value_concat ox !i sz; + assert { forall j. x.offset + !i <= j < x.offset + sz -> + (pelts x)[j] = (pelts ox)[j] + by let k = j - x.offset in + !i <= k < sz + so (pelts x)[x.offset + k] = (pelts ox)[x.offset + k]}; + value_sub_frame (pelts x) (pelts ox) (x.offset + p2i !i) (x.offset + p2i sz) + + (** [incr_1 x sz] adds 1 to [x] in place. + [x] has size [sz]. The addition must not overflow. + This corresponds to [mpn_incr] *) + let incr_1 (x:t) (ghost sz:int32) : unit + requires { valid x sz } + requires { sz > 0 } + requires { value x sz + 1 < power radix sz } + ensures { value x sz = value (old x) sz + 1 } + ensures { forall j. j < x.offset \/ x.offset + sz <= j -> + (pelts x)[j] = (pelts (old x))[j] } + writes { x.data.elts } + = + let ghost ox = { x } in + let r : ref limb = ref 0 in + let ghost c : ref limb = ref 1 in + let lx : ref limb = ref 0 in + let i : ref int32 = ref 0 in + while (Limb.(=) !r 0) do + invariant { 0 <= !i <= sz } + invariant { !i = sz -> !r <> 0 } + invariant { !r <> 0 <-> !c = 0 } + invariant { 0 <= !c <= 1 } + invariant { value x !i + (power radix !i) * !c + = value ox !i + 1 } + invariant { forall j. !i <= j < sz -> + (pelts x)[x.offset + j] = (pelts ox)[x.offset + j] } + invariant { forall j. j < x.offset \/ x.offset + sz <= j -> + (pelts x)[j] = (pelts ox)[j] } + variant { sz - !i } + label StartLoop in + lx := get_ofs x !i; + assert { !lx = (pelts ox)[ox.offset + !i] }; + let res = add_mod !lx 1 in + r := res; + ghost (if Limb.(=) res 0 then c := 1 else c := 0); + assert { res + radix * !c = !lx + 1 }; + value_sub_update_no_change (pelts x) (x.offset + p2i !i) + (x.offset + p2i !i + 1) + (x.offset + p2i sz) res; + set_ofs x !i res; + assert { forall j. !i < j < sz -> + (pelts x)[x.offset + j] + = (pelts ox)[x.offset + j] }; + assert { value x !i + (power radix !i) * (!c at StartLoop) = value ox !i + 1 }; + value_tail x !i; + value_tail ox !i; + assert { value x (!i+1) + power radix (!i+1) * !c = + value ox (!i+1) + 1 }; + i := Int32.(+) !i 1; + assert { !i = sz -> !c = 0 + by value x sz + power radix sz * !c = value ox sz + 1 + so value ox sz + 1 < power radix sz + so 0 <= !c <= 1}; + done; + value_concat x !i sz; + value_concat ox !i sz; + assert { forall j. x.offset + !i <= j < x.offset + sz -> + (pelts x)[j] = (pelts ox)[j] + by let k = j - x.offset in + !i <= k < sz + so (pelts x)[x.offset + k] = (pelts ox)[x.offset + k]}; + value_sub_frame (pelts x) (pelts ox) (x.offset + p2i !i) (x.offset + p2i sz) + +end \ No newline at end of file diff --git a/examples/multiprecision/add/why3session.xml b/examples/multiprecision/add/why3session.xml new file mode 100644 index 0000000000000000000000000000000000000000..bd1f243383f766950650eacfa789f44220130b02 --- /dev/null +++ b/examples/multiprecision/add/why3session.xml @@ -0,0 +1,1307 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multiprecision/add/why3shapes.gz b/examples/multiprecision/add/why3shapes.gz new file mode 100644 index 0000000000000000000000000000000000000000..62d04273f3f86547bb4dc5f9a51c1c695bcbd336 Binary files /dev/null and b/examples/multiprecision/add/why3shapes.gz differ diff --git a/examples/multiprecision/compare.mlw b/examples/multiprecision/compare.mlw new file mode 100644 index 0000000000000000000000000000000000000000..acbda8e76b21bd3d006bd80ea288c87c52ac073e --- /dev/null +++ b/examples/multiprecision/compare.mlw @@ -0,0 +1,87 @@ +module Compare + + use import int.Int + use import mach.int.Int32 + use import mach.int.UInt64GMP as Limb + use import int.Power + use import ref.Ref + use import mach.c.C + use import map.Map + use import types.Types + use import lemmas.Lemmas + + function compare_int (x y:int) : int = + if x < y then -1 else if x=y then 0 else 1 + + (** [compare_same_size] compares [x[0..sz-1]] and [y[0..sz-1]] as unsigned integers. It corresponds to [GMPN_CMP]. *) + let compare_same_size (x y:t) (sz:int32) : int32 + requires { valid x sz } + requires { valid y sz } + ensures { result = compare_int (value x sz) (value y sz) } + = + let i = ref sz in + try + while Int32.(>=) !i (Int32.of_int 1) do + variant { p2i !i } + invariant { 0 <= !i <= sz } + invariant { forall j. !i <= j < sz -> + (pelts x)[x.offset+j] = (pelts y)[y.offset+j] } + assert { forall j. 0 <= j < sz - !i -> + let k = !i+j in + !i <= k < sz -> + (pelts x)[x.offset+k] = (pelts y)[y.offset+k] /\ + (pelts x)[!i+x.offset+j] = (pelts y)[!i+y.offset+j] }; + value_sub_frame_shift (pelts x) (pelts y) (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); + + assert { 0 <= !i < sz }; + let lx = get_ofs x !i in + let ly = get_ofs y !i in + if (not (Limb.(=) 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); + assert { compare_int (value x sz) + (value y sz) + = compare_int (value x k) (value y k) }; + value_sub_tail (pelts x) x.offset (x.offset+k-1); + value_sub_tail (pelts y) y.offset (y.offset+k-1); + if Limb.(>) 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); + assert { value x k - value y k = + (l2i lx - ly) * (power radix (k-1)) + - ((value y (k-1)) - (value x (k-1))) + }; + assert { (lx - ly) * (power radix (k-1)) + >= power radix (k-1) + > ((value y (k-1)) - (value x (k-1))) + }; + raise Return32 (Int32.of_int 1) + end + else begin + assert { ly > 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); + assert { value y k - value x k = + (ly - lx) * (power radix (k-1)) + - ((value x (k-1)) - (value y (k-1))) + }; + assert { (ly - lx) * (power radix (k-1)) + >= power radix (k-1) + > ((value x (k-1)) - (value y (k-1))) + }; + raise Return32 (Int32.(-_) (Int32.of_int 1)) + end + end + else () + done; + value_sub_frame_shift (pelts x) (pelts y) x.offset y.offset (p2i sz); + Int32.of_int 0 + with Return32 r -> r + end + +end \ No newline at end of file diff --git a/examples/multiprecision/compare/why3session.xml b/examples/multiprecision/compare/why3session.xml new file mode 100644 index 0000000000000000000000000000000000000000..fd61f6bc3ef5d40ae95be76939284d9607d6a56e --- /dev/null +++ b/examples/multiprecision/compare/why3session.xml @@ -0,0 +1,147 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multiprecision/compare/why3shapes.gz b/examples/multiprecision/compare/why3shapes.gz new file mode 100644 index 0000000000000000000000000000000000000000..d96164e40957441c3c528c27d1ae5e976946bc0a Binary files /dev/null and b/examples/multiprecision/compare/why3shapes.gz differ diff --git a/examples/multiprecision/div.mlw b/examples/multiprecision/div.mlw new file mode 100644 index 0000000000000000000000000000000000000000..5ff4e649d008f8ca3a7a0f06880f8f8f2f4a89ed --- /dev/null +++ b/examples/multiprecision/div.mlw @@ -0,0 +1,4433 @@ +module Div + + use import int.Int + use import mach.int.Int32 + use import mach.int.UInt64GMP as Limb + use import int.Power + use import ref.Ref + use import mach.c.C + use import array.Array + use import map.Map + use import types.Types + use import lemmas.Lemmas + use import compare.Compare + use import util.Util + use import add.Add + use import sub.Sub + use import logical.Logical + use import int.EuclideanDivision + + (** Based on Niels Möller and Torbjörn Granlund, “Improved + division by invariant integers” 2010 *) + + use int.MinMax as MM + + predicate reciprocal (v d:limb) = + v = (div (radix*radix - 1) (d)) - radix + + let lemma fact_div (x y z:int) + requires { y > 0 } + ensures { div (x + y * z) y = (div x y) + z } + = + assert { x + y * z = y * (div (x + y * z) y) + mod (x + y * z) y + so mod (x + y * z) y = mod (y * z + x) y = mod x y + so x + y * z = y * (div (x + y * z) y) + mod x y + so + x = y * div x y + mod x y + so x + y * z = y * div x y + mod x y + y * z + so y * (div (x + y * z) y) + mod x y + = y * div x y + mod x y + y * z + so y * (div (x + y * z) y) = y * div x y + y * z + = y * ((div x y) + z) + so y <> 0 + so div (x + y * z) y = div x y + z + } + + let invert_limb (d:limb) : limb + requires { d >= div radix 2 } + ensures { reciprocal result d } + = + let v = div2by1 (Limb.of_int max_uint64) + (Limb.(-) (Limb.of_int max_uint64) d) + d in + fact_div (radix * radix - 1) (l2i d) (- radix); + assert { v = (div (radix*radix - 1) (d)) - radix + by + radix - 1 + radix * (radix - 1 - d) + = radix - 1 + radix * (radix - 1) - radix * d + = radix - 1 + radix * radix - radix - radix * d + = radix * radix - 1 - radix * d + so + radix - 1 + radix * (radix - 1 - d) + = radix * radix - 1 - radix * d + so + v + = div ((radix - 1) + radix * (radix - 1 - d)) (d) + = div (radix * radix - 1 - radix * d) (d) + = div (radix * radix - 1) (d) - radix + }; + v + + (** Divide a two-word integer by a one-word integer given the + reciprocal of the divisor. *) + let div2by1_inv (uh ul d v:limb) : (limb,limb) + requires { d >= div radix 2 } + requires { uh < d } + requires { reciprocal v d } + returns { q, r -> l2i q * d + l2i r = ul + radix * uh } + returns { _q, r -> 0 <= l2i r < d } + = + let zero = Limb.of_int 0 in + let one = Limb.of_int 1 in + let ghost k = radix * radix - (radix + l2i v) * l2i d in + let ghost u = l2i ul + radix * l2i uh in + assert { 1 <= k <= d }; + let l,h = mul_double v uh in + let sl,c = add_with_carry l ul zero in + let (sh,ghost c') = add_with_carry uh h c in (* = + *) + assert { sl + radix * sh + radix * radix * c' + = l + radix * h + ul + radix * uh }; + assert { c' = 0 + by + uh < d + so v * uh <= v * d + so k = radix * radix - (radix + v) * d + = radix * radix - radix * d - v * d + so v * d = radix * radix - radix * d - k + = radix * (radix - d) - k + so k > 0 + so v * d < radix * (radix - d) + so v * uh < radix * (radix - d) + so l + radix * h = v * uh + so l + radix * h < radix * (radix - d) + so uh <= d - 1 + so radix * uh <= radix * (d - 1) = radix * d - radix + so l + radix * h + radix * uh + < radix * (radix - d) + radix * uh + <= radix * (radix - d) + radix * d - radix + <= radix * (radix - d + d) - radix = radix * radix - radix + so ul < radix + so l + radix * h + ul + radix * uh + = l + radix * h + radix * uh + ul + < radix * radix - radix + ul + < radix * radix - radix + radix = radix * radix + so sl + radix * sh + radix * radix * c' + = l + radix * h + ul + radix * uh + < radix * radix + so radix * radix * c' <= sl + radix * sh + radix * radix * c' + so radix * radix * c' < radix * radix + }; + assert { sl + radix * sh = l + radix * h + ul + radix * uh + = v * uh + ul + radix * uh + = ul + (radix + v) * uh }; + let qh = ref (sh:limb) in + let ql = ref sl in + let ghost q0 = l2i !ql in + let ghost cq = l2i sh + 1 in (*candidate quotient*) + let ghost cr = l2i ul - cq * l2i d + radix * l2i uh in (*candidate remainder*) + assert { cq * d + cr = u}; + qh := add_mod !qh one; + assert { !qh = mod cq radix }; + let p = mul_mod !qh d in + let r = ref (sub_mod ul p) in + let ghost r' = !r in + assert { r' = mod cr radix + by + let a = (- div (!qh * d) radix) in + r' = !r + = mod (ul - p) radix + = mod (ul - mod (!qh * d) radix) radix + = mod (radix * a + + ul - mod (!qh * d) radix) radix + = mod (ul - mod (!qh * d) radix + - radix * div (!qh * d) radix) radix + = mod (ul - !qh * d) radix + = mod (ul - mod cq radix * d) radix + = mod (radix * (- (div cq radix)) * d + ul - mod cq radix * d) radix + = mod (ul - (mod cq radix + radix * div cq radix) * d) radix + = mod (ul - cq * d) radix + = mod (radix * uh + ul - cq * d) radix + = mod (ul - cq * d + radix * uh) radix + = mod cr radix }; + assert { radix * cr = uh * k + ul * (radix - d) + q0 * d - radix * d }; + prod_compat_strict_r (l2i ul) radix (radix - l2i d); + prod_compat_strict_r (l2i d) radix (radix - q0); + assert { (* Theorem 2 of Möller&Granlund 2010 *) + (MM.max (radix - d) (q0 + 1)) - radix <= cr < MM.max (radix - d) q0 + by radix * cr = uh * k + ul * (radix - d) + q0 * d - radix * d + so (uh * k + ul * (radix - d) >= 0 + by uh >= 0 /\ k >= 0 /\ ul >= 0 /\ radix - d >= 0) + so radix * cr >= q0 * d - radix * d + so radix * cr >= - radix * d + so cr >= - d + so radix * cr >= q0 * d - radix * d = (q0 - radix) * d + so radix > d + so radix - q0 > 0 + so d * (radix-q0) < radix * (radix - q0) + so (q0 - radix) * d > (q0 - radix) * radix + so radix * cr > (q0 - radix) * radix + so cr > q0 - radix + so (let m = MM.max (radix - d) (q0 +1) in + cr >= m - radix + by (cr + radix >= - d + radix + /\ (cr + radix > q0 so cr + radix >= q0 + 1)) + so cr + radix >= m) + so 0 < k <= d so 0 <= uh < d + so k * uh < k * d <= d * d + so radix * cr < d * d + ul * (radix - d) + q0 * d - radix * d + so ul * (radix - d) < radix * (radix - d) + so radix * cr < d * d + radix * (radix - d) + q0 * d - radix * d + so (radix * cr < (radix - d) * (radix - d) + q0 * d + by + d * d + radix * (radix - d) + q0 * d - radix * d + = radix * (radix - d) + d * d - radix * d + q0 * d + = radix * (radix - d) + (d - radix) * d + q0 * d + = radix * (radix - d) - d * (radix - d) + q0 * d + = (radix - d) * (radix - d) + q0 * d) + so let m = MM.max (radix - d) q0 in + radix - d <= m + so (radix - d) * (radix - d) <= m* (radix - d) + so (q0 * d <= m * d by 0 <= q0 <= m /\ 0 < d) + so radix * cr < (radix - d) * (radix - d) + q0 * d + <= m* (radix - d) + q0 * d + <= m* (radix - d) + m * d + = m * radix + so cr < m + }; + assert { cr >= 0 -> r' = cr }; + assert { cr < 0 -> + ( r' = cr + radix + by cr >= MM.max (radix - d) (q0 + 1) - radix + so cr >= - d + so cr + radix >= radix - d >= 0 + so 0 <= cr + radix < radix + so mod (cr + radix) radix = mod cr radix + so r' = mod (cr + radix) radix ) }; + assert { cr < 0 -> + ( !r > !ql + by MM.max (radix - d) (q0 + 1) >= q0 + 1 > q0 + so cr >= (MM.max (radix - d) (q0 +1)) - radix > q0 - radix + so r' = cr + radix > q0 - radix + radix = q0 ) }; + assert { 1 <= cq <= radix }; + assert { (!qh = cq \/ (!qh = 0 /\ cq = radix) + by (1 <= cq < radix -> !qh = mod cq radix = cq) + so (cq = radix -> !qh = 0) ) }; + assert { cq = radix -> + (cr < 0 + by cq * d + cr = u + so uh <= d - 1 + so 1 + uh <= d + so ul < radix + so u = ul + radix * uh + < radix + radix * uh + = radix * (1 + uh) + <= radix * d + so u < radix * d + so radix * d + cr = u + so radix * d + cr < radix * d + so cr < 0) }; + assert { 1 <= cq < radix -> !qh = cq /\ !qh * d + cr = u }; + if Limb.(>) !r !ql + then + begin + qh := sub_mod !qh one; + r := add_mod !r d; + assert { cr >= 0 -> + (!r = cr + d + by r' = cr + so r' < MM.max (radix - d) q0 + so r' > q0 + so 0 <= r' < radix - d + so d <= r' + d < radix + so !r = mod (r' + d) radix = r' + d) }; + assert { cr >= 0 -> + ( !r >= d + by r' = cr >= 0 + so !r = r' + d >= d ) }; + assert { cr < 0 -> + ( !r = r' + d - radix + by r' = cr + radix < radix + so cr >= MM.max (radix - d) (q0 + 1) - radix + >= radix - d - radix = - d + so r' = cr + radix >= radix - d + so !r = mod (r' + d) radix + so radix + radix >= r' + d >= radix + so !r = mod (r' + d) radix = r' + d - radix ) }; + assert { cr < 0 -> + ( 0 <= !r < d + by r' = cr + radix < radix + so !r = mod (r' + d) radix = r' + d - radix + so !r >= 0 + so !r = r' + d - radix < d ) }; + assert { cq = radix -> + ( !qh * d + !r = u + by cq * d + cr = u + so cr < 0 + so r' = cr + radix + so u = radix * d + cr + = (radix - 1) * d + d + cr + = (radix - 1) * d + d + r' - radix + so r' = cr + radix >= MM.max (radix - d) (q0 + 1) + >= radix - d + so radix + radix >= d + r' >= radix + so !r = mod (d + r') radix = d + r' - radix + so (radix - 1) * d + !r = u + so !qh = mod ((mod cq radix) - 1) radix + = mod (-1) radix + = radix - 1 + so !qh * d + !r = u + ) }; + assert { !r = cr + d by [@case_split] cr >= 0 \/ cr < 0 }; + assert { 1 <= cq <= radix -> + ( !qh * d + !r = u + by cq * d + cr = u + so !qh = cq - 1 + so !qh * d + cr + d = u + so !r = cr + d ) }; + end + else + begin + assert { cr >= 0 }; + assert { 1 <= cq < radix }; + end; + assert { !qh * d + !r = ul + radix * uh + by [@case_split] cq = radix \/ 1 <= cq < radix }; + if Limb.(>=) !r d + then begin + assert { cr >= 0 }; + assert { !qh < radix - 1 + by + !qh * d = ul + radix * uh - !r + so uh <= d - 1 + so ul + radix * uh - !r + <= ul + radix * (d - 1) - !r + = ul + radix * d - radix - !r + = (ul - radix) + radix * d - !r + < radix * d - !r + <= radix * d - d + = (radix - 1) * d + so !qh * d < (radix - 1) * d + so d > 0 + so !qh < radix - 1 }; + qh := Limb.(+) !qh one; + r := Limb.(-) !r d; + assert { 0 <= !r < d }; + assert { !qh * d + !r = ul + radix * uh }; + end; + assert { 0 <= !r < d }; + assert { !qh * d + !r = ul + radix * uh }; + (!qh,!r) + +(** [divmod_1 q x y sz] divides [(x,sz)] by [y], writes the quotient + in [(q, sz)] and returns the remainder. Corresponds to + [mpn_divmod_1]. *) +(* TODO develop further decimal points (qxn) *) +let divmod_1 (q x:t) (y:limb) (sz:int32) : limb + requires { valid x sz } + requires { valid q sz } + requires { 0 < sz } + requires { 0 < y } + ensures { value x sz + = value q sz * y + result } + ensures { result < y } + = + let limb_zero = Limb.of_int 0 in + let zero = Int32.of_int 0 in + let one = Int32.of_int 1 in + let msb = Int32.(-) sz one in + let lx = ref limb_zero in + let i = ref msb in + let r = ref limb_zero in + (*normalize divisor*) + let clz = count_leading_zeros y in + if (Int32.(>) clz zero) + then begin + let ghost mult = power 2 (p2i clz) in + let ry = lsl y (Limb.of_int32 clz) in + assert { ry = mult * y }; + let ghost tlum = power 2 (Limb.length - p2i clz) in + assert { tlum * mult = radix }; + let v = invert_limb ry in + while (Int32.(>=) !i zero) do + variant { p2i !i } + invariant { -1 <= !i <= msb } + invariant { !r < ry } + invariant { mult * value_sub (pelts x) (x.offset + !i + 1) (x.offset + sz) + = value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) + * ry + + !r } + invariant { !r <= radix - mult } + invariant { mod (!r) mult = 0 } + assert { !i >= 0 }; + label StartLoop in + lx := C.get_ofs x !i; + (*TODO lshift in place would simplify things*) + let l,h = lsld_ext !lx (Limb.of_int32 clz) in + mod_mult mult (l2i y) 0; + assert { !r + h < ry + by + let drm = div (!r) mult in + let dym = div (ry) mult in + mod (!r) mult = 0 + so !r = mult * drm + so mod (ry) mult + = mod (mult * (y) + 0) mult + = mod 0 mult + = 0 + so ry = mult * dym + so !r < ry + so 0 < ry - !r + = mult * dym - mult * drm + = mult * (dym - drm) + so mult > 0 + so dym - drm > 0 + so dym >= drm + 1 + so h < mult + so !r + h = mult * drm + h + < mult * drm + mult + = mult * (drm + 1) + <= mult * dym = l2i ry }; + assert { !r + h < radix by + !r + h < ry < radix }; + let (qu,rem) = div2by1_inv (Limb.(+) !r h) l ry v in + mod_mult mult (l2i y * l2i qu) (l2i rem); + mod_mult mult (tlum * (l2i !r + l2i h)) (l2i l); + assert { mod (rem) mult = 0 + by + ry * qu + rem + = (radix * (!r + h) + l) + so + mult * y * qu + rem + = (mult * tlum * (!r + h) + l) + so mod (mult * y * qu + rem) mult + = mod (mult * tlum * (!r + h) + l) mult + so mult > 0 + so mod (mult * (y * qu) + rem) mult + = mod (rem) mult + so mod (mult * tlum * (!r + h) + l) mult + = mod (l) mult + = 0 + }; + let ghost mer = div (l2i rem) mult in + assert { rem <= radix - mult + by + mod (rem) mult = 0 + so mult * mer = l2i rem < radix = mult * tlum + so mult > 0 + so 0 < mult * tlum - mult * mer = mult * (tlum - mer) + so tlum - mer > 0 + so mer < tlum + so rem = mult * mer <= mult * (tlum - 1) = radix - mult + }; + r:=rem; + assert { qu * ry + !r = l + radix * h + radix * (!r at StartLoop) }; + (* coerced div2by1 postcondition *) + value_sub_update_no_change (pelts q) (q.offset + p2i !i) + (q.offset + 1 + p2i !i) + (q.offset + p2i sz) qu; + C.set_ofs q !i qu; + assert { mult * value_sub (pelts x) (x.offset + !i + 1) (x.offset + sz) + = value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) + * ry + + (!r at StartLoop) }; (* previous invariant is still true *) + value_sub_head (pelts x) (x.offset + int32'int !i) (x.offset + p2i sz); + value_sub_head (pelts q) (q.offset + int32'int !i) (q.offset + p2i sz); + assert { l + radix * h = mult * !lx }; (*lsld_ext postcondition *) + assert { mult * value_sub (pelts x) (x.offset + !i) + (x.offset + sz) + = mult * !lx + + radix * (mult * value_sub (pelts x) (x.offset + !i + 1) + (x.offset + sz)) + by (pelts x)[x.offset + !i] = !lx + so value_sub (pelts x) (x.offset + !i) (x.offset + sz) + = !lx + radix * value_sub (pelts x) (x.offset + !i + 1) + (x.offset + sz) }; (*nonlinear*) + assert { value_sub (pelts q) (q.offset + !i) (q.offset + sz) * ry + = qu * ry + + radix + * (value_sub (pelts q) (q.offset + !i + 1) (q.offset + sz) + * ry) + by (pelts q)[q.offset + !i] = qu + so value_sub (pelts q) (q.offset + !i) (q.offset + sz) + = qu + radix * value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) }; (*nonlinear*) + assert { mult * value_sub (pelts x) (x.offset + !i) + (x.offset + sz) + = value_sub (pelts q) (q.offset + !i) (q.offset + sz) + * ry + + !r + (* by + (pelts q)[q.offset + k] = qu + so + (pelts x)[x.offset + k] = !lx + so + l + radix * h = !lx * mult + so + mult * value_sub (pelts x) (x.offset + !i + 1) + (x.offset + sz) + = mult * value_sub (pelts x) (x.offset + k) (x.offset + sz) + = mult * ((pelts x)[x.offset + k] + + radix * value_sub (pelts x) (x.offset + k + 1) + (x.offset + sz)) + = mult * !lx + + mult * radix * value_sub (pelts x) (x.offset + k + 1) + (x.offset + sz) + = l + radix * h + + mult * radix * value_sub (pelts x) (x.offset + k + 1) + (x.offset + sz) + = l + radix * h + + radix * (value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * ry + + (!r at StartLoop)) + = l + radix * h + radix * (!r at StartLoop) + + radix * (value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * ry) + = l + radix * (h + (!r at StartLoop)) + + radix * (value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * ry) + = qu * ry + !r + + radix * value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * ry + = (pelts q)[q.offset + k] * ry + !r + + radix * value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * ry + = ry * ((pelts q)[q.offset + k] + + radix * value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz)) + + !r + = ry * value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) + + !r *) + }; + i := Int32.(-) !i one; + done; + let ghost res = lsr !r (Limb.of_int32 clz) in + assert { value x sz = value q sz * y + res + by !r = res * mult + so mult * value x sz + = value q sz * ry + !r + = value q sz * y * mult + !r + = value q sz * y * mult + res * mult + = (value q sz * y + res) * mult }; + lsr !r (Limb.of_int32 clz) end + else begin + let v = invert_limb y in + while (Int32.(>=) !i zero) do + variant { p2i !i } + invariant { -1 <= !i <= msb } + invariant { !r < y } + invariant { value_sub (pelts x) (x.offset + !i + 1) (x.offset + sz) + = value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) + * y + + !r } + assert { !i >= 0 }; + label StartLoop in + let ghost k = p2i !i in + lx := C.get_ofs x !i; + let (qu, rem) = div2by1_inv !r !lx y v in + r := rem; + value_sub_update_no_change (pelts q) (q.offset + p2i !i) + (q.offset + 1 + p2i !i) + (q.offset + p2i sz) qu; + C.set_ofs q !i qu; + i := Int32.(-) !i one; + value_sub_head (pelts x) (x.offset + k) (x.offset + p2i sz); + value_sub_head (pelts q) (q.offset + k) (q.offset + p2i sz); + assert { value_sub (pelts x) (x.offset + !i + 1) (x.offset + sz) + = value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) + * y + + !r + by (pelts q)[q.offset + k] = qu + so (pelts x)[x.offset + k] = !lx + so value_sub (pelts x) (x.offset + !i + 1) (x.offset + sz) + = value_sub (pelts x) (x.offset + k) (x.offset + sz) + = !lx + radix * value_sub (pelts x) (x.offset + k + 1) + (x.offset + sz) + = !lx + radix * (value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * y + (!r at StartLoop)) + = !lx + radix * (!r at StartLoop) + + radix * (value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * y) + = qu * y + !r + + radix * (value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz) + * y) + = (qu + radix * value_sub (pelts q) (q.offset + k + 1) + (q.offset + sz)) + * y + + !r + = value_sub (pelts q) (q.offset + !i + 1) + (q.offset + sz) + * y + + !r }; + done; + !r + end + + + predicate reciprocal_3by2 (v dh dl:limb) = + v = div (radix*radix*radix -1) (dl + radix * dh) - radix + + let div3by2_inv (uh um ul dh dl v: limb) : (limb,limb,limb) + requires { dh >= div radix 2 } + requires { reciprocal_3by2 v dh dl } + requires { um + radix * uh < dl + radix * dh } + returns { q, rl, rh -> uint64'int q * dl + radix * q * dh + + uint64'int rl + radix * uint64'int rh + = ul + radix * um + radix * radix * uh } + returns { _q, rl, rh -> 0 <= uint64'int rl + radix * uint64'int rh < dl + radix * dh } + = + let ghost d = l2i dl + radix * l2i dh in + let ghost u = l2i ul + radix * (l2i um + radix * l2i uh) in + let zero = Limb.of_int 0 in + let one = Limb.of_int 1 in + let q1 = ref zero in + let r0 = ref zero in + let r1 = ref zero in + let l,h = mul_double v uh in + let sl, c = add_with_carry um l zero in + let sh, ghost c' = add_with_carry uh h c in + assert { sl + radix * sh + radix * radix * c' + = um + radix * uh + v * uh }; + assert { c' = 0 + by + um + radix * uh < d + so radix * uh < d + so radix * (um + radix * uh + v * uh) + < radix * (d + v * uh) + = radix * d + v * radix * uh + <= radix * d + v * d + = (div (radix * radix * radix - 1) d) * d + <= radix * radix * radix - 1 + < radix * radix * radix + so um + radix * uh + v * uh < radix * radix + so sl + radix * sh + radix * radix * c' < radix * radix + so radix * radix * c' < radix * radix + }; + q1 := sh; + let ghost q0 = l2i sl in + let ghost cq = l2i !q1 + 1 in (*candidate quotient*) + q1 := add_mod !q1 one; + assert { !q1 = mod cq radix }; + let p = mul_mod dh sh in + r1 := sub_mod um p; + label CQuot in + let ghost a = div (l2i um - l2i dh * l2i sh) radix in + (*assert { um - dh * sh = a * radix + !r1 + by !r1 = mod (um - dh * sh) radix };*) + let tl, th = mul_double sh dl in + let il, b = sub_with_borrow ul tl zero in + let (ih, ghost b') = sub_with_borrow !r1 th b in + assert { il + radix * ih - radix * radix * b' + = ul + radix * !r1 - sh * dl }; + let bl,b2 = sub_with_borrow il dl zero in + let bh, ghost b2' = sub_with_borrow ih dh b2 in + assert { bl + radix * bh - radix * radix * b2' + = il + radix * ih - dl - radix * dh }; + mod_mult (radix * radix) (l2i b') + (l2i ul + radix * l2i !r1 - l2i sh * l2i dl - l2i dl + - radix * l2i dh); + assert { bl + radix * bh + = mod (ul + radix * !r1 + - sh * dl- dl + - radix * dh) (radix * radix) + by + bl + radix * bh + = mod (il + radix * ih + - dl - radix * dh) (radix * radix) + so il + radix * ih + = radix * radix * b' + ul + radix * !r1 + - sh * dl + so mod (il + radix * ih + - dl - radix * dh) (radix * radix) + = mod (radix * radix * b' + ul + radix * !r1 + - sh * dl - dl - radix * dh) + (radix * radix) + = mod (ul + radix * !r1 + - sh * dl - dl + - radix * dh) (radix * radix) }; + r1 := bh; + r0 := bl; + let ghost r' = l2i !r0 + radix * l2i !r1 in + let ghost cr = u - d * cq in + assert { r' = mod cr(radix * radix) + by + (!r1 at CQuot = mod (um - dh * sh) radix + by let a' = div (dh * sh) radix in + dh * sh = p + radix * a' + so !r1 at CQuot = mod (um - p) radix + = mod (radix * a' + um - dh * sh) radix + = mod (um - dh * sh) radix ) + so um - dh * sh = a * radix + !r1 at CQuot + so !r0 + radix * !r1 + = mod (ul + radix * (!r1 at CQuot) + - sh * dl - dl + - radix * dh) (radix * radix) + so ul + radix * (!r1 at CQuot) + - sh * dl - dl - radix * dh + = ul + radix * (um - dh * sh - a * radix) + - sh * dl - dl - radix * dh + = ul + radix * um - radix * dh * sh + - radix * radix * a - sh * dl - dl + - radix * dh + = ul + radix * um - radix * dh * (sh + 1) + - radix * radix * a - sh * dl - dl + = ul + radix * um - radix * dh * (sh + 1) + - radix * radix * a - dl * (sh + 1) + = ul + radix * um + - (dl + radix * dh) * (sh + 1) + - radix * radix * a + = ul + radix * um - d * cq - radix * radix * a + = u - radix * radix * uh - d * cq - radix * radix * a + = cr + radix * radix * (- a - uh) + so (*let y = - a - uh in*) + mod (ul + radix * (!r1 at CQuot) + - sh * dl - dl + - radix * dh) (radix * radix) + = mod (radix * radix * (-a - uh) + cr) + (radix * radix) + = mod cr (radix*radix) + }; + let ghost m = MM.max (radix * radix - d) (q0 * radix) in + assert { (* Theorem 3 of Moller&Granlund 2010 *) + m - radix * radix <= cr < m + by + let k = radix * radix * radix - (radix + v) * d in + reciprocal_3by2 v dh dl + so let m3 = radix * radix * radix - 1 in + (radix + v) * d = d * div m3 d = m3 - mod m3 d + so (k = 1 + mod m3 d + by k = radix * radix * radix - (radix + v) * d + = m3 + 1 - (radix + v) * d + = m3 + 1 - m3 + mod m3 d + = 1 + mod m3 d) + so 1 <= k <= d + so q0 + radix * sh = (radix + v) * uh + um + so cq = sh + 1 + so radix * cq = radix * sh + radix + = (radix + v) * uh + um - q0 + radix + so (radix * cr = k * uh + (radix * radix - d) * um + + radix * ul + d * q0 - d * radix + by radix * cr = radix * (u - cq * d) + = radix * u + - ((radix + v) * uh + um - q0 + radix) * d + = radix * u - d * (radix + v) * uh + - d * um + d * q0 - d * radix + = radix * u - (radix * radix * radix - k) * uh + - d * um + d * q0 - d * radix + = (radix * radix * radix * uh + radix * radix * um + + radix * ul) - (radix * radix * radix - k) * uh + - d * um + d * q0 - d * radix + = k * uh + radix * radix * um + radix * ul + - d * um + d * q0 - d * radix + = k * uh + (radix * radix - d) * um + radix * ul + + d * q0 - d * radix ) + so (cr >= m - radix * radix + by ( + k >= 0 so radix * radix - d >= 0 + so uh >= 0 so um >= 0 so ul >= 0 + so k * uh + (radix * radix - d) * um + radix * ul + >= 0 + so radix * cr >= d * q0 - d * radix + so q0 >= 0 so d >= 0 + so d * q0 >= 0 + so radix * cr >= - d * radix + so cr >= -d = radix * radix - d - radix * radix + so radix * cr >= d * (q0 - radix) + so ( + (radix - q0) * d < (radix - q0) * radix * radix + by let rq = radix - q0 in let r2 = radix * radix in + rq > 0 /\ d < r2 + so rq * d < rq * r2 + ) + so d * (q0 - radix) > radix * radix * (q0 - radix) + so radix * cr > radix * radix * (q0 - radix) + so cr > radix * (q0 - radix) = radix * q0 - radix * radix + )) + so cr < m + by ( + let bbd = radix * radix - d in + bbd > 0 /\ bbd <= m /\ q0 * radix <= m + so (bbd * bbd <= bbd * m + by [@case_split] + (bbd = m \/ (bbd < m so bbd * bbd < bbd * m))) + so (d*(radix * q0) <= d * m + by [@case_split] + (radix * q0 = m \/ (radix * q0 < m so d > 0 so d * (radix * q0) < d * m))) + so if uh <= dh - 1 + then + let dm = dh - 1 in + uh <= dm + so + k * uh <= k * dm + so (k * dm <= d * dm + by k <= d /\ 0 <= dm + so [@case_split] (k = d \/ dm = 0 \/ + (k < d /\ dm > 0 so k * dm < d * dm))) + so k * uh <= d * dm + so + bbd * um <= bbd * (radix - 1) + so + radix * cr + = k * uh + (radix * radix - d) * um + + radix * ul + d * q0 - radix * d + <= d * dm + bbd * um + + radix * ul + d * q0 - radix * d + <= d * dm + bbd * (radix - 1) + + radix * ul + d * q0 - radix * d + < d * dm + bbd * (radix - 1) + + radix * radix + d * q0 - radix * d + so radix * radix * cr + < radix * (d * dm + bbd * (radix - 1) + + radix * radix + d * q0 - radix * d) + = d * radix * (dh - 1) + bbd * radix * (radix - 1) + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * radix * dh - d * radix + bbd * radix * (radix - 1) + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * (d - dl) - d * radix + bbd * radix * (radix - 1) + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * d - d * radix + bbd * radix * (radix - 1) + + radix * radix * radix + radix * d * q0 - radix * radix * d - d * dl + so (d * dl >= 0 by d >= 0 /\ dl >= 0) + so radix * radix * cr + < d * d - d * radix + bbd * radix * (radix - 1) + + radix * radix * radix + radix * d * q0 - radix * radix * d - d * dl + <= d * d - d * radix + bbd * radix * (radix - 1) + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * d - d * radix + bbd * (radix * radix - radix) + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * d - d * radix + bbd * radix * radix - (radix * radix - d) * radix + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * d - d * radix + bbd * radix * radix + + radix * d - radix * radix * radix + + radix * radix * radix + radix * d * q0 - radix * radix * d + = d * d + bbd * radix * radix - radix * radix * d + radix * d * q0 + = bbd * radix * radix - d * (radix * radix - d) + radix * d * q0 + = bbd * radix * radix - d * bbd + radix * d * q0 + = bbd * bbd + d * (radix * q0) + <= bbd * m + d * (radix * q0) + <= bbd * m + d * m + = radix * radix * m + so cr < m + else + uh = dh + so + (um <= dl - 1 + by um + radix * uh < dl + radix * dh) + so (radix * radix - d) * um <= (radix * radix - d) * (dl - 1) + so + ( radix * radix * cr + < radix * radix * m + - (radix - dl) * (radix * radix * radix - d * (1+ radix)) + by radix * cr + = k * dh + (radix * radix - d) * um + + radix * ul + d * q0 - radix * d + <= d * dh + (radix * radix - d) * um + + radix * ul + d * q0 - radix * d + <= d * dh + (radix * radix - d) * (dl - 1) + + radix * ul + d * q0 - radix * d + < d * dh + (radix * radix - d) * (dl - 1) + + radix * radix + d * q0 - radix * d + so radix * radix * cr + < radix * (d * dh + (radix * radix - d) * (dl - 1) + + radix * radix + d * q0 - radix * d) + = d * radix * dh + + (radix * radix - d) * (dl - 1) * radix + + radix * radix * radix + d * q0 * radix - radix * radix * d + = d * (d - dl) + + (radix * radix - d) * (radix * dl - radix) + + radix * radix * radix + d * q0 * radix - radix * radix * d + = d * d - d * dl + radix * radix * radix * dl + - d * radix * dl + d * radix - radix * radix * radix + + radix * radix * radix + d * q0 * radix - radix * radix * d + = d * d - d * dl + radix * radix * radix * dl + - d * radix * dl + d * radix + d * q0 * radix + - radix * radix * d + = d * d - radix * radix * d + d * radix + d * q0 * radix + + dl * (radix * radix * radix - d - d * radix) + = d * (d - radix * radix) + d * radix + d * q0 * radix + + dl * (radix * radix * radix - d - d * radix) + = bbd * (-d) + d * radix + d * q0 * radix + + dl * (radix * radix * radix - d - d * radix) + = bbd * (bbd - radix * radix) + d * radix + d * q0 * radix + + dl * (radix * radix * radix - d - d * radix) + = bbd * bbd + d * q0 * radix + - bbd * radix * radix + d * radix + + dl * (radix * radix * radix - d * (1 + radix)) + = bbd * bbd + d * q0 * radix + - (radix * radix - d) * radix * radix + d * radix + + dl * (radix * radix * radix - d * (1 + radix)) + = bbd * bbd + d * q0 * radix + - radix * ((radix * radix - d) * radix - d) + + dl * (radix * radix * radix - d * (1 + radix)) + = bbd * bbd + d * q0 * radix + - radix * (radix * radix * radix - d * radix - d) + + dl * (radix * radix * radix - d * (1 + radix)) + = bbd * bbd + d * q0 * radix + - radix * (radix * radix * radix - d * (1+ radix)) + + dl * (radix * radix * radix - d * (1 + radix)) + = bbd * bbd + d * q0 * radix + - (radix - dl) * (radix * radix * radix - d * (1+ radix)) + <= bbd * m + d * q0 * radix + - (radix - dl) * (radix * radix * radix - d * (1+ radix)) + <= bbd * m + d * m + - (radix - dl) * (radix * radix * radix - d * (1+ radix)) + = (bbd + d) * m + - (radix - dl) * (radix * radix * radix - d * (1+ radix)) + = radix * radix * m + - (radix - dl) * (radix * radix * radix - d * (1+ radix)) + ) + so + (cr < m by + if d <= radix * (radix - 1) + then (radix + 1) * d <= radix * (radix - 1) * (radix + 1) + = radix * (radix * radix - 1) + = radix * radix * radix - radix + < radix * radix * radix + so (radix * radix * radix - d * (1+ radix)) > 0 + so radix - dl > 0 + so (radix - dl) * (radix * radix * radix + - d * (1+ radix)) + > 0 + so + radix * radix * cr + < radix * radix * m + - (radix - dl) * (radix * radix * radix + - d * (1+ radix)) + < radix * radix * m + so radix * radix * cr < radix * radix * m + else + dl + radix * dh = d > radix * (radix - 1) + so dl < radix + so dl + radix * dh < radix * (1 + dh) + so radix - 1 < 1 + dh + so dh > radix - 2 + so dh = radix - 1 + so uh = dh + so d >= radix * (radix - 1) +1 + so d * (radix + 1) + >= (radix * (radix - 1) + 1) * (radix +1) + = radix * (radix * radix - 1) + radix + 1 + = radix * radix * radix - radix + radix + 1 + = radix * radix * radix + 1 + so + (d * div (radix * radix * radix - 1) d + <= d * (radix + 1) + by d * div (radix * radix * radix - 1) d + <= radix * radix * radix - 1 + < radix * radix * radix + 1 + <= d * (radix + 1)) + so (let a = div (radix * radix * radix - 1) d in + a < radix + 1 + by d > 0 + so (forall x y z. x * z < y * z /\ z > 0 -> x < y) + so (forall x y. x * d < y * d -> x < y) + so let r = radix + 1 in + a * d < r * d + so a < r) + so v = div (radix * radix * radix - 1) d - radix + < radix + 1 - radix = 1 + so v = 0 + so sh = uh = radix - 1 + so cq = sh + 1 = radix + so cr = u - cq * d + = u - radix * d + = ul + radix * (um + radix * dh) + - radix * (dl + radix * dh) + = ul + radix * (um - dl) + so um <= dl - 1 + so 1 + um - dl <= 0 + so ul < radix + so cr = ul + radix * (um - dl) + < radix + radix * (um - dl) + = radix * (1 + um - dl) <= 0 + so cr < 0 <= m + ) + ) + }; + assert { cr >= 0 -> r' = cr }; + assert { cr < 0 -> r' = radix * radix + cr + by + m >= radix * radix - d + so cr >= m - radix * radix >= -d + so cr + radix * radix >= radix * radix - d >= 0 + so 0 <= cr + radix * radix < radix * radix + so mod (radix * radix + cr) (radix*radix) = mod cr (radix*radix) + so r' = mod (radix * radix + cr) (radix*radix) }; + assert { cr < 0 -> !r1 >= sl + by m >= radix * q0 + so cr >= m - radix * radix >= radix * q0 - radix * radix + so r' = radix * radix + cr >= radix * q0 + so r' = radix * !r1 + !r0 >= radix * q0 + so !r0 < radix + so r' < radix * !r1 + radix = radix * (!r1 + 1) + so radix * q0 < radix * (!r1 + 1) + so sl = q0 < !r1 + 1 }; + assert { 1 <= cq <= radix }; + assert { 1 <= cq < radix -> !q1 = cq so !q1 * d + cr = u }; + assert { cq = radix -> + (cr < 0 + by cq * d + cr = u + so um + radix * uh <= d - 1 + so radix * d + cr = ul + + radix * (um + radix * uh) + <= ul + radix * (d - 1) + = ul - radix + radix * d + < radix * d + ) + }; + label PreCorrections in + if Limb.(>=) !r1 sl + then begin + q1 := sub_mod !q1 one; + assert { !q1 = cq - 1 + by + if cq = radix + then + (!q1 at PreCorrections) + = mod cq radix = mod radix radix= 0 + so !q1 = mod (0 - 1) radix = radix - 1 = cq - 1 + else + 0 <= cq - 1 < radix - 1 + so (!q1 at PreCorrections) = cq + so !q1 = mod (cq - 1) radix = cq - 1 + }; + let rl, c = add_with_carry !r0 dl zero in + let rh, ghost c' = add_with_carry !r1 dh c in + assert { rl + radix * rh = mod (r' + d) (radix * radix) + by radix * radix * c' + rl + radix * rh + = r' + d + so mod (r' + d) (radix * radix) + = mod (radix * radix * c' + rl + radix * rh) + (radix * radix) + = mod (rl + radix * rh) (radix * radix) }; + assert { rl + radix * rh = cr + d + by + if cr >= 0 + then r' = cr + so rl + radix * rh = mod (cr + d) (radix * radix) + so cr < MM.max (radix * radix - d) (q0*radix) + so (cr >= q0 * radix + by + r' = radix * !r1 + !r0 + >= radix * !r1 + >= radix * q0) + so cr < radix * radix - d + so cr + d < radix * radix + so (cr + d >= 0 by cr + d >= cr) + so mod (cr + d) (radix * radix) = cr + d + else + r' = cr + radix * radix + so cr >= m - radix * radix + so r' >= m >= radix * radix - d + so r' + d >= radix * radix + so r' < radix * radix + so d < radix * radix + so r' + d < radix * radix + radix * radix + so mod (r' + d) (radix * radix) + = r' + d - radix * radix + = cr + d + }; + r1 := rh; + r0 := rl; + assert { !q1 * d + !r0 + radix * !r1 = u + by + cq * d + cr = u + so !q1 = cq - 1 + so !r0 + radix * !r1 = cr + d + so !q1 * d + !r0 + radix * !r1 + = (cq - 1) * d + cr + d + = cq * d - d + cr + d + = cq * d + cr }; + end + else assert { !q1 * d + r' = u + by cr >= 0 + so r' = cr + so 1 <= cq < radix + so !q1 * d + cr = u }; + assert { !q1 * d + !r0 + radix * !r1 = u }; + label PreRemAdjust in + if [@ex:unlikely] (Limb.(>) !r1 dh) || (Limb.(=) !r1 dh && Limb.(>=) !r0 dl) + then begin + let bl, b = sub_with_borrow !r0 dl zero in + let bh, ghost b'= sub_with_borrow !r1 dh b in + assert { b' = 0 }; + assert { bl + radix * bh = !r0 + radix * !r1 - d }; + assert { !q1 < radix - 1 + by !q1 * d + !r0 + radix * !r1 = u + so !r0 + radix * !r1 >= d + so um + radix * uh <= d - 1 + so u = ul + radix * (um + radix * uh) + <= ul + radix * (d - 1) + < radix + radix * (d-1) + = radix * d + so (!q1 * d < (radix - 1) * d + by + !q1 * d = u - (!r0 + radix * !r1) + <= u - d + < radix * d - d + = (radix - 1) * d ) + }; + q1 := add_mod !q1 one; + assert { !q1 = (!q1 at PreRemAdjust) + 1 }; + r1 := bh; + r0 := bl; + assert { !q1 * d + !r0 + radix * !r1 = u + by + !q1 * d + !r0 + radix * !r1 + = ((!q1 at PreRemAdjust) + 1) * d + + (!r0 + radix * !r1 at PreRemAdjust) - d + = (!q1 * d + !r0 + radix * !r1 at PreRemAdjust) + }; + end; + assert { 0 <= !r0 + radix * !r1 < d }; + (!q1,!r0,!r1) + + let lemma bounds_imply_rec3by2 (v dh dl:limb) + requires { radix * radix * radix - (dl + radix * dh) + <= (radix + v) * (dl + radix * dh) + < radix * radix * radix } + ensures { reciprocal_3by2 v dh dl } + = () + (*let ghost d = dl + radix * dh in + let ghost w = Limb.of_int (div (radix*radix*radix -1) d - radix) in + assert { reciprocal_3by2 w dh dl }; + let ghost e = v - w in + assert { radix * radix * radix - d + <= (radix + w) * d + < radix * radix * radix }; + assert { e = 0 }*) + + + let reciprocal_word_3by2 (dh dl:limb) : limb + requires { dh >= div radix 2 } + ensures { reciprocal_3by2 result dh dl } + = + let ghost d = l2i dl + radix * l2i dh in + let one = Limb.of_int 1 in + let v = ref (invert_limb dh) in + assert { radix * radix - dh + <= (radix + !v) * dh + < radix * radix + by + radix + !v = div (radix * radix - 1) (dh) }; + let p = ref (mul_mod dh !v) in + assert { (radix + !v) * dh + = radix * (radix-1) + + !p + by + mod ((radix + !v) * dh) radix + = mod (radix * dh + dh * !v) radix + = mod (dh * !v) radix = l2i !p + so + div ((radix + !v) * dh) radix = radix - 1 + so + (radix + !v) * dh + = radix * div ((radix + !v) * dh) radix + + mod (dh * !v) radix + = radix * (radix - 1) + !p + }; + label Estimate in + p := add_mod !p dl; + if Limb.(<) !p dl (* carry out *) + then begin + assert { (!p at Estimate) + dl >= radix }; + assert { (!p at Estimate) + dl = radix + !p }; + assert { !v >= 1 + by + (!p at Estimate) + dl >= radix + so (!p at Estimate) > 0 + }; + assert { (radix + !v) * dh + dl + = radix * (radix - 1) + radix + !p }; + label Carry in + if Limb.(>=) !p dh + then begin + v := Limb.(-) !v one; + p := Limb.(-) !p dh; + assert { (radix + !v) * dh + dl + = radix * (radix - 1) + radix + !p + }; + end; + label Borrow in + v := Limb.(-) !v one; + assert { !p < dh }; + p := sub_mod !p dh; + assert { !p = radix + !p at Borrow - dh }; + end; + assert { (radix + !v) * dh * radix + radix * dl + = radix * radix * (radix - 1) + radix * !p + by (radix + !v) * dh + dl + = radix * (radix - 1) + !p }; + assert { radix * radix - dh + <= (radix + !v) * dh + dl + < radix * radix }; + let tl, th = mul_double !v dl in + label Adjust in + p := add_mod !p th; + if Limb.(<) !p th (* carry out *) + then begin + assert { (!p at Adjust) + th >= radix }; + assert { (!p at Adjust) + th = radix + !p + by (!p at Adjust) + th < radix + radix + so div ((!p at Adjust) + th) radix = 1 + so !p = mod ((!p at Adjust) + th) radix + so (!p at Adjust) + th + = radix * div ((!p at Adjust) + th) radix + + mod ((!p at Adjust) + th) radix + = radix + !p + }; + assert { !v >= 1 + by + th <> 0 + so !v <> 0 + }; + if Limb.(>) !p dh || (Limb.(=) !p dh && Limb.(>=) tl dl) + then begin + assert { tl + radix * !p >= d }; + v := Limb.(-) !v one; + assert { (radix + !v) * dh * radix + radix * dl + + !v * dl + = radix * radix * radix + + radix * !p + tl - d + by + (radix + !v) * dh * radix + radix * dl + + !v * dl + = (radix + !v at Adjust - 1) * dh * radix + + radix * dl + + (!v at Adjust - 1) * dl + = (radix + !v at Adjust) * dh * radix + + radix * dl + + (!v at Adjust) * dl - radix * dh + - dl + = radix * radix * (radix - 1) + radix * (!p at Adjust) + + (!v at Adjust) * dl - radix * dh + - dl + = radix * radix * (radix - 1) + radix * (!p at Adjust) + + radix * th + tl - d + = radix * radix * (radix - 1) + radix * (radix + !p) + + tl - d + = radix * radix * (radix - 1) + radix * radix + radix * !p + + tl - d + = radix * radix * radix + radix * !p + tl - d + }; + end; + assert { radix * radix * radix + <= (radix + !v) * dh * radix + radix * dl + + !v * dl + < radix * radix * radix + d }; + v := Limb.(-) !v one; + end; + bounds_imply_rec3by2 !v dh dl; + !v + + let sub3 (x y z:limb) : (limb,limb) + returns { (r,d) -> x - y - z = l2i r - radix * l2i d + /\ 0 <= d <= 2 } + = + let limb_zero = Limb.of_int 0 in + let u1, b1 = sub_with_borrow x y limb_zero in + let u2, b2 = sub_with_borrow u1 z limb_zero in + (u2, (Limb.(+) b1 b2)) + + (** [submul_limb r x y sz] multiplies [(x, sz)] by [y], substracts the [sz] + least significant limbs from [(r, sz)] and writes the result in [(r,sz)]. + Returns the most significant limb of the product plus the borrow + of the substraction. Corresponds to [mpn_submul_1].*) + let submul_limb (r x:t) (y:limb) (sz:int32):limb + requires { valid x sz } + requires { valid r sz } + ensures { value r sz - (power radix sz) * result + = value (old r) sz + - value x sz * y } + writes { r.data.elts } + ensures { forall j. j < r.offset \/ r.offset + sz <= j -> + (pelts r)[j] = (pelts (old r))[j] } += + let limb_zero = Limb.of_int 0 in + let lx = ref limb_zero in + let lr = ref limb_zero in + let b = ref limb_zero in + let i = ref (Int32.of_int 0) in + while Int32.(<) !i sz do + variant { sz - !i } + invariant { 0 <= !i <= sz } + invariant { value r !i - (power radix !i) * !b + = value (old r) !i + - value x !i * y } + invariant { forall j. !i <= j < sz -> + (pelts (old r)) [r.offset+j] = (pelts r)[r.offset + j] } + invariant { forall j. j < r.offset \/ r.offset + sz <= j -> + (pelts r)[j] = (pelts (old r))[j] } + label StartLoop in + let ghost k = p2i !i in + lx := get_ofs x !i; + lr := get_ofs r !i; + assert { !lr = (pelts (old r))[r.offset + !i] }; + let rl, rh = Limb.mul_double !lx y in + let res, borrow = sub3 !lr rl !b 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; + set_ofs r !i res; + assert { forall j. (!i + 1) <= j < sz -> + (pelts (old r))[r.offset+j] = (pelts r)[r.offset+j] + by + (pelts r)[r.offset+j] = ((pelts r) at StartLoop)[r.offset+j] + = (pelts (old r))[r.offset+j] }; + assert { value r (!i + 1) + = value (r at StartLoop) (!i + 1) + + (power radix !i) * (res - !lr) + }; + assert { rl + radix * rh <= (radix-1)*(radix-1) + by + (!lx * y <= !lx * (radix-1) <= (radix-1)*(radix-1) + by + 0 <= !lx <= radix - 1 /\ 0 <= y <= radix -1) + /\ + rl + radix * rh = !lx * y + }; + assert { rh < radix - 1 + by + rl + radix * rh <= (radix -1) * (radix -1) + so + radix * rh <= (radix -1) * (radix -1) + }; + assert { rh = radix - 2 -> rl <= 1 + by + rl + radix * rh <= (radix-1)*(radix-1) }; + assert { rh = radix - 2 -> borrow <= 1 + by rl <= 1 }; + b := Limb.(+) rh borrow; + i := Int32.(+) !i (Int32.of_int 1); + assert { value r !i - (power radix !i) * !b + = value (old r) !i + - value x !i * y + by + (value r !i - (power radix !i) * !b + = value (r at StartLoop) !i + + (power radix k) * (res - !lr) + - (power radix !i) * !b + = value (r at StartLoop) !i + + (power radix k) * (res - !lr) + - (power radix !i) * (rh + borrow) + = value (r at StartLoop) !i + + (power radix k) * (res - !lr) + - (power radix k) * radix * (rh + borrow) + = value (r at StartLoop) !i + + (power radix k) * (res - !lr + - radix * (rh + borrow)) + = value (r at StartLoop) !i + + (power radix k) * (res - radix * borrow + - !lr - radix * rh) + = value (r at StartLoop) !i + + (power radix k) * (!lr - rl - (!b at StartLoop) + - !lr - radix * rh) + = value (r at StartLoop) !i - + (power radix k) * (rl + radix * rh + (!b at StartLoop)) + = value (r at StartLoop) !i - + (power radix k) * (!lx * y + (!b at StartLoop)) + = value (r at StartLoop) k + + (power radix k) * !lr + - (power radix k) * (!lx * y + (!b at StartLoop)) + = value (r at StartLoop) k + - (power radix k) * (!b at StartLoop) + + (power radix k) * (!lr - !lx * y) + = value (old r) k + - value x k * y + + (power radix k) * (!lr - !lx * y) + = value (old r) k + + (power radix k) * !lr + - (value x k + (power radix k)*(!lx)) * y + = value (old r) !i + - (value x k + (power radix k)*(!lx)) * y + = value (old r) !i + - value x !i * y + by + value (old r) !i = value (old r) k + + (power radix k) * (!lr) + ) + }; + done; + !b + + (* [(x,sz)] is normalized if its most significant bit is set. *) + predicate normalized (x:t) (sz:int32) = + valid x sz + /\ (pelts x)[x.offset + sz - 1] >= div radix 2 + + let div_sb_qr (q x y:t) (sx sy:int32) : limb + requires { 3 <= sy <= sx } + requires { valid x sx } + requires { valid y sy } + requires { valid q (sx - sy) } + requires { normalized y sy } + ensures { value (old x) sx = + (value q (sx - sy) + + power radix (sx - sy) * result) + * value y sy + + value x sy } + ensures { value x sy < value y sy } + ensures { 0 <= result <= 1 } + = + let one = Int32.of_int 1 in + let two = Int32.of_int 2 in + let limb_zero = Limb.of_int 0 in + let zero = Int32.of_int 0 in + let uone = Limb.of_int 1 in + let xp = ref (C.incr x (Int32.(-) sx two)) in + let qp = ref (C.incr q (Int32.(-) sx sy)) in + let dh = C.get_ofs y (Int32.(-) sy one) in + assert { dh >= div radix 2 by normalized y sy }; + let dl = C.get_ofs y (Int32.(-) sy two) in + let v = reciprocal_word_3by2 dh dl in + let i = ref (Int32.(-) sx sy) in + let mdn = Int32.(-) two sy in + let ql = ref limb_zero in + let xd = C.incr !xp mdn in + let ghost vy = value y (p2i sy) in + let x1 = ref limb_zero in + let x0 = ref limb_zero in + let r = compare_same_size xd y sy in + let qh = (*begin + ensures { r >= 0 -> result = 1 } + ensures { r < 0 -> result = 0 }*) + if (Int32.(>=) r zero) + then uone + else limb_zero + (*end*) in + label PreAdjust in + begin + ensures { value (old x) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 } + ensures { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy } + ensures { dl + radix * dh + >= (pelts x)[(!xp).offset] + radix * !x1 } + let ghost ox = pelts x in + begin [@vc:sp] + if (not (Limb.(=) qh limb_zero)) + then begin + assert { qh = 1 }; + let ghost b = sub_in_place xd y sy sy in + begin + ensures { value (x at PreAdjust) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x sx } + ensures { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy) + < vy } + value_sub_upper_bound (pelts x) xd.offset (xd.offset + p2i sy); + assert { b = 0 }; + assert { value (xd at PreAdjust) sy + = value xd sy + vy }; + value_sub_concat (pelts x) x.offset xd.offset (xd.offset + p2i sy); + value_sub_concat ox x.offset xd.offset (xd.offset + p2i sy); + value_sub_frame (pelts x) ox x.offset xd.offset; + assert { value (x at PreAdjust) sx + = value x sx + + power radix (sx - sy) * vy + by + value_sub (pelts (x at PreAdjust)) x.offset xd.offset + = value_sub (pelts x) x.offset xd.offset + so pelts (xd at PreAdjust) = pelts (x at PreAdjust) + so value_sub (pelts (x at PreAdjust)) xd.offset (xd.offset + sy) + = value (xd at PreAdjust) sy + so value (x at PreAdjust) sx + = value_sub (pelts (x at PreAdjust)) x.offset xd.offset + + power radix (sx - sy) + * value_sub (pelts (x at PreAdjust)) xd.offset (xd.offset + sy) + = value_sub (pelts x) x.offset xd.offset + + power radix (sx - sy) + * value (xd at PreAdjust) sy + = value_sub (pelts x) x.offset xd.offset + + power radix (sx - sy) + * (value xd sy + vy) + = value_sub (pelts x) x.offset xd.offset + + power radix (sx - sy) + * (value_sub (pelts x) (xd.offset) (xd.offset + sy) + vy) + = value_sub (pelts x) x.offset xd.offset + + power radix (sx - sy) + * value_sub (pelts x) (xd.offset) (xd.offset + sy) + + power radix (sx - sy) * vy + = value x sx + + power radix (sx - sy) * vy + }; + value_sub_tail (pelts x) x.offset (x.offset + p2i sy + p2i !i - 1); + assert { value (x at PreAdjust) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x sx + by + !i = sx - sy + so power radix (sx - sy - !i) = 1 + so value !qp (sx - sy - !i) = 0 }; + value_sub_lower_bound_tight (pelts y) y.offset (y.offset + p2i sy); + assert { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy) + < vy + by + value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy) + = value xd sy + = value (xd at PreAdjust) sy - vy + so value (xd at PreAdjust) sy + < power radix sy + so vy >= dh * power radix (sy - 1) + so 2 * vy >= 2 * dh * power radix (sy - 1) + so 2 * dh >= radix + so 2 * dh * power radix (sy - 1) >= radix * power radix (sy - 1) + so 2 * vy >= radix * power radix (sy - 1) = power radix sy + so value (xd at PreAdjust) sy < 2 * vy + so value (xd at PreAdjust) sy - vy < vy }; + end + end + else begin + assert { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy) + < vy + by r < 0 }; + assert { value (x at PreAdjust) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x sx + by qh = 0 + so sx - sy - !i = 0 + so (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) = 0 }; + end + end; + let ghost gx1 = (C.get_ofs !xp one) in + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_upper_bound_tight (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts x) (!xp.offset) (!xp.offset + p2i sy - 1); + value_sub_lower_bound_tight (pelts x) (!xp.offset) (!xp.offset + p2i sy - 1); + assert { dl + radix * dh + >= (pelts x)[(!xp).offset] + radix * gx1 + by value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy) + < vy + so value y (sy - 1) < (dl + 1) * power radix (sy - 1 - 1) + so vy = dh * power radix (sy - 1) + + value y (sy - 1) + < dh * power radix (sy - 1) + + (dl + 1) * power radix (sy - 1 - 1) + = power radix (sy - 2) * (dl+1 + radix * dh) + so !xp.offset + mdn + sy - 1 = !xp.offset + 1 + so (pelts x)[!xp.offset + mdn + sy - 1] + = (pelts x)[!xp.offset + 1] = gx1 + so value_sub (pelts x) (!xp.offset + mdn) (!xp.offset + mdn + sy) + = gx1 * power radix (sy - 1) + + value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + >= gx1 * power radix (sy - 1) + + (pelts x)[!xp.offset] * power radix (sy - 1 - 1) + = power radix (sy - 2) + * ((pelts x) [!xp.offset] + radix * gx1) + so power radix (sy - 2) * ((pelts x) [!xp.offset] + radix * gx1) + < power radix (sy - 2) * (dl+1 + radix * dh) + so (pelts x) [!xp.offset] + radix * gx1 + < dl + 1 + radix * dh + }; + value_sub_tail (pelts x) (!xp.offset + p2i mdn) + (!xp.offset + p2i mdn + p2i sy - 1); + value_sub_tail (pelts x) x.offset (x.offset + p2i sy + p2i !i - 1); + + x1 := (C.get_ofs !xp one); + assert { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + by + !xp.offset + mdn + sy - 1 = !xp.offset + 1 + so value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * (pelts x)[!xp.offset + 1] + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) + * (pelts x)[!xp.offset + mdn + sy - 1] + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy) + < vy }; + assert { value (x at PreAdjust) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + by value (x at PreAdjust) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x sx + so sx = sy + !i + so x.offset + sy + !i - 1 = !xp.offset + 1 + so (pelts x)[x.offset + sy + !i - 1] = + (pelts x)[!xp.offset + 1]= !x1 + so value x sx + = value x (sx - 1) + + power radix (sx -1) * (pelts x)[x.offset + sx - 1] + = value x (sy + !i - 1) + + power radix (sy + !i - 1) * (pelts x)[x.offset + sy + !i - 1] + so value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = value x sx + }; + end; + while (Int32.(>) !i zero) do + variant { p2i !i } + invariant { 0 <= !i <= sx - sy } + invariant { (!qp).offset = q.offset + !i } + invariant { (!xp).offset = x.offset + sy + !i - 2 } + invariant { plength !qp = plength q } + invariant { !qp.min = q.min } + invariant { !qp.max = q.max } + invariant { plength !xp = plength x } + invariant { !xp.min = x.min } + invariant { !xp.max = x.max } + invariant { pelts !qp = pelts q } + invariant { pelts !xp = pelts x } + invariant { value (old x) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 } + invariant { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy } + invariant { dl + radix * dh + >= (pelts x)[(!xp).offset] + radix * !x1 } + label StartLoop in + let ghost k = int32'int !i in + i := Int32.(-) !i one; + let ghost s = int32'int sy + int32'int !i - 1 in + xp.contents <- C.incr !xp (-1); + let xd = C.incr !xp mdn in + let nx0 = C.get_ofs !xp one in + if [@ex:unlikely] (Limb.(=) !x1 dh && Limb.(=) nx0 dl) + then begin + ql := Limb.of_int Limb.max_uint64; + value_sub_concat (pelts x) x.offset xd.offset (xd.offset + p2i sy); + value_sub_tail (pelts xd) xd.offset (xd.offset + p2i sy - 1); + let ghost vlx = value xd (p2i sy - 1) in + assert { value xd sy + = vlx + power radix (sy - 1) * dl + by value xd sy + = vlx + power radix (sy - 1) + * (pelts xd)[xd.offset + sy - 1] + so xd.offset + sy - 1 = !xp.offset + mdn + sy - 1 + = !xp.offset + 1 + so pelts xd = pelts !xp + so (pelts xd)[xd.offset + sy - 1] + = (pelts !xp)[!xp.offset + 1] = dl + }; + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 2); + let ghost vly = value y (p2i sy - 2) in + assert { vy = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + by (pelts y)[y.offset + sy - 1] = dh + so (pelts y)[y.offset + sy - 2] = dl + so + vy = value y (sy - 1) + + power radix (sy - 1) * dh + = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh }; + begin + ensures { value_sub (pelts xd) (xd.offset+1) (xd.offset + p2i sy - 1) + + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + < vy } + value_sub_tail (pelts xd) (xd.offset + 1) (xd.offset + p2i sy - 2); + assert { value_sub (pelts x) (!xp.offset at StartLoop + mdn) + (!xp.offset at StartLoop + mdn + sy - 1) + = value_sub (pelts xd) (xd.offset+1) (xd.offset + p2i sy - 1) + + power radix (sy - 2) * dl + by + pelts x = pelts xd + so !xp.offset at StartLoop + mdn = xd.offset + 1 + so !xp.offset at StartLoop + mdn + sy - 1 = xd.offset + sy + so xd.offset + sy - 1 = !xp.offset + 1 + so pelts xd = pelts !xp + so (pelts xd)[xd.offset + sy - 1] = (pelts !xp)[!xp.offset+1] = dl + so value_sub (pelts x) (!xp.offset at StartLoop + mdn) + (!xp.offset at StartLoop + mdn + sy - 1) + = value_sub (pelts xd) (xd.offset+1) (xd.offset + sy) + = value_sub (pelts xd) (xd.offset+1) (xd.offset + p2i sy - 1) + + power radix (sy - 2) + * (pelts xd)[xd.offset + p2i sy - 1] + = value_sub (pelts xd) (xd.offset+1) (xd.offset + p2i sy - 1) + + power radix (sy - 2) * dl + }; + assert { !x1 = dh }; + end; + label SubMax in + let ghost xc = Array.copy (x.data) in + value_sub_frame (pelts x) xc.elts x.offset (x.offset + p2i !i); + let ghost b = submul_limb xd y !ql sy in + begin + ensures { value x !i + = value (x at SubMax) !i } + assert { forall j. x.offset <= j < x.offset + !i + -> (pelts x)[j] = xc.elts[j] + by + (pelts x)[j] = (pelts x at SubMax)[j] + so + ((pelts x at SubMax)[j] = xc.elts[j] + by + 0 <= j /\ j < xc.Array.length + ) }; + value_sub_frame (pelts x) xc.elts x.offset (x.offset + p2i !i); + end; + value_sub_upper_bound (pelts xd) xd.offset (xd.offset + p2i sy); + value_sub_lower_bound (pelts xd) xd.offset (xd.offset + p2i sy); + value_sub_head (pelts xd) xd.offset (xd.offset + p2i sy - 1); + assert { vlx < radix * vly + by + vlx = value_sub (pelts xd at SubMax) xd.offset + (xd.offset + sy - 1) + = (pelts xd at SubMax)[xd.offset] + + radix * value_sub (pelts xd at SubMax) + (xd.offset + 1) + (xd.offset + sy - 1) + so value_sub (pelts xd at SubMax) (xd.offset + 1) + (xd.offset + sy - 1) + + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + < vy + = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + so value_sub (pelts xd at SubMax) (xd.offset + 1) + (xd.offset + sy - 1) + < vly + so value_sub (pelts xd at SubMax) (xd.offset + 1) + (xd.offset + sy - 1) + <= vly - 1 + so vlx = (pelts xd at SubMax)[xd.offset] + + radix * value_sub (pelts xd at SubMax) + (xd.offset + 1) + (xd.offset + sy - 1) + <= (pelts xd at SubMax)[xd.offset] + + radix * (vly - 1) + < radix + radix * (vly - 1) + = radix * vly + }; + assert { b = dh + by + value xd sy + = value (xd at SubMax) sy + - (!ql) * vy + + power radix sy * b + so !ql = radix - 1 + so 0 <= value xd sy < power radix sy + so radix * power radix (sy - 2) = power radix (sy - 1) + so radix * power radix (sy - 1) = power radix sy + so value xd sy + = power radix (sy - 1) * dl + vlx + - (radix - 1) * vy + + power radix sy * b + = power radix (sy - 1) * dl + vlx + - radix * (vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh) + + vy + power radix sy * b + = power radix (sy - 1) * dl + vlx + - radix * vly - radix * power radix (sy - 2) * dl + - radix * power radix (sy - 1) * dh + + vy + power radix sy * b + = power radix (sy - 1) * dl + vlx + - radix * vly - power radix (sy - 1) * dl + - power radix sy * dh + + vy + power radix sy * b + = power radix sy * (b - dh) + + vlx - radix * vly + vy + so vlx < radix * vly + so (0 <= vlx - radix * vly + vy < power radix sy + by + vy - radix * vly + = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + - radix * vly + = power radix (sy - 2) * (dl + radix * dh) + - vly * (radix - 1) + so let pr2 = power radix (sy - 2) in + 0 <= vly < pr2 + so 0 <= vly * (radix - 1) < pr2 * (radix - 1) + so vy - radix * vly + >= pr2 * (dl + radix * dh) + - pr2 * (radix - 1) + = pr2 * (dl + radix * dh - (radix - 1)) + so dh + radix * dh - (radix - 1) >= 0 + so pr2 >= 0 + so vy - radix * vly + >= pr2 * (dl + radix * dh - (radix - 1)) >= 0 + so vlx - radix * vly < 0 + so vlx - radix * vly + vy < vy < power radix sy + ) + so - (power radix sy) + < power radix sy * (b - dh) + < power radix sy + so - 1 < b - dh < 1 + }; + value_sub_concat (pelts x) x.offset xd.offset (x.offset + s); + x1 := C.get_ofs !xp one; + qp.contents <- C.incr !qp (-1); + value_sub_update_no_change (pelts q) (!qp).offset + ((!qp).offset + 1) + ((!qp).offset + p2i sx - p2i sy - p2i !i) + !ql; + label QUp in + C.set !qp !ql; + assert { value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + = value (!qp at StartLoop) + (sx - sy - k) + by value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + = value_sub (pelts q at QUp) (!qp.offset + 1) + ((!qp).offset + sx - sy - !i) + = value (!qp at StartLoop) (sx - sy - k) + (* by offset !qp at StartLoop = (!qp).offset + 1 + so offset (!qp at StartLoop) + sx - sy - k + = (!qp).offset + sx - sy - !i + so map_eq_sub_shift (pelts q) (pelts !qp at StartLoop) + ((!qp).offset + 1) ((!qp).offset + 1) (sx + sy - k) *) }; + value_sub_head (pelts q) (!qp).offset + ((!qp).offset + p2i sx - p2i sy - p2i !i); + value_sub_tail (pelts x) x.offset (x.offset + p2i sy + p2i !i - 1); + assert { value xd (sy - 1) + + power radix (sy - 1) * !x1 + = value (xd at SubMax) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + by + value xd sy + = value (xd at SubMax) sy + - (!ql) * vy + + power radix sy * b + so b = dh = !x1 at StartLoop + so pelts !xp = pelts x = pelts xd + so ((pelts xd)[xd.offset + sy - 1] = !x1 + by + xd.offset = x.offset + !i + so (!xp).offset = x.offset + !i + sy - 2 + so (!xp).offset + 1 = xd.offset + sy - 1 + so (pelts xd)[xd.offset + sy - 1] + = (pelts !xp)[(!xp).offset + 1] + = !x1 + ) + so value xd sy + = value xd (sy - 1) + + power radix (sy - 1) * (pelts xd)[xd.offset + sy - 1] + = value xd (sy - 1) + + power radix (sy - 1) * !x1 + }; + (* refl *) + assert { value (old x) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + by + pelts !xp = pelts x = pelts xd + so + value xd sy + = value (xd at SubMax) sy + - (!ql) * vy + + power radix sy * b + = value (xd at SubMax) sy + - (!ql) * vy + + power radix sy * dh + so (value x s + = value x !i + + power radix !i + * value xd (sy - 1) + by + xd.offset = x.offset + !i + so x.offset + s = xd.offset + sy - 1 + so value_sub (pelts x) (x.offset + !i) (x.offset + s) + = value xd (sy - 1) + so value x s + = value x !i + + power radix !i + * value_sub (pelts x) (x.offset + !i) + (x.offset + s) + = value x !i + + power radix !i + * value xd (sy - 1)) + so (power radix s + = power radix !i * power radix (sy - 1) + by + let n = !i in + let m = sy - 1 in + let x = radix in + power x s = power x (n + m) + so (power x (n + m) = power x n * power x m + by 0 <= n + so 0 <= m + so forall x:int, n:int, m:int. + 0 <= n -> 0 <= m -> + power x (n + m) = (power x n * power x m))) + so (value x s + power radix s * !x1 + = value x !i + + power radix !i * (value xd sy) + by + value x s + power radix s * !x1 + = value x !i + + power radix !i + * value xd (sy - 1) + + power radix (!i + sy - 1) * !x1 + = value x !i + + power radix !i * + (value xd (sy - 1) + + power radix (sy - 1) * !x1) + = value x !i + + power radix !i * (value xd sy) + ) + so (value (x at StartLoop) (sy + k - 1) + = value (x at SubMax) !i + + power radix !i + * value (xd at SubMax) sy + by + pelts xd at SubMax = pelts x at SubMax + so x.offset at SubMax + !i = xd.offset at SubMax + so + value (x at StartLoop) (sy + k - 1) + = value_sub (pelts x at SubMax) (x at SubMax).offset + (xd.offset at SubMax) + + power radix !i + * value_sub (pelts x at SubMax) + (xd.offset at SubMax) + (xd.offset at SubMax + sy) + so value_sub (pelts x at SubMax) (x at SubMax).offset + (xd at SubMax).offset + = value (x at SubMax) !i + so value_sub (pelts x at SubMax) (xd.offset at SubMax) + (xd.offset at SubMax + sy) + = value (xd at SubMax) sy + ) + so value x !i + = value (x at SubMax) !i + so value x s + power radix s * !x1 + = value (x at StartLoop) (sy + k - 1) + + power radix !i + * (value xd sy + - value (xd at SubMax) sy) + = value (x at StartLoop) (sy + k - 1) + + power radix !i + * (- (!ql) * vy + + power radix sy * b) + = value (x at StartLoop) (sy + k - 1) + + power radix !i + * (- (!ql) * vy + + power radix sy * (!x1 at StartLoop)) + so value !qp (sx - sy - !i) + = !ql + radix * + value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + so (value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + = value (!qp at StartLoop) + (sx - sy - k) + by value (!qp at StartLoop) (sx - sy - k) + = value_sub (pelts q at StartLoop) + (!qp.offset + 1) (!qp.offset + sx - sy - !i)) + so value !qp (sx - sy - !i) + = !ql + radix * value (!qp at StartLoop) + (sx - sy - k) + so power radix (sx - sy - !i) + = radix * power radix (sx - sy - k) + so radix * power radix !i = power radix k + so (power radix !i * power radix sy + = power radix (sy + k - 1) + by !i + sy = sy + k - 1 + so power radix !i * power radix sy + = power radix (!i + sy)) + so (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + radix * qh * power radix (sx - sy - k)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + radix * qh * power radix (sx - sy - k)) + * vy * power radix !i + + value x s + + power radix s * !x1 + = !ql * vy * power radix !i + + radix * (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix !i + + value x s + + power radix s * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * radix * power radix !i + + value x s + + power radix s * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value x s + + power radix s * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix !i + * (- (!ql) * vy + + power radix sy * (!x1 at StartLoop)) + = (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix !i * power radix sy + * (!x1 at StartLoop) + = (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + = value (old x) sx + }; + assert { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + by + pelts x = pelts xd + so xd.offset = !xp.offset + mdn + so !xp.offset + mdn + sy - 1 = xd.offset + sy - 1 + so + value xd (sy - 1) + = value_sub (pelts xd) xd.offset (xd.offset + sy - 1) + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + so value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + = value (xd at SubMax) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + so value (xd at SubMax) sy = + vlx + power radix (sy - 1) * dl + so vlx < radix * vly + so (value (xd at SubMax) sy + + power radix sy * (!x1 at StartLoop) + < radix * vy + by + !x1 at StartLoop = dh + so power radix sy = radix * power radix (sy - 1) + so power radix (sy - 1) = radix * power radix (sy - 2) + so value (xd at SubMax) sy + + power radix sy * (!x1 at StartLoop) + = vlx + power radix (sy - 1) * dl + + power radix sy * dh + < radix * vly + power radix (sy - 1) * dl + + power radix sy * dh + = radix * vly + radix * power radix (sy - 2) * dl + + radix * power radix (sy - 1) * dh + = radix * (vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh) + = radix * vy + ) + so !ql = radix - 1 + so value (xd at SubMax) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + < radix * vy - (radix - 1) * vy + = vy + }; + value_sub_tail (pelts x) (!xp.offset + p2i mdn) (!xp.offset); + value_sub_upper_bound (pelts y) (y.offset) (y.offset + p2i sy - 2); + value_sub_lower_bound (pelts x) (!xp.offset + p2i mdn) (!xp.offset); + assert { dl + radix * dh + >= (pelts x)[(!xp).offset] + radix * !x1 + by + vy = vly + power radix (sy - 2) + * (dl + radix * dh) + so value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + so !xp.offset + mdn + sy - 1 = !xp.offset + 1 + so power radix (sy - 1) = power radix (sy - 2) * radix + so - mdn = sy - 2 + so vy + > value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (- mdn) * (pelts x)[(!xp).offset] + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) * (pelts x)[(!xp).offset] + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) * (pelts x)[(!xp).offset] + + power radix (sy - 2) * radix * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + >= power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + so vly < power radix (sy - 2) + so vy < power radix (sy - 2) + + power radix (sy - 2) + * (dl + radix * dh) + = power radix (sy - 2) + * (1 + dl + radix * dh) + so power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + < power radix (sy - 2) * (1 + dl + radix * dh) + so power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1 + - (1 + dl + radix * dh)) + < 0 + so (pelts x)[(!xp).offset] + radix * !x1 + - (1 + dl + radix * dh) + < 0 + }; + end + else begin + assert { dl + radix * dh + > (pelts x)[(!xp).offset + 1] + radix * !x1 + by + dl + radix * dh + >= (pelts x)[(!xp).offset + 1] + radix * !x1 + so dh >= !x1 + so [@case_split] dh <> !x1 + \/ (dh = !x1 + /\ dl <> (pelts x)[(!xp).offset + 1]) + so + [@case_split] dh > !x1 \/ + (dh = !x1 /\ dl > (pelts x)[(!xp).offset + 1]) + }; + label SmallDiv in + let ghost vlx = value xd (p2i sy - 2) in + let xp0 = C.get !xp in + let xp1 = C.get_ofs !xp one in + begin + ensures { value xd sy = + vlx + + power radix (sy - 2) * (xp0 + radix * xp1) } + value_sub_tail (pelts xd) xd.offset (xd.offset + p2i sy - 1); + value_sub_tail (pelts xd) xd.offset (xd.offset + p2i sy - 2); + value_sub_upper_bound (pelts xd) xd.offset (xd.offset + p2i sy - 2); + assert { value xd sy + = vlx + power radix (sy - 2) + * (xp0 + radix * xp1) + by xd.offset + sy - 2 = !xp.offset + so (pelts xd)[xd.offset + sy - 1] = xp1 + so (pelts xd)[xd.offset + sy - 2] = xp0 + so pelts xd = pelts !xp + so value xd sy + = value xd (sy - 1) + + power radix (sy - 1) + * (pelts xd)[xd.offset + sy - 1] + = value xd (sy - 2) + + power radix (sy - 2) + * (pelts xd)[xd.offset + sy - 2] + + power radix (sy - 1) + * (pelts xd)[xd.offset + sy - 1] + = vlx + + power radix (sy - 2) * xp0 + + power radix (sy - 1) * xp1 + = value xd (sy - 2) + + power radix (sy - 2) * xp0 + + power radix (sy - 2) * radix * xp1 + = vlx + power radix (sy - 2) + * (xp0 + radix * xp1) + }; + end; + let qu, rl, rh = + div3by2_inv !x1 xp1 xp0 dh dl v in + ql := qu; + x1 := rh; + x0 := rl; + label SubProd in + value_sub_concat (pelts x) x.offset xd.offset + (x.offset + p2i sy + k - 1); + let ghost xc = Array.copy (x.data) in + value_sub_frame (pelts x) xc.elts x.offset (x.offset + p2i !i); + let cy = submul_limb xd y !ql (Int32.(-) sy two) in + label PostSub in + begin + ensures { value x !i + = value (x at SubProd) !i } + assert { forall j. x.offset <= j < x.offset + !i + -> (pelts x)[j] = xc.elts[j] + by + (pelts x)[j] = (pelts x at SubProd)[j] + so + ((pelts x at SubProd)[j] = xc.elts[j] + by + 0 <= j /\ j < xc.Array.length + ) }; + value_sub_frame (pelts x) xc.elts x.offset (x.offset + p2i !i); + end; + let cy1 = [@vc:sp] if (Limb.(<) !x0 cy) then uone else limb_zero in + x0 := sub_mod !x0 cy; + let cy2 = [@vc:sp] if (Limb.(<) !x1 cy1) then uone else limb_zero in + x1 := sub_mod !x1 cy1; + assert { 0 <= cy2 <= 1 }; + (* assert { cy2 = 1 -> rh = 0 }; (* and cy > rl *)*) + value_sub_update (pelts x) (!xp).offset xd.offset + (xd.offset + p2i sy - 1) !x0; + value_sub_update_no_change (pelts x) (!xp).offset + x.offset (x.offset + p2i !i) !x0; + value_sub_update_no_change (pelts x) (!xp).offset + xd.offset (xd.offset + p2i sy - 2) !x0; + C.set !xp !x0; + assert { value x !i + = value (x at SubProd) !i + by + value x !i + = value (x at PostSub) !i + = value (x at SubProd) !i }; + value_sub_tail (pelts x) xd.offset (xd.offset + p2i sy - 1); + begin + ensures { value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy } + assert { value xd (sy - 2) + = value (xd at PostSub) (sy - 2) }; + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 2); + let ghost vly = value y (p2i sy - 2) in + assert { vy = vly + power radix (sy - 2) + * (dl + radix * dh) + by (pelts y)[y.offset + sy - 1] = dh + so (pelts y)[y.offset + sy - 2] = dl + so + vy = value y (sy - 1) + + power radix (sy - 1) * dh + = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + so power radix (sy - 1) + = power radix (sy - 2) * radix }; + assert { value xd (sy - 2) + - power radix (sy - 2) * cy + = vlx - !ql * vly + by + value xd (sy - 2) + - power radix (sy - 2) * cy + = value (xd at PostSub) (sy - 2) + - power radix (sy - 2) * cy + = vlx - !ql * vly + }; + assert { power radix sy + = power radix (sy - 2) * radix * radix }; + assert { xp0 + radix * xp1 + + radix * radix * !x1 at StartLoop + - !ql * (dl + radix * dh) + = rl + radix * rh }; + begin ensures { value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = value xd (sy - 2) + - power radix (sy - 2) * cy + + power radix (sy - 2) * + (rl + radix * rh) } + assert { value (xd at SubProd) sy + = vlx + power radix (sy - 2) * xp0 + + power radix (sy - 1) * xp1 }; (*nonlinear*) + assert { !ql * vy = !ql * vly + + power radix (sy - 2) + * (!ql * (dl + radix * dh)) }; (*nonlinear*) + (*assert { value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = value xd (sy - 2) + - power radix (sy - 2) * cy + + power radix (sy - 2) * (rl + radix * rh) + by + value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = vlx + power radix (sy - 2) + * (xp0 + radix * xp1) + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = vlx + power radix (sy - 2) + * (xp0 + radix * xp1) + + power radix sy * (!x1 at StartLoop) + - !ql * (vly + power radix (sy - 2) + * (dl + radix * dh)) + = vlx + + power radix (sy - 2) + * (xp0 + radix * xp1 + + radix * radix * !x1 at StartLoop) + - !ql * (vly + power radix (sy - 2) + * (dl + radix * dh)) + = vlx + + power radix (sy - 2) + * (xp0 + radix * xp1 + + radix * radix * !x1 at StartLoop) + - !ql * vly + - power radix (sy - 2) + * !ql * (dl + radix * dh) + = vlx - !ql * vly + + power radix (sy - 2) + * (xp0 + radix * xp1 + + radix * radix * !x1 at StartLoop + - !ql * (dl + radix * dh)) + = vlx - !ql * vly + + power radix (sy - 2) * + (rl + radix * rh) + = value xd (sy - 2) + - power radix (sy - 2) * cy + + power radix (sy - 2) * + (rl + radix * rh) + } *) + end; + begin ensures { value xd (sy - 2) + - power radix (sy - 2) * cy + + power radix (sy - 2) * (rl + radix * rh) + = value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 } + value_sub_tail (pelts xd) xd.offset (xd.offset + p2i sy - 2); + assert { value xd (sy - 1) + = value xd (sy - 2) + + power radix (sy - 2) * !x0 + by (pelts xd)[xd.offset + sy - 2] = !x0 + so value xd (sy - 1) + = value_sub (pelts xd) xd.offset (xd.offset + sy - 1) + = value_sub (pelts xd) xd.offset (xd.offset + sy - 2) + + power radix (sy - 2) * !x0 + = value xd (sy - 2) + + power radix (sy - 2) * !x0 }; + assert { rl + radix * rh - cy + = !x0 + radix * !x1 - power radix 2 * cy2 + by + (!x0 - radix * cy1 = rl - cy + by + !x0 = mod (rl - cy) radix + so - radix < rl - cy < radix + so (if rl < cy + then cy1 = 1 + /\ (- radix < rl - cy < 0 + so + div (rl - cy) radix = - 1 + so rl - cy + = radix * div (rl - cy) radix + + mod (rl - cy) radix + = !x0 - radix + = !x0 - radix * cy1) + else cy1 = 0 /\ rl - cy = l2i !x0)) } + (* nonlinear *) + (* refl example *) + (* assert { value xd (sy - 2) + - power radix (sy - 2) * cy + + power radix (sy - 2) * + (rl + radix * rh) + = value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + by + (rl + radix * rh - cy + = !x0 + radix * !x1 - radix * radix * cy2 + by + (!x0 - radix * cy1 = rl - cy + by + !x0 = mod (rl - cy) radix + so - radix < rl - cy < radix + so (if rl < cy + then cy1 = 1 + /\ (- radix < rl - cy < 0 + so + div (rl - cy) radix = - 1 + so rl - cy + = radix * div (rl - cy) radix + + mod (rl - cy) radix + = !x0 - radix + = !x0 - radix * cy1) + else cy1 = 0 /\ rl - cy = l2i !x0) + ) + so !x1 - radix * cy2 = rh - cy1 + so radix * !x1 - radix * radix * cy2 + = radix * rh - radix * cy1 + so radix * rh + = radix * cy1 + + radix * !x1 - radix * radix * cy2 + so rl + radix * rh - cy + = rl - cy + radix * rh + = !x0 - radix * cy1 + radix * rh + = !x0 - radix * cy1 + + radix * cy1 + + radix * !x1 - radix * radix * cy2 + = !x0 + radix * !x1 - radix * radix * cy2 + ) + so + ( - power radix (sy - 2) * cy + + power radix (sy - 2) * (rl + radix * rh) + = power radix (sy - 2) + * (rl + radix * rh - cy) + = power radix (sy - 2) + * (!x0 + radix * !x1 - radix * radix * cy2) + = power radix (sy - 2) * !x0 + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + by power radix (sy - 2) * radix = power radix (sy - 1) + so power radix (sy - 2) * radix * radix = power radix sy + ) + so value xd (sy - 2) + - power radix (sy - 2) * cy + + power radix (sy - 2) * (rl + radix * rh) + = value xd (sy - 2) + + power radix (sy - 2) * !x0 + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + = value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + }*) + end; + end; + if [@ex:unlikely] (not (Limb.(=) cy2 limb_zero)) + then begin + label Adjust in + assert { cy2 = 1 }; + begin ensures { !ql > 0 } + value_sub_lower_bound (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_upper_bound (pelts xd) xd.offset (xd.offset + p2i sy - 1); + assert { !ql > 0 + by + (value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + < 0 + by + value xd (sy - 1) < power radix (sy - 1) + so !x1 <= radix - 1 + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + < power radix (sy - 1) + + power radix (sy - 1) * !x1 + = power radix (sy - 1) * (1 + !x1) + <= power radix (sy - 1) * radix + = power radix sy + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + < power radix sy - power radix sy * cy2 + = 0 + ) + so value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + < 0 + so (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) >= 0 + by value (xd at SubProd) sy >= 0 + so !x1 at StartLoop >= 0 + so power radix sy * (!x1 at StartLoop) >= 0 + ) + so !ql * vy > 0 + so vy = value_sub (pelts y) + y.offset (y.offset + sy - 1) + + power radix (sy - 1) * dh + so dh > 0 + so vy > 0 + }; + end; + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 2); + let ghost vly = value y (p2i sy - 2) in + assert { vy = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + by (pelts y)[y.offset + sy - 1] = dh + so (pelts y)[y.offset + sy - 2] = dl + so + vy = value y (sy - 1) + + power radix (sy - 1) * dh + = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh }; + begin + ensures { value xd (sy - 1) + + power radix (sy - 1) * !x1 + >= power radix sy - vy } + assert { value xd (sy - 1) + + power radix (sy - 1) * !x1 + = power radix sy + value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy }; + assert { value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + >= - vy + by + value (xd at SubProd) sy + = vlx + power radix (sy - 2) * (xp0 + radix * xp1) + so xp0 + radix * xp1 + radix * radix * (!x1 at StartLoop) + = !ql * (dl + radix * dh) + rl + radix * rh + so power radix (sy - 1) = power radix (sy - 2) * radix + so vy = vly + power radix (sy - 2) * (dl + radix * dh) + so (!ql * vly < vy + by + vly <= power radix (sy - 2) + so !ql < radix + so !ql * vly <= !ql * power radix (sy - 2) + < radix * power radix (sy - 2) + = power radix (sy - 1) + so vy = vly + power radix (sy - 2) * (dl + radix * dh) + so dh >= div radix 2 > 1 + so vly >= 0 + so dl >= 0 + so vy >= power radix (sy - 2) * radix * dh + > power radix (sy - 2) * radix * 1 + = power radix (sy - 1) + ) + so - !ql * vly > - vy + so vlx >= 0 + so power radix sy = power radix (sy - 2) * radix * radix + so value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = vlx + power radix (sy - 2) * (xp0 + radix * xp1) + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = vlx + power radix (sy - 2) * (xp0 + radix * xp1) + + power radix (sy - 2) + * radix * radix * (!x1 at StartLoop) + - !ql * vy + = vlx + power radix (sy - 2) + * (xp0 + radix * xp1 + + radix * radix * (!x1 at StartLoop)) + - !ql * vy + = vlx + power radix (sy - 2) * + (!ql * (dl + radix * dh) + rl + radix * rh) + - !ql * vy + = vlx + power radix (sy - 2) * + (!ql * (dl + radix * dh) + rl + radix * rh) + - !ql * (vly + + power radix (sy - 2) * (dl + radix * dh)) + = vlx + power radix (sy - 2) * (rl + radix * rh) + - !ql * vly + >= power radix (sy - 2) * (rl + radix * rh) + - !ql * vly + >= - !ql * vly > - vy + }; + end; + let ghost xc = Array.copy (x.data) in + assert { forall j. x.offset <= j < x.offset + !i + -> (pelts x)[j] = xc.elts[j] + by + 0 <= x.offset <= j /\ j < x.offset + !i <= xc.Array.length + so 0 <= j < xc.Array.length + } ; + value_sub_frame (pelts x) xc.elts x.offset (x.offset + p2i !i); + let c = add_in_place xd y (Int32.(-) sy one) (Int32.(-) sy one) in + begin + ensures { value x !i + = value (x at Adjust) !i } + assert { forall j. x.offset <= j < x.offset + !i + -> (pelts x)[j] = xc.elts[j] + by + pelts (xd at Adjust) = pelts (x at Adjust) + so pelts x = pelts xd + so (pelts x)[j] = (pelts x at Adjust)[j] + so + ((pelts x at Adjust)[j] = xc.elts[j] + by + 0 <= j /\ j < xc.Array.length + ) } ; + value_sub_frame (pelts x) xc.elts x.offset (x.offset + p2i !i); + end; + label MidAdd in + begin + ensures { value xd (sy - 1) + power radix (sy - 1) * !x1 + = value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + - power radix sy } + assert { 0 <= c <= 1 + by + value xd (sy - 1) + c * power radix (sy - 1) + = value (xd at Adjust) (sy - 1) + + value y (sy - 1) + so + value (xd at Adjust) (sy - 1) + < power radix (sy - 1) + so value y (sy - 1) < power radix (sy - 1) + so value xd (sy - 1) >= 0 + so c * power radix (sy - 1) < 2 * power radix (sy - 1) + so let p = power radix (sy - 1) in + (c < 2 by c * p < 2 * p so p > 0) + }; + let ghost c' = div (l2i !x1 + l2i dh + l2i c) radix in + x1 := add_mod !x1 (add_mod dh c); + assert { !x1 + c' * radix = !x1 at Adjust + dh + c + by + (!x1 = mod (!x1 at Adjust + dh + c) radix + by + !x1 = mod (!x1 at Adjust + (mod (dh + c) radix)) radix + so mod (div (dh + c) radix * radix + !x1 at Adjust + + mod (dh + c) radix) radix + = mod (!x1 at Adjust + (mod (dh + c) radix)) radix + so !x1 = mod (div (dh + c) radix * radix + !x1 at Adjust + + mod (dh + c) radix) radix + = mod (!x1 at Adjust + dh + c) radix + ) + so (!x1 at Adjust) + dh + c + = div (!x1 at Adjust + dh + c) radix * radix + + mod (!x1 at Adjust + dh + c) radix + = c' * radix + !x1 + }; + assert { 0 <= c' <= 1 }; + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + assert { value xd (sy - 1) + power radix (sy - 1) * !x1 + = value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + - power radix sy + by + value xd (sy - 1) + power radix (sy - 1) * c + = value (xd at Adjust) (sy - 1) + + value y (sy - 1) + so vy = value y (sy - 1) + + power radix (sy - 1) * dh + so value xd (sy - 1) + power radix (sy - 1) * c + + power radix (sy - 1) * (!x1 at Adjust) + + power radix (sy - 1) * dh + = value (xd at Adjust) (sy - 1) + + value y (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + power radix (sy - 1) * dh + = value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + so value xd (sy - 1) + power radix (sy - 1) * c + + power radix (sy - 1) * (!x1 at Adjust) + + power radix (sy - 1) * dh + = value xd (sy - 1) + + power radix (sy - 1) * (c + dh + !x1 at Adjust) + = value xd (sy - 1) + + power radix (sy - 1) * (!x1 + radix * c') + = value xd (sy - 1) + + power radix (sy - 1) * !x1 + + power radix sy * c' + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + + power radix sy * c' + = value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + so value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + >= power radix sy - vy + so value xd (sy - 1) < power radix (sy - 1) + so !x1 <= radix - 1 + so power radix (sy - 1) * !x1 + <= power radix (sy - 1) * (radix - 1) + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + <= value xd (sy - 1) + + power radix (sy - 1) * (radix - 1) + < power radix (sy - 1) + + power radix (sy - 1) * (radix - 1) + = power radix sy + so c' <> 0 + so c' = 1 + }; + end; + ql := Limb.(-) !ql uone; + (* todo refl *) + assert { value xd (sy - 1) + power radix (sy - 1) * !x1 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + by + value xd (sy - 1) + power radix (sy - 1) * !x1 + = value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + - power radix sy + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - (!ql at Adjust) * vy + + vy + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - (!ql + 1) * vy + + vy + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy }; + qp.contents <- C.incr !qp (-1); + value_sub_update_no_change (pelts q) (!qp).offset + ((!qp).offset + 1) + ((!qp).offset + p2i sx - p2i sy - p2i !i) + !ql; + C.set !qp !ql; + value_sub_head (pelts q) (!qp).offset + ((!qp).offset + p2i sx - p2i sy - p2i !i); + value_sub_tail (pelts x) x.offset (x.offset + p2i sy + p2i !i - 1); + value_sub_concat (pelts x) x.offset xd.offset (x.offset + s); + (* todo refl *) + assert { value (old x) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + by + value !qp (sx - sy - !i) + = !ql + radix * + value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + so (value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + = value (!qp at StartLoop) + (sx - sy - k) + by + (!qp at StartLoop).offset = (!qp).offset + 1 + so ((!qp).offset + sx - sy - !i) + - ((!qp).offset + 1) + = sx - sy - k + ) + so value !qp (sx - sy - !i) + = !ql + radix * value (!qp at StartLoop) + (sx - sy - k) + so (value x s + = value x !i + + power radix !i + * value xd (sy - 1) + by + xd.offset = x.offset + !i + so x.offset + s = xd.offset + sy - 1 + so pelts x = pelts xd + so x.offset + s - xd.offset = sy - 1 + so value_sub (pelts x) xd.offset (x.offset + s) + = value xd (sy - 1) + so value x s + = value_sub (pelts x) x.offset xd.offset + + power radix !i * value_sub (pelts x) xd.offset (x.offset + s) + = value x !i + + power radix !i * value xd (sy - 1) + ) + so (power radix s + = power radix !i * power radix (sy - 1) + by + let n = !i in + let m = sy - 1 in + let x = radix in + power x s = power x (n + m) + so (power x (n + m) = power x n * power x m + by 0 <= n + so 0 <= m + so forall x:int, n:int, m:int. + 0 <= n -> 0 <= m -> power x (n + m) = (power x n * power x m))) + so (value x s + power radix s * !x1 + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + by value xd (sy - 1) + + power radix (sy - 1) * !x1 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + so value x s + power radix s * !x1 + = value x !i + + power radix !i + * value xd (sy - 1) + + power radix (!i + sy - 1) * !x1 + = value x !i + + power radix !i + * value xd (sy - 1) + + power radix !i + * power radix (sy - 1) * !x1 + = value x !i + + power radix !i * + (value xd (sy - 1) + + power radix (sy - 1) * !x1) + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + ) + so (value (x at StartLoop) (sy + k - 1) + = value (x at SubProd) !i + + power radix !i + * value (xd at SubProd) sy + by + value (x at StartLoop) (sy + k - 1) + = value_sub (pelts x at SubProd) (x at SubProd).offset + ((x at SubProd).offset + sy + k - 1) + = value_sub (pelts x at SubProd) (x at SubProd).offset xd.offset + + power radix (xd.offset - (x at SubProd).offset) + * value_sub (pelts x at SubProd) xd.offset + ((x at SubProd).offset + sy + k - 1) + so (x at SubProd).offset = x.offset + so xd.offset = x.offset + !i + so value_sub (pelts x at SubProd) (x at SubProd).offset xd.offset + = value (x at SubProd) !i + so power radix (xd.offset - x.offset) = power radix !i + so x.offset + sy + k - 1 - xd.offset = p2i sy + so value_sub (pelts x at SubProd) xd.offset + (x.offset + sy + k - 1) + = value (xd at SubProd) sy + ) + so (value x !i + = value (x at SubProd) !i + by + value x !i + = value (x at Adjust) !i + = value (x at SubProd) !i + ) + so power radix !i * power radix sy = power radix (!i + sy) + so value x s + power radix s * !x1 + - value (x at StartLoop) (sy + k - 1) + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + - (value (x at SubProd) !i + + power radix !i + * value (xd at SubProd) sy) + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + - (value x !i + + power radix !i + * value (xd at SubProd) sy) + = power radix !i + * (power radix sy * (!x1 at StartLoop) + - !ql * vy) + = power radix !i * power radix sy * (!x1 at StartLoop) + - power radix !i * !ql * vy + = power radix (!i + sy) * (!x1 at StartLoop) + - power radix !i * !ql * vy + = power radix (sy + k - 1) * (!x1 at StartLoop) + - power radix !i * !ql * vy + so value x s + power radix s * !x1 + = value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + - power radix !i * !ql * vy + so power radix (sx - sy - !i) + = radix * power radix (sx - sy - k) + so radix * power radix !i = power radix k + so (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + qh * radix * power radix (sx - sy - k)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * radix * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value x s + + power radix s * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + - power radix !i * !ql * vy + = (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + = value (old x) sx + }; + assert { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + by + (value xd (sy - 1) + power radix (sy - 1) * !x1 < vy + by + value xd (sy - 1) + power radix (sy - 1) * !x1 + = value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + - power radix sy + so value (xd at Adjust) (sy - 1) + < power radix (sy - 1) + so 1 + (!x1 at Adjust) <= radix + so value (xd at Adjust) (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + - power radix sy + < power radix (sy - 1) + + power radix (sy - 1) * (!x1 at Adjust) + + vy + - power radix sy + = power radix (sy - 1) * (1 + !x1 at Adjust) + + vy + - power radix sy + <= power radix (sy - 1) * radix + + vy + - power radix sy + = vy + ) + so pelts x = pelts xd + so xd.offset = !xp.offset + mdn + so value xd (sy - 1) + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + }; + assert { dl + radix * dh + >= (pelts x)[(!xp).offset] + radix * !x1 + by + vy = vly + power radix (sy - 2) + * (dl + radix * dh) + so value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + so !xp.offset + mdn + sy - 1 = !xp.offset + 1 + so power radix (sy - 1) = power radix (sy - 2) * radix + so - mdn = sy - 2 + so vy + > value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (- mdn) * (pelts x)[(!xp).offset] + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) * (pelts x)[(!xp).offset] + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) * (pelts x)[(!xp).offset] + + power radix (sy - 2) * radix * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + >= power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + so vly < power radix (sy - 2) + so vy < power radix (sy - 2) + + power radix (sy - 2) + * (dl + radix * dh) + = power radix (sy - 2) + * (1 + dl + radix * dh) + so power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + < power radix (sy - 2) * (1 + dl + radix * dh) + so power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1 + - (1 + dl + radix * dh)) + < 0 + so (pelts x)[(!xp).offset] + radix * !x1 + - (1 + dl + radix * dh) + < 0 + }; + end + else begin + qp.contents <- C.incr !qp (-1); + value_sub_update_no_change (pelts q) (!qp).offset + ((!qp).offset + 1) + ((!qp).offset + p2i sx - p2i sy - p2i !i) + !ql; + C.set !qp !ql; + value_sub_head (pelts q) (!qp).offset + ((!qp).offset + p2i sx - p2i sy - p2i !i); + assert { value !qp (sx - sy - !i) * vy + = !ql * vy + radix * + (value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) * vy) }; (*nonlinear*) + assert { value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) * vy + = (value !qp (sx - sy - !i) * vy at StartLoop) }; (*nonlinear*) + value_tail x (sy + !i - 1); + value_sub_concat (pelts x) x.offset xd.offset (x.offset + s); + (* todo refl *) + assert { cy2 = 0 }; + assert { value x !i = value (x at SubProd) !i }; + assert { value x s = value x !i + power radix !i * value xd (sy-1) + by xd.offset = x.offset + !i + so x.offset + s = xd.offset + sy - 1 + so pelts x = pelts xd + so x.offset + s - xd.offset = sy - 1 + so value_sub (pelts x) xd.offset (x.offset + s) + = value xd (sy - 1) + so value x s + = value_sub (pelts x) x.offset xd.offset + + power radix !i * value_sub (pelts x) xd.offset (x.offset + s) + = value x !i + + power radix !i * value xd (sy - 1)}; (*lifted from assertion*) + assert { (value !qp (sx - sy - !i) + qh * power radix (sx - sy - !i)) + * vy + = value !qp (sx - sy - !i) * vy + + qh * vy * power radix (sx - sy - !i) }; (*nonlinear*) + assert { ((value !qp (sx - sy - !i) + qh * power radix (sx - sy - !i)) + * vy at StartLoop) + = (value !qp (sx - sy - !i) * vy + + qh * vy * power radix (sx - sy - !i) at StartLoop) }; (*nonlinear*) + assert { value x s = value x (sy + !i - 1) }; + assert { value (xd at SmallDiv) sy = + vlx + power radix (sy - 2) * xp0 + + power radix (sy - 1) * xp1 }; (*nonlinear*) + assert { value (x at SubProd) (sy + (!i at StartLoop) - 1) + = value (x at SubProd) !i + power radix !i * value (xd at SubProd) sy }; + assert { value (old x) sx = + (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + (*by + value !qp (sx - sy - !i) + = !ql + radix * + value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + so (value_sub (pelts q) ((!qp).offset + 1) + ((!qp).offset + sx - sy - !i) + = value (!qp at StartLoop) + (sx - sy - k) + by + (!qp at StartLoop).offset = (!qp).offset + 1 + so ((!qp).offset + sx - sy - !i) + - ((!qp).offset + 1) + = sx - sy - k + ) + so value !qp (sx - sy - !i) + = !ql + radix * value (!qp at StartLoop) + (sx - sy - k) + so (value x s + = value x !i + + power radix !i + * value xd (sy - 1) + by + xd.offset = x.offset + !i + so x.offset + s = xd.offset + sy - 1 + so pelts x = pelts xd + so x.offset + s - xd.offset = sy - 1 + so value_sub (pelts x) xd.offset (x.offset + s) + = value xd (sy - 1) + so value x s + = value_sub (pelts x) x.offset xd.offset + + power radix !i * value_sub (pelts x) xd.offset (x.offset + s) + = value x !i + + power radix !i * value xd (sy - 1) + ) + so (power radix s + = power radix !i * power radix (sy - 1) + by + let n = !i in + let m = sy - 1 in + let x = radix in + power x s = power x (n + m) + so (power x (n + m) = power x n * power x m + by 0 <= n + so 0 <= m + so forall x:int, n:int, m:int. + 0 <= n -> 0 <= m -> power x (n + m) = (power x n * power x m))) + so (value x s + power radix s * !x1 + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + by + cy2 = 0 + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + so value x s + power radix s * !x1 + = value x !i + + power radix !i + * value xd (sy - 1) + + power radix (!i + sy - 1) * !x1 + = value x !i + + power radix !i + * value xd (sy - 1) + + power radix !i + * power radix (sy - 1) * !x1 + = value x !i + + power radix !i * + (value xd (sy - 1) + + power radix (sy - 1) * !x1) + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + ) + so (value (x at StartLoop) (sy + k - 1) + = value (x at SubProd) !i + + power radix !i + * value (xd at SubProd) sy + by + value (x at StartLoop) (sy + k - 1) + = value_sub (pelts x at SubProd) (x at SubProd).offset + ((x at SubProd).offset + sy + k - 1) + = value_sub (pelts x at SubProd) (x at SubProd).offset xd.offset + + power radix (xd.offset - (x at SubProd).offset) + * value_sub (pelts x at SubProd) xd.offset + ((x at SubProd).offset + sy + k - 1) + so (x at SubProd).offset = x.offset + so xd.offset = x.offset + !i + so value_sub (pelts x at SubProd) (x at SubProd).offset xd.offset + = value (x at SubProd) !i + so power radix (xd.offset - x.offset) = power radix !i + so x.offset + sy + k - 1 - xd.offset = p2i sy + so value_sub (pelts x at SubProd) xd.offset + (x.offset + sy + k - 1) + = value (xd at SubProd) sy + ) + so (value x !i + = value (x at SubProd) !i + ) + so power radix !i * power radix sy = power radix (!i + sy) + so value x s + power radix s * !x1 + - value (x at StartLoop) (sy + k - 1) + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + - (value (x at SubProd) !i + + power radix !i + * value (xd at SubProd) sy) + = value x !i + + power radix !i * + (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy) + - (value x !i + + power radix !i + * value (xd at SubProd) sy) + = power radix !i + * (power radix sy * (!x1 at StartLoop) + - !ql * vy) + = power radix !i * power radix sy * (!x1 at StartLoop) + - power radix !i * !ql * vy + = power radix (!i + sy) * (!x1 at StartLoop) + - power radix !i * !ql * vy + = power radix (sy + k - 1) * (!x1 at StartLoop) + - power radix !i * !ql * vy + so value x s + power radix s * !x1 + = value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + - power radix !i * !ql * vy + so power radix (sx - sy - !i) + = radix * power radix (sx - sy - k) + so radix * power radix !i = power radix k + so (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (!ql + radix * value (!qp at StartLoop) + (sx - sy - k) + + qh * radix * power radix (sx - sy - k)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * radix * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value x s + + power radix s * !x1 + = !ql * vy * power radix !i + + (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + - power radix !i * !ql * vy + = (value (!qp at StartLoop) + (sx - sy - k) + + qh * power radix (sx - sy - k)) + * vy * power radix k + + value (x at StartLoop) (sy + k - 1) + + power radix (sy + k - 1) * (!x1 at StartLoop) + = value (old x) sx *) + }; + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 2); + let ghost vly = value y (p2i sy - 2) in + assert { vy = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh + by (pelts y)[y.offset + sy - 1] = dh + so (pelts y)[y.offset + sy - 2] = dl + so + vy = value y (sy - 1) + + power radix (sy - 1) * dh + = vly + power radix (sy - 2) * dl + + power radix (sy - 1) * dh }; + assert { value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + by + pelts x = pelts xd + so xd.offset = !xp.offset + mdn + so !xp.offset + mdn + sy - 1 = xd.offset + sy - 1 + so + value xd (sy - 1) + = value_sub (pelts xd) xd.offset (xd.offset + sy - 1) + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + - power radix sy * cy2 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + so cy2 = 0 + so value xd (sy - 1) + + power radix (sy - 1) * !x1 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + so !ql * (dl + radix * dh) + + (rl + radix * rh) + = xp0 + + radix * xp1 + + radix * radix * (!x1 at StartLoop) + so vy = vly + power radix (sy - 2) + * (dl + radix * dh) + so !ql * vy + = power radix (sy - 2) * + (xp0 + + radix * xp1 + + radix * radix * (!x1 at StartLoop)) + - power radix (sy - 2) * (rl + radix * rh) + + !ql * vly + so value (xd at SubProd) sy + = vlx + + power radix (sy - 2) * (xp0 + radix * xp1) + so power radix sy + = power radix (sy - 2) * radix * radix + so (value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + < vy + by + (!ql * vly >= 0 + by !ql >= 0 so vly >= 0) + so (power radix (sy - 2) * (rl + radix * rh) + <= power radix (sy - 2) + * (dl + radix * dh) + - power radix (sy - 2) + by + rl + radix * rh <= dl + radix * dh - 1 + so power radix (sy - 2) >= 0 + so power radix (sy - 2) * (rl + radix * rh) + <= power radix (sy - 2) + * (dl + radix * dh - 1) + = power radix (sy - 2) + * (dl + radix * dh) + - power radix (sy - 2) + ) + so vlx < power radix (sy - 2) + so value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = vlx + + power radix (sy - 2) * (xp0 + radix * xp1) + + power radix sy * (!x1 at StartLoop) + - !ql * vy + = vlx + + power radix (sy - 2) * + (xp0 + radix * xp1 + + radix * radix * (!x1 at StartLoop)) + - !ql * vy + = vlx + + power radix (sy - 2) * + (xp0 + radix * xp1 + + radix * radix * (!x1 at StartLoop)) + - (power radix (sy - 2) * + (xp0 + + radix * xp1 + + radix * radix * (!x1 at StartLoop)) + - power radix (sy - 2) * (rl + radix * rh) + + !ql * vly) + = vlx + + power radix (sy - 2) * (rl + radix * rh) + - !ql * vly + <= vlx + + power radix (sy - 2) * (rl + radix * rh) + <= vlx + + power radix (sy - 2) + * (dl + radix * dh) + - power radix (sy - 2) + < power radix (sy - 2) + + power radix (sy - 2) + * (dl + radix * dh) + - power radix (sy - 2) + = power radix (sy - 2) * (dl + radix * dh) + = vy - vly <= vy + ) + so value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + = value xd (sy - 1) + + power radix (sy - 1) * !x1 + = value (xd at SubProd) sy + + power radix sy * (!x1 at StartLoop) + - !ql * vy + < vy + }; + value_sub_tail (pelts x) (!xp.offset + p2i mdn) (!xp.offset); + value_sub_upper_bound (pelts y) (y.offset) (y.offset + p2i sy - 2); + value_sub_lower_bound (pelts x) (!xp.offset + p2i mdn) (!xp.offset); + assert { dl + radix * dh + >= (pelts x)[(!xp).offset] + radix * !x1 + by + vy = vly + power radix (sy - 2) + * (dl + radix * dh) + so value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + < vy + so !xp.offset + mdn + sy - 1 = !xp.offset + 1 + so power radix (sy - 1) = power radix (sy - 2) * radix + so - mdn = sy - 2 + so vy + > value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + mdn + sy - 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) + (!xp.offset + 1) + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (- mdn) * (pelts x)[(!xp).offset] + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) * (pelts x)[(!xp).offset] + + power radix (sy - 1) * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) * (pelts x)[(!xp).offset] + + power radix (sy - 2) * radix * !x1 + = value_sub (pelts x) (!xp.offset + mdn) (!xp.offset) + + power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + >= power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + so vly < power radix (sy - 2) + so vy < power radix (sy - 2) + + power radix (sy - 2) + * (dl + radix * dh) + = power radix (sy - 2) + * (1 + dl + radix * dh) + so power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1) + < power radix (sy - 2) * (1 + dl + radix * dh) + so power radix (sy - 2) + * ((pelts x)[(!xp).offset] + radix * !x1 + - (1 + dl + radix * dh)) + < 0 + so (pelts x)[(!xp).offset] + radix * !x1 + - (1 + dl + radix * dh) + < 0 + }; + end; + end; + done; + label EndLoop in + assert { !i = 0 }; + assert { !xp.offset = x.offset + sy - 2 }; + value_sub_update_no_change (pelts x) (!xp.offset + 1) + x.offset (!xp.offset) !x1; + C.set_ofs !xp 1 !x1; + assert { value x (sy - 1) = + value (x at EndLoop) (sy - 1) + by pelts x = Map.set (pelts x at EndLoop) (x.offset + sy - 1) !x1 }; + value_sub_tail (pelts x) x.offset (!xp.offset+1); + (* todo refl *) + assert { value (old x) sx = + (value q (sx - sy) + + power radix (sx - sy) * qh) + * value y sy + + value x sy + by + value x sy + = value x (sy - 1) + + power radix (sy - 1) * !x1 + so vy = value y sy + so value (old x) sx + = (value !qp (sx - sy - !i) + + qh * power radix (sx - sy - !i)) + * vy * power radix !i + + value x (sy + !i - 1) + + power radix (sy + !i - 1) * !x1 + = (value !qp (sx - sy) + + qh * power radix (sx - sy)) + * vy * 1 + + value x (sy - 1) + + power radix (sy - 1) * !x1 + = (value !qp (sx - sy) + + qh * power radix (sx - sy)) + * value y sy + + value x sy }; + qh + + let divmod_2 (q x y:t) (sx:int32) : limb + requires { 2 <= sx } + requires { valid x sx } + requires { valid y 2 } + requires { valid q (sx - 2) } + requires { (pelts y)[y.offset + 1] >= div radix 2 } + ensures { value (old x) sx = + (value q (sx - 2) + + power radix (sx - 2) * result) + * value y 2 + + value x 2 } + ensures { value x 2 < value y 2 } + ensures { 0 <= result <= 1 } + = + let one = Int32.of_int 1 in + let zero = Int32.of_int 0 in + let two = Int32.of_int 2 in + let uzero = Limb.of_int 0 in + let uone = Limb.of_int 1 in + let xp = ref (C.incr x (Int32.(-) sx two)) in + let dh = C.get_ofs y one in + let dl = C.get y in + let rh = ref (C.get_ofs !xp one) in + let rl = ref (C.get !xp) in + let qh = ref uzero in + let lx = ref uzero in + assert { value y 2 = dl + radix * dh }; + let i = ref (Int32.(-) sx two) in + let dinv = reciprocal_word_3by2 dh dl in + ([@vc:sp] if (Limb.(>=) !rh dh && ([@vc:sp] Limb.(>) !rh dh || Limb.(>=) !rl dl)) + then + label Adjust in + begin + ensures { value x sx + = (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) } + ensures { !rl + radix * !rh < dl + radix * dh } + ensures { !qh = 1 } + let (r0, b) = sub_with_borrow !rl dl uzero in + let (r1, ghost b') = sub_with_borrow !rh dh b in + assert { b' = 0 }; + assert { r0 + radix * r1 = !rl + radix * !rh - (dl + radix * dh) }; + value_sub_tail (pelts x) x.offset (x.offset + p2i sx - 1); + value_sub_tail (pelts x) x.offset (x.offset + p2i sx - 2); + rh := r1; + rl := r0; + qh := uone; + assert { value x sx + = (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) + by + value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) = 0 + so (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) + = value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) + = value x !i + + power radix !i * (dl + radix * dh + !rl + radix * !rh) + = value x !i + + power radix !i * (!rl at Adjust + radix * !rh at Adjust) + = value x !i + + power radix !i * !rl at Adjust + + power radix (!i+1) * !rh at Adjust + = value x sx + }; + end + else + begin + ensures { value x sx + = (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) } + ensures { !rl + radix * !rh < dl + radix * dh } + ensures { !qh = 0 } + value_sub_tail (pelts x) x.offset (x.offset + p2i sx - 1); + value_sub_tail (pelts x) x.offset (x.offset + p2i sx - 2); + end); + while (Int32.(>) !i zero) do + variant { p2i !i } + invariant { 0 <= !i <= sx - 2 } + invariant { !xp.offset = x.offset + !i } + invariant { plength !xp = plength x } + invariant { !xp.min = x.min } + invariant { !xp.max = x.max } + invariant { pelts !xp = pelts x } + invariant { value x sx + = (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) } + invariant { !rl + radix * !rh < dl + radix * dh } + label StartLoop in + let ghost k = p2i !i in + xp.contents <- C.incr !xp (-1); + lx := C.get !xp; + label Got in + let (qu, r0, r1) = div3by2_inv !rh !rl !lx dh dl dinv in + rh := r1; + rl := r0; + i := Int32.(-) !i one; + C.set_ofs q !i qu; + assert { qu * (dl + radix * dh) + r0 + radix * r1 + = !lx + radix * (!rl at StartLoop) + + radix * radix * (!rh at StartLoop) + by + radix * ((!rl at StartLoop) + radix * (!rh at StartLoop)) + = radix * (!rl at StartLoop) + radix * radix * (!rh at StartLoop) + so + qu * (dl + radix * dh) + r0 + radix * r1 + = !lx + radix * ((!rl at StartLoop) + radix * (!rh at StartLoop)) + = !lx + radix * (!rl at StartLoop) + + radix * radix * (!rh at StartLoop) + }; + value_sub_head (pelts q) (q.offset + p2i !i) (q.offset + p2i sx - 2); + value_sub_tail (pelts x) x.offset (x.offset + p2i !i); + assert { value x sx + = (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) + by + value x k = value x !i + power radix !i * !lx + so value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + = qu + radix + * value_sub (pelts q) (q.offset + k) (q.offset + sx - 2) + so power radix (sx - 2 - !i) = radix * power radix (sx - 2 - k) + so + (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + = qu + radix + * (value_sub (pelts q) (q.offset + k) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + so power radix !i * radix = power radix k + so ((value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + = power radix !i * qu * (dl + radix * dh) + + (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + by + (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + = (qu + radix + * (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k))) + * value y 2 * power radix !i + = power radix !i * qu * (dl + radix * dh) + + radix * (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix !i + = power radix !i * qu * (dl + radix * dh) + + (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k) + so (value_sub (pelts q) (q.offset + !i) (q.offset + sx - 2) + + !qh * power radix (sx - 2 - !i)) + * value y 2 * power radix !i + + value x !i + + power radix !i * (!rl + radix * !rh) + = power radix !i * qu * (dl + radix * dh) + + (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + + value x !i + + power radix !i * (!rl + radix * !rh) + = (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + + value x !i + + power radix !i * (qu * (dl + radix * dh) + + !rl + radix * !rh) + = (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + + value x !i + + power radix !i + * (!lx + radix * (!rl at StartLoop) + + radix * radix * (!rh at StartLoop)) + = (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + + value x !i + + power radix !i * !lx + + power radix !i * (radix * (!rl at StartLoop + + radix * !rh at StartLoop)) + = (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + + value x k + + power radix !i * (radix * (!rl at StartLoop + + radix * !rh at StartLoop)) + = (value_sub (pelts q) (q.offset + k) + (q.offset + sx - 2) + + !qh * power radix (sx - 2 - k)) + * value y 2 * power radix k + + value x k + + power radix k * (!rl at StartLoop + + radix * !rh at StartLoop) + = value x sx + }; + done; + assert { !i = 0 }; + assert { value x sx + = (value_sub (pelts q) q.offset (q.offset + sx - 2) + + !qh * power radix (sx - 2)) + * value y 2 + + !rl + radix * !rh + by power radix !i = 1 }; + C.set_ofs x one !rh; + C.set x !rl; + assert { value x 2 = !rl + radix * !rh + by (pelts x)[x.offset] = !rl + /\ (pelts x)[x.offset + 1] = !rh}; + !qh + + +(* val sub_limb_in_place (x:t) (y:limb) (sz:int32) : limb*) + + (** [div_qr q r x y sx sy] divides [(x,sx)] by [(y,sy)], writes the quotient + in [(q, (sx-sy))] and the remainder in [(r, sy)]. Corresponds to + [mpn_tdiv_qr]. *) + let div_qr (q r x y nx ny:t) (sx sy:int32) : unit + requires { 1 <= sy <= sx <= (Int32.max_int32 - 1) } + requires { valid x sx } + requires { valid y sy } + requires { valid q (sx - sy + 1) } + requires { valid r sy } + requires { valid nx (sx + 1) } + requires { valid ny sy } + requires { (pelts y)[y.offset + sy - 1] > 0 } + ensures { value x sx + = value q (sx - sy + 1) * value y sy + + value r sy } + ensures { value r sy < value y sy } + = + label Start in + let one = Int32.of_int 1 in + let limb_zero = Limb.of_int 0 in + let zero = Int32.of_int 0 in + let two = Int32.of_int 2 in + value_sub_tail (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_lower_bound (pelts y) y.offset (y.offset + p2i sy - 1); + assert { value y sy >= power radix (sy - 1) }; + if (Int32.(=) sy one) + then + let lr = divmod_1 q x (C.get y) sx in + C.set r lr + else + if (Int32.(=) sy two) + then + let clz = clz_ext (C.get_ofs y (Int32.(-) sy one)) in + let ghost p = power 2 (p2i clz) in + if Int32.(=) clz zero + then begin + copy nx x sx; + value_sub_shift_no_change (pelts x) x.offset (p2i sx) (p2i sx) limb_zero; + C.set_ofs nx sx limb_zero; + value_sub_frame_shift (pelts x) (pelts nx) x.offset nx.offset (p2i sx); + label Div2_ns in + let ghost _qh = divmod_2 q nx y (Int32.(+) sx one) in + copy r nx sy; + assert { value x sx + = value q (sx - sy + 1) * value y sy + + value r sy + by value r sy = value nx sy + so value (nx at Div2_ns) (sx + 1) < power radix sx + so value (nx at Div2_ns) (sx + 1) + = value (nx at Div2_ns) sx + so (_qh = 0 + by + power radix sx + > value (nx at Div2_ns) (sx + 1) + = (value q (sx - 1) + power radix (sx - 1) * _qh) + * value y 2 + + value nx 2 + so value nx 2 >= 0 + so value y 2 >= radix + so value q (sx - 1) >= 0 + so _qh >= 0 + so (value q (sx - 1) + + power radix (sx - 1) * _qh) >= 0 + so (value q (sx - 1) + power radix (sx - 1) * _qh) + * value y 2 + + value nx 2 + >= (value q (sx - 1) + + power radix (sx - 1) * _qh) + * value y 2 + >= (value q (sx - 1) + + power radix (sx - 1) * _qh) + * radix + >= power radix (sx - 1) * _qh * radix + = power radix sx * _qh + so power radix sx > power radix sx * _qh + ) + so value x sx = value (nx at Div2_ns) sx + }; + () + end + else begin + let ghost _c = lshift ny y sy (Limb.of_int32 clz) in + begin + ensures { normalized ny sy } + ensures { value ny sy = power 2 clz * value y sy } + let ghost dh = (pelts y)[y.offset + p2i sy - 1] in + assert { value y sy + = value y (sy - 1) + power radix (sy - 1) * dh }; + value_sub_upper_bound (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts ny) ny.offset (ny.offset + p2i sy - 1); + value_sub_upper_bound (pelts ny) ny.offset (ny.offset + p2i sy - 1); + let ghost ndh = (pelts ny)[ny.offset + p2i sy - 1] in + assert { normalized ny sy + /\ value ny sy = power 2 clz * value y sy + by + value y sy < (dh + 1) * power radix (sy - 1) + so value ny sy + (power radix sy) * _c + = power 2 clz * value y sy + = power 2 clz + * (value y (sy - 1) + + dh * power radix (sy - 1)) + so power 2 clz * dh <= radix - power 2 clz + so value ny sy + (power radix sy) * _c + = power 2 clz * value y (sy - 1) + + power 2 clz * dh * power radix (sy - 1) + < power 2 clz * power radix (sy - 1) + + power 2 clz * dh * power radix (sy - 1) + <= power 2 clz * power radix (sy - 1) + + (radix - power 2 clz) * power radix (sy - 1) + = radix * power radix (sy - 1) + = power radix sy + so _c = 0 + so value ny sy + = power 2 clz * value y sy + so value y sy >= dh * power radix (sy - 1) + so value ny sy + >= power 2 clz * dh * power radix (sy - 1) + so value ny sy = + value ny (sy - 1) + power radix (sy - 1) * ndh + < power radix (sy - 1) + power radix (sy - 1) * ndh + = power radix (sy - 1) * (ndh + 1) + so power radix (sy - 1) * (ndh + 1) + > power radix (sy - 1) * (power 2 clz * dh) + so ndh + 1 > power 2 clz * dh + so ndh >= power 2 clz * dh + so 2 * power 2 clz * dh >= radix + so 2 * ndh >= radix + so ndh >= div radix 2 + }; + end; + let h = lshift nx x sx (Limb.of_int32 clz) in + C.set_ofs nx sx h; + begin + ensures { value nx (sx + 1) + = p * value x sx } + value_sub_tail (pelts nx) nx.offset (nx.offset + p2i sx); + assert { value nx (sx + 1) + = p * value x sx + by + value nx sx + power radix sx * h + = p * value x sx + so value nx (sx + 1) + = value nx sx + power radix sx * h + } + end; + label Div2_s in + (* TODO don't add 1 when not needed, cf "adjust" in GMP algo *) + let ghost _qh = divmod_2 q nx ny (Int32.(+) sx one) in + let ghost _l = rshift r nx sy (Limb.of_int32 clz) in + begin ensures { value nx 2 = p * value r 2 } + assert { _l = 0 + by + (mod (value nx sy) p = 0 + by + value (nx at Div2_s) (sx + 1) + = (value q (sx - 1) + power radix (sx - 1) * _qh) + * value ny sy + + value nx sy + so value (nx at Div2_s) (sx + 1) + = p * value x sx + so value ny sy = p * value y sy + so value nx sy + = value (nx at Div2_s) (sx + 1) + - (value q (sx - 1) + + power radix (sx - 1) * _qh) + * value ny sy + = p * value x sx + - p * (value q (sx - 1) + + power radix (sx - 1) * _qh) + * value y sy + = p * (value x sx + - (value q (sx - 1) + + power radix (sx - 1) * _qh) + * value y sy) + so let n = (value x sx + - (value q (sx - 1) + + power radix (sx - 1) * _qh) + * value y sy) + in + value nx sy = p * n + so value nx sy >= 0 + so p > 0 + so n >= 0 + so mod (value nx sy) p + = mod (p * n) p + = mod ((p*n)+0) p + = mod 0 p + = 0 + ) + so _l + radix * value r sy + = power 2 (Limb.length - clz) * (value nx sy) + so let a = div (value nx sy) p in + value nx sy = p * a + so power 2 (Limb.length - clz) * p = radix + so power 2 (Limb.length - clz) * (value nx sy) + = power 2 (Limb.length - clz) * (p * a) + = (power 2 (Limb.length - clz) * p) * a + = radix * a + so mod (radix * value r sy + _l) radix + = mod _l radix + so mod (radix * value r sy + _l) radix + = mod (radix * a) radix = 0 + so mod _l radix = 0 + so 0 <= _l < radix + }; + assert { value nx 2 = p * value r 2 + by + radix * value r 2 + = power 2 (Limb.length - clz) * value nx 2 + so p * power 2 (Limb.length - clz) + = radix + so p * radix * value r 2 + = p * power 2 (Limb.length - clz) * value nx 2 + = radix * value nx 2 + so p * value r 2 = value nx 2 + } + end; + assert { value x sx + = value q (sx - sy + 1) * value y sy + + value r sy + by + value (nx at Div2_s) (sx + 1) + = (value q (sx - 1) + power radix (sx - 1) * _qh) + * value ny 2 + + value nx 2 + so value (nx at Div2_s) (sx + 1) + = p * value x sx + so value ny 2 = p * value y 2 + so (_qh = 0 + by + value x sx < power radix sx + so value y 2 >= radix + so value ny 2 >= p * radix + so value q (sx - 1) >= 0 + so value nx 2 >= 0 + so (value q (sx - 1) + power radix (sx - 1) * _qh) + >= 0 + so (value q (sx - 1) + power radix (sx - 1) * _qh) + * value ny 2 + + value nx 2 + >= (value q (sx - 1) + + power radix (sx - 1) * _qh) + * value ny 2 + >= (value q (sx - 1) + + power radix (sx - 1) * _qh) + * (p * radix) + >= power radix (sx - 1) * _qh * p * radix + = power radix sx * p * _qh + so power radix sx * p + > value (nx at Div2_s) (sx + 1) + >= power radix sx * p * _qh + ) + so value nx 2 = p * value r 2 + so p * value x sx + = value q (sx - 1) * p * value y 2 + + p * value r 2 + = p * (value q (sx - 1) * value y 2 + + value r 2) + }; + () + end + else + (* let qn = ref (Int32.(-) (Int32.(+) sx one) sy) in + if (Int32.(>=) (Int32.(+) !qn !qn) sx) + then*) begin + let adjust = + if Limb.(>=) (get_ofs x (Int32.(-) sx one)) + (get_ofs y (Int32.(-) sy one)) + then one + else zero + in + let clz = clz_ext (C.get_ofs y (Int32.(-) sy one)) in + let ghost p = power 2 (p2i clz) in + if Int32.(=) clz zero + then begin + copy nx x sx; + value_sub_shift_no_change (pelts x) x.offset + (p2i sx) (p2i sx) limb_zero; + C.set_ofs nx sx limb_zero; + value_sub_frame_shift (pelts x) (pelts nx) x.offset nx.offset (p2i sx); + assert { value y sy * (power radix (sx - sy + adjust)) + > value nx (sx + adjust) + by + let dh = (pelts y)[y.offset + sy - 1] in + value y sy >= dh * power radix (sy - 1) + so value nx (sx + adjust) = value nx sx = value x sx + so [@case_split] + ((adjust = 1 + so value x sx < power radix sx + so value y sy * power radix (sx - sy + adjust) + >= dh * power radix (sy - 1) + * power radix (sx - sy + adjust) + = dh * power radix ((sy - 1) + (sx - sy + adjust)) + = dh * power radix sx + so dh >= div radix 2 > 1 + so dh * power radix sx > power radix sx ) + \/ + (adjust = 0 + so let ah = (pelts x)[x.offset + sx - 1] in + value x sx < (ah + 1) * power radix (sx - 1) + so ah + 1 <= dh + so value x sx < dh * power radix (sx - 1) + so value y sy * power radix (sx - sy + adjust) + = value y sy * power radix (sx - sy) + >= dh * power radix (sy - 1) + * power radix (sx - sy) + = dh * power radix (sy - 1 + sx - sy) + = dh * power radix (sx - 1))) }; + label Div_ns in + let ghost _qh = div_sb_qr q nx y (Int32.(+) sx adjust) sy in + copy r nx sy; + assert { value x sx + = value q (sx - sy + adjust) * value y sy + + value r sy + by value r sy = value nx sy + so value (nx at Div_ns) (sx + adjust) = value x sx < power radix sx + so value (nx at Div_ns) (sx + adjust) + = value (nx at Div_ns) sx + so (_qh = 0 + by + value (nx at Div_ns) (sx + adjust) + = (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value y sy + + value nx sy + so value nx sy >= 0 + so value q (sx - sy + adjust) >= 0 + so _qh >= 0 + so (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) >= 0 + so (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value y sy + + value nx sy + >= (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value y sy + >= power radix (sx - sy + adjust) * _qh * value y sy + so _qh <> 1) + so value x sx = value (nx at Div_ns) sx + }; + label Ret_ns in + begin + ensures { value q (sx - sy + 1) + = value (q at Ret_ns) (sx - sy + adjust) } + if (Int32.(=) adjust zero) + then begin + value_sub_shift_no_change (pelts x) x.offset + (p2i sx) (p2i sx) limb_zero; + set_ofs q (Int32.(-) sx sy) limb_zero; + value_sub_tail (pelts q) q.offset (q.offset + p2i sx - p2i sy); + () + end + end + end + else begin + let ghost _c = lshift ny y sy (Limb.of_int32 clz) in + begin + ensures { normalized ny sy } + ensures { value ny sy + = power 2 clz * value y sy } + let ghost dh = (pelts y)[y.offset + p2i sy - 1] in + assert { value y sy + = value y (sy - 1) + power radix (sy - 1) * dh }; + value_sub_upper_bound (pelts y) y.offset (y.offset + p2i sy - 1); + value_sub_tail (pelts ny) ny.offset (ny.offset + p2i sy - 1); + value_sub_upper_bound (pelts ny) ny.offset (ny.offset + p2i sy - 1); + let ghost ndh = (pelts ny)[ny.offset + p2i sy - 1] in + assert { normalized ny sy + /\ value ny sy + = power 2 clz * value y sy + by + value y sy < (dh + 1) * power radix (sy - 1) + so value ny sy + (power radix sy) * _c + = power 2 clz * value y sy + = power 2 clz + * (value y (sy - 1) + + dh * power radix (sy - 1)) + so power 2 clz * dh <= radix - power 2 clz + so (_c = 0 + by + value ny sy + (power radix sy) * _c + = power 2 clz * value y (sy - 1) + + power 2 clz * dh * power radix (sy - 1) + < power 2 clz * power radix (sy - 1) + + power 2 clz * dh * power radix (sy - 1) + <= power 2 clz * power radix (sy - 1) + + (radix - power 2 clz) * power radix (sy - 1) + = radix * power radix (sy - 1) + = power radix sy + so value ny sy >= 0 + so power radix sy * _c < power radix sy + so power radix sy > 0 + so _c >= 0 + ) + so value ny sy + = power 2 clz * value y sy + so value y sy >= dh * power radix (sy - 1) + so value ny sy + >= power 2 clz * dh * power radix (sy - 1) + so value ny sy = + value ny (sy - 1) + power radix (sy - 1) * ndh + < power radix (sy - 1) + power radix (sy - 1) * ndh + = power radix (sy - 1) * (ndh + 1) + so power radix (sy - 1) * (ndh + 1) + > power radix (sy - 1) * (power 2 clz * dh) + so ndh + 1 > power 2 clz * dh + so ndh >= power 2 clz * dh + so 2 * power 2 clz * dh >= radix + so 2 * ndh >= radix + so ndh >= div radix 2 + }; + end; + let h = lshift nx x sx (Limb.of_int32 clz) in + label Shifted in + C.set_ofs nx sx h; + begin + ensures { value nx (sx + adjust) + = p * value x sx } + if (Int32.(=) adjust one) + then begin + value_sub_tail (pelts nx) nx.offset (nx.offset + p2i sx); + assert { value nx (sx + 1) + = p * value x sx + by + value nx sx + power radix sx * h + = p * value x sx + so value nx (sx + 1) + = value nx sx + power radix sx * h + } end + else begin + assert { adjust = 0 }; + assert { h = 0 + by + let dh = (pelts y)[y.offset + sy - 1] in + let ah = (pelts x)[x.offset + sx - 1] in + p * dh < radix + so 0 <= ah <= dh + so p * ah < radix + so (p * ah <= radix - p + by + let q = power 2 (Limb.length - clz) in + radix = p * q + so p * ah < p * q + so ah < q + so ah <= q - 1 + so p * ah <= p * (q - 1) = radix - p + ) + so p * (ah + 1) <= radix + so let s = power radix (sx - 1) in + value x sx < (ah + 1) * s + so p * value x sx < p * (ah + 1) * s + so (p * (ah + 1) * s + <= radix * s + by + [@case_split] + (p * (ah + 1) = radix + \/ (p * (ah + 1) < radix + so s > 0 + so p * (ah + 1) * s + < radix * s))) + so radix * power radix (sx - 1) = power radix sx + so value (nx at Shifted) sx + power radix sx * h + < power radix sx + so power radix sx * h < power radix sx * 1 + so (h < 1 by power radix sx > 0) + } + end + end; + label Div_s in + assert { value ny sy * (power radix (sx - sy + adjust)) + > value nx (sx + adjust) + by + let dh = (pelts y)[y.offset + sy - 1] in + value ny sy >= p * dh * power radix (sy - 1) + so value nx (sx + adjust) = p * value x sx + so p > 0 + so [@case_split] + ((adjust = 1 + so value x sx < power radix sx + so p * value x sx < p * power radix sx + so value ny sy * power radix (sx - sy + adjust) + >= p * dh * power radix (sy - 1) + * power radix (sx - sy + adjust) + = p * dh * power radix ((sy - 1) + (sx - sy + adjust)) + = p * dh * power radix sx + so dh >= 1 + so p * dh * power radix sx >= p * power radix sx ) + \/ + (adjust = 0 + so let ah = (pelts x)[x.offset + sx - 1] in + value x sx < (ah + 1) * power radix (sx - 1) + so ah + 1 <= dh + so value x sx < dh * power radix (sx - 1) + so p * value x sx < p * dh * power radix (sx - 1) + so value ny sy * power radix (sx - sy + adjust) + = value ny sy * power radix (sx - sy) + >= p * dh * power radix (sy - 1) + * power radix (sx - sy) + = p * dh * power radix (sy - 1 + sx - sy) + = p * dh * power radix (sx - 1))) }; + let ghost _qh = div_sb_qr q nx ny (Int32.(+) sx adjust) sy in + let ghost _l = rshift r nx sy (Limb.of_int32 clz) in + begin ensures { value nx sy = p * value r sy } + assert { _l = 0 + by + (mod (value nx sy) p = 0 + by + value (nx at Div_s) (sx + adjust) + = (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value ny sy + + value nx sy + so value (nx at Div_s) (sx + adjust) + = p * value x sx + so value ny sy = p * value y sy + so value nx sy + = value (nx at Div_s) (sx + adjust) + - (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value ny sy + = p * value x sx + - p * (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value y sy + = p * (value x sx + - (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value y sy) + so let n = (value x sx + - (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value y sy) + in + value nx sy = p * n + so value nx sy >= 0 + so p > 0 + so n >= 0 + so mod (value nx sy) p + = mod (p * n) p + = mod ((p*n)+0) p + = mod 0 p + = 0 + ) + so _l + radix * value r sy + = power 2 (Limb.length - clz) * (value nx sy) + so let a = div (value nx sy) p in + value nx sy = p * a + so power 2 (Limb.length - clz) * p = radix + so power 2 (Limb.length - clz) * (value nx sy) + = power 2 (Limb.length - clz) * (p * a) + = (power 2 (Limb.length - clz) * p) * a + = radix * a + so mod (radix * value r sy + _l) radix + = mod _l radix + so mod (radix * value r sy + _l) radix + = mod (radix * a) radix = 0 + so mod _l radix = 0 + so 0 <= _l < radix + }; + assert { value nx sy = p * value r sy + by + radix * value r sy + = power 2 (Limb.length - clz) * value nx sy + so p * power 2 (Limb.length - clz) + = radix + so p * radix * value r sy + = p * power 2 (Limb.length - clz) * value nx sy + = radix * value nx sy + so p * value r sy = value nx sy + } + end; + assert { value x sx + = value q (sx - sy + adjust) * value y sy + + value r sy + by + value (nx at Div_s) (sx + adjust) + = (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value ny sy + + value nx sy + so value (nx at Div_s) (sx + adjust) + = p * value x sx + so power radix (sx - sy + 1) * power radix (sy - 1) + = power radix sx + so value ny sy = p * value y sy + so (_qh = 0 + by + value (nx at Div_s) (sx + adjust) + = (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value ny sy + + value nx sy + so value nx sy >= 0 + so value q (sx - sy + adjust) >= 0 + so _qh >= 0 + so (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) >= 0 + so (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value ny sy + + value nx sy + >= (value q (sx - sy + adjust) + + power radix (sx - sy + adjust) * _qh) + * value ny sy + >= power radix (sx - sy + adjust) * _qh * value ny sy + so _qh <> 1) + so value nx sy = p * value r sy + so p * value x sx + = value q (sx - sy + adjust) * p * value y sy + + p * value r sy + = p * (value q (sx - sy + adjust) + * value y sy + + value r sy) + }; + label Ret_s in + begin + ensures { value q (sx - sy + 1) + = value (q at Ret_s) (sx - sy + adjust) } + if (Int32.(=) adjust zero) + then begin + value_sub_shift_no_change (pelts x) x.offset + (p2i sx) (p2i sx) limb_zero; + set_ofs q (Int32.(-) sx sy) limb_zero; + value_sub_tail (pelts q) q.offset (q.offset + p2i sx - p2i sy); + assert { value q (sx - sy + 1) = value (q at Ret_s) (sx - sy) + by value q (sx - sy + 1) + = value (q at Ret_s) (sx - sy) + power radix (sx - sy) * 0 + = value (q at Ret_s) (sx - sy) } + end + end; + () + end + end + (* else begin + let dn = Int32.(+) !qn one in + let dqn = Int32.(+) !qn !qn in + let ign = Int32.(-) sy dn in + let ix = C.incr nx (Int32.(-) sx dqn) in + let iy = C.incr y ign in + let clz = clz_ext (C.get_ofs y (Int32.(-) sy one)) in + (*let ghost p = power 2 (p2i clz) in*) + (if Int32.(=) clz zero + then begin + copy nx x sx; + C.set_ofs nx sx limb_zero; + ( + if (Int32.(=) dn two) + then + let _d1 = divmod_2 q ix iy (Int32.(+) dqn one) in () + else + let _s1 = div_sb_qr q ix iy (Int32.(+) dqn one) dn in () + ) + end + else begin + let _ = lshift ny y sy (Limb.of_int32 clz) in + let h = lshift nx x sx (Limb.of_int32 clz) in + C.set_ofs nx sx h; + begin + if (Int32.(=) dn two) + then + let _d2 = divmod_2 q ix (incr ny ign) (Int32.(+) dqn one) in () + else + let _s2 = div_sb_qr q ix (incr ny ign) (Int32.(+) dqn one) dn in () + end + end); + (* we have an estimated q, adjust by at most 1 *) + let dl = ref limb_zero in + let st = Int32.(-) sy one in + let snx = Int32.(+) sx one in + let tp = C.malloc (UInt32.of_int32 st) in + mul tp q ny !qn ign; + let b = sub_in_place nx tp snx st in + (if Limb.(>) b limb_zero + then (* quotient too large *) + let _s = sub_limb_in_place q (Limb.of_int 1) (!qn) in + let _a = add_in_place nx ny snx sy in + () + else ()); + if Int32.(=) clz zero + then begin copy r nx sy end + else let _r = rshift r nx sy (Limb.of_int32 clz) in (); + C.free tp; + () + end*) + + let tdiv_qr (q r x y:t) (sx sy:int32) : unit + requires { 1 <= sy <= sx <= (Int32.max_int32 - 1) } + requires { valid x sx } + requires { valid y sy } + requires { valid q (sx - sy + 1) } + requires { valid r sy } + requires { (pelts y)[y.offset + sy - 1] > 0 } + ensures { value x sx + = value q (sx - sy + 1) * value y sy + + value r sy } + ensures { value r sy < value y sy } + diverges + = + let uone = UInt32.of_int 1 in + let nx = malloc (UInt32.(+) (UInt32.of_int32 sx) uone) in + c_assert (is_not_null nx); + let ny = malloc (UInt32.of_int32 sy) in + c_assert (is_not_null ny); + div_qr q r x y nx ny sx sy; + free nx; + free ny; + +end \ No newline at end of file diff --git a/examples/multiprecision/div/why3session.xml b/examples/multiprecision/div/why3session.xml new file mode 100644 index 0000000000000000000000000000000000000000..400b55d67bc824d19d669f88ffb671b8c3cce274 --- /dev/null +++ b/examples/multiprecision/div/why3session.xml @@ -0,0 +1,10635 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multiprecision/div/why3shapes.gz b/examples/multiprecision/div/why3shapes.gz new file mode 100644 index 0000000000000000000000000000000000000000..0f30d444872710aa0a6ddcdb2a636438b0ca460b Binary files /dev/null and b/examples/multiprecision/div/why3shapes.gz differ diff --git a/examples/multiprecision/lemmas.mlw b/examples/multiprecision/lemmas.mlw new file mode 100644 index 0000000000000000000000000000000000000000..f2abb6ebbbdd765be31e5fa685c455163d5150d6 --- /dev/null +++ b/examples/multiprecision/lemmas.mlw @@ -0,0 +1,207 @@ +module Lemmas + + use import array.Array + use import map.Map + use map.MapEq + use map.Const + use import int.Int + + (** {3 complements to map standard library} *) + + predicate map_eq_sub_shift (x y:map int 'a) (xi yi sz:int) = + forall i. 0 <= i < sz -> x[xi+i] = y[yi+i] + + let lemma map_eq_shift (x y:map int 'a) (xi yi sz k:int) + requires { map_eq_sub_shift x y xi yi sz } + requires { 0 <= k < sz } + ensures { x[xi+k] = y[yi+k] } + = () + + let rec lemma map_eq_shift_zero (x y: map int 'a) (n m: int) + requires { map_eq_sub_shift x y n n (m-n) } + variant { m - n } + ensures { MapEq.map_eq_sub x y n m } + = + if n < m then + begin + assert { forall i. 0 <= i < m-n -> x[n+i] = y[n+i] }; + assert { forall i. n <= i < m -> + let j = i - n in 0 <= j < m-n -> + x[n+j] = y[n+j] -> x[i] = y[i]}; + map_eq_shift_zero x y (n+1) m; + end + else () + + use import mach.int.Int32 + use import ref.Ref + use import mach.int.UInt64GMP as Limb + use import int.Int + use import int.Power + use import mach.c.C + use import types.Types + + meta compute_max_steps 0x100000 + + (** {3 Long integers as arrays of libs} *) + + lemma limb_max_bound: 1 <= max_uint64 + + function l2i (x:limb) : int = Limb.to_int x + + function p2i (i:int32) : int = int32'int i + + let lemma prod_compat_strict_r (a b c:int) + requires { 0 <= a < b } + requires { 0 < c } + ensures { c * a < c * b } + = () + let lemma prod_compat_r (a b c:int) + requires { 0 <= a <= b } + requires { 0 <= c } + ensures { c * a <= c * b } + = () + + (** {3 Integer value of a natural number} *) + + (** [value_sub x n m] denotes the integer represented by + the digits x[n..m-1] with lsb at index n *) + let rec ghost function value_sub (x:map int limb) (n:int) (m:int) : int + variant {m - n} + = + if n < m then + l2i x[n] + radix * value_sub x (n+1) m + else 0 + + let rec lemma value_sub_frame (x y:map int limb) (n m:int) + requires { MapEq.map_eq_sub x y n m } + variant { m - n } + ensures { value_sub x n m = value_sub y n m } + = + if n < m then value_sub_frame x y (n+1) m else () + + let rec lemma value_sub_frame_shift (x y:map int limb) (xi yi sz:int) + requires { map_eq_sub_shift x y xi yi sz } + variant { sz } + ensures { value_sub x xi (xi+sz) = value_sub y yi (yi+sz) } + = + if sz>0 + then begin + map_eq_shift x y xi yi sz 0; + assert { forall i. 0 <= i < sz-1 -> + let j = 1+i in x[xi+j] = y[yi+j] }; + value_sub_frame_shift x y (xi+1) (yi+1) (sz-1) + end + else assert { 1+2 = 3 } + + let rec lemma value_sub_tail (x:map int limb) (n m:int) + requires { n <= m } + variant { m - n } + ensures { + value_sub x n (m+1) = + value_sub x n m + (Map.get x m) * power radix (m-n) } + = [@vc:sp] if n < m then value_sub_tail x (n+1) m else ()(*assert { 1+2=3 }*) + + let rec lemma value_sub_concat (x:map int limb) (n m l:int) + requires { n <= m <= l} + variant { m - n } + ensures { + value_sub x n l = + value_sub x n m + value_sub x m l * power radix (m-n) } + = + if n < m then + begin + assert {n + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/multiprecision/lemmas/why3shapes.gz b/examples/multiprecision/lemmas/why3shapes.gz new file mode 100644 index 0000000000000000000000000000000000000000..189729d2c747f463d41b1ca04c652c36daed6b81 Binary files /dev/null and b/examples/multiprecision/lemmas/why3shapes.gz differ diff --git a/examples/multiprecision/lineardecision.mlw b/examples/multiprecision/lineardecision.mlw new file mode 100644 index 0000000000000000000000000000000000000000..6dae622ca9f375a45c6073b32a8f1512afde2929 --- /dev/null +++ b/examples/multiprecision/lineardecision.mlw @@ -0,0 +1,2105 @@ +module LinearEquationsCoeffs + +type a +function (+) a a : a +function ( *) a a : a +function (-_) a : a +function azero: a +function aone: a +predicate ale a a + +clone algebra.OrderedUnitaryCommutativeRing as A with type t = a, function (+) = (+), function ( *) = ( *), function (-_) = (-_), constant zero = azero, constant one=aone, predicate (<=) = ale + +function (-) a a : a + +axiom sub_def: forall a1 a2. a1 - a2 = a1 + (- a2) + +type t +type vars = int -> a +type cvars +exception Unknown + +function interp t cvars : a + +val constant czero : t +val constant cone : t + +axiom zero_def: forall y. interp czero y = azero +axiom one_def: forall y. interp cone y = aone + +lemma neg_mul: + forall x y: a. (-x) * y = - (x*y) + +val add (a b: t) : t + ensures { forall v: cvars. interp result v = interp a v + interp b v } + raises { Unknown -> true } + +val mul (a b: t) : t + ensures { forall v: cvars. interp result v = interp a v * interp b v } + raises { Unknown -> true } + +val opp (a:t) : t + ensures { forall v: cvars. interp result v = - (interp a v) } + +val predicate eq (a b:t) + ensures { result -> forall y:cvars. interp a y = interp b y } + +val inv (a:t) : t + requires { not (eq a czero) } + (* ensures { forall v: cvars. interp result v * interp a v = aone } no proof needed, but had better be true *) + ensures { not (eq result czero) } + raises { Unknown -> true } + +end + +module LinearEquationsDecision + +use import int.Int +type coeff + +clone LinearEquationsCoeffs as C with type t = coeff +type vars = C.vars + +type expr = Term coeff int | Add expr expr | Cst coeff + +let rec predicate valid_expr (e:expr) + variant { e } += match e with + | Term _ i -> 0 <= i + | Cst _ -> true + | Add e1 e2 -> valid_expr e1 && valid_expr e2 + end + +let rec predicate expr_bound (e:expr) (b:int) + variant { e } += match e with + | Term _ i -> 0 <= i <= b + | Cst _ -> true + | Add e1 e2 -> expr_bound e1 b && expr_bound e2 b + end + +function interp (e:expr) (y:vars) (z:C.cvars) : C.a += match e with + | Term c v -> C.( *) (C.interp c z) (y v) + | Add e1 e2 -> C.(+) (interp e1 y z) (interp e2 y z) + | Cst c -> C.interp c z + end + +meta rewrite_def function interp + +use import bool.Bool +use import list.List + +type equality = (expr, expr) +type context = list equality + +let predicate valid_eq (eq:equality) += match eq with (e1,e2) -> valid_expr e1 && valid_expr e2 end + +let predicate eq_bound (eq:equality) (b:int) += match eq with (e1,e2) -> expr_bound e1 b && expr_bound e2 b end + +let rec predicate valid_ctx (ctx:context) += match ctx with Nil -> true | Cons eq t -> valid_eq eq && valid_ctx t end + +let rec predicate ctx_bound (ctx:context) (b:int) += match ctx with Nil -> true | Cons eq t -> eq_bound eq b && ctx_bound t b end + +let rec lemma expr_bound_w (e:expr) (b1 b2:int) + requires { b1 <= b2 } + requires { expr_bound e b1 } + ensures { expr_bound e b2 } + variant { e } += match e with + | Add e1 e2 -> expr_bound_w e1 b1 b2; expr_bound_w e2 b1 b2 + | Cst _ -> () + | Term _ _ -> () + end + +lemma eq_bound_w: forall e:equality, b1 b2:int. eq_bound e b1 -> b1 <= b2 -> eq_bound e b2 + +let rec lemma ctx_bound_w (l:context) (b1 b2:int) + requires { ctx_bound l b1 } + requires { b1 <= b2 } + ensures { ctx_bound l b2 } + variant { l } += match l with Nil -> () | Cons _ t -> ctx_bound_w t b1 b2 end + +function interp_eq (g:equality) (y:vars) (z:C.cvars) : bool + = match g with (g1, g2) -> interp g1 y z = interp g2 y z end + +meta rewrite_def function interp_eq + +function interp_ctx (l: context) (g: equality) (y: vars) (z:C.cvars) : bool += match l with + | Nil -> interp_eq g y z + | Cons h t -> (interp_eq h y z) -> (interp_ctx t g y z) + end + +meta rewrite_def function interp_ctx + +use import mach.int.Int63 +use import seq.Seq +use import mach.array.Array63 +use import mach.matrix.Matrix63 + +let apply_r (m: matrix coeff) (v: array coeff) : array coeff + requires { v.length = m.columns } + ensures { result.length = m.rows } + raises { C.Unknown -> true } += let r = Array63.make m.rows C.czero in + for i = 0 to m.rows - 1 do + for j = 0 to m.columns - 1 do + r[i] <- C.add r[i] (C.mul (get m i j) v[j]); + done + done; + r + +let apply_l (v: array coeff) (m: matrix coeff) : array coeff + requires { v.length = m.rows } + ensures { result.length = m.columns } + raises { C.Unknown -> true } += let r = Array63.make m.columns C.czero in + for j = 0 to m.columns - 1 do + for i = 0 to m.rows - 1 do + r[j] <- C.add r[j] (C.mul (get m i j) v[i]); + done + done; + r + +use import ref.Ref + +let sprod (a b: array coeff) : coeff + requires { a.length = b.length } + raises { C.Unknown -> true } += let r = ref C.czero in + for i = 0 to a.length - 1 do + r := C.add !r (C.mul a[i] b[i]); + done; + !r + +let m_append (m: matrix coeff) (v:array coeff) : matrix coeff + requires { m.rows = v.length } + requires { m.columns < int63'maxInt } + ensures { result.rows = m.rows } + ensures { result.columns = m.columns + 1 } + ensures { forall i j. 0 <= i < m.rows -> 0 <= j < m.columns -> + result.elts i j = m.elts i j } + ensures { forall i. 0 <= i < m.rows -> result.elts i m.columns = v[i] } += let r = Matrix63.make m.rows (m.columns + 1) C.czero in + for i = 0 to m.rows - 1 do + invariant { forall k j. 0 <= k < i -> 0 <= j < m.columns -> + r.elts k j = m.elts k j } + invariant { forall k. 0 <= k < i -> r.elts k m.columns = v[k] } + for j = 0 to m.columns - 1 do + invariant { forall k j. 0 <= k < i -> 0 <= j < m.columns -> + r.elts k j = m.elts k j } + invariant { forall k. 0 <= k < i -> r.elts k m.columns = v[k] } + invariant { forall l. 0 <= l < j -> r.elts i l = m.elts i l } + set r i j (get m i j) + done; + set r i m.columns v[i] + done; + r + +let v_append (v: array coeff) (c: coeff) : array coeff + requires { length v < int63'maxInt } + ensures { length result = length v + 1 } + ensures { forall k. 0 <= k < v.length -> result[k] = v[k] } + ensures { result[v.length] = c } += let r = Array63.make (v.length + 1) c in + for i = 0 to v.length - 1 do + invariant { forall k. 0 <= k < i -> r[k] = v[k] } + invariant { r[v.length] = c } + r[i] <- v[i] + done; + r + +let predicate (==) (a b: array coeff) + ensures { result = true -> length a = length b /\ + forall i. 0 <= i < length a -> C.eq a[i] b[i] } += + if length a <> length b then false + else + let r = ref true in + for i = 0 to length a - 1 do + invariant { !r = true -> forall j. 0 <= j < i -> C.eq a[j] b[j] } + if not (C.eq a[i] b[i]) then r := false; + done; + !r + +use import int.MinMax +use import list.Length + +let rec function max_var (e:expr) : int + variant { e } + requires { valid_expr e } + ensures { 0 <= result } + ensures { expr_bound e result } += match e with + | Term _ i -> i + | Cst _ -> 0 + | Add e1 e2 -> max (max_var e1) (max_var e2) + end + +let function max_var_e (e:equality) : int + requires { valid_eq e } + ensures { 0 <= result } + ensures { eq_bound e result } += match e with (e1,e2) -> max (max_var e1) (max_var e2) end + +let rec function max_var_ctx (l:context) : int + variant { l } + requires { valid_ctx l } + ensures { 0 <= result } + ensures { ctx_bound l result } += match l with + | Nil -> 0 + | Cons e t -> max (max_var_e e) (max_var_ctx t) + end + +let rec opp_expr (e:expr) : expr + ensures { forall y z. interp result y z = C.(-_) (interp e y z) } + ensures { valid_expr e -> valid_expr result } + ensures { forall b. expr_bound e b -> expr_bound result b } + variant { e } += match e with + | Cst c -> Cst (C.opp c) + | Term c j -> + let oc = C.opp c in + let r = Term oc j in + assert { forall y z. interp r y z = C.( *) (C.interp oc z) (y j) + = C.( *) (C.(-_) (C.interp c z)) (y j) + = C.(-_) (C.( *) (C.interp c z) (y j)) + = C.(-_) (interp e y z) }; + r + | Add e1 e2 -> + let e1' = opp_expr e1 in + let e2' = opp_expr e2 in + assert { forall a1 a2. C.(+) (C.(-_) a1) (C.(-_) a2) = C.(-_) (C.(+) a1 a2) }; + assert { forall y z. interp (Add e1' e2') y z = C.(-_) (interp e y z) by + interp (Add e1' e2') y z = C.(+) (interp e1' y z) (interp e2' y z) + = C.(+) (C.(-_) (interp e1 y z)) (C.(-_) (interp e2 y z)) + = C.(-_) (C.(+) (interp e1 y z) (interp e2 y z)) + = C.(-_) (interp e y z) }; + Add e1' e2' + end + +predicate atom (e:expr) += match e with + | Add _ _ -> false | _ -> true + end + +(*TODO put this back in norm_eq*) +let rec norm_eq_aux (ex acc_e:expr) (acc_c:coeff) : (expr, coeff) + returns { (rex, rc) -> forall y z. + C.(+) (interp rex y z) (interp (Cst rc) y z) + = C.(+) (interp ex y z) + (C.(+) (interp acc_e y z) (interp (Cst acc_c) y z)) } + returns { (rex, _) -> forall b:int. expr_bound ex b /\ expr_bound acc_e b + -> expr_bound rex b } + raises { C.Unknown -> true } + variant { ex } += match ex with + | Cst c -> acc_e, (C.add c acc_c) + | Term _ _ -> (Add acc_e ex, acc_c) + | Add e1 e2 -> let ae, ac = norm_eq_aux e1 acc_e acc_c in + norm_eq_aux e2 ae ac + end + +use import debug.Debug + +let norm_eq (e:equality) : (expr, coeff) + returns { (ex, c) -> forall y z. + interp_eq e y z <-> interp_eq (ex, Cst c) y z } + returns { (ex, _) -> forall b:int. eq_bound e b -> expr_bound ex b } + raises { C.Unknown -> true } += match e with + | (e1, e2) -> + let s = Add e1 (opp_expr e2) in + assert { forall b. eq_bound e b -> expr_bound s b }; + match norm_eq_aux s (Cst C.czero) C.czero with + (e, c) -> + let ec = C.opp c in + assert { forall a1 a2. C.(+) a1 a2 = C.azero -> a1 = C.(-_) a2 }; + assert { forall y z. interp_eq (e1,e2) y z -> interp_eq (e, Cst ec) y z + by interp_eq (s, Cst C.czero) y z so interp s y z = C.azero + so C.(+) (interp e y z) (interp (Cst c) y z) = C.azero + so interp e y z = C.(-_) (interp (Cst c) y z) + = interp (Cst ec) y z }; + e, ec + end + end + + +let rec lemma interp_ctx_impl (ctx: context) (g1 g2:equality) + requires { forall y z. interp_eq g1 y z -> interp_eq g2 y z } + ensures { forall y z. interp_ctx ctx g1 y z -> interp_ctx ctx g2 y z } + variant { ctx } += match ctx with Nil -> () | Cons _ t -> interp_ctx_impl t g1 g2 end + +let rec lemma interp_ctx_valid (ctx:context) (g:equality) + ensures { forall y z. interp_eq g y z -> interp_ctx ctx g y z } + variant { ctx } += match ctx with Nil -> () | Cons _ t -> interp_ctx_valid t g end + +use import list.Append + +let rec lemma interp_ctx_wr (ctx l:context) (g:equality) + ensures { forall y z. interp_ctx ctx g y z -> interp_ctx (ctx ++ l) g y z } + variant { ctx } += match ctx with + | Nil -> () + | Cons _ t -> interp_ctx_wr t l g end + +let rec lemma interp_ctx_wl (ctx l: context) (g:equality) + ensures { forall y z. interp_ctx ctx g y z -> interp_ctx (l ++ ctx) g y z } + variant { l } += match l with Nil -> () | Cons _ t -> interp_ctx_wl ctx t g end + +let rec mul_expr (e:expr) (c:coeff) : expr + ensures { forall y z. interp result y z + = C.( *) (C.interp c z) (interp e y z) } + ensures { valid_expr e -> valid_expr result } + variant { e } + raises { C.Unknown -> true } += if C.eq c C.czero then Cst C.czero + else match e with + | Cst c1 -> Cst (C.mul c c1) + | Term c1 v -> Term (C.mul c c1) v + | Add e1 e2 -> Add (mul_expr e1 c) (mul_expr e2 c) + end + +let rec add_expr (e1 e2: expr) : expr + ensures { forall y z. interp result y z + = C.(+) (interp e1 y z) (interp e2 y z) } + variant { e2 } + raises { C.Unknown -> true } += + let term_or_cst c i + ensures { forall y z. interp result y z = interp (Term c i) y z } + = if C.eq C.czero c then Cst C.czero else Term c i in + let rec add_atom (e a:expr) : (expr, bool) + requires { atom a } + returns { r,_ -> forall y z. interp r y z + = C.(+) (interp e y z) (interp a y z) } + variant { e } + raises { C.Unknown -> true } + = match (e,a) with + | Term ce ie, Term ca ia -> + if ie = ia then (term_or_cst (C.add ce ca) ie, True) + else if C.eq ce C.czero then (term_or_cst ca ia, True) + else if C.eq ca C.czero then (e,True) + else (Add e a, False) + | Cst ce, Cst ca -> Cst (C.add ce ca), True + | Cst ce, Term ca _ -> + if C.eq ca C.czero then (e, True) + else if C.eq ce C.czero then (a, True) + else (Add e a, False) + | Term ce _, Cst ca -> + if C.eq ce C.czero then (a, True) + else if C.eq ca C.czero then (e, True) + else (Add e a, False) + | Add e1 e2, _ -> + let r, b = add_atom e1 a in + if b + then + match r with + | Cst c -> + if C.eq c C.czero + then begin + assert { forall y z. C.(+) (interp e1 y z) (interp a y z) = C.azero }; + e2, True end + else Add r e2, True + | _ -> Add r e2, True + end + else + let r,b = add_atom e2 a in + match r with + | Cst c -> + if C.eq c C.czero + then begin + assert { forall y z. C.(+) (interp e2 y z) (interp a y z) = C.azero }; + e1, True end + else Add e1 r, b + | _ -> Add e1 r, b + end + | _, Add _ _ -> absurd + end + in + match e2 with + | Add e1' e2' -> add_expr (add_expr e1 e1') e2' + | _ -> let r,_= add_atom e1 e2 in r + end + +let mul_eq (eq:equality) (c:coeff) + ensures { forall y z. interp_eq eq y z -> interp_eq result y z } + raises { C.Unknown -> true } += match eq with (e1,e2) -> (mul_expr e1 c, mul_expr e2 c) end + +let add_eq (eq1 eq2:equality) + ensures { forall y z. interp_eq eq1 y z -> interp_eq eq2 y z + -> interp_eq result y z } + ensures { forall y z ctx. interp_ctx ctx eq1 y z -> interp_ctx ctx eq2 y z + -> interp_ctx ctx result y z } + raises { C.Unknown -> true } += match eq1, eq2 with ((a1,b1), (a2,b2)) -> + let a = add_expr a1 a2 in let b = add_expr b1 b2 in + let r = (a,b) in + let rec lemma aux (l:context) + ensures { forall y z. interp_ctx l eq1 y z -> interp_ctx l eq2 y z + -> interp_ctx l r y z } + variant { l } + = match l with Nil -> () | Cons _ t -> aux t end in + r + end + +let rec zero_expr (e:expr) : bool + ensures { result -> forall y z. interp e y z = C.azero } + variant { e } + raises { C.Unknown -> true } += + let rec all_zero (e:expr) : bool + ensures { result -> forall y z. interp e y z = C.azero } + variant { e } + = match e with + | Cst c -> C.eq c C.czero + | Term c _ -> C.eq c C.czero + | Add e1 e2 -> all_zero e1 && all_zero e2 + end + in + let e' = add_expr (Cst C.czero) e in (* simplifies expr *) + all_zero e' + +let sub_expr (e1 e2:expr) + ensures { forall y z. C.(+) (interp result y z) (interp e2 y z) + = interp e1 y z } + raises { C.Unknown -> true } += let r = add_expr e1 (mul_expr e2 (C.opp C.cone)) in + assert { forall y z. + let v1 = interp e1 y z in + let v2 = interp e2 y z in + let vr = interp r y z in + C.(+) vr v2 = v1 + by C.( *) v2 (C.(-_) C.aone) = C.(-_) v2 + so C.(+) vr v2 + = C.(+) (C.(+) v1 (C.( *) v2 (C.(-_) C.aone))) v2 + = C.(+) (C.(+) v1 (C.(-_) v2)) v2 = v1 }; + r + +let rec same_eq (eq1 eq2: equality) : bool + ensures { result -> forall y z. interp_eq eq1 y z -> interp_eq eq2 y z } + raises { C.Unknown -> true } += let (e1,c1) = norm_eq eq1 in + let (e2,c2) = norm_eq eq2 in + let e = sub_expr e1 e2 in + if zero_expr e && C.eq c1 c2 then true + else (print (add_expr (Cst C.czero) e); print c1; print c2; false) + +use import option.Option + +let rec norm_context (l:context) : context + ensures { forall g y z. interp_ctx result g y z -> interp_ctx l g y z } + raises { C.Unknown -> true } + variant { l } += match l with + | Nil -> Nil + | Cons h t -> + let ex, c = norm_eq h in + Cons (ex, Cst c) (norm_context t) + end + +let rec print_lc ctx v : unit variant { ctx } += match ctx, v with + | Nil, Nil -> () + | Cons l t, Cons v t2 -> + (if C.eq C.czero v then () + else (print l; print v)); + print_lc t t2 + | _ -> () + end + +let check_combination (ctx:context) (g:equality) (v:list coeff) : bool + ensures { result = true -> forall y z. interp_ctx ctx g y z} + raises { C.Unknown -> true } += + (*let ctx = norm_context ctx in + let (g,c) = norm_eq g in*) + (* normalize before for fewer Unknown exceptions in computations ? *) + let rec aux (l:context) (ghost acc: context) (s:equality) (v:list coeff) : option equality + requires { forall y z. interp_ctx acc s y z } + requires { ctx = acc ++ l } + returns { Some r -> forall y z. interp_ctx ctx r y z | None -> true } + raises { C.Unknown -> true } + variant { l } + = match (l, v) with + | Nil, Nil -> Some s + | Cons eq te, Cons c tc -> + let ghost nacc = acc ++ (Cons eq Nil) in + if C.eq c C.czero then aux te nacc s tc + else begin + let ns = (add_eq s (mul_eq eq c)) in + interp_ctx_wr ctx (Cons eq Nil) s; + interp_ctx_wl ctx (Cons eq Nil) eq; + assert { forall y z. interp_ctx nacc ns y z + by interp_ctx nacc s y z /\ interp_ctx nacc eq y z }; + aux te nacc ns tc end + | _ -> None + end + in + match aux ctx Nil (Cst C.czero, Cst C.czero) v with + | Some sum -> if same_eq sum g then true else (print_lc ctx v; false) + | None -> false + end + +let transpose (m:matrix coeff) : matrix coeff + ensures { result.rows = m.columns /\ result.columns = m.rows } += + let r = Matrix63.make m.columns m.rows C.czero in + for i = 0 to m.rows - 1 do + for j = 0 to m.columns - 1 do + set r j i (get m i j) + done + done; + r + +let swap_rows (m:matrix coeff) (i1 i2: int63) : unit + requires { 0 <= i1 < m.rows /\ 0 <= i2 < m.rows } += for j = 0 to m.columns - 1 do + let c = get m i1 j in + set m i1 j (get m i2 j); + set m i2 j c + done + +let mul_row (m:matrix coeff) (i: int63) (c: coeff) : unit + requires { 0 <= i < m.rows } + requires { not (C.eq c C.czero) } + raises { C.Unknown -> true } += if C.eq c C.cone then () else + for j = 0 to m.columns - 1 do + set m i j (C.mul c (get m i j)) + done + +let addmul_row (m:matrix coeff) (src dst: int63) (c: coeff) : unit + requires { 0 <= src < m.rows /\ 0 <= dst < m.rows } + raises { C.Unknown -> true } += if C.eq c C.czero then () else + for j = 0 to m.columns - 1 do + set m dst j (C.add (get m dst j) (C.mul c (get m src j))) + done + +use import ref.Ref + +let gauss_jordan (a: matrix coeff) : option (array coeff) + (*AX=B, a=(A|B), result=X*) + returns { Some r -> Array63.length r = a.columns | None -> true } + requires { 1 <= a.rows /\ 1 <= a.columns } + raises { C.Unknown -> true } += + let n = a.rows in + let m = a.columns in + (* print n; print m; *) + let rec find_nonz (i j:int63) + requires { 0 <= i <= n } + requires { 0 <= j < m } + variant { n-i } + ensures { i <= result <= n } + ensures { result < n -> not (C.eq (a.elts result j) C.czero) } + = if i >= n then n + else + if C.eq (get a i j) C.czero + then find_nonz (i+1) j + else i in + let pivots = Array63.make n 0 in + let r = ref (-1) in + for j = 0 to m-2 do + invariant { -1 <= !r < n } + invariant { forall i. 0 <= i <= !r -> 0 <= pivots[i] } + invariant { forall i1 i2: int. 0 <= i1 < i2 <= !r -> pivots[i1] < pivots[i2] } + invariant { !r >= 0 -> pivots[!r] < j } + label Start in + let k = find_nonz (!r+1) j in + if k < n + then begin + r := !r + 1; + pivots[!r] <- j; + mul_row a k (C.inv(get a k j)); + if k <> !r then swap_rows a k !r; + for i = 0 to n-1 do + if i <> !r + then addmul_row a !r i (C.opp(get a i j)) + done; + end; + assert { forall i1 i2: int. 0 <= i1 < i2 <= !r -> pivots[i1] < pivots[i2] + by pivots[i1] = pivots[i1] at Start + so [@case_split] + ((i2 < !r so pivots[i2] = pivots[i2] at Start) + \/ (i2 = !r so pivots[i1] < j(* = pivots[i2])*))) }; + done; + if !r < 0 then None (* matrix is all zeroes *) + else begin + let v = Array63.make m(*(m-1)*) C.czero in + for i = 0 to !r do + v[pivots[i]] <- get a i (m-1) + done; + Some v (*pivots[!r] < m-1*) (*pivot on last column, no solution*) + end + +let rec function to_list (a: array 'a) (l u: int63) : list 'a + requires { l >= 0 /\ u <= Array63.length a } + variant { u - l } += if u <= l then Nil else Cons a[l] (to_list a (l+1) u) + +exception Failure + +let linear_decision (l: context) (g: equality) : bool + requires { valid_ctx l } + requires { valid_eq g } + requires { length l < 100000 } (* integer overflows *) + ensures { forall y z. result -> interp_ctx l g y z } + raises { C.Unknown -> true | Failure -> true } += + let nv = (max (max_var_e g) (max_var_ctx l)) in + begin ensures { nv < 100000 } + if nv >= 100000 then raise Failure + end; + let nv = Int63.of_int nv in + let ll = Int63.of_int (length l) in + let a = Matrix63.make ll (nv+1) C.czero in + let b = Array63.make ll C.czero in (* ax = b *) + let v = Array63.make (nv+1) C.czero in (* goal *) + let rec fill_expr (ex: expr) (i:int63): unit + variant { ex } + raises { C.Unknown -> true } + requires { 0 <= i < length l } + requires { expr_bound ex nv } + raises { Failure -> true } + = match ex with + | Cst c -> if C.eq c C.czero then () else raise Failure + | Term c j -> + let j = Int63.of_int j in + set a i j (C.add (get a i j) c) + | Add e1 e2 -> fill_expr e1 i; fill_expr e2 i + end in + let rec fill_ctx (ctx:context) (i:int63) : unit + requires { ctx_bound ctx nv } + variant { length l - i } + requires { length l - i = length ctx } + requires { 0 <= i <= length l } + raises { Failure -> true } + = match ctx with + | Nil -> () + | Cons e t -> + assert { i < length l }; + try + let ex, c = norm_eq e in + if (not (C.eq c C.czero)) then b[i] <- C.add b[i] c; + fill_expr ex i; + with C.Unknown -> () (* some equalities are in the context but cannot be normalized, typically they are useless, ignore them *) + end; + fill_ctx t (i+1) + end in + let rec fill_goal (ex:expr) : unit + requires { expr_bound ex nv } + variant { ex } + raises { C.Unknown -> true } + raises { Failure -> true } + = match ex with + | Cst c -> if C.eq c C.czero then () else raise Failure + | Term c j -> + let j = Int63.of_int j in + v[j] <- C.add v[j] c + | Add e1 e2 -> fill_goal e1; fill_goal e2 + end in + fill_ctx l 0; + let (ex, d) = norm_eq g in + fill_goal ex; + let ab = m_append a b in + let cd = v_append v d in + let ab' = transpose ab in + match gauss_jordan (m_append ab' cd) with + | Some r -> + check_combination l g (to_list r 0 ll) + | None -> false + end + +type expr' = | Sum expr' expr' | ProdL expr' cprod | ProdR cprod expr' | Diff expr' expr' + | Var int | Coeff coeff + +with cprod = | C coeff | Times cprod cprod + +function interp_c (e:cprod) (y:vars) (z:C.cvars) : C.a += match e with + | C c -> C.interp c z + | Times e1 e2 -> C.(*) (interp_c e1 y z) (interp_c e2 y z) + end + +meta rewrite_def function interp_c + +function interp' (e:expr') (y:vars) (z:C.cvars) : C.a += match e with + | Sum e1 e2 -> C.(+) (interp' e1 y z) (interp' e2 y z) + | ProdL e c -> C.(*) (interp' e y z) (interp_c c y z) + | ProdR c e -> C.(*) (interp_c c y z) (interp' e y z) + | Diff e1 e2 -> C.(-) (interp' e1 y z) (interp' e2 y z) + | Var n -> y n + | Coeff c -> C.interp c z + end + +meta rewrite_def function interp' + +(*exception NonLinear*) + +type equality' = (expr', expr') +type context' = list equality' + +function interp_eq' (g:equality') (y:vars) (z:C.cvars) : bool += match g with (g1, g2) -> interp' g1 y z = interp' g2 y z end + +meta rewrite_def function interp_eq' + +function interp_ctx' (l: context') (g: equality') (y: vars) (z:C.cvars) : bool += match l with + | Nil -> interp_eq' g y z + | Cons h t -> (interp_eq' h y z) -> (interp_ctx' t g y z) + end + +meta rewrite_def function interp_ctx' + +let rec predicate valid_expr' (e:expr') + variant { e } += match e with + | Var i -> 0 <= i + | Sum e1 e2 | Diff e1 e2 -> valid_expr' e1 && valid_expr' e2 + | Coeff _ -> true + | ProdL e _ | ProdR _ e -> valid_expr' e + end + +let predicate valid_eq' (eq:equality') += match eq with (e1,e2) -> valid_expr' e1 && valid_expr' e2 end + +let rec predicate valid_ctx' (ctx:context') += match ctx with Nil -> true | Cons eq t -> valid_eq' eq && valid_ctx' t end + +let rec simp (e:expr') : expr + ensures { forall y z. interp result y z = interp' e y z } + ensures { valid_expr' e -> valid_expr result } + raises { C.Unknown -> true } + variant { e } += + let rec simp_c (e:cprod) : coeff + ensures { forall y z. C.interp result z = interp_c e y z } + variant { e } + raises { C.Unknown -> true } + = + match e with + | C c -> c + | Times c1 c2 -> C.mul (simp_c c1) (simp_c c2) + end + in + match e with + | Sum e1 e2 -> Add (simp e1) (simp e2) + | Diff e1 e2 -> Add (simp e1) (opp_expr (simp e2)) + | Var n -> Term C.cone n + | Coeff c -> Cst c + | ProdL e c | ProdR c e -> + mul_expr (simp e) (simp_c c) + end + +let simp_eq (eq:equality') : equality + ensures { forall y z. interp_eq result y z = interp_eq' eq y z } + ensures { valid_eq' eq -> valid_eq result } + raises { (*NonLinear -> true | *)C.Unknown -> true } += match eq with (g1, g2) -> (simp g1, simp g2) end + +let rec simp_ctx (ctx: context') (g:equality') : (context, equality) + returns { (rc, rg) -> + (valid_ctx' ctx -> valid_eq' g -> valid_ctx rc /\ valid_eq rg) /\ + length rc = length ctx /\ + forall y z. interp_ctx rc rg y z = interp_ctx' ctx g y z } + raises { (*NonLinear -> true | *) C.Unknown -> true } + variant { ctx } += match ctx with + | Nil -> Nil, simp_eq g + | Cons eq t -> let rt, rg = simp_ctx t g in + Cons (simp_eq eq) rt, rg + end + +let decision (l:context') (g:equality') + requires { valid_ctx' l } + requires { valid_eq' g } + requires { length l < 100000 } + ensures { forall y z. result -> interp_ctx' l g y z } + raises { (* NonLinear -> true | *) C.Unknown -> true | Failure -> true } += let sl, sg = simp_ctx l g in + linear_decision sl sg + +end + +module RationalCoeffs + +use import int.Int +use import real.RealInfix +use import real.FromInt +use import int.Abs + +(*meta coercion function from_int*) + +type t = (int, int) +type rvars = int -> real + +exception QError + +let constant rzero = (0,1) +let constant rone = (1,1) + +function rinterp (t:t) (v:rvars) : real += match t with + | (n,d) -> from_int n /. from_int d + end + +meta rewrite_def function rinterp + +let lemma prod_compat_eq (a b c:real) + requires { c <> 0.0 } + requires { a *. c = b *. c } + ensures { a = b } += () + +let lemma cross_d (n1 d1 n2 d2:int) + requires { d1 <> 0 /\ d2 <> 0 } + requires { n1 * d2 = n2 * d1 } + ensures { forall v. rinterp (n1,d1) v = rinterp (n2,d2) v } += let d = from_int (d1 * d2) in + assert { forall v. rinterp (n1, d1) v = rinterp (n2, d2) v + by rinterp (n1, d1) v *. d = rinterp (n2,d2) v *. d } + +let lemma cross_ind (n1 d1 n2 d2:int) + requires { d1 <> 0 /\ d2 <> 0 } + requires { forall v. rinterp (n1,d1) v = rinterp (n2,d2) v } + ensures { n1 * d2 = n2 * d1 } += assert { from_int d1 <> 0.0 /\ from_int d2 <> 0.0 }; + assert { from_int n1 /. from_int d1 = from_int n2 /. from_int d2 }; + assert { from_int n1 *. from_int d2 = from_int n2 *. from_int d1 + by from_int n1 *. from_int d2 + = (from_int n1 /. from_int d1) *. from_int d1 *. from_int d2 + = (from_int n2 /. from_int d2) *. from_int d1 *. from_int d2 + = from_int n2 *. from_int d1 }; + assert { from_int (n1*d2) = from_int (n2 * d1) } + + +lemma cross: forall n1 d1 n2 d2: int. d1 <> 0 -> d2 <> 0 -> + n1 * d2 = n2 * d1 <-> + forall v. rinterp (n1,d1) v = rinterp (n2,d2) v + +use import int.ComputerDivision +use import ref.Ref +use import number.Gcd + +let gcd (x:int) (y:int) + requires { x > 0 /\ y > 0 } + ensures { result = gcd x y } + ensures { result > 0 } + = + let ghost ox = x in + let x = ref x in let y = ref y in + label Pre in + while (!y > 0) do + invariant { !x >= 0 /\ !y >= 0 } + invariant { gcd !x !y = gcd (!x at Pre) (!y at Pre) } + variant { !y } + invariant { ox > 0 -> !x > 0 } + let r = mod !x !y in let ghost q = div !x !y in + assert { r = !x - q * !y }; + x := !y; y := r; + done; + !x + +let simp (t:t) : t + ensures { forall v:rvars. rinterp result v = rinterp t v } += match t with + | (n,d) -> + if d = 0 then t + else if n = 0 then rzero + else + let g = gcd (abs n) (abs d) in + let n', d' = (div n g, div d g) in + assert { n = g * n' /\ d = g * d' }; + assert { n' * d = n * d' }; + (n', d') + end + +let radd (a b:t) + ensures { forall y. rinterp result y = rinterp a y +. rinterp b y } + raises { QError -> true } += match (a,b) with + | (n1,d1), (n2,d2) -> + if d1 = 0 || d2 = 0 then raise QError + else begin + let r = (n1*d2 + n2*d1, d1*d2) in + let ghost d = from_int d1 *. from_int d2 in + assert { forall y. + rinterp a y +. rinterp b y = rinterp r y + by rinterp a y *. d = from_int n1 *. from_int d2 + so rinterp b y *. d = from_int n2 *. from_int d1 + so (rinterp a y +. rinterp b y) *. d + = from_int (n1*d2 + n2*d1) + = rinterp r y *. d }; + simp r end + end + +let rmul (a b:t) + ensures { forall y. rinterp result y = rinterp a y *. rinterp b y } + raises { QError -> true } += match (a,b) with + | (n1,d1), (n2, d2) -> + if d1 = 0 || d2 = 0 then raise QError + else begin + let r = (n1*n2, d1*d2) in + assert { forall y. rinterp r y = rinterp a y *. rinterp b y + by rinterp r y = from_int (n1*n2) /. from_int(d1*d2) + = (from_int n1 *. from_int n2) /. (from_int d1 *. from_int d2) + = (from_int n1 /. from_int d1) *. (from_int n2 /. from_int d2) + = rinterp a y *. rinterp b y }; + r + end + end + +let ropp (a:t) + ensures { forall y. rinterp result y = -. rinterp a y } += match a with + | (n,d) -> (-n, d) + end + +let predicate req (a b:t) + ensures { result -> forall y. rinterp a y = rinterp b y } += match (a,b) with + | (n1,d1), (n2,d2) -> n1 = n2 && d1 = d2 || (d1 <> 0 && d2 <> 0 && n1 * d2 = n2 * d1) + end + +let rinv (a:t) + requires { not req a rzero } + ensures { not req result rzero } + ensures { forall y. rinterp result y *. rinterp a y = 1.0 } + raises { QError -> true } += match a with + | (n,d) -> if n = 0 || d = 0 then raise QError else (d,n) + end + +let is_zero (a:t) + ensures { result <-> req a rzero } += match a with + | (n,d) -> n = 0 && d <> 0 + end + +end + +module LinearDecisionRational + +use import RationalCoeffs +use import real.RealInfix +use import real.FromInt + +clone export LinearEquationsDecision with type C.a = real, function C.(+) = (+.), function C.( * ) = ( *. ), function C.(-_) = (-._), function C.(-) = (-.), type coeff = t, type C.cvars=int -> real, function C.interp=rinterp, exception C.Unknown = QError, constant C.azero = Real.zero, constant C.aone = Real.one, predicate C.ale = (<=.), val C.czero=rzero, val C.cone=rone, lemma C.sub_def, lemma C.zero_def, lemma C.one_def, val C.add=radd, val C.mul=rmul, val C.opp=ropp, val C.eq=req, val C.inv=rinv, goal C.A.ZeroLessOne, goal C.A.CompatOrderAdd, goal C.A.CompatOrderMult, goal C.A.Unitary, goal C.A.NonTrivialRing, goal C.A.Mul_distr_l, goal C.A.Mul_distr_r, goal C.A.Inv_def_l, goal C.A.Inv_def_r, goal C.A.MulAssoc.Assoc, goal C.A.Assoc, goal C.A.MulComm.Comm, goal C.A.Comm, goal C.A.Unit_def_l, goal C.A.Unit_def_r + +end + +module LinearDecisionInt + +use import int.Int + +type t' = IC int | Error + +function interp_id (t:t') (v:int -> int) : int += match t with + | IC i -> i + | Error -> 0 (* never created *) + end + +meta rewrite_def function interp_id + +let constant izero = IC 0 + +let constant ione = IC 1 + +let predicate ieq (a b:t') = false + +exception NError + +let iadd (a b:t') : t' + ensures { forall z. interp_id result z = interp_id a z + interp_id b z } + raises { NError -> true } += raise NError + +let imul (a b:t') : t' + ensures { forall z. interp_id result z = interp_id a z * interp_id b z } + raises { NError -> true } += raise NError + +let iopp (a:t') : t' + ensures { forall z. interp_id result z = - interp_id a z } + raises { NError -> true } += raise NError + +let iinv (t:t') : t' + (*ensures { forall v: int -> int. id result v * id t v = one }*) + ensures { not (ieq result izero) } + raises { NError -> true } += raise NError + +clone export LinearEquationsDecision with type C.a = int, function C.(+)=(+), function C.(*) = (*), function C.(-_) = (-_), function C.(-) = (-), type coeff = t', type C.cvars = int->int,function C.interp = interp_id, constant C.azero = zero, constant C.aone = one, predicate C.ale= (<=), val C.czero = izero, val C.cone = ione, lemma C.sub_def, lemma C.zero_def, lemma C.one_def, val C.add = iadd, val C.mul = imul, val C.opp = iopp, val C.eq = ieq, val C.inv = iinv, goal C.A.ZeroLessOne, goal C.A.CompatOrderAdd, goal C.A.CompatOrderMult, goal C.A.Unitary, goal C.A.NonTrivialRing, goal C.A.Mul_distr_l, goal C.A.Mul_distr_r, goal C.A.Inv_def_l, goal C.A.Inv_def_r, goal C.A.MulAssoc.Assoc, goal C.A.Assoc, goal C.A.MulComm.Comm, goal C.A.Comm, goal C.A.Unit_def_l, goal C.A.Unit_def_r + + +use import real.FromInt +use import RationalCoeffs +use LinearDecisionRational as R +use import list.List + +let ghost function m_y (y:int -> int): (int -> real) + ensures { forall i. result i = from_int (y i) } += fun i -> from_int (y i) + +meta rewrite_def function m_y + +let m (t:t') : (int, int) + ensures { forall z. rinterp result (m_y z) = from_int (interp_id t z) } + raises { NError -> true } += match t with + | IC x -> (x,1) + | _ -> raise NError + end + +let rec m_cprod (e:cprod) : R.cprod + ensures { forall y z. R.interp_c result (m_y y) (m_y z) + = from_int (interp_c e y z) } + raises { NError -> true } + variant { e } += match e with + | C c -> R.C (m c) + | Times c1 c2 -> R.Times (m_cprod c1) (m_cprod c2) + end + +let rec m_expr (e:expr') : R.expr' + ensures { forall y z. R.interp' result (m_y y) (m_y z) + = from_int (interp' e y z) } + ensures { valid_expr' e -> R.valid_expr' result } + raises { NError -> true } + variant { e } += match e with + | Var i -> R.Var i + | Coeff c -> R.Coeff (m c) + | Sum e1 e2 -> R.Sum (m_expr e1) (m_expr e2) + | Diff e1 e2 -> R.Diff (m_expr e1) (m_expr e2) + | ProdL e c -> R.ProdL (m_expr e) (m_cprod c) + | ProdR c e -> R.ProdR (m_cprod c) (m_expr e) + end + +use import list.Length +use import debug.Debug + +let m_eq (eq:equality') : R.equality' + ensures { forall y z. R.interp_eq' result (m_y y) (m_y z) + <-> interp_eq' eq y z } + ensures { valid_eq' eq -> R.valid_eq' result } + raises { NError -> true } += match eq with (e1,e2) -> (m_expr e1, m_expr e2) end + +let rec m_ctx (ctx:context') (g:equality') : (R.context', R.equality') + returns { c',g' -> forall y z. R.interp_ctx' c' g' (m_y y) (m_y z) <-> + interp_ctx' ctx g y z } + returns { c', _ -> valid_ctx' ctx -> R.valid_ctx' c' } + returns { c', _ -> length c' = length ctx } + returns { _, g' -> valid_eq' g -> R.valid_eq' g' } + raises { NError -> true } + variant { ctx } += match ctx with + | Nil -> Nil, m_eq g + | Cons h t -> + let c',g' = m_ctx t g in + (Cons (m_eq h) c',g') + end + +let int_decision (l: context') (g: equality') : bool + requires { valid_ctx' l } + requires { valid_eq' g } + requires { length l < 100000 } + ensures { forall y z. result -> interp_ctx' l g y z } + raises { R.Failure -> true | QError -> true | NError -> true } += let l',g' = m_ctx l g in + R.decision l' g' + +end + + +module Test + +use import RationalCoeffs +use import LinearDecisionRational +use import int.Int +use import real.RealInfix +use import real.FromInt + +meta "compute_max_steps" 0x10000 +meta coercion function from_int + +goal g: forall x y: real. + (from_int 3 /. from_int 1) *. x +. (from_int 2/. from_int 1) *. y = (from_int 21/. from_int 1) -> + (from_int 7 /. from_int 1) *. x +. (from_int 4/. from_int 1) *. y = (from_int 47/. from_int 1) -> + x = (from_int 5 /. from_int 1) +end + +module TestInt + +use import LinearDecisionInt +use import int.Int + +meta "compute_max_steps" 0x10000 + +goal g: forall x y:int. + 3 * x + 2 * y = 21 -> + 7 * x + 4 * y = 47 -> + x = 5 + +end + +module MP64Coeffs + +use mach.int.UInt64 as M +use import real.RealInfix +use import real.FromInt +use import real.PowerReal +use RationalCoeffs as Q +use import int.Int + +use import debug.Debug + +type evars = int -> int + + +type exp = Lit int | Var int | Plus exp exp | Minus exp | Sub exp exp +type t = (Q.t, exp) + +let constant mzero = (Q.rzero, Lit 0) +let constant mone = (Q.rone, Lit 0) + +constant rradix: real = from_int (M.radix) + +function qinterp (q:Q.t) : real += match q with (n,d) -> from_int n /. from_int d end + +meta rewrite_def function qinterp + +lemma qinterp_def: forall q v. qinterp q = Q.rinterp q v + +function interp_exp (e:exp) (y:evars) : int += match e with + | Lit n -> n + | Var v -> y v + | Plus e1 e2 -> interp_exp e1 y + interp_exp e2 y + | Sub e1 e2 -> interp_exp e1 y - interp_exp e2 y + | Minus e' -> - (interp_exp e' y) + end + +meta rewrite_def function interp_exp + +function minterp (t:t) (y:evars) : real += match t with + (q,e) -> + qinterp q *. pow rradix (from_int (interp_exp e y)) + end + +meta rewrite_def function minterp + +exception MPError + +let rec opp_exp (e:exp) + ensures { forall y. interp_exp result y = - interp_exp e y } + variant { e } += match e with + | Lit n -> Lit (-n) + | Minus e' -> e' + | Plus e1 e2 -> Plus (opp_exp e1) (opp_exp e2) + | Sub e1 e2 -> Sub e2 e1 + | Var _ -> Minus e + end + +let rec add_sub_exp (e1 e2:exp) (s:bool) : exp + ensures { forall y. + if s + then interp_exp result y = interp_exp e1 y + interp_exp e2 y + else interp_exp result y = interp_exp e1 y - interp_exp e2 y } + raises { MPError -> true } + variant { e2, e1 } += + let rec add_atom (e a:exp) (s:bool) : (exp, bool) + returns { r, _ -> forall y. + if s then interp_exp r y = interp_exp e y + interp_exp a y + else interp_exp r y = interp_exp e y - interp_exp a y } + raises { MPError -> true } + variant { e } + = match (e,a) with + | Lit n1, Lit n2 -> (if s then Lit (n1+n2) else Lit (n1-n2)), True + | Lit n, Var i + -> if n = 0 then (if s then Var i else Minus (Var i)), True + else (if s then Plus e a else Sub e a), False + | Var i, Lit n + -> if n = 0 then Var i, true + else (if s then Plus e a else Sub e a), False + | Lit n, Minus e' -> + if n = 0 then (if s then Minus e' else e'), True + else (if s then Plus e a else Sub e a), False + | Minus e', Lit n -> + if n = 0 then Minus e', True + else (if s then Plus e a else Sub e a), False + | Var i, Minus (Var j) | Minus (Var j), Var i -> + if s && (i = j) then (Lit 0, true) + else (if s then Plus e a else Sub e a), False + | Var i, Var j -> if s then Plus e a, False + else + if i = j then Lit 0, True + else Sub e a, False + | Minus (Var i), Minus (Var j) -> + if (not s) && (i=j) then Lit 0, true + else (if s then Plus e a else Sub e a), False + | Minus _, Minus _ -> (if s then Plus e a else Sub e a), False + | Plus e1 e2, _ -> + let r, b = add_atom e1 a s in + if b then + match r with + | Lit n -> if n = 0 then e2, True else Plus r e2, True + | _ -> Plus r e2, True + end + else let r, b = add_atom e2 a s in Plus e1 r, b + | Sub e1 e2, _ -> + let r, b = add_atom e1 a s in + if b then + match r with + | Lit n -> if n = 0 then opp_exp e2, True else Sub r e2, True + | _ -> Sub r e2, True + end + else let r, b = add_atom e2 a (not s) in + if b then Sub e1 r, True + else if s then Sub (Plus e1 a) e2, False + else Sub e1 (Plus e2 a), False + | _ -> raise MPError + end + in + match e2 with + | Plus e1' e2' -> + let r = add_sub_exp e1 e1' s in + match r with + | Lit n -> if n = 0 + then (if s then e2' else opp_exp e2') + else add_sub_exp r e2' s + | _ -> add_sub_exp r e2' s + end + | Sub e1' e2' -> + let r = add_sub_exp e1 e1' s in + match r with + | Lit n -> if n = 0 + then (if s then opp_exp e2' else e2') + else add_sub_exp r e2' (not s) + | _ -> add_sub_exp r e2' (not s) + end + | _ -> let r, _ = add_atom e1 e2 s in r + end + +let add_exp (e1 e2:exp) : exp + ensures { forall y. interp_exp result y = interp_exp e1 y + interp_exp e2 y } + raises { MPError -> True } += add_sub_exp e1 e2 True + + +let rec zero_exp (e:exp) : bool + ensures { result -> forall y. interp_exp e y = 0 } + variant { e } + raises { MPError -> true } += + let rec all_zero (e:exp) : bool + ensures { result -> forall y. interp_exp e y = 0 } + variant { e } + = match e with + | Lit n -> n = 0 + | Var _ -> false + | Minus e -> all_zero e + | Plus e1 e2 -> all_zero e1 && all_zero e2 + | Sub e1 e2 -> all_zero e1 && all_zero e2 + end + in + let e' = add_exp (Lit 0) e in (* simplifies exp *) + all_zero e' + +let rec same_exp (e1 e2: exp) + ensures { result -> forall y. interp_exp e1 y = interp_exp e2 y } + variant { e1, e2 } + raises { MPError -> true } += match e1, e2 with + | Lit n1, Lit n2 -> n1 = n2 + | Var v1, Var v2 -> v1 = v2 + | Minus e1', Minus e2' -> same_exp e1' e2' + | _ -> zero_exp (add_exp e1 (opp_exp e2)) + end + +let madd (a b:t) + ensures { forall y. minterp result y = minterp a y +. minterp b y } + raises { MPError -> true } + raises { Q.QError -> true } += match a, b with + | (q1, e1), (q2, e2) -> + if Q.is_zero q1 then b + else if Q.is_zero q2 then a + else if same_exp e1 e2 + then begin + let q = Q.radd q1 q2 in + assert { forall y. minterp (q, e1) y = minterp a y +. minterp b y + by let p = pow rradix (from_int (interp_exp e1 y)) in + minterp (q, e1) y = (qinterp q) *. p + = (qinterp q1 +. qinterp q2) *. p + = qinterp q1 *. p +. qinterp q2 *. p + = minterp a y +. minterp b y }; + (q,e1) end + else raise MPError + end + +let mmul (a b:t) + ensures { forall y. minterp result y = minterp a y *. minterp b y } + raises { Q.QError -> true } + raises { MPError -> true } += match a, b with + | (q1,e1), (q2,e2) -> + let q = Q.rmul q1 q2 in + if Q.is_zero q then mzero + else begin + let e = add_exp e1 e2 in + assert { forall y. minterp (q,e) y = minterp a y *. minterp b y + by let p1 = pow rradix (from_int (interp_exp e1 y)) in + let p2 = pow rradix (from_int (interp_exp e2 y)) in + let p = pow rradix (from_int (interp_exp e y)) in + interp_exp e y = interp_exp e1 y + interp_exp e2 y + so p = p1 *. p2 + so minterp (q,e) y = qinterp q *. p + = (qinterp q1 *. qinterp q2) *. p + = (qinterp q1 *. qinterp q2) *. p1 *. p2 + = minterp a y *. minterp b y }; + (q,e) + end + end + +let mopp (a:t) + ensures { forall y. minterp result y = -. minterp a y } += match a with (q,e) -> (Q.ropp q, e) end + +let rec predicate pure_same_exp (e1 e2: exp) + ensures { result -> forall y. interp_exp e1 y = interp_exp e2 y } + variant { e1, e2 } += match e1, e2 with + | Lit n1, Lit n2 -> n1 = n2 + | Var v1, Var v2 -> v1 = v2 + | Minus e1', Minus e2' -> pure_same_exp e1' e2' + | Plus a1 a2, Plus b1 b2 -> + (pure_same_exp a1 b1 && pure_same_exp a2 b2) || + (pure_same_exp a1 b2 && pure_same_exp a2 b1) + | _ -> false + end + +let predicate meq (a b:t) + ensures { result -> forall y. minterp a y = minterp b y } += match (a,b) with + | (q1,e1), (q2,e2) -> (Q.req q1 q2 && pure_same_exp e1 e2) || (Q.is_zero q1 && Q.is_zero q2) + end + +let minv (a:t) + requires { not meq a mzero } + ensures { not meq result mzero } +(* ensures { forall y. minterp result y *. minterp a y = 1.0 } no need to prove this*) + raises { Q.QError -> true } += match a with + | (q,e) -> (Q.rinv q, opp_exp e) + end + +end + +module LinearDecisionRationalMP + +use import MP64Coeffs +use import real.RealInfix + +type coeff = t + +clone export LinearEquationsDecision with type C.a = real, function C.(+) = (+.), function C.( *) = ( *.), function C.(-_) = (-._), function C.(-) = (-.), type coeff = t, type C.cvars=evars, function C.interp=minterp, exception C.Unknown = MPError, constant C.azero = Real.zero, constant C.aone = Real.one, predicate C.ale = (<=.), val C.czero=mzero, val C.cone=mone, lemma C.sub_def, lemma C.zero_def, lemma C.one_def, val C.add=madd, val C.mul=mmul, val C.opp=mopp, val C.eq=meq, val C.inv=minv, goal C.A.ZeroLessOne, goal C.A.CompatOrderAdd, goal C.A.CompatOrderMult, goal C.A.Unitary, goal C.A.NonTrivialRing, goal C.A.Mul_distr_l, goal C.A.Mul_distr_r, goal C.A.Inv_def_l, goal C.A.Inv_def_r, goal C.A.MulAssoc.Assoc, goal C.A.Assoc, goal C.A.MulComm.Comm, goal C.A.Comm, goal C.A.Unit_def_l, goal C.A.Unit_def_r + +end +module LinearDecisionIntMP + +use import int.Int +use import int.Power +use import MP64Coeffs + +type t = | I int | E exp | R + +let constant mpzero: t = I 0 +let constant mpone: t = I 1 + +function mpinterp (t:t) (y:evars) : int += match t with + | I n -> n + | E e -> power M.radix (interp_exp e y) + | R -> M.radix + end + +meta rewrite_def function mpinterp + +(* TODO restructure stuff so that expr, eq, ctx, valid_ can be imported without having to implement these *) + +let mpadd (a b:t) : t + ensures { forall y. mpinterp result y = mpinterp a y + mpinterp b y } + raises { MPError -> true } += raise MPError + +let mpmul (a b:t) : t + ensures { forall y. mpinterp result y = mpinterp a y * mpinterp b y } + raises { MPError -> true } += raise MPError + +let mpopp (a:t) : t + ensures { forall y. mpinterp result y = - mpinterp a y } + raises { MPError -> true } += raise MPError + +let predicate mpeq (a b:t) + ensures { result -> forall y. mpinterp a y = mpinterp b y } += false (*match a, b with + (n1, e1), (n2, e2) -> n1=n2 && (n1 = 0 || same_exp e1 e2) + end*) + +let mpinv (a:t) : t + ensures { not mpeq result mpzero } + raises { MPError -> true } += raise MPError + + +clone export LinearEquationsDecision with type C.a = int, function C.(+) = (+), function C.(*) = (*), function C.(-_) = (-_), function C.(-) = (-), type coeff = t, type C.cvars = int->int, function C.interp = mpinterp, constant C.azero = zero, constant C.aone = one, val C.czero = mpzero, val C.cone = mpone, predicate C.ale = (<=), lemma C.sub_def, lemma C.zero_def, lemma C.one_def, val C.add = mpadd, val C.mul = mpmul, val C.opp = mpopp, val C.eq = mpeq, val C.inv = mpinv, goal C.A.ZeroLessOne, goal C.A.CompatOrderAdd, goal C.A.CompatOrderMult, goal C.A.Unitary, goal C.A.NonTrivialRing, goal C.A.Mul_distr_l, goal C.A.Mul_distr_r, goal C.A.Inv_def_l, goal C.A.Inv_def_r, goal C.A.MulAssoc.Assoc, goal C.A.Assoc, goal C.A.MulComm.Comm, goal C.A.Comm, goal C.A.Unit_def_l, goal C.A.Unit_def_r + +use LinearDecisionRationalMP as R +use import real.FromInt +use import real.PowerReal +use import real.RealInfix +use import int.Int + +use import list.List + +predicate pos_exp (t:t) (y:evars) += match t with + | E e -> 0 <= interp_exp e y + | I _ | R -> true + end + +predicate pos_cprod (e:cprod) (y:evars) += match e with + | C c -> pos_exp c y + | Times c1 c2 -> pos_cprod c1 y && pos_cprod c2 y + end + +predicate pos_expr' (e:expr') (y:evars) += match e with + | Coeff c -> pos_exp c y + | Var _ -> true + | Sum e1 e2 | Diff e1 e2 + -> pos_expr' e1 y /\ pos_expr' e2 y + | ProdL e c | ProdR c e -> pos_expr' e y && pos_cprod c y + end + +predicate pos_eq' (eq:equality') (y:evars) += match eq with (e1, e2) -> pos_expr' e1 y /\ pos_expr' e2 y end + +predicate pos_ctx' (l:context') (y:evars) += match l with Nil -> true | Cons h t -> pos_eq' h y /\ pos_ctx' t y end + +let rec function m (t:t) : R.coeff + ensures { forall y. pos_exp t y -> minterp result y + = from_int (mpinterp t y) } += match t with + | I n -> ((n,1), Lit 0) + | E e -> ((1,1), e) + | R -> ((1,1), Lit 1) (* or ((radix, 1), Lit 0) ? *) + end + +meta rewrite_def function m + +let ghost function m_y (y:int->int): (int -> real) + ensures { forall i. result i = from_int (y i) } += fun i -> from_int (y i) + +let rec function m_cprod (e:cprod) : R.cprod + ensures { forall y z. pos_cprod e z -> R.interp_c result (m_y y) z + = from_int (interp_c e y z) } += match e with + | C c -> R.C (m c) + | Times c1 c2 -> R.Times (m_cprod c1) (m_cprod c2) + end + +meta rewrite_def function m_cprod + +let rec function m_expr (e:expr') : R.expr' + ensures { forall y z. pos_expr' e z -> R.interp' result (m_y y) z + = from_int (interp' e y z) } + ensures { valid_expr' e -> R.valid_expr' result} += match e with + | Var i -> R.Var i + | Coeff c -> R.Coeff (m c) + | Sum e1 e2 -> R.Sum (m_expr e1) (m_expr e2) + | Diff e1 e2 -> R.Diff (m_expr e1) (m_expr e2) + | ProdL e c -> R.ProdL (m_expr e) (m_cprod c) + | ProdR c e -> R.ProdR (m_cprod c) (m_expr e) + end + +meta rewrite_def function m_expr + +let function m_eq (eq:equality') : R.equality' + ensures { forall y z. pos_eq' eq z -> (R.interp_eq' result (m_y y) z + <-> interp_eq' eq y z) } + ensures { valid_eq' eq -> R.valid_eq' result } += match eq with (e1,e2) -> (m_expr e1, m_expr e2) end + +meta rewrite_def function m_eq + +use import list.Length + +let rec function m_ctx (ctx:context') : R.context' + ensures { forall y z g. pos_ctx' ctx z -> pos_eq' g z -> + (R.interp_ctx' result (m_eq g) (m_y y) z + <-> interp_ctx' ctx g y z) } + ensures { length result = length ctx } + ensures { valid_ctx' ctx -> R.valid_ctx' result } + variant { ctx } += match ctx with + | Nil -> Nil + | Cons h t -> + let r = Cons (m_eq h) (m_ctx t) in + r + end + +meta rewrite_def function m_ctx + +let mp_decision (l: context') (g: equality') : bool + requires { valid_ctx' l } + requires { valid_eq' g } + requires { length l < 100000 } + ensures { forall y z. result -> pos_ctx' l z -> pos_eq' g z + -> interp_ctx' l g y z } + raises { R.Failure -> true | MPError -> true | Q.QError -> true } += + R.decision (m_ctx l) (m_eq g) + +end + +module EqPropMP + +use import int.Int +use import LinearDecisionIntMP +use import array.Array +use import int.MinMax +use import option.Option +use import list.List +use import list.Append + + +use MP64Coeffs as E + +let rec predicate expr_bound' (e:expr') (b:int) + variant { e } += match e with + | Sum e1 e2 | Diff e1 e2 -> expr_bound' e1 b && expr_bound' e2 b + | ProdL e _ | ProdR _ e -> expr_bound' e b + | Var n -> 0 <= n <= b + | Coeff _ -> true + end + +let predicate eq_bound' (eq:equality') (b:int) += match eq with (e1,e2) -> expr_bound' e1 b && expr_bound' e2 b end + +let rec predicate ctx_bound' (ctx:context') (b:int) += match ctx with Nil -> true | Cons eq t -> eq_bound' eq b && ctx_bound' t b end + +let rec lemma expr_bound_w' (e:expr') (b1 b2:int) + requires { b1 <= b2 } + requires { expr_bound' e b1 } + ensures { expr_bound' e b2 } + variant { e } += match e with + | Sum e1 e2 | Diff e1 e2 -> + expr_bound_w' e1 b1 b2; expr_bound_w' e2 b1 b2 + | ProdL e _ | ProdR _ e -> expr_bound_w' e b1 b2 + | _ -> () + end + +lemma eq_bound_w': forall e:equality', b1 b2:int. eq_bound' e b1 -> b1 <= b2 -> eq_bound' e b2 + +let rec lemma ctx_bound_w' (l:context') (b1 b2:int) + requires { ctx_bound' l b1 } + requires { b1 <= b2 } + ensures { ctx_bound' l b2 } + variant { l } += match l with Nil -> () | Cons _ t -> ctx_bound_w' t b1 b2 end + +let rec function max_var' (e:expr') : int + variant { e } + requires { valid_expr' e } + ensures { 0 <= result } + ensures { expr_bound' e result } += match e with + | Var i -> i + | Coeff _ -> 0 + | Sum e1 e2 | Diff e1 e2 -> max (max_var' e1) (max_var' e2) + | ProdL e _ | ProdR _ e -> max_var' e + end + +let function max_var_e' (e:equality') : int + requires { valid_eq' e } + ensures { 0 <= result } + ensures { eq_bound' e result } += match e with (e1,e2) -> max (max_var' e1) (max_var' e2) end + +let rec function max_var_ctx' (l:context') : int + variant { l } + requires { valid_ctx' l } + ensures { 0 <= result } + ensures { ctx_bound' l result } += match l with + | Nil -> 0 + | Cons e t -> max (max_var_e' e) (max_var_ctx' t) + end + +let rec lemma interp_ctx_valid' (ctx:context') (g:equality') + ensures { forall y z. interp_eq' g y z -> interp_ctx' ctx g y z } + variant { ctx } += match ctx with Nil -> () | Cons _ t -> interp_ctx_valid' t g end + +let rec lemma interp_ctx_wr' (ctx l:context') (g:equality') + ensures { forall y z. interp_ctx' ctx g y z -> interp_ctx' (ctx ++ l) g y z } + variant { ctx } += match ctx with + | Nil -> () + | Cons _ t -> interp_ctx_wr' t l g end + +let rec lemma interp_ctx_wl' (ctx l: context') (g:equality') + ensures { forall y z. interp_ctx' ctx g y z -> interp_ctx' (l ++ ctx) g y z } + variant { l } += match l with Nil -> () | Cons _ t -> interp_ctx_wl' ctx t g end + + +let lemma interp_ctx_cons' (e:equality') (l:context') (g:equality') + requires { forall y z. (interp_eq' e y z -> interp_ctx' l g y z) } + ensures { forall y z. interp_ctx' (Cons e l) g y z } += () + +predicate ctx_impl_ctx' (c1 c2: context') += match c2 with + | Nil -> true + | Cons eq t -> ctx_impl_ctx' c1 t /\ forall y z. y=z -> interp_ctx' c1 eq y z + end + +predicate ctx_holds' (c: context') (y z:vars) += match c with + | Nil -> true + | Cons h t -> interp_eq' h y z /\ ctx_holds' t y z + end + +let rec lemma holds_interp_ctx' (l:context') (g:equality') (y z:vars) + requires { ctx_holds' l y z -> interp_eq' g y z } + ensures { interp_ctx' l g y z } + variant { l } += match l with + | Nil -> () + | Cons h t -> + if interp_eq' h y z then holds_interp_ctx' t g y z + end + +let rec lemma interp_holds' (l:context') (g:equality') (y z:vars) + requires { interp_ctx' l g y z } + requires { ctx_holds' l y z } + ensures { interp_eq' g y z } + variant { l } += match l with + | Nil -> () + | Cons _ t -> interp_holds' t g y z + end + +let rec lemma impl_holds' (c1 c2: context') (y z: vars) + requires { ctx_impl_ctx' c1 c2 } + requires { y=z } + requires { ctx_holds' c1 y z } + ensures { ctx_holds' c2 y z } + variant { c2 } += match c2 with + | Nil -> () + | Cons h t -> interp_holds' c1 h y z; impl_holds' c1 t y z + end + +let rec lemma ctx_impl' (c1 c2: context') (g:equality') (y z: vars) + requires { ctx_impl_ctx' c1 c2 } + requires { y=z } + requires { interp_ctx' c2 g y z } + ensures { interp_ctx' c1 g y z } + variant { c2 } += if ctx_holds' c1 y z + then begin + impl_holds' c1 c2 y z; + interp_holds' c2 g y z; + holds_interp_ctx' c1 g y z + end + +let rec lemma interp_ctx_impl' (ctx: context') (g1 g2:equality') + requires { forall y z. interp_eq' g1 y z -> interp_eq' g2 y z } + ensures { forall y z. interp_ctx' ctx g1 y z -> interp_ctx' ctx g2 y z } + variant { ctx } += match ctx with Nil -> () | Cons _ t -> interp_ctx_impl' t g1 g2 end + +let lemma impl_cons (c1 c2:context') (e:equality') (y z:vars) + requires { ctx_impl_ctx' c1 c2 } + requires { forall y z. interp_ctx' c1 e y z } + ensures { ctx_impl_ctx' c1 (Cons e c2) } += () + +let rec lemma impl_wl' (c1 c2:context') (e:equality') + requires { ctx_impl_ctx' c1 c2 } + ensures { ctx_impl_ctx' (Cons e c1) c2 } + variant { c2 } += match c2 with + | Nil -> () + | Cons h t -> interp_ctx_wl' c1 (Cons e Nil) h; impl_wl' c1 t e + end + +let rec lemma impl_self (c:context') + ensures { ctx_impl_ctx' c c } + variant { c } += match c with + | Nil -> () + | Cons h t -> (impl_self t; impl_wl' c t h) + end + +predicate is_eq_tbl (a:array (option E.exp)) (l:context') += forall i. 0 <= i < length a -> + match a[i] with + | None -> true + | Some e -> forall y z. y=z -> ctx_holds' l y z + -> E.interp_exp (E.Var i) z = E.interp_exp e z + end +use import int.NumOf +use import array.NumOfEq +use import list.Length + +let prop_ctx (l:context') (g:equality') : (context', equality') + requires { valid_ctx' l } + requires { valid_eq' g } + returns { rl, _ -> length rl = length l } + returns { rl, rg -> valid_ctx' rl /\ valid_eq' rg + /\ forall y z. y=z -> interp_ctx' rl rg y z + -> interp_ctx' l g y z } + returns { rl, rg -> forall y z. y=z -> ctx_holds' l y z + -> pos_ctx' l z -> pos_eq' g z + -> (pos_ctx' rl z /\ pos_eq' rg z) } + raises { OutOfBounds -> true } += + let m = max (max_var_ctx' l) (max_var_e' g) in + let a : array (option E.exp) = Array.make (m+1) None in + let rec exp_of_expr' (e:expr') : option E.exp + returns { | None -> true + | Some ex -> forall y z. y=z -> interp' e y z = E.interp_exp ex z } + variant { e } + = match e with + | Var i -> Some (E.Var i) + | Sum e1 e2 -> + let r1,r2 = (exp_of_expr' e1, exp_of_expr' e2) in + match r1,r2 with + | Some ex1, Some ex2 -> Some (E.Plus ex1 ex2) + | _ -> None + end + | Diff e1 e2 -> + let r1,r2 = (exp_of_expr' e1, exp_of_expr' e2) in + match r1,r2 with + | Some ex1, Some ex2 -> Some (E.Sub ex1 ex2) + | _ -> None + end + | Coeff (I n) -> Some (E.Lit n) + | _ -> None + end + in + let fill_tbl_eq (eq:equality') : unit + requires { eq_bound' eq m } + ensures { forall l. is_eq_tbl (old a) l -> + is_eq_tbl a (Cons eq l) } + = match eq with + | Var i, e | e, Var i -> + let r = exp_of_expr' e in + match r with + | None -> () + | Some ex -> + assert { forall l y z. y=z -> ctx_holds' (Cons eq l) y z -> + E.interp_exp ex z = interp' e y z + = interp' (Var i) y z = y i }; + a[i] <- Some ex + end + | _ -> () + end + in + let rec fill_tbl_ctx (l:context') : unit + requires { is_eq_tbl a Nil } + ensures { is_eq_tbl a l } + requires { ctx_bound' l m } + variant { l } + = match l with + | Nil -> () + | Cons eq l -> fill_tbl_ctx l; fill_tbl_eq eq + end + in + fill_tbl_ctx l; + (* a contains equalities, let us propagate them so that + only a single pass on the context is needed *) + let seen = Array.make (m+1) false in + let rec propagate_in_tbl (i:int) : unit + requires { is_eq_tbl a l } + ensures { is_eq_tbl a l } + raises { OutOfBounds -> true } + variant { numof seen false 0 (m+1) } + requires { seen[i] = false } + ensures { seen[i] = true } + ensures { forall j. old seen[j] -> seen[j] } + = + label Start in + let rec prop (e:E.exp) : E.exp + requires { is_eq_tbl a l } + ensures { is_eq_tbl a l } + ensures { forall y z. y=z -> ctx_holds' l y z -> + E.interp_exp e z = E.interp_exp result z } + ensures { forall j. old seen[j] -> seen[j] } + raises { OutOfBounds -> true } + requires { numof seen false 0 (m+1) < numof (seen at Start) false 0 (m+1) } + variant { e } + = match e with + | E.Lit _ -> e + | E.Var j -> + if (not (defensive_get seen j)) then propagate_in_tbl j; + match (defensive_get a j) with + | None -> e + | Some e' -> e' + end + | E.Plus e1 e2 -> E.Plus (prop e1) (prop e2) + | E.Sub e1 e2 -> E.Sub (prop e1) (prop e2) + | E.Minus e -> E.Minus (prop e) + end + in + defensive_set seen i true; + assert { numof seen false 0 (m+1) < numof (old seen) false 0 (m+1) + by forall j. 0 <= j < m+1 -> (old seen)[j] -> seen[j] + so not (old seen)[i] so seen[i] }; + match a[i] with + | None -> () + | Some e -> a[i] <- Some (prop e) + end; + in + for i = 0 to m do + invariant { is_eq_tbl a l } + if not seen[i] then propagate_in_tbl i; + done; + let rec propagate_exp (e:E.exp) + ensures { forall y z. y=z -> ctx_holds' l y z -> + E.interp_exp e z = E.interp_exp result z } + variant { e } + raises { OutOfBounds -> true } + = match e with + | E.Lit _ -> e + | E.Var i -> match (defensive_get a i) with Some e' -> e' | None -> e end + | E.Plus e1 e2 -> E.Plus (propagate_exp e1) (propagate_exp e2) + | E.Sub e1 e2 -> E.Sub (propagate_exp e1) (propagate_exp e2) + | E.Minus e -> E.Minus (propagate_exp e) + end + in + let propagate_coeff (c:t) + ensures { forall y z. y=z -> ctx_holds' l y z -> + interp_eq' (Coeff c, Coeff result) y z } + ensures { forall y z. y = z -> ctx_holds' l y z -> + pos_exp c z -> pos_exp result z } + raises { OutOfBounds -> true } + = match c with + | I _ -> c + | E e -> E (propagate_exp e) + | R -> R + end + in + let rec propagate_c (c:cprod) + ensures { forall y z. y=z -> ctx_holds' l y z -> + interp_c c y z = interp_c result y z } + variant { c } + raises { OutOfBounds -> true } + ensures { forall y z. y = z -> ctx_holds' l y z -> + pos_cprod c z -> pos_cprod result z } + = match c with + | C c -> C (propagate_coeff c) + | Times c1 c2 -> Times (propagate_c c1) (propagate_c c2) + end + in + let rec propagate_e (e:expr') + requires { expr_bound' e m } + ensures { expr_bound' result m } + ensures { forall y z. y=z -> ctx_holds' l y z -> interp_eq' (e,result) y z } + variant { e } + raises { OutOfBounds -> true } + requires { valid_expr' e } + ensures { valid_expr' result } + ensures { forall y z. y = z -> ctx_holds' l y z + -> pos_expr' e z -> pos_expr' result z } + = match e with + | Var _ -> e + | ProdL e c -> ProdL (propagate_e e) (propagate_c c) + | ProdR c e -> ProdR (propagate_c c) (propagate_e e) + | Sum e1 e2 -> Sum (propagate_e e1) (propagate_e e2) + | Diff e1 e2 -> Diff (propagate_e e1) (propagate_e e2) + | Coeff c -> Coeff (propagate_coeff c) + end + in + let rec propagate_eq (eq:equality') + requires { eq_bound' eq m } + ensures { eq_bound' result m } + ensures { forall y z. y=z -> interp_ctx' l eq y z <-> interp_ctx' l result y z } + raises { OutOfBounds -> true } + requires { valid_eq' eq } + ensures { valid_eq' result } + ensures { forall y z. y = z -> ctx_holds' l y z + -> pos_eq' eq z -> pos_eq' result z } + = match eq with (a,b) -> (propagate_e a, propagate_e b) end + in + let rec propagate (acc:context') : context' + requires { ctx_bound' acc m } + ensures { ctx_bound' result m } + requires { ctx_impl_ctx' l acc } + ensures { ctx_impl_ctx' l result } + ensures { length result = length acc } + variant { acc } + requires { valid_ctx' acc } + ensures { valid_ctx' result } + ensures { forall y z. y = z -> ctx_holds' l y z + -> pos_ctx' acc z -> pos_ctx' result z } + raises { OutOfBounds -> true } + = match acc with + | Nil -> Nil + | Cons h t -> + let h' = propagate_eq h in + let t' = propagate t in + Cons h' t' + end + in + propagate l, propagate_eq g + + use LinearDecisionRationalMP as R + + let prop_mp_decision (l:context') (g:equality') : bool + requires { valid_ctx' l } + requires { valid_eq' g } + requires { length l < 100000 } + ensures { forall y z. result -> pos_ctx' l z -> pos_eq' g z + -> y = z -> interp_ctx' l g y z } + raises { | OutOfBounds -> true | E.MPError -> true + | E.Q.QError -> true | R.Failure -> true} + = let l', g' = prop_ctx l g in + mp_decision l' g' + +end + +module TestMP + +use import EqPropMP +use import mach.int.UInt64 +use import int.Int +use import int.Power + +meta "compute_max_steps" 0x10000 + +goal g: forall i x c r: int. + 0 <= i -> + x + (2 * (power radix i) * c) = r -> + radix * x + (2 * (power radix (i+1)) * c) = radix * r + +goal g': forall a b i j: int. + 0 <= i -> 0 <= j -> + (power radix i) * a = b -> + i+1 = j -> + (power radix j) * a = radix*b + +goal g'': forall r r' i c x x' y l: int. + 0 <= i -> + c = 0 -> + r + power radix i * c = x + y -> + r' = r + power radix i * l -> + x' = x + power radix i * l -> + r' + power radix (i+1) * c = x' + y + +(*tries to add power radix i and power radix (i+1), fails + -> cst propagation ? *) + +end + +module Test2 + +use import int.Int +use import LinearDecisionInt + +meta "compute_max_steps" 0x10000 + +goal g: forall x y z: int. + x + y = 0 -> + y - z = 0 -> + x = 0 + +end + +module Fmla + +use import map.Map +use import int.Int + +type value +constant dummy : value +predicate foo value +function add value value : value + +type term = Val int | Add term term +type fmla = Forall fmla | Foo term + +function interp_term (t:term) (b:int->value) : value = + match t with + | Val n -> b n + | Add t1 t2 -> add (interp_term t1 b) (interp_term t2 b) + end + +meta rewrite_def function interp_term + +function interp_fmla (f:fmla) (l:int) (b:int->value) : bool = + match f with + | Foo t -> foo (interp_term t b) + | Forall f -> forall v. interp_fmla f (l-1) b[l <- v] + end + +meta rewrite_def function interp_fmla + +function interp (f:fmla) (b: int -> value) : bool = + interp_fmla f (-1) b + +meta rewrite_def function interp + +let f (f:fmla) : bool + ensures { result -> forall b. interp f b } += false +end + +module TestFmla + +use import Fmla + +meta "compute_max_steps" 0x10000 + +goal g: + forall a: value. + ((forall x. forall y. foo (add x (add (add a dummy) y))) = True) + +end \ No newline at end of file diff --git a/examples/multiprecision/lineardecision/why3session.xml b/examples/multiprecision/lineardecision/why3session.xml new file mode 100644 index 0000000000000000000000000000000000000000..204df7ae524b0907a46a5eb5ad51b8cb2bc6c714 --- /dev/null +++ b/examples/multiprecision/lineardecision/why3session.xml @@ -0,0 +1,4352 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +