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 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+