Implemented cast on int31 directly

3 files changed, 114 insertions, 61 deletions

diff --git a/src/versions/standard/Int63/Int63Native_standard.v b/src/versions/standard/Int63/Int63Native_standard.v
index c8eadfd..ed9d3d0 100644
--- a/src/versions/standard/Int63/Int63Native_standard.v
+++ b/src/versions/standard/Int63/Int63Native_standard.v
@@ -117,18 +117,6 @@ Definition modulo : int -> int -> int :=
 Notation "n '\%' m" := (modulo n m) (at level 40, left associativity) : int63_scope.
 
 (* Comparisons *)
-(* We do not use eqb63 to be able to easily prove eqb_correct *)
-(* Definition eqb_digits d1 d2 := *)
-(*   match d1, d2 with *)
-(*     | D0, D0 | D1, D1 => true *)
-(*     | _, _ => false *)
-(*   end. *)
-
-(* Definition eqb i j := *)
-(*   match i, j with *)
-(*     | I63 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d29 d30 d31 d32 d33 d34 d35 d36 d37 d38 d39 d40 d41 d42 d43 d44 d45 d46 d47 d48 d49 d50 d51 d52 d53 d54 d55 d56 d57 d58 d59 d60 d61 d62, I63 d'0 d'1 d'2 d'3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30 d'31 d'32 d'33 d'34 d'35 d'36 d'37 d'38 d'39 d'40 d'41 d'42 d'43 d'44 d'45 d'46 d'47 d'48 d'49 d'50 d'51 d'52 d'53 d'54 d'55 d'56 d'57 d'58 d'59 d'60 d'61 d'62 => *)
-(*       (eqb_digits d0 d'0) && (eqb_digits d1 d'1) && (eqb_digits d2 d'2) && (eqb_digits d3 d'3) && (eqb_digits d4 d'4) && (eqb_digits d5 d'5) && (eqb_digits d6 d'6) && (eqb_digits d7 d'7) && (eqb_digits d8 d'8) && (eqb_digits d9 d'9) && (eqb_digits d10 d'10) && (eqb_digits d11 d'11) && (eqb_digits d12 d'12) && (eqb_digits d13 d'13) && (eqb_digits d14 d'14) && (eqb_digits d15 d'15) && (eqb_digits d16 d'16) && (eqb_digits d17 d'17) && (eqb_digits d18 d'18) && (eqb_digits d19 d'19) && (eqb_digits d20 d'20) && (eqb_digits d21 d'21) && (eqb_digits d22 d'22) && (eqb_digits d23 d'23) && (eqb_digits d24 d'24) && (eqb_digits d25 d'25) && (eqb_digits d26 d'26) && (eqb_digits d27 d'27) && (eqb_digits d28 d'28) && (eqb_digits d29 d'29) && (eqb_digits d30 d'30) && (eqb_digits d31 d'31) && (eqb_digits d32 d'32) && (eqb_digits d33 d'33) && (eqb_digits d34 d'34) && (eqb_digits d35 d'35) && (eqb_digits d36 d'36) && (eqb_digits d37 d'37) && (eqb_digits d38 d'38) && (eqb_digits d39 d'39) && (eqb_digits d40 d'40) && (eqb_digits d41 d'41) && (eqb_digits d42 d'42) && (eqb_digits d43 d'43) && (eqb_digits d44 d'44) && (eqb_digits d45 d'45) && (eqb_digits d46 d'46) && (eqb_digits d47 d'47) && (eqb_digits d48 d'48) && (eqb_digits d49 d'49) && (eqb_digits d50 d'50) && (eqb_digits d51 d'51) && (eqb_digits d52 d'52) && (eqb_digits d53 d'53) && (eqb_digits d54 d'54) && (eqb_digits d55 d'55) && (eqb_digits d56 d'56) && (eqb_digits d57 d'57) && (eqb_digits d58 d'58) && (eqb_digits d59 d'59) && (eqb_digits d60 d'60) && (eqb_digits d61 d'61) && (eqb_digits d62 d'62) *)
-(*   end. *)
 Definition eqb := eqb31.
 Notation "m '==' n" := (eqb m n) (at level 70, no associativity) : int63_scope.
 
@@ -140,23 +128,10 @@ Definition leb : int -> int -> bool :=
   fun i j => match compare31 i j with | Gt => false | _ => true end.
 Notation "m <= n" := (leb m n) : int63_scope.
 
-(* This operator has the following reduction rule
-     eqb_correct i i (eq_refl true) ---> (eq_refl i) *)
-(* Lemma eqb_digits_correct : *)
-(*   forall d1 d2, eqb_digits d1 d2 = true <-> d1 = d2. *)
-(* Proof. intros [|] [|]; split; try reflexivity; discriminate. Defined. *)
-
-(* Lemma andb_true_iff : forall b1 b2, *)
-(*   b1 && b2 = true <-> b1 = true /\ b2 = true. *)
-(* Proof. intros [|] [|]; repeat split; try reflexivity; try discriminate; intros [H1 H2]; discriminate. Defined. *)
 
+(* TODO: fill this proof (should be in the stdlib) *)
 Lemma eqb_correct : forall i j, (i==j)%int = true -> i = j.
 Admitted.
-(* Proof. *)
-(*   unfold eqb. intros [d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d29 d30 d31 d32 d33 d34 d35 d36 d37 d38 d39 d40 d41 d42 d43 d44 d45 d46 d47 d48 d49 d50 d51 d52 d53 d54 d55 d56 d57 d58 d59 d60 d61 d62] [d'0 d'1 d'2 d'3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30 d'31 d'32 d'33 d'34 d'35 d'36 d'37 d'38 d'39 d'40 d'41 d'42 d'43 d'44 d'45 d'46 d'47 d'48 d'49 d'50 d'51 d'52 d'53 d'54 d'55 d'56 d'57 d'58 d'59 d'60 d'61 d'62]. *)
-(*   do 62 (rewrite andb_true_iff; intros [H1 H2]; rewrite eqb_digits_correct in H2; subst; revert H1). *)
-(*   rewrite eqb_digits_correct. intros ->. reflexivity. *)
-(* Defined. *)
 
 
 (* Iterators *)
diff --git a/src/versions/standard/Int63/Int63Op_standard.v b/src/versions/standard/Int63/Int63Op_standard.v
index 1863497..3a0dfae 100644
--- a/src/versions/standard/Int63/Int63Op_standard.v
+++ b/src/versions/standard/Int63/Int63Op_standard.v
@@ -241,18 +241,91 @@ Definition sqrt2 ih il :=
 
 (* Extra function on equality *)
 
-Definition cast i j :=
-     (if i == j as b return ((b = true -> i = j) -> option (forall P : int -> Type, P i -> P j))
-      then fun Heq : true = true -> i = j =>
-             Some
-             (fun (P : int -> Type) (Hi : P i) =>
-               match Heq (eq_refl true) in (_ = y) return (P y) with
-               | eq_refl => Hi
-               end)
-      else fun _ : false = true -> i = j => None) (eqb_correct i j).
-
-Definition eqo i j :=
-   (if i == j as b return ((b = true -> i = j) -> option (i=j))
-    then fun Heq : true = true -> i = j =>
-             Some (Heq (eq_refl true))
-     else fun _ : false = true -> i = j => None) (eqb_correct i j).
+Definition cast_digit d1 d2 :
+  option (forall P : Int31.digits -> Type, P d1 -> P d2) :=
+  match d1, d2 with
+  | D0, D0 | D1, D1 => Some (fun P h => h)
+  | _, _ => None
+  end.
+
+(* TODO: improve this definition... *)
+Definition cast i j :
+  option (forall P : int -> Type, P i -> P j) :=
+  match i, j return option (forall P : int -> Type, P i -> P j) with
+  | I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d29 d30, I31 d'0 d'1 d'2 d'3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30 =>
+    match
+      cast_digit d0 d'0,
+      cast_digit d1 d'1,
+      cast_digit d2 d'2,
+      cast_digit d3 d'3,
+      cast_digit d4 d'4,
+      cast_digit d5 d'5,
+      cast_digit d6 d'6,
+      cast_digit d7 d'7,
+      cast_digit d8 d'8,
+      cast_digit d9 d'9,
+      cast_digit d10 d'10,
+      cast_digit d11 d'11,
+      cast_digit d12 d'12,
+      cast_digit d13 d'13,
+      cast_digit d14 d'14,
+      cast_digit d15 d'15,
+      cast_digit d16 d'16,
+      cast_digit d17 d'17,
+      cast_digit d18 d'18,
+      cast_digit d19 d'19,
+      cast_digit d20 d'20,
+      cast_digit d21 d'21,
+      cast_digit d22 d'22,
+      cast_digit d23 d'23,
+      cast_digit d24 d'24,
+      cast_digit d25 d'25,
+      cast_digit d26 d'26,
+      cast_digit d27 d'27,
+      cast_digit d28 d'28,
+      cast_digit d29 d'29,
+      cast_digit d30 d'30
+    with
+    | Some k0,
+      Some k1,
+      Some k2,
+      Some k3,
+      Some k4,
+      Some k5,
+      Some k6,
+      Some k7,
+      Some k8,
+      Some k9,
+      Some k10,
+      Some k11,
+      Some k12,
+      Some k13,
+      Some k14,
+      Some k15,
+      Some k16,
+      Some k17,
+      Some k18,
+      Some k19,
+      Some k20,
+      Some k21,
+      Some k22,
+      Some k23,
+      Some k24,
+      Some k25,
+      Some k26,
+      Some k27,
+      Some k28,
+      Some k29,
+      Some k30 =>
+      Some (fun P h =>
+              k0 (fun d0 => P (I31 d0 d'1 d'2 d'3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k1 (fun d1 => P (I31 d0 d1 d'2 d'3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k2 (fun d2 => P (I31 d0 d1 d2 d'3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k3 (fun d3 => P (I31 d0 d1 d2 d3 d'4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k4 (fun d4 => P (I31 d0 d1 d2 d3 d4 d'5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k5 (fun d5 => P (I31 d0 d1 d2 d3 d4 d5 d'6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k6 (fun d6 => P (I31 d0 d1 d2 d3 d4 d5 d6 d'7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k7 (fun d7 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d'8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k8 (fun d8 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d'9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k9 (fun d9 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d'10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k10 (fun d10 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d'11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k11 (fun d11 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d'12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k12 (fun d12 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d'13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k13 (fun d13 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d'14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k14 (fun d14 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d'15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k15 (fun d15 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d'16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k16 (fun d16 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d'17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k17 (fun d17 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d'18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k18 (fun d18 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d'19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k19 (fun d19 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d'20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k20 (fun d20 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d'21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k21 (fun d21 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d'22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k22 (fun d22 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d'23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k23 (fun d23 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d'24 d'25 d'26 d'27 d'28 d'29 d'30)) (k24 (fun d24 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d'25 d'26 d'27 d'28 d'29 d'30)) (k25 (fun d25 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d'26 d'27 d'28 d'29 d'30)) (k26 (fun d26 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d'27 d'28 d'29 d'30)) (k27 (fun d27 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d'28 d'29 d'30)) (k28 (fun d28 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d'29 d'30)) (k29 (fun d29 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d29 d'30)) (k30 (fun d30 => P (I31 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28 d29 d30)) h)))))))))))))))))))))))))))))))
+    | _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ => None
+    end
+  end.
+
+
+Definition eqo i j : option (i = j) :=
+  match cast i j with
+  | Some k => Some (k (fun j => i = j) (refl_equal i))
+  | None => None
+  end.
diff --git a/src/versions/standard/Int63/Int63Properties_standard.v b/src/versions/standard/Int63/Int63Properties_standard.v
index ccb103b..c9d57d0 100644
--- a/src/versions/standard/Int63/Int63Properties_standard.v
+++ b/src/versions/standard/Int63/Int63Properties_standard.v
@@ -77,33 +77,38 @@ Proof.
  intros i j;destruct (eqs i j);auto.
 Qed.
 
+(* TODO: fill these proofs *)
 Lemma cast_refl : forall i, cast i i = Some (fun P H => H).
-Proof.
- unfold cast;intros.
- generalize (eqb_correct i i).
- rewrite eqb_refl;intros.
- rewrite (eq_proofs_unicity eq_dec (e (eq_refl true)) (eq_refl i));trivial.
-Qed.
+Admitted.
+(* Proof. *)
+(*  unfold cast;intros. *)
+(*  generalize (eqb_correct i i). *)
+(*  rewrite eqb_refl;intros. *)
+(*  rewrite (eq_proofs_unicity eq_dec (e (eq_refl true)) (eq_refl i));trivial. *)
+(* Qed. *)
 
 Lemma cast_diff : forall i j, i == j = false -> cast i j = None.
-Proof.
- intros;unfold cast;intros; generalize (eqb_correct i j).
- rewrite H;trivial.
-Qed.
+Admitted.
+(* Proof. *)
+(*  intros;unfold cast;intros; generalize (eqb_correct i j). *)
+(*  rewrite H;trivial. *)
+(* Qed. *)
 
 Lemma eqo_refl : forall i, eqo i i = Some (eq_refl i).
-Proof.
- unfold eqo;intros.
- generalize (eqb_correct i i).
- rewrite eqb_refl;intros.
- rewrite (eq_proofs_unicity eq_dec (e (eq_refl true)) (eq_refl i));trivial.
-Qed.
+Admitted.
+(* Proof. *)
+(*  unfold eqo;intros. *)
+(*  generalize (eqb_correct i i). *)
+(*  rewrite eqb_refl;intros. *)
+(*  rewrite (eq_proofs_unicity eq_dec (e (eq_refl true)) (eq_refl i));trivial. *)
+(* Qed. *)
 
 Lemma eqo_diff : forall i j, i == j = false -> eqo i j = None.
-Proof.
- unfold eqo;intros; generalize (eqb_correct i j).
- rewrite H;trivial.
-Qed.
+Admitted.
+(* Proof. *)
+(*  unfold eqo;intros; generalize (eqb_correct i j). *)
+(*  rewrite H;trivial. *)
+(* Qed. *)
 
 (** translation with Z *)
 Require Import Ndigits.