more unfinished coq files

coq/baby.v

@@ -0,0 +1,180 @@
+(* non-narcissist version by Olivier Laurent *)
+Section baby.
+	Variable person : Set.
+	Variable loves : person -> person -> Prop.
+
+	Axiom nonNarcissism : forall p1 p2:person,
+		loves p1 p2 -> p1 <> p2.
+
+  Axiom mybaby me : person.
+  Axiom everyoneLovesMybaby : forall p:person,
+    p <> mybaby -> loves p mybaby.
+	Axiom mybabyLovesMe : loves mybaby me.
+  Axiom mybabyLovesOnlyMe : forall p:person,
+		(loves mybaby p) -> p = me.
+  Theorem mybabyIsNotMe : mybaby <> me.
+  Proof.
+		apply nonNarcissism.
+		exact mybabyLovesMe.
+	Qed.
+End baby.
+
+(* trivial version *)
+(* TODO *)
+
+
+(*
+There's a post-apocalyptic model where it's only you and your baby left in the world.
+*)
+
+Section baby.
+
+Inductive person : Set := Me | Baby.
+Variable loves : person -> person -> Prop.
+
+Axiom babyLovesBaby : loves Baby Baby.
+Axiom meLovesBaby : loves Me Baby.
+Axiom babyLovesOnlyMe : forall p:person,
+  p <> Baby -> loves Baby p -> p = Me.
+Theorem mybabyIsMe : Me <> Baby.
+Proof.
+	pose proof (babyLovesOnlyMe Me).
+
+Qed.
+
+
+End baby.
+
+
+Hadn't know about `Variant`. Is the 
+
+
+
+
+
+
+(* SSFT22 version *)
+Section baby.
+  Variable Person : Set.
+  Variable loves : Person -> Person -> Prop.
+
+  Axiom mybaby me : Person.
+  Axiom everyoneLovesMybaby : forall person:Person,
+    loves person mybaby.
+  Axiom mybabyLovesOnlyMe : forall person:Person,
+    person <> me -> not (loves mybaby person).
+  Theorem mybabyIsMe : mybaby = me.
+  Proof.
+    pose proof (everyoneLovesMybaby mybaby).
+    pose proof (mybabyLovesOnlyMe mybaby).
+
+    destruct H0.
+    - intro HH.
+      
+
+    destruct (mybabyLovesOnlyMe mybaby).
+    - intro H.
+
+
+(* Another attempt at accuracy *)
+Section baby.
+  Variable Person : Set.
+  Variable loves : Person -> Person -> Prop.
+
+  Axiom mybaby me : Person.
+  Axiom everyoneLovesMybaby : forall person:Person,
+    person <> mybaby -> loves person mybaby. (* baby cannot love himself *)
+  Axiom mybabyLovesOnlyMe : forall person:Person,
+    loves mybaby person -> person = me.
+  Theorem mybabyIsMe : mybaby <> me.
+  Proof.
+
+
+(* Attempt at accurate framing *)
+Section baby.
+  Variable Person : Set.
+  Variable loves : Person -> Person -> Prop.
+
+  Axiom mybaby me : Person.
+  Axiom everyoneLovesMybaby : forall person:Person,
+    loves person mybaby. (* baby can love himself too *)
+  Axiom mybabyLovesOnlyMe : forall person:Person,
+    loves mybaby person -> person = me \/ person = mybaby.
+  Theorem mybabyIsMe : mybaby <> me.
+  Proof.
+
+
+
+
+
+
+(* backward reasoning *)
+Section baby.
+  Variable Person : Set.
+  Variable loves : Person -> Person -> Prop.
+
+  Axiom mybaby me : Person.
+  Axiom everyoneLovesMybaby : forall person:Person,
+    loves person mybaby.
+  Axiom mybabyLovesOnlyMe : forall person:Person,
+    loves mybaby person -> person = me.
+  Theorem mybabyIsMe : mybaby = me.
+  Proof.
+    rewrite (mybabyLovesOnlyMe mybaby).
+    - reflexivity.
+    - apply (everyoneLovesMybaby mybaby).
+  Show Proof.
+(*
+(eq_ind_r (fun p : Person => p = me) eq_refl
+   (mybabyLovesOnlyMe mybaby (everyoneLovesMybaby mybaby)))
+*)
+  Restart.
+    exact (mybabyLovesOnlyMe mybaby (everyoneLovesMybaby mybaby)).
+  Show Proof.
+(*
+(mybabyLovesOnlyMe mybaby (everyoneLovesMybaby mybaby))
+*)
+  Qed.
+End baby.
+Print mybabyIsMe.
+
+(* forward reasoning *)
+Section baby.
+  Parameter Person : Set.
+  Parameter loves : Person -> Person -> Prop.
+
+  Axiom mybaby' me' : Person.
+  Axiom everyoneLovesMybaby' : forall person:Person,
+    loves person mybaby'.
+  Axiom mybabyLovesOnlyMe' : forall person:Person,
+    loves mybaby' person -> person = me'.
+  Theorem mybabyIsMe' : mybaby = me.
+  Proof.
+    pose proof everyoneLovesMybaby'.
+    specialize (H me').
+    pose proof mybabyLovesOnlyMe.
+    specialize (H0 _ loves me').
+(*
+#+BEGIN_OUTPUT (Goal)
+1 subgoal
+
+Person : Set
+loves : Person -> Person -> Prop
+H : loves me' mybaby'
+H0 : loves (mybaby Person) me' -> me' = me Person
+
+========================= (1 / 1)
+
+mybaby = me
+#+END_OUTPUT (Goal) *)
+
+    specialize (H0 _ loves mybaby).
+    specialize (H0 _ loves me').
+    specialize (H0 nat).
+    exact 
+    specialize H0.
+    rewrite (mybabyLovesOnlyMe mybaby).
+    - reflexivity.
+    - apply (everyoneLovesMybaby mybaby).
+  Qed.
+End baby.

coq/binN-more.v

@@ -0,0 +1,183 @@
+(*
+ - N: https://coq.inria.fr/library/Coq.Numbers.BinNums.html
+ - Z: https://coq.inria.fr/library/Coq.Numbers.BinNums.html
+ - positive: https://coq.inria.fr/library/Coq.Numbers.BinNums.html
+ *)
+
+Require Import ZArith.
+Require Import QArith.
+Require Import Reals.
+
+Check INR.
+(*
+INR
+     : nat -> R
+*)
+Compute 12%R.
+(*
+= ((R1 + R1) * ((R1 + R1) * (R1 + (R1 + R1))))%R
+     : R
+*)
+Compute INR 5.
+(*
+= (R1 + R1 + R1 + R1 + R1)%R
+     : R
+*)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Check Q.
+
+Compute Qmake 2 3.
+(*
+= 2 # 3
+     : Q
+*)
+
+Definition a:Q := Qmake 10 5.
+Definition b:Q := Qmake 5 10.
+Compute a*b.
+(*
+= 50 # 50
+     : Q
+*)
+
+Search (Q -> _).
+
+Compute Qred (50 # 25).
+(*
+= 2
+     : Q
+*)
+Compute Qopp (50 # 25).
+Compute Qopp (-1 # 25).
+Compute Qinv (-1 # 25).
+Compute Qmult (20 # 1) (1 # 2).
+Compute Qmult' (20 # 1) (1 # 2).
+Compute Qminus (10 # 2) (6 # 3).
+Compute Qminus' (10 # 2) (6 # 3).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Check Z.
+
+Compute Z0.
+(*
+= 0%Z
+     : Z
+*)
+Compute Zpos 8%positive.
+(*
+= 8%Z
+     : Z
+*)
+Compute Zneg 53%positive.
+(*
+= (-53)%Z
+     : Z
+*)
+
+
+
+
+
+
+
+
+
+
+Check N.
+
+Compute N0.
+(*
+= 0%N
+     : N
+*)
+Compute Npos 1%positive.
+(*
+= 1%N
+     : N
+*)
+Compute Npos 45%positive.
+(*
+= 45%N
+     : N
+*)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Check positive.
+Check N.
+Check Z.
+
+
+Compute xH.
+(*
+= 1%positive
+     : positive
+*)
+
+Compute xO xH.
+(*
+= 2%positive
+     : positive
+*)
+
+Compute xI xH.
+(*
+= 3%positive
+     : positive
+*)
+
+Compute xO (xI (xO xH)).
+(*
+The term "xO" has type "positive -> positive"
+while it is expected to have type "positive".
+*)
+
+
+Compute xO (xI (xO xO)).
+
+Unset Printing Notations.
+
+Compute xI xH.
+Set Printing Notations.
+Compute xI xH.
+Compute (Pos.to_nat 6%positive).
+
+Search (positive -> nat).

coq/binN.v

@@ -0,0 +1,71 @@
+(*
+ - N: https://coq.inria.fr/library/Coq.Numbers.BinNums.html
+ - Z: https://coq.inria.fr/library/Coq.Numbers.BinNums.html
+ - positive: https://coq.inria.fr/library/Coq.Numbers.BinNums.html
+ *)
+
+Print Nat.
+Require Import Nat.
+Print Nat.
+Print t.
+Unset Printing Notations.
+Check ~True.
+Set Printing Notations.
+
+
+Print nat.
+(*
+Inductive nat : Set :=
+| O : nat
+| S : nat -> nat.
+*)
+
+Require Import BinNums.
+Print positive.
+(*
+Inductive positive : Set :=
+| xI : positive -> positive
+| xO : positive -> positive
+| xH : positive.
+*)
+
+(*Require Import BinNat.*)
+Print N.
+(*
+Inductive N : Set := 
+| N0 : N
+| Npos : positive -> N.
+*)
+
+(*Require Import ZArith.*)
+Print Z.
+(*
+Inductive Z : Set := 
+| Z0 : Z
+| Zpos : positive -> Z
+| Zneg : positive -> Z.
+*)
+
+Require Import Reals.
+Print R.
+
+Require Import QArith.
+Print Q.
+(*
+Record Q : Set := Qmake {
+   Qnum : Z;
+   Qden : positive
+}.
+*)
+
+Check 6%positive.
+Check 6%Q.
+Check 6%R.
+Check 6%N.
+Check 6%Z.
+Compute 6%xpositive.
+
+Unset Printing Notations.
+Check 6%nat.
+Set Printing Notations.
+

coq/cpdt/typed-stack-mc.v

@@ -0,0 +1,171 @@
+Inductive type : Set :=
+| Nat
+| Bool.
+
+Check Nat.
+
+Definition typeDenote (t:type) : Type :=
+  match t with
+  | Nat => nat
+  | Bool => bool
+  end.
+
+Compute (typeDenote Nat).
+
+Inductive binop : type -> type -> type -> Set :=
+| Plus : binop Nat Nat Nat
+| Mult : binop Nat Nat Nat
+| Eq : forall t:type, binop t t Bool
+| Lt : binop Nat Nat Bool.
+
+Check Plus.
+
+Definition binopDenote {t1 t2 t3 : type} (op:binop t1 t2 t3)
+  : (typeDenote t1) -> (typeDenote t2) -> (typeDenote t3) :=
+  match op with
+  | Plus => Nat.add
+  | Mult => Nat.mul
+  | Eq Nat => Nat.eqb
+  | Eq Bool =>
+      fun (x y:bool) => negb (xorb x y)
+  | Lt => Nat.ltb
+  end.
+
+Compute binopDenote Plus.
+
+Inductive exp : type -> Set :=
+| NConst : nat -> exp Nat
+| BConst : bool -> exp Bool
+| Binop : forall (t1 t2 t3:type),
+    binop t1 t2 t3 -> exp t1 -> exp t2 -> exp t3.
+Arguments Binop {t1 t2 t3}.
+
+Check BConst.
+Check Binop Plus (NConst 3) (NConst 4).
+
+Fixpoint expDenote {t:type} (e:exp t) : typeDenote t :=
+  match e with
+  | NConst n => n
+  | BConst b => b
+  | Binop b e1 e2 => (binopDenote b) (expDenote e1) (expDenote e2)
+  end.
+Compute expDenote (Binop Plus (NConst 3) (NConst 4)).
+
+(* Target *)
+Require Import List.
+Import ListNotations.
+
+Definition stack := list type.
+
+Inductive instr : stack -> stack -> Set :=
+| INConst : forall s:stack,
+    nat -> instr s (Nat::s)%list
+| IBConst : forall s:stack,
+    bool -> instr s (Bool::s)%list
+| IBinop : forall (t1 t2 t3:type) (b:binop t1 t2 t3) (s:stack),
+    instr (t1::t2::s)%list (t3::s)%list.
+Arguments IBinop {t1 t2 t3}.
+
+Check INConst [] 3.
+Check IBConst [Nat] true.
+
+(* Converts a list of [type] to an n-tuple of [Type].
+end is [unit] *)
+Fixpoint valstack (s:stack) : Type :=
+  match s with
+  | [] => unit
+  | (t::ts) => (typeDenote t) * (valstack ts)
+  end.
+Compute valstack [Nat; Bool].
+(* = (nat * (bool * unit))%type : Type *)
+
+Definition instrDenote {s1 s2:stack} (i:instr s1 s2)
+  : valstack s1 -> valstack s2 :=
+  match i with
+  | INConst _ n =>
+      fun vs => (n, vs)
+  | IBConst _ b =>
+      fun vs => (b, vs)
+  | IBinop op _ =>
+      fun vs => 
+        let '(t1, (t2, ts)) := vs in
+        ((binopDenote op) t1 t2, ts)
+  end.
+
+
+Compute (3, (nat,unit)).
+
+Compute (instrDenote (INConst [] 3)).
+Compute instrDenote (IBConst [Nat] true).
+
+Inductive prog : stack -> stack -> Set :=
+| pnil : forall s:stack, prog s s
+| pcons : forall s1 s2 s3:stack,
+    instr s1 s2 -> prog s2 s3 -> prog s1 s3.
+Arguments pcons {s1 s2 s3}.
+
+Check pnil [].
+Check pcons (INConst [] 3) (pnil [Nat]).
+Check pcons (INConst [Bool] 3) (pnil [Nat; Bool]).
+Check pcons (INConst _ 3) (pnil _).
+Check pcons (IBConst _ true) (pcons (INConst _ 3) (pnil _)).
+(* Check pcons (INConst [] 3) (pnil []). ✗ *)
+
+Fixpoint progDenote {s1 s2 : stack} (p:prog s1 s2)
+  : valstack s1 -> valstack s2 :=
+  match p with
+  | pnil _ =>
+      fun vs => vs
+  | pcons i p' =>
+      fun vs =>
+        (progDenote p' (instrDenote i vs))
+  end.
+Check progDenote (pnil []).
+Compute (valstack []).
+Compute (valstack [Bool]).
+
+Compute progDenote (pcons (INConst [] 3) (pnil [Nat])).
+Compute (instrDenote (INConst [] 3)).
+Compute (instrDenote (INConst [] 3) tt).
+Compute (instrDenote (INConst [Bool] 3)).
+Compute (instrDenote (INConst [Bool] 3) (true,tt)).
+Compute (instrDenote (INConst [Nat] 3) (2, tt)).
+Compute progDenote (pcons (INConst [Nat] 3) (pnil [Nat; Nat]))
+(instrDenote (INConst [Nat] 3) (2, tt)).
+
+Check progDenote.
+(*
+progDenote
+     : prog ?s1 ?s2 -> valstack ?s1 -> valstack ?s2
+*)
+
+Check instrDenote.
+(*
+instrDenote
+     : instr ?s1 ?s2 -> valstack ?s1 -> valstack ?s2
+*)
+
+(* Concat 2 programs *)
+Fixpoint pconcat {s1 s2 s3:stack} (p:prog s1 s2)
+  : prog s2 s3 -> prog s1 s3 :=
+  match p with
+  | pnil _ => fun p' => p'
+  | pcons i pr => fun p' => pcons i (pconcat pr p')
+  end.
+
+(*
+  | NConst n => pcons (INConst [] n) (pnil [Nat])
+  | BConst b => pcons (IBConst [] b) (pnil [Bool])
+*)
+Fixpoint pcompile {t:type} (e:exp t) (s:stack) : prog s (t::s) :=
+  match e with
+  | NConst n => pcons (INConst s n) (pnil (Nat::s))
+  | BConst b => pcons (IBConst s b) (pnil (Bool::s))
+  | Binop bop e1 e2 => pconcat (pcompile e2 _)
+      (pconcat (pcompile e1 _)
+        (*(pcons (IBinop bop s) (pnil _)))*)
+        (pcons (IBinop bop s) (pnil (_::s))))
+(*
+  (pcons (@IBinop t1 t2 t3 bop s) (pnil (t3::s))))
+*)
+  end.

coq/sf/1-lf-logic.v

@@ -0,0 +1,194 @@
+Require Import Arith.
+
+Example and_exercise :
+  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
+Proof.
+  intros n m H. 
+  destruct n.
+  - auto.
+  - inversion H.
+Qed.
+
+Example and_exercise':
+  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
+Proof.
+  (* https://github.com/yanhick/coq-exercises/blob/master/LF/Logic.v *)
+  intros n m H. 
+  split.
+  - destruct n.
+    + reflexivity.
+    + inversion H.
+  - destruct m.
+    + reflexivity.
+    + rewrite plus_comm in H.
+      inversion H. (* XXX: Why rewrite helped for inversion? *)
+Qed.
+
+Lemma proj2 : forall P Q : Prop, P /\ Q -> Q.
+Proof.
+  intros p q H.
+  destruct H as [Hp Hq].
+  exact Hq.
+Qed.
+
+Theorem and_assoc : forall P Q R : Prop,
+  P /\ (Q /\ R) -> (P /\ Q) /\ R.
+Proof.
+    intros p q r H.
+    destruct H as [Hp [Hq Hr]].
+    split.
+    - split.
+      + exact Hp.
+      + exact Hq.
+    - exact Hr.
+Qed.
+
+Fact not_implies_our_not : forall (P:Prop),
+  ~ P -> (forall (Q:Prop), P -> Q).
+Proof.
+  intros p Hp' q Hp.
+  contradiction.
+Qed.
+
+Theorem double_not: forall P:Prop, P -> ~~P. 
+Proof.
+  intros p Hp.
+  (* Or just [auto] *)
+  unfold not.
+  intro pF.
+  apply pF.
+  exact Hp.
+Qed.
+
+Theorem contrapositive : forall (P Q : Prop),
+    (P -> Q) -> (~Q -> ~P).
+Proof.
+  intros p q Hpq.
+  intro Hq'.
+  unfold not.
+  intro Hp.
+  destruct Hq'.  (* XXX: What happened here? *)
+  apply Hpq.
+  exact Hp.
+Qed.
+
+Theorem not_both_true_and_false : forall P : Prop,
+  ~ (P /\ ~P).
+Proof.
+  intros p.
+  intro H.
+  destruct H as [H'].
+  destruct H.
+  exact H'.
+Qed.
+
+Theorem not_true_is_false : forall b : bool,
+  b <> true -> b = false.
+Proof.
+  intros b Hb'.
+  unfold not in Hb'.
+  destruct b.
+  - destruct Hb'.
+    reflexivity.
+  - reflexivity.
+Qed.
+
+Theorem iff_sym : forall P Q : Prop,
+  (P <-> Q) -> (Q <-> P).
+Proof.
+  intros p q Hpqiff.
+	destruct Hpqiff as [Hpq Hqp].
+  split.
+  - exact Hqp.
+  - exact Hpq.
+Qed.
+
+Lemma not_true_iff_false : forall b,
+  b <> true <-> b = false.
+Proof.
+	intros b.
+	split.
+  - intro HbnqT.
+	  apply not_true_is_false.
+		exact HbnqT.
+  - intro HbeqF. 
+		rewrite HbeqF.
+	  auto.
+Qed.
+
+Theorem or_distributes_over_and : forall P Q R: Prop,
+  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
+Proof.
+	intros p q r.
+	split.
+  - intro H.
+		split.
+    + destruct H.
+      * auto.
+      * destruct H; auto.
+    + destruct H.
+      * auto.
+      * destruct H; auto.
+  - intro H.
+    destruct H.
+		left.
+		destruct H0.
+    + exact H0.
+    + destruct H.
+		  * exact H.
+      * 
+Abort.
+
+Lemma mul_eq_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0.
+Proof.
+  intros n m.
+  split.
+  - intro H.
+Abort.
+
+Theorem or_assoc :
+  forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R.
+Proof.
+  intros p q r.
+  split.
+  - intro H.
+    destruct H.
+    + left.
+      left.
+      exact H.
+    + destruct H.
+      * left.
+        right.
+        exact H.
+      * right.
+        exact H.
+  - intros [[Hp | Hq] | Hr].
+    + left.
+      exact Hp.
+    + right.
+      left.
+      exact Hq.
+    + right.
+      right.
+      exact Hr.
+Qed.
+
+Lemma mul_eq_0_ternary :
+  forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
+Proof.
+  intros n m p.
+  split.
+  - intro H.
+    Search (_ * _ = 0).
+    (*rewrite mult_is_O.*)
+Abort.
+
+Lemma apply_iff_example :
+  forall n m : nat, n * m = 0 -> n = 0 \/ m = 0.
+Proof.
+  intros n m H.
+  induction n.
+  - auto.
+  - induction m.
+    + auto.
+Abort.

coq/unfinished/2irrat.v

@@ -0,0 +1,196 @@
+(*
+https://www.cs.ru.nl/~freek/comparison/comparison.pdf (page 36)
+https://github.com/coq-community/gaia/blob/61303be0805404b916098dc40f4e946d3df6ac7c/theories/numbers/ssetr.v#L295
+https://github.com/coq-community/coqtail-math/blob/5c22c3d7dcd8cf4c47cf84a281780f5915488e9e/Reals/Reirr.v#L465
+ *)
+(* Attempt to duplicate coq example from '17 provers of the world' *)
+Require Import Coq.Reals.Reals.
+Require Import ArithRing.
+Require Import Wf_nat.
+Require Import Peano_dec.
+Require Import Div2.
+Require Import Even.
+(*
+
+(*Compute double 3.2.*)
+Compute div2 3.
+
+Theorem double_div2 : forall (n : nat),
+  div2 (double n) = n.
+Proof.
+  intros.
+  induction n.
+  - reflexivity.
+  - 
+Qed.
+ *)
+(* Old
+Definition irrational (x : R) : Prop :=
+  forall (p : Z) (q : nat), q <> 0 -> x <> (IZR p / NZR q)%R.
+(* The term "p" has type "Z" while it is expected to have type "R".
+*)
+ *)
+
+(* Set of real numbers *)
+Print R.
+
+Definition irrational (x:R) : Prop :=
+  forall (p:Z) (q:nat),
+  q <> 0 ->
+  x <> (IZR p/INR q)%R.
+Check IZR.  (* IZR : Z -> R *)
+Check INR.  (* INR : nat -> R *)
+
+Check even. (* Say that a nat is an even number *)
+Compute (div2 4). (* Divide a nat by 2 *)
+Compute double 4. (* Multiply a nat by 2 *)
+
+Check double_S.
+(*
+double_S
+     : forall n : nat, Nat.double (S n) = S (S (Nat.double n))
+*)
+
+Theorem double_div2 : forall n:nat,
+  div2 (double n) = n.
+Proof.
+  intros.
+  induction n.
+  - reflexivity.
+  - rewrite double_S.
+    simpl.
+    rewrite IHn.
+    reflexivity.
+Qed.
+
+Compute (double_div2 4).
+(*
+= double_div2 4
+     : Nat.div2 (Nat.double 4) = 4
+*)
+
+Theorem double_inv : forall (n m:nat),
+  (double n = double m)
+  -> (n = m).
+Proof.
+  intros.
+  rewrite <- (double_div2 n).
+  rewrite <- (double_div2 m).
+  rewrite H.
+  reflexivity.
+Qed.
+
+Theorem double_mult_left : forall (n m:nat),
+  double (n*m) = (double n) * m.
+Proof.
+  intros.
+  unfold double.
+  auto with arith. (* TODO *)
+Qed.
+
+Theorem double_mult_right : forall (n m:nat),
+  double (n*m) = n * (double m).
+Proof.
+  intros.
+  unfold double.
+  ring. (* TODO *)
+Qed.
+
+Print even.
+(*
+Inductive even : nat -> Prop :=
+| even_O : even 0
+| even_S : forall n : nat, odd n -> even (S n)
+with odd : nat -> Prop :=
+| odd_S : forall n : nat, even n -> odd (S n)
+
+Arguments even _%nat_scope
+Arguments even_S _%nat_scope
+Arguments odd _%nat_scope
+Arguments odd_S _%nat_scope
+*)
+
+Theorem even_times_even_is_even: forall n:nat,
+  even (n*n) -> even n.
+Proof.
+  intros.
+  case (even_or_odd n).
+  - auto.
+  - apply (even_mult_inv_r _ _ H).
+Qed.
+(*
+#+BEGIN_OUTPUT (Info)
+even_mult_inv_r
+     : forall n m : nat, even (n * m) -> odd n -> even m
+#+END_OUTPUT (Info) *)
+
+(*
+  intros.
+  induction n.
+  - constructor.
+  - 
+
+  Search (even _).
+  pose proof (even_mult_r n n).
+  apply (even_mult_r) with (n:=n;m:=n).
+  - 
+  rewrite <- (even_mult_r n n).
+
+  apply n in (even_mult_r n n).
+  induction n.
+  - constructor.
+  - apply even_S.
+
+    Search (even (S _)).
+
+  - apply (S n) in IHn.
+    Search (even (_*_)).
+
+  Search (even _).
+
+even_mult_r: forall n m : nat, even m -> even (n * m)
+
+even_mult_l: forall n m : nat, even n -> even (n * m)
+
+    Search (even _).
+    *)
+(*
+1 subgoal
+
+n : nat
+H : even (S n * S n)
+IHn : even (n * n) -> even n
+
+========================= (1 / 1)
+
+even (S n)
+*)
+
+Theorem main_th_aux : forall (n:nat),
+  (even n)
+  -> (double (double ((div2 n) * (div2 n)))) = (n * n).
+Proof.
+  intros.
+  rewrite double_mult_left.
+  rewrite double_mult_right.
+  repeat (rewrite <- even_double; auto).
+Qed.
+
+Theorem main_th: forall (n p:nat),
+  n*n = double p*p
+  -> p = 0.
+Proof.
+  intros n.
+  pattern n.
+  induction n.
+  - unfold Nat.double.
+  - 
+  Search (double _).
+Admitted.
+
+Check sqrt.  (* sqrt : R -> R *)
+Print sqrt.
+
+Theorem sqrt2_is_irrational : irrational (sqrt 2%R).
+Proof.
+Admitted.

coq/unfinished/IP.v

@@ -0,0 +1,72 @@
+Definition ipv4part : Set := {n:nat | n<256}.
+
+Check sig.
+(*
+sig
+     : forall A : Type, (A -> Prop) -> Type
+*)
+Print sig.
+(*
+Inductive sig (A : Type) (P : A -> Prop) : Type :=
+    exist : forall x : A, P x -> {x : A | P x}
+*)
+Lemma Lt3_256 : 3 < 256.
+Proof.
+  repeat constructor.
+Qed.
+Check @exist nat (fun x:nat => x<256) 3 Lt3_256.
+Check @exist nat (fun x:nat => x<256) 3 Lt3_256: ipv4part.
+Check @exist nat (fun x:nat => x<256) 3 _:ipv4part.
+Check exist _ 3 _:ipv4part.
+(*
+Check exist (fun x=>x<256) 3.
+Check sig nat.
+Check sig nat 3 3<256.
+Check 3 3<256 :ipv4part.
+ *)
+
+Inductive ipv4 : Set :=
+| IPv4 : ipv4part ->  ipv4part -> ipv4part -> ipv4part -> ipv4.
+
+Notation "a ; b ; c ; d" := (IPv4
+  (exist _ a _ : ipv4part)
+  (exist _ b _ : ipv4part)
+  (exist _ c _ : ipv4part)
+  (exist _ d _ : ipv4part))
+  (at level 80, b at next level, c at next level, d at next level).
+Check 12;12;12;12.
+
+Definition projIPv4 (ip:ipv4) (n:nat): nat :=
+  let comp : ipv4part :=
+    match ip with
+    | IPv4 p q r s =>
+        match n with
+        | 0 => p
+        | 1 => q
+        | 2 => r
+        | 3 => s
+        | _ => p
+        end
+    end
+  in
+    match comp with
+    | exist _ res _ => res
+    end.
+Compute projIPv4 (12;13;14;15) 2.
+
+Theorem Th1 : forall (n:nat) (ip:ipv4),
+  projIPv4 ip n < 256.
+Proof.
+  intros.
+  induction n.
+  - induction ip.
+    induction i.
+
+  induction ip.
+  - 
+
+(*
+Notation "| n" := (exist _ n _ : ipv4part) (at level 100).
+Check |2.
+Check IPV4 (|2) (|2) (|2) (|2).
+ *)

coq/unfinished/ball-fixpoint-eg.v

@@ -0,0 +1,157 @@
+Require Import List.
+Require Import Coq.Arith.Even.
+Require Import Recdef.
+Import ListNotations.
+Require Import Relations.
+
+(* ** Attempt 3 *)
+Record bag := mkBag {
+    nblack: nat
+  ; nwhite: nat
+}.
+
+Print relation.
+(*
+relation = fun A : Type => A -> A -> Prop
+     : Type -> Type
+
+Arguments relation _%type_scope
+*)
+
+Inductive step : relation bag :=
+| bb : forall b w,
+    step (mkBag (S (S b)) w) (mkBag b (S w))
+| ww : forall b w,
+    step (mkBag b (S (S w))) (mkBag b (S w))
+| bw : forall b w,
+    step (mkBag (S b) (S w)) (mkBag (S b) w).
+
+Print clos_refl_trans.
+(*
+Inductive clos_refl_trans (A : Type) (R : relation A) (x : A) : A -> Prop :=
+    rt_step : forall y : A, R x y -> clos_refl_trans A R x y
+  | rt_refl : clos_refl_trans A R x x
+  | rt_trans : forall y z : A,
+               clos_refl_trans A R x y ->
+               clos_refl_trans A R y z -> clos_refl_trans A R x z
+
+Arguments clos_refl_trans _%type_scope
+Arguments rt_step _%type_scope
+Arguments rt_refl _%type_scope
+Arguments rt_trans _%type_scope
+*)
+
+Check step.
+Check clos_refl_trans bag step.
+
+Definition process : bag -> bag -> Prop := clos_refl_trans _ step.
+
+Definition invariant (bin bout:bag) : Prop :=
+  Nat.odd (nblack bin) = Nat.odd (nblack bout).
+
+Lemma step_invariant (bin bout:bag)
+  : step bin bout -> invariant bin bout.
+Proof.
+  inversion 1; unfold invariant; simpl; trivial.
+Qed.
+
+(*
+  inversion 1.
+  - unfold invariant.
+    simpl.
+    trivial.
+ *)
+
+Theorem process_invariant (bin bout:bag)
+  : process bin bout -> invariant bin bout.
+Proof.
+  (*intros.
+     induction H.*)
+  induction 1.
+  - apply step_invariant.
+    exact H.
+  - reflexivity.
+  - unfold invariant.
+    transitivity (Nat.odd (nblack y)).
+    * transitivity (IH.
+
+
+(* ** Attempt 2 *)
+
+Notation black := false.
+Notation white := true.
+
+
+
+(*
+Fixpoint proc (bag:list bool) : list bool :=
+  match bag with
+  | (a::b::ls) =>
+      match a, b with
+      | black, black => proc (white::ls)
+      | white, white => proc (white::ls)
+      | _, _ => proc (black::ls)
+      end
+  | _ => bag
+  end.
+*)
+
+Function proc_rec (bag:list bool) {measure length bag} : list bool :=
+  match bag with
+  | nil | [_] => bag
+  | _::_::ls => proc_rec (proc_rec bag)
+  (*| _ => bag*)
+  end.
+
+Definition b := false.
+Check b.
+Compute match b with
+| true => true
+| false => true
+end.
+
+Fixpoint proc (bag:list bool) {struct bag} : list bool :=
+  match bag with
+  | (a::b::ls) =>
+      match a, b with
+      | false, false => proc (true::ls)
+      | true, true => proc (true::ls)
+      | _, _ => proc (false::ls)
+      end
+  | _ => bag
+  end.
+
+Compute Nat.even 3.
+Compute even 3.
+
+Check filter.
+(*
+filter
+     : forall A : Type, (A -> bool) -> list A -> list A
+*)
+Check count_occ.
+
+Definition booleqb (a b:bool):bool := negb (xorb a b).
+Compute filter (fun x=>x) [].
+
+Definition count (l:list bool) (val:bool) : nat :=
+  length (filter (fun elem => booleqb elem val) l).
+Compute count [true; false; true] true.
+
+Compute Nat.odd 1.
+(*
+Goal forall (p q : Prop), p -> p->q -> q.
+Proof.
+  intros.
+ *)
+
+Theorem proc_odd_b : forall bag:list bool,
+  (length bag) > 0 -> odd (count bag false) -> proc bag = [false].
+Proof.
+  intros.
+  induction bag.
+  - simpl.
+    inversion H.
+  - induction a.
+    * intuition.
+    * apply IHbag in H.

coq/unfinished/day.v

@@ -0,0 +1,165 @@
+(* https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/A.20date.20type.20in.20coq *)
+
+Require Import NArith.
+Require Import List.
+Import ListNotations.
+
+Record raw_date := mkRawDate {
+  year:nat
+; month:nat
+; day:nat
+}.
+
+Definition range_check (val low high:nat) : bool :=
+  (Nat.leb low val) && (Nat.leb val high).
+
+Definition isLeapYear (y:nat) : bool :=
+  if (Nat.modulo y 4) then
+    if (Nat.modulo y 100) then
+      if (Nat.modulo y 400) then
+        true
+      else
+        false
+    else
+      true
+  else
+    false.
+
+Fixpoint isin (a:nat) (ls:list nat) : bool :=
+  (* Check if [a] ∈ [ls] *)
+  match ls with
+  | nil => false
+  | cons x xs =>
+     if (Nat.eqb x a) then true
+     else isin a xs
+  end.
+
+Definition range_check_N (val low high:N) : bool :=
+  (* Check if val ∈ [low, high] interval *)
+  (N.leb low val) && (N.leb val high).
+
+Definition valid_year (y:nat) : bool := range_check y 1 9999.
+Definition valid_month (m:nat) : bool := range_check m 1 12.
+Definition valid_day (y m d:nat) : bool :=
+  if Nat.eqb m 2 then
+    (* It's February *)
+    if isLeapYear y then
+      range_check d 1 29
+    else
+      range_check d 1 28
+  else
+    if isin 2 [1; 3; 5; 7; 8; 10; 12]%list then
+      range_check d 1 31
+    else
+      range_check d 1 30.
+
+Definition valid_date (d:raw_date) : bool :=
+  (valid_year d.(year)    &&
+  valid_month d.(month)  &&
+  valid_day d.(year) d.(month) d.(day))%bool.
+
+Definition date : Type := {d:raw_date | valid_date d = true}.
+
+Definition rawDateEq (a b:raw_date) : bool :=
+  (Nat.eqb a.(year) b.(year)    && 
+   Nat.eqb a.(month) b.(month)  && 
+   Nat.eqb a.(day) b.(day))%bool.
+Definition rawDateLt (a b:raw_date) : bool :=
+  if (Nat.ltb a.(year) b.(year)) then
+    true
+  else
+    if (Nat.ltb a.(month) b.(month)) then
+      true
+    else
+      if (Nat.ltb a.(day) b.(day)) then
+        true
+      else
+        false.
+Definition rawDateGt (a b:raw_date) : bool :=
+  rawDateLt b a.
+Definition rawDateLe (a b:raw_date) : bool :=
+  orb (rawDateEq a b) (rawDateLt a b).
+Definition rawDateGe (a b:raw_date) : bool :=
+  orb (rawDateEq a b) (rawDateGt a b).
+
+Compute mkRawDate 2002 12 01.
+Print existT.
+Compute valid_date (mkRawDate 2002 12 01).
+Check exist (fun d => valid_date d = true).
+Compute
+  let x := (mkRawDate 2002 12 01) in
+   exist (fun d => valid_date d = true) x.
+Compute
+  let x := (mkRawDate 2002 12 41) in
+   exist (fun d => valid_date d = true) x.
+Program Example foo : date := 
+  let x := (mkRawDate 2002 12 41) in
+   exist (fun d => valid_date d = true) x _.
+Next Obligation.
+  unfold valid_date.
+  simpl.
+  unfold valid_day.
+  simpl.
+  unfold range_check.
+  simpl.
+  (* Goal becomes [false = true] *)
+Abort.
+
+Program Example foo : date := 
+  let x := (mkRawDate 2002 12 11) in
+   exist (fun d => valid_date d = true) x _.
+Compute foo.
+Compute proj1_sig foo.
+
+Check le_n.
+Program Example bar2 : {n:nat | n < 2} :=
+  exist _ 1 _.
+Compute bar2.
+
+Program Example bar10 : {n:nat | n < 10} :=
+  exist _ 1 _.
+Next Obligation.
+  repeat constructor.
+Qed.
+Compute bar10.
+
+Notation "{{ y m d }}" :=
+  Program 
+
+Example foo' : date.
+  refine (exist (fun d => valid_date d = true) _ _).
+  (*
+  refine ((fun d => valid_date d = true) (mkRawDate 2002 12 11)).
+  *)
+Abort.
+Check 02.
+
+Program Example foo1 : date := 
+  let x := (mkRawDate 2011 02 29) in
+   exist (fun d => valid_date d = true) x _.
+Next Obligation.
+Abort.
+
+
+(*
+Definition day28 : Set := { n:nat | n > 0 /\ n < 29}.
+Definition day29 : Set := { n:nat | n > 0 /\ n < 30}.
+Definition day30 : Set := { n:nat | n > 0 /\ n < 31}.
+Definition day31 : Set := { n:nat | n > 0 /\ n < 32}.
+
+Inductive day : Set :=
+| D28 : day28 -> day
+| D29 : day29 -> day
+| D31 : day30 -> day
+| D30 : day31 -> day.
+
+Check 2:day28.
+Check (D28 28).
+Definition month : Set := { n:nat | n > 0 /\ n < 13}.
+
+Inductive month : Set :=
+| D28 : day28 -> day
+| D29 : day29 -> day
+| D31 : day30 -> day
+| D30 : day31 -> day.
+ *)

coq/unfinished/embeddings.v

@@ -0,0 +1,149 @@
+Check mult.
+
+Inductive exp : Set :=
+| Const : nat -> exp
+| Plus : exp -> exp -> exp
+| Mult : exp -> exp -> exp.
+
+Fixpoint expDenote (e : exp) : nat :=
+  match e with
+  | Const n => n
+  | Plus e1 e2 => plus (expDenote e1) (expDenote e2)
+  | Mult e1 e2 => mult (expDenote e1) (expDenote e2)
+  end.
+
+
+
+(*
+(* Deep 2 *)
+Inductive exp : Set :=
+| Const : nat -> exp
+| Plus : exp -> exp -> exp.
+
+Fixpoint expDenote (e : exp) : nat :=
+  match e with
+  | Const n => n
+  | Plus e1 e2 => plus (expDenote e1) (expDenote e2)
+  end.
+Compute (expDenote (Plus (Const 3) (Const 2))).
+(*
+#+BEGIN_OUTPUT (Info)
+= 5
+     : nat
+#+END_OUTPUT (Info) *)
+Compute (expDenote (Plus (Plus (Const 1) (Const 3)) (Const 2))).
+(*
+#+BEGIN_OUTPUT (Info)
+= 6
+     : nat
+#+END_OUTPUT (Info) *)
+
+Reset expDenote.
+Reset Plus.
+Reset Const.
+ *)
+
+
+(*
+(* Deep 1 *)
+Inductive oprtr : Set :=
+| Plus.
+
+Definition opDenote (op : oprtr) : nat -> nat -> nat :=
+  match op with
+  | Plus => plus
+  end.
+Compute (opDenote Plus) 3 2. 
+
+Inductive exp : Set :=
+| Const : nat -> exp
+| Oprtr : oprtr -> nat -> nat -> exp.
+
+Definition expDenote (e : exp) : nat :=
+  match e with
+  | Const n => n
+  | Oprtr op n1 n2 => (opDenote op) n1 n2
+  end.
+Compute (Plus (Const 3) (Const 2)).
+*)
+
+(*
+(* Shallow *)
+Definition Plus := plus.
+Definition Const (n : nat) := n.
+Compute (Plus (Const 3) (Const 2)).
+Compute (Plus (Plus (Const 1) (Const 3)) (Const 2)).
+ *)
+
+(*
+(* Shallow: new construct *)
+Definition Const (n : nat) := n.
+Definition Plus := plus.
+Definition Mult := mult.
+Compute (Mult (Const 3) (Const 2)).
+Compute (Plus (Const 2) (Mult (Const 5) (Const 3))).
+ *)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Inductive shape : Type :=
+| Circule : nat -> region.
+with
+Inductive region : Type :=
+| Circle : nat -> region
+| Outside : region -> region
+| Intersect : region -> region -> region
+| Union : region -> region -> region.
+
+Fixpoint regionDenote (r : region) :=
+  match 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(* Deep *)
+Inductive exp : Type :=
+| Const : nat -> exp
+| Plus : nat -> nat -> exp.
+
+Fixpoint expDenote (e : exp) : nat :=
+  match e with
+  | Const n => n
+  | Plus e1 e2 => e1 + e2
+  end.
+Compute (expDenote (Plus (Const 2) (Const 3))).
+
+(* Shallow *)
+Definition Const' (n : nat) : nat := n.
+Definition Plus' (e1 e2 : nat) : nat := e1 + e2.
+Compute Plus' (Const' 2) (Const' 3).
+

coq/unfinished/eqdec.v

@@ -0,0 +1,24 @@
+Print Eq.
+Class Eq (A:Type) := {
+  eqb: A -> A -> bool;
+}.
+
+Instance eqBool : Eq bool := {
+  eqb :=
+    fun (a b:bool) =>
+      match a,b with
+      | true, true => true
+      | false, false => true
+      | _, _ => false
+      end
+}.
+
+Class EqDec (A:Type) {H:Eq A} := {
+  eqb_eq: forall x y:A,
+    (eqb x y) = true <-> x = y
+}.
+
+Require Import Nat.
+Instance eqdecNat : EqDec nat := {
+  eqb_eq := Nat.eqb_eq
+}.

coq/unfinished/fibo-property.v

@@ -0,0 +1,36 @@
+Check {1=2} + {1<>2}.
+Require Import List.
+Import ListNotations.
+
+Fixpoint fibo (n:nat):nat :=
+  match n with
+  | O => 0
+  | S n' =>
+      match n' with
+      | O => 1
+      | S n'' => (fibo n') + (fibo n'')
+      end
+  end.
+
+Compute fold_right (fun x acc => (fibo x)::acc)
+  [] [0;1;2;3;4;5;6;7].
+
+Theorem th: forall n0 n1 n2:nat,
+  n2 = S n1 -> n1 = S n0 ->
+  let n0n2 := (fibo n0)*(fibo n2) in
+  let fn1 := (fibo n1) in
+  {n0n2 = (fn1*fn1)+1} + {n0n2 = (fn1*fn1)-1}.
+Proof.
+  intros.
+  unfold n0n2.
+  unfold fn1.
+  right.
+  induction n0.
+  - simpl.
+    induction n1.
+    + reflexivity.
+    + 
+
+  left.
+  induction n1.
+  - simpl.

coq/unfinished/geekcode.v

@@ -0,0 +1,55 @@
+Inductive othergeektype : Set :=
+| GB	(* Geek of Business *)
+| GC	(* Geek of Classics *)
+| GCA	(* Geek of Commercial Arts *)
+| GCM	(* Geek of Computer Management *)
+| GCS	(* Geek of Computer Science *)
+| GCC	(* Geek of Communications *)
+| GE	(* Geek of Engineering *)
+| GED	(* Geek of Education *)
+| GFA	(* Geek of Fine Arts *)
+| GG	(* Geek of Government *)
+| GH	(* Geek of Humanities *)
+| GIT	(* Geek of Information Technology *)
+| GJ	(* Geek of Jurisprudence (Law) *)
+| GLS	(* Geek of Library Science *)
+| GL	(* Geek of Literature *)
+| GMC	(* Geek of Mass Communications *)
+| GM	(* Geek of Math *)
+| GMD	(* Geek of Medicine *)
+| GMU	(* Geek of Music *)
+| GPA	(* Geek of Performing Arts *)
+| GP	(* Geek of Philosophy *)
+| GS	(* Geek of Science (Physics, Chemistry, Biology, etc.) *)
+| GSS	(* Geek of Social Science (Psychology, Sociology, etc.) *)
+| GTW	(* Geek of Technical Writing*)
+| GO	(* Geek of Other. Some types of geeks deviate from the normal geek activities. This is encouraged as true geeks come from all walks of life. *)
+| GU	(* Geek of 'Undecided'. This is a popular vocation with incoming freshmen.*)
+| GNo	(* Geek of no qualifications. A rather miserable existence, you would think.*).
+
+Inductive geektype : Set :=
+| GAT	(* Geek of All Trades*)
+| Gother : othergeektype -> list othergeektype -> geektype (* Other geek types *).
+(* GAT means no other can show up *)
+
+Inductive pgp : Set :=
+| PGP4   (* I am Philip Zimmerman  *)
+| PGP3   (* I don't send or answer mail that is not encrypted, or at the very least signed. If you are reading this without decrypting it first, something is wrong. IT DIDN'T COME FROM ME!  *)
+| PGP2   (* I have the most recent version and use it regularly  *)
+| PGP1   (* "Finger me for my public key"  *)
+| PGP0   (* I've used it, but stopped long ago.  *)
+| PGP1'  (* I don't have anything to hide.  *)
+| PGP2'  (* I feel that the glory of the Internet is in the anarchic, trusting environment that so nurtures the exchange of information. Encryption just bogs that down.  *)
+| PGP3'  (* If you support encryption on the Internet, you must be a drug dealer or terrorist or something like that.  *)
+| PGP4'  (* Oh, here is something you all can use that is better (insert Clipper here).  *).
+
+Inductive education : Set :=
+| e5    (* I am Stephen Hawking  *)
+| e4    (* Managed to get my Ph.D.  *)
+| e3    (* Got a Masters degree  *)
+| e2    (* Got a Bachelors degree  *)
+| e1    (* Got an Associates degree  *)
+| e0    (* Finished High School  *)
+| e1'   (* Haven't finished High School  *)
+| e2'   (* Haven't even entered High School  *)
+| estar (* I learned everything there is to know about life from the "Hitchhiker's Trilogy" *).

coq/unfinished/hilbert-geometry.v

@@ -0,0 +1,18 @@
+Inductive point : Set :=
+| Point : nat -> nat -> point.
+
+Inductive line : Set :=
+| Line : point -> point -> line.
+
+Inductive plane : Set :=
+(* Plane through 3 non-collinear points *)
+| Plane3Pt : point -> point -> point -> plane.
+
+Definition projX (a:point) : nat :=
+  match a with
+  | Point x _ => x
+  end.
+Definition projY (a:point) : nat :=
+  match a with
+  | Point _ y => y
+  end.

coq/unfinished/infinite-proof.v

@@ -0,0 +1,71 @@
+CoInductive stream (A : Type) : Type :=
+| scons : A -> stream A -> stream A.
+Arguments scons {A}.
+
+CoFixpoint map {A B : Type} (f:A->B) (s : stream A): stream B :=
+  match s with
+  | scons x xs => scons (f x) (map f xs)
+  end.
+
+CoFixpoint interleave {A:Type} (s1 s2:stream A) : stream A :=
+  match s1, s2 with
+  | scons x xs, scons y ys => scons x (scons y (interleave xs ys))
+  end.
+
+Fixpoint take {A:Type} (n:nat) (s:stream A) : list A :=
+  match n, s with
+  | O, _ => nil
+  | S n', scons x xs => cons x (take n' xs)
+  end.
+
+(* Every corecursive call must be guarded by a constructor *)
+
+CoFixpoint true_falses : stream bool := scons true (false_trues)
+  with false_trues : stream bool := scons false (true_falses).
+
+Definition tl {A:Type} (s:stream A) : stream A :=
+  match s with
+  | scons _ xs => xs
+  end.
+
+CoFixpoint zeros : stream nat := scons 0 zeros.
+CoFixpoint ones : stream nat := scons 1 ones.
+CoFixpoint ones' : stream nat := map S zeros.
+
+Theorem ones_eq : ones = ones'.
+Proof.
+  (* Unprovable goal *)
+Abort.
+
+CoInductive stream_eq {A:Type} : stream A -> stream A -> Prop :=
+| Stream_eq : forall (x:A) (t1 t2:stream A),
+    stream_eq t1 t2 -> stream_eq (scons x t1) (scons x t2).
+
+Theorem ones_eq : stream_eq ones ones'.
+Proof.
+  cofix ones_eq.
+  assumption.
+Abort.
+
+Definition strid {A:Type} (s:stream A) : stream A :=
+  match s with
+  | scons x xs => scons x xs
+  end.
+
+Theorem strid_eq {A:Type}: forall (s:stream A),
+  s = strid s.
+Proof.
+  intros.
+  destruct s.
+  - reflexivity.
+Qed.
+
+Theorem ones_eq : stream_eq ones ones'.
+Proof.
+  cofix ones_eq.
+  rewrite (strid_eq ones).
+  rewrite (strid_eq ones').
+  simpl.
+  constructor.
+  unfold map.
+  assumption.

coq/unfinished/inflist.v

@@ -0,0 +1,15 @@
+Require Import Streams.
+
+Print Stream.
+
+CoFixpoint incStream (n:nat):Stream nat :=
+  Cons n (incStream (S n)).
+
+Definition natseq : Stream nat :=
+  let 
+  cofix natseq' (n:nat) : Stream nat :=
+    Cons n (natseq' (S n))
+  in
+    natseq' 0.
+
+Compute Streams.hd (Streams.tl (incStream 1)).

coq/unfinished/metacoq-get-constr.v

@@ -0,0 +1,345 @@
+From MetaCoq.Template Require Import utils All.
+Require Import List String.
+Import ListNotations MonadNotation.
+Locate List.hd.
+Definition default_global_decl :=
+  ConstantDecl (Build_constant_body
+    (tVar ""%string)
+    None
+    (Monomorphic_ctx
+      (LevelSet.Mkt []%list, ConstraintSet.Mkt []%list))).
+Locate kername.
+Check (1,2,3).
+(* (1, 2, 3) : (nat × nat) × nat *)
+Check ((1,2),3).
+(* (1, 2, 3) : (nat × nat) × nat *)
+
+Check ind_bodies.
+Definition default_kername : kername :=
+  (MPfile []%list, ""%string).
+
+Definition default_kg : (kername * global_decl) :=
+  (default_kername, default_global_decl).
+
+Inductive C :=
+| r : C
+| g : nat -> C
+| b : bool -> nat -> C.
+
+MetaCoq Quote Recursively Definition qC := C.
+
+(* TODO *)
+Definition default_oib := 
+{|
+   ind_name := "Empty";
+   ind_type := tSort
+                 {|
+ Universe.t_set := {|
+           UnivExprSet.this := [UnivExpr.npe
+           (NoPropLevel.lSet, false)];
+           UnivExprSet.is_ok := UnivExprSet.Raw.singleton_ok
+           (UnivExpr.npe
+           (NoPropLevel.lSet, false)) |};
+                 Universe.t_ne := eq_refl |};
+   ind_kelim := InType;
+   ind_ctors := [];
+   ind_projs := [] |}.
+
+
+
+Definition aux1 (p : program) : global_env := fst p.
+Compute aux1 qC.
+Locate ident.
+
+Definition aux2 (g : global_env) : (kername * global_decl) := List.hd default_kg g.
+Compute aux2 (aux1 qC).
+
+Definition aux3 (kg : kername * global_decl) : global_decl := snd kg.
+Compute aux3 (aux2 (aux1 qC)).
+Definition t1 := aux3 (aux2 (aux1 qC)).
+Check t1.
+Print global_decl.
+
+Print universes_decl.
+
+Check (Monomorphic_ctx (LevelSet.Mkt []%list, ConstraintSet.Mkt []%list)).
+
+Compute Build_mutual_inductive_body Finite 0 []%list []%list
+(Monomorphic_ctx (LevelSet.Mkt []%list, ConstraintSet.Mkt []%list)) None.
+Definition default_mib := Build_mutual_inductive_body Finite 0 []%list []%list
+(Monomorphic_ctx (LevelSet.Mkt []%list, ConstraintSet.Mkt []%list)) None.
+
+Check InductiveDecl.
+
+Definition aux4 (g : global_decl) : list one_inductive_body := 
+  match g with
+  | ConstantDecl _ => []%list
+  | InductiveDecl mib => mib.(ind_bodies) (* TODO Map *)
+  end.
+Compute aux4 (aux3 (aux2 (aux1 qC))).
+Check map.
+Definition aux5 (oibs : list one_inductive_body)
+  : list (list (ident * term * nat)) :=
+  map (fun o:one_inductive_body => o.(ind_ctors)) oibs.
+
+Compute aux5 (aux4 (aux3 (aux2 (aux1 qC)))). (* CONSTRUCTORS! *)
+
+
+
+Definition aux (p : program) : list (list (ident * term * nat)) :=
+  let genv := fst p in
+  let kgd := List.hd default_kg genv in
+  let gd := snd kgd in
+  let oibs :=
+    match gd with
+    | ConstantDecl _ => []%list
+    | InductiveDecl mib => mib.(ind_bodies)
+    end in
+  map (fun o:one_inductive_body => o.(ind_ctors)) oibs.
+Compute aux qC.
+
+Notation "f $ x" := (f x)
+  (at level 60, right associativity, only parsing).
+
+Definition aux'' (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind => (tmQuoteInductive ind.(inductive_mind)) >>= tmPrint
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'' "C").
+
+Compute let a:=3 in a.
+
+
+Definition aux'2_1 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      oibs <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* list one_inductive_body *)
+
+      tmFail "test"
+
+      (*
+      rs <- map (fun o:one_inductive_body => o.(ind_ctors)) oibs ;;
+         tmPrint rs *)
+  | _ => tmFail "not an inductive"
+  end.
+Compute aux'2_1 "C".
+
+Definition aux'2 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      mib <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* mib : mutual_inductive_body *)
+
+      (* o.(ind_ctors) : list one_inductive_body *)
+      let rs := map (fun o:one_inductive_body => o.(ind_ctors))
+                    mib.(ind_bodies) in
+      tmPrint rs
+      (* rs : list (list ((ident * term) * nat) ) *)
+
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'2 "C").
+
+Definition aux'3 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      mib <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* mib : mutual_inductive_body *)
+
+      (* o.(ind_ctors) : list one_inductive_body *)
+      let rs := map (fun o:one_inductive_body => o.(ind_ctors))
+                    mib.(ind_bodies) in
+      res <- tmEval cbn rs ;;
+      tmPrint res
+      (* rs : list (list ((ident * term) * nat) ) *)
+
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'3 "C").
+
+Definition aux'4 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      mib <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* mib : mutual_inductive_body *)
+
+      (* m.(ind_bodies) : list one_inductive_body *)
+      (* o.(ind_ctors) : list ((ident * term) * nat) *)
+      let rs := map (fun o:one_inductive_body =>
+        map (fun k:((ident*term)*nat) =>
+          let '(i, t, n) := k in
+          (i, t)) o.(ind_ctors))
+                    mib.(ind_bodies) in
+      res <- tmEval cbn rs ;;
+      tmPrint res
+      (* rs : list (list ((ident * term) * nat) ) *)
+
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'4 "C").
+
+
+Print typed_term.
+Print dirpath.
+
+Definition ident_from_inductive (ind : inductive) : ident :=
+  snd ind.(inductive_mind).
+Compute ident_from_inductive (
+      {|
+      inductive_mind := (MPfile ["Datatypes"; "Init"; "Coq"], "nat");
+      inductive_ind := 0 |}).
+Unset Printing Notations.
+Check True \/ False.
+Print or.
+Set Printing Notations.
+Check True \/ False.
+
+(*
+Lemma pq' : forall (p q : Prop), (p -> q) -> (~p \/ q).
+ *)
+
+Lemma a : forall (n : nat), n + 0 = n.
+Proof.
+  intros.
+  induction n.
+  - reflexivity.
+  - simpl.
+    rewrite IHn.
+    reflexivity.
+Qed.
+
+
+Lemma pq : forall (p q : Prop), (p \/ ~p) -> (p -> q) -> (~p \/ q).
+Proof.
+  intros p q H H0.
+  destruct H.  
+  - right.
+    apply H0.
+    exact H.
+  - left.
+    exact H.
+Qed.
+Print pq.
+  
+(*
+Definition helper (ind: inductive) : TemplateMonad typed_term :=
+  x <- tmLocate1 ind.(inductive_mind)
+ *)
+
+Definition aux'5 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      mib <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* mib : mutual_inductive_body *)
+
+      (* m.(ind_bodies) : list one_inductive_body *)
+      (* o.(ind_ctors) : list ((ident * term) * nat) *)
+      let rs := map (fun o:one_inductive_body =>
+        map (fun k:((ident*term)*nat) =>
+          let '(i, t, n) := k in
+          (i, t)) o.(ind_ctors))
+                    mib.(ind_bodies) in
+      res <- tmEval cbn rs ;;
+      tmPrint res
+      (* rs : list (list ((ident * term) * nat) ) *)
+
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'5 "C").
+(* list (string * Type) *)
+
+Definition aux'2 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      oibs <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* list one_inductive_body *)
+
+      let rs := (map (fun o:one_inductive_body => o.(ind_ctors)) oibs) in
+      tmPrint rs
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'2 "C").
+
+
+Definition aux'2 (qname : qualid) : TemplateMonad unit :=
+  x <- tmLocate1 qname ;;
+  (*x2 <- tmQuoteInductive x;;*)
+  match x with
+  | IndRef ind =>
+      x3 <- tmQuoteInductive ind.(inductive_mind) ;;
+      (* list one_inductive_body *)
+     tmPrint x3
+  | _ => tmFail "not an inductive"
+  end.
+MetaCoq Run (aux'2 "C").
+
+Definition aux' (p : program) : list (list (ident * term * nat)) :=
+  let gd := snd $ List.hd default_kg $ (fst p) in
+  map (fun o:one_inductive_body => o.(ind_ctors)) 
+    match gd with
+    | ConstantDecl _ => []%list
+    | InductiveDecl mib => mib.(ind_bodies)
+    end.
+Compute aux' qC.
+
+
+
+Definition aux4 (g : global_decl) : one_inductive_body := 
+  match g with
+  | ConstantDecl _ => default_oib
+  | InductiveDecl mib => List.hd default_oib mib.(ind_bodies) (* TODO Map *)
+  end.
+Compute aux4 (aux3 (aux2 (aux1 qC))).
+Print one_inductive_body.
+Definition aux5 (o : one_inductive_body) : list (ident * term * nat) := o.(ind_ctors).
+Definition default_itxn := ((""%string, tVar ""%string), 3).
+Check default_itxn : ident * term * nat.
+Compute aux5 (aux4 (aux3 (aux2 (aux1 qC)))). (* CONSTRUCTORS! *)
+Definition t2 := aux5 (aux4 (aux3 (aux2 (aux1 qC)))). (* CONSTRUCTORS! *)
+Compute t2.
+Definition sample_ctor := List.last t2 default_itxn.
+Compute sample_ctor.
+Definition sample_ctor' := fst sample_ctor.
+Compute sample_ctor'.
+Definition sample_ctor'' := snd sample_ctor'.
+Compute sample_ctor''.
+
+MetaCoq Test Unquote (tRel 0).
+
+
+= [("r", tRel 0, 0);
+       ("g",
+       tProd nAnon
+         (tInd
+            {|
+            inductive_mind := (MPfile ["Datatypes"; "Init"; "Coq"], "nat");
+            inductive_ind := 0 |} []) (tRel 1), 1);
+       ("b",
+       tProd nAnon
+         (tInd
+            {|
+            inductive_mind := (MPfile ["Datatypes"; "Init"; "Coq"], "bool");
+            inductive_ind := 0 |} [])
+         (tProd nAnon
+            (tInd
+               {|
+               inductive_mind := (MPfile ["Datatypes"; "Init"; "Coq"], "nat");
+               inductive_ind := 0 |} []) (tRel 2)), 2)]
+     : list ((ident × term) × nat)
+

coq/unfinished/mult-arg-functor.v

@@ -0,0 +1,71 @@
+Require List.
+Class Functor (f: Type -> Type) := {
+  fmap : forall {A B:Type}, (A -> B) -> f A -> f B
+}.
+
+Class Applicative (f: Type -> Type) `{Functor f} := {                       
+  pure: forall {A:Type}, A -> f A;                             
+  ap: forall {A B:Type}, f (A -> B) -> f A -> f B              
+}.                                                             
+
+#[export] Instance option_functor : Functor option := {        
+  fmap {A B:Type} (f:A->B) x :=
+      match x with                                             
+      | Some x' => Some (f x')                                 
+      | None => None                                           
+      end                                                      
+}.                                                             
+                                                               
+#[export] Instance option_applicative : Applicative option := {
+  pure {A:Type} (x:A) := Some x;                               
+   ap {A B:Type} f a :=                                        
+     match f, a with
+     | Some f', Some a' => Some (f' a')
+     | _, _ => None
+     end
+}.                                                             
+
+#[export] Instance list_functor : Functor list := {    
+  fmap {A B:Type} :=                                   
+    fix fmap f x :=                                    
+      match x with                                     
+      | List.cons x' xs => List.cons (f x') (fmap f xs)
+      | List.nil => List.nil                           
+      end                                              
+}.                                                     
+                                                               
+#[export] Instance list_applicative : Applicative list := {
+  pure {A:Type} (x:A) := List.cons x List.nil;
+   ap {A B:Type} :=
+     fix ap f a :=
+       match f, a with
+       | List.cons f' ff, List.cons a' aa =>
+           List.cons (f' a') (ap ff aa)
+       | _, _ => List.nil
+       end
+}.                                                             
+
+
+Inductive tuple2 (A B:Type) : Type :=
+| Tuple2: A -> B -> tuple2 A B.
+Arguments Tuple2 {A B}.
+
+Compute Tuple2 2 3.
+Compute Tuple2 2 true.
+
+#[export] Instance tuple2_functor : Functor tuple2 := {
+  fmap {A B C:Type} (f:A*B->C) x :=
+    let res := f x in
+    Tuple2 (fst res) (snd res)
+}.
+                                                               
+#[export] Instance list_applicative : Applicative list := {
+  pure {A:Type} (x:A) := List.cons x List.nil;
+   ap {A B:Type} :=
+     fix ap f a :=
+       match f, a with
+       | List.cons f' ff, List.cons a' aa =>
+           List.cons (f' a') (ap ff aa)
+       | _, _ => List.nil
+       end
+}.                                                             

coq/unfinished/nofixpoint-fn-real.v

@@ -0,0 +1,12 @@
+Require Import Coq.Reals.Reals.
+Require Export Coq.Reals.RIneq.
+(*Require Import Raxioms.*)
+
+Definition f (x:R) : R := x + 1.
+
+Theorem fnofix : forall x:R,
+    f x <> x.
+Proof.
+  intros.
+  field.
+

coq/unfinished/nofixpoint-fn.v

@@ -0,0 +1,72 @@
+Require Import Lia.
+
+Definition f (x:nat) : nat := x + 1.
+
+Theorem fnofix : forall n:nat,
+    f n <> n.
+Proof.
+  intros.
+  induction n.
+  - discriminate.
+  - intros H.
+    apply IHn.
+    injection H.
+    unfold f.
+    trivial.
+Qed.
+
+(*
+Require Import Relations.
+Check clos_refl_trans.
+Print relation.
+(*
+
+    replace (n+1) with (f n).
+    + reflexivity.
+    auto.
+
+  - now intros [=H].
+ *)
+
+
+
+
+
+Lemma fsn_eq_sfn: forall n:nat,
+    f (S n) = S (f n).
+Proof.
+  intros.
+  induction n.
+Admitted.
+
+Theorem fnofix : forall n:nat,
+    f n <> n.
+Proof.
+  intros.
+  induction n.
+  - discriminate.
+  - rewrite -> (fsn_eq_sfn  n).
+ *)
+
+Definition f2 (x:nat) : nat := 0.
+
+Theorem f2_fix_is_O : forall x:nat,
+  ((f2 x) = x) -> (x = 0).
+Proof.
+  intros.
+  rewrite <- H.
+  unfold f2.
+  reflexivity.
+Qed.
+
+Definition f3 (x:nat) : nat := x*x.
+
+Theorem f3_fix_is_O : forall x:nat,
+  ((f3 x) = x) -> (x = 0) \/ (x = 1).
+Proof.
+  intros.
+  induction x.
+  - now left.
+  - right.
+		destruct IHx.
+    * 

coq/unfinished/notation-scope.v

@@ -0,0 +1,10 @@
+Require Import List.
+Import ListNotations.
+
+Module EgNotations.
+Declare Scope eg_scope.
+Delimit Scope eg_scope with eg.
+Print Visibility.
+Notation "[ ]" := 3
+  (at level 30) : eg_scope.
+End EgNotations.

coq/unfinished/operational-sem.v

@@ -0,0 +1,79 @@
+Require Import String.
+Open Scope string.
+
+Check String.eqb.
+Check string_dec.
+Compute string_dec "a" "b".
+Compute if (string_dec "a" "b") then true else false.
+Compute if (string_dec "a" "a") then true else false.
+Compute if (String.eqb "a" "b") then true else false.
+Compute if (String.eqb "a" "a") then true else false.
+Print String.eqb.
+
+Search (string -> string -> bool).
+Compute eqb "sh" "s".
+Print String.eqb.
+Print Nat.eqb.
+
+Require Import List.
+Import ListNotations.
+
+Definition env : Set := list (string * nat).
+
+Fixpoint envLookUp (e : env) (key : string) : option nat :=
+  match e with
+  | [] => None
+  | ((var, val)::xs) =>
+      if (String.eqb key var) then
+        Some val
+      else
+        envLookUp xs key
+  end.
+
+Inductive natexp : Set :=
+| Nat  : nat -> natexp
+| Var  : string -> natexp
+| Plus : natexp -> natexp -> natexp.
+
+Inductive boolexp : Set :=
+| Lt : natexp -> natexp -> boolexp.
+
+
+Check "a" <> "y".
+Check 3 < 2.
+Check 3 <= 2.
+
+Inductive nateval : env -> natexp -> nat -> Prop :=
+(* Eval of [Nat n] is [n] *)
+| NatInit : forall (e : env) (n : nat),
+    nateval e (Nat n) n
+| NatVar : forall (e : env) (n : nat) (v : string),
+    nateval ((v,n)::e) (Var v) n
+    (*
+| NatVarNeq : forall (e : env) (n1 n2 : nat) (v1 v2 : string),
+    v1 <> v2
+    -> nateval e (Var v1) n1
+    -> nateval ((v2,n2)::e) (Var v1) n1
+     *)
+| NatPlus : forall (e : env) (nexp1 nexp2 : natexp)
+           (n1 n2 : nat) (v : string),
+    nateval e nexp1 n1
+    -> nateval e nexp2 n2
+    -> nateval e (Plus nexp1 nexp2) (n1 + n2).
+
+Inductive booleval : env -> boolexp -> bool -> Prop :=
+| BoolLt : forall (e : env) (n1 n2 : nat) (nexp1 nexp2 : natexp),
+    nateval e nexp1 n1
+    -> nateval e nexp2 n2
+    -> n1 < n2
+    -> booleval e (Lt nexp1 nexp2) true.
+
+Lemma lookUpEval : forall (e : env) (key : string) (n : nat),
+  envLookUp e key = Some n -> nateval e (Var key) n.
+Proof.
+  intros.
+Qed.
+
+Definition env1 := [("h"%string, 2); ("a"%string, 4)].
+Compute envLookUp env1 "h"%string.
+Compute envLookUp env1 "b"%string.

coq/unfinished/perms.v

@@ -0,0 +1,76 @@
+Require Import Permutation.
+Require Import List.
+Import ListNotations.
+Print Permutation.
+
+(*
+Permutation (A : Type)
+  : list A -> list A -> Prop :=
+    perm_nil : Permutation [] []
+  | perm_skip : forall (x : A)
+                  (l l' : list A),
+                Permutation l l' ->
+                Permutation 
+                  (x :: l) 
+                  (x :: l')
+  | perm_swap : forall (x y : A)
+                  (l : list A),
+                Permutation
+                  (y :: x :: l)
+                  (x :: y :: l)
+  | perm_trans : forall
+                   l l' l'' : list A,
+                 Permutation l l' ->
+                 Permutation l' l'' ->
+                 Permutation l l''
+
+Arguments Permutation [A]%type_scope (_ _)%list_scope
+Arguments perm_nil _%type_scope
+Arguments perm_skip [A]%type_scope _ [l l']%list_scope
+Arguments perm_swap [A]%type_scope _ _ _%list_scope
+Arguments perm_trans [A]%type_scope [l l' l'']%list_scope
+*)
+
+Compute 
+ perm_trans
+   (perm_skip
+     1
+     (perm_swap 3 2 [])
+   )
+   (perm_swap 3 1 [2])
+: Permutation [1; 2; 3] [3; 1; 2].
+(*
+
+1)    2 3 |   3 2  (perm_swap)
+2)  1 2 3 | 1 3 2  (perm_skip 1)
+3)  1 3 2 | 3 1 2  (perm_swap)
+4)  1 2 3 | 3 1 2  (perm_trans 2,3)
+*)
+
+Example butterfly : forall (b u t e r f l y : nat),
+    Permutation ([b;u;t;t;e;r]++[f;l;y]) ([f;l;u;t;t;e;r]++[b;y]).
+Proof.
+  intros.
+  change [b;u;t;t;e;r] with ([b]++[u;t;t;e;r]).
+  change [f;l;u;t;t;e;r] with ([f;l]++[u;t;t;e;r]).
+  remember [u;t;t;e;r] as utter.
+  clear Hequtter. (* We don't need the value. Forget about the value. *)
+  change [f;l;y] with ([f;l]++[y]).
+  remember [f;l] as fl.
+  clear Heqfl.
+  replace ((fl ++ utter) ++ [b; y]) with (fl ++ utter ++ [b; y]) by apply app_assoc.
+  replace (([b] ++ utter) ++ fl ++ [y]) with ([b] ++ utter ++ fl ++ [y]) by apply app_assoc.
+Qed.
+
+Lemma p123 : Permutation [1;2;3] [3;1;2].
+Proof.
+  Search Permutation.
+  (*apply (perm_trans [1;2;3] [1;3;2] [3;1;2]).*)
+  apply (perm_trans
+           (perm_swap 3 1 [2]) (*[1;3;2] [1; 3; 2]) *)
+           (perm_skip 1 Permutation [1;3;2] [3; 1; 2])).
+  apply (perm_trans
+           (Permutation [1;2;3] [1; 3; 2])
+           (Permutation [1;3;2] [3; 1; 2])).
+  apply (perm_swap 3 1 [2]).
+  constructor (perm_swap 3 2 []).

coq/unfinished/phoas.v

@@ -0,0 +1,384 @@
+Check nat.
+
+(* STLC *)
+
+Inductive type : Type :=
+| Bool: type
+| Arrow: type -> type -> type.
+
+Section stlc.
+  (*Variable V : type -> Type. *)
+  Context {V : type -> Type}.
+  
+  Inductive term : type -> Type :=
+  | Var : forall t:type, V t -> term t
+  | Tru : term Bool
+  | Fals : term Bool
+  | App : forall (t1 t2 : type),
+      term (Arrow t1 t2) -> term t1 -> term t2
+  | Abs : forall (t1 t2 : type),
+      (V t1 -> term t2) -> term (Arrow t1 t2).
+End stlc.
+
+Fixpoint typeDenote (t : type) : Type :=
+  match t with
+  | Bool => bool
+  | Arrow t1 t2 => (typeDenote t1) -> (typeDenote t2)
+  end.
+
+Fixpoint termDenote {t : type} (e : term t) : typeDenote t :=
+  (*match e in (term _ t) return (typeDenote t) with*)
+  match e with
+  (* _ is for the t *)
+  | Var _ v => v
+  | Tru => true
+  | Fals => false
+  | App _ _ e1 e2 =>
+      (termDenote e1) (termDenote e2)
+  | Abs _ _ f =>  (* XXX: why was the fun abstr needed here?? *)
+      fun x => termDenote (f x)
+  end.
+
+
+(* CPS *)
+
+Inductive ptype : Type :=
+| PBool : ptype
+| PCont : ptype -> ptype  (* Continuation type *)
+| PUnit : ptype  (* Useful for PCont?? *)
+| PProd : ptype -> ptype -> ptype.
+
+Fixpoint ptypeDenote (t : ptype) : Type :=
+  match t with
+  | PBool => bool
+  | PCont t' => ptypeDenote t' -> bool (* τ → 0 *)
+  | PUnit => unit
+  | PProd t1 t2 => (ptypeDenote t1) * (ptypeDenote t2)
+  end.
+
+Section cpsterm.
+  (*Variable V : ptype -> Type.
+     Variable res : ptype.*)
+  Context {V : ptype -> Type} {res : ptype}.
+  Inductive pterm : Type :=
+  | PHalt : V res -> pterm
+  | PApp : forall (t:ptype), V (PCont t) -> V t -> pterm
+  | PBind : forall (t : ptype),
+      pprimop t -> (V t -> pterm) -> pterm
+  with
+  pprimop : ptype -> Type :=
+  | PVar : forall (t : ptype),
+      V t -> pprimop t
+  | PTrue : pprimop PBool
+  | PFalse : pprimop PBool
+  | PAbs : forall (t : ptype),
+      (V t -> pterm) -> pprimop (PCont t)
+  | PPair : forall (t1 t2 : ptype),
+      V t1 -> V t2 -> pprimop (PProd t1 t2)
+  | PFst : forall (t1 t2 : ptype),
+      V (PProd t1 t2) -> pprimop t1
+  | PSnd : forall (t1 t2 : ptype),
+      V (PProd t1 t2) -> pprimop t2.
+(*  Arguments PVar {t}. *)
+End cpsterm.
+Arguments PAbs {V res t}.
+Arguments PPair {V res t1 t2}.
+Arguments PFst {V res t1 t2}.
+Arguments PSnd {V res t1 t2}.
+Check PAbs.
+
+(* Translation *)
+
+Section splices.
+  Fixpoint splice {V : ptype -> Type} {res1 res2 : ptype}
+    (e1: pterm) (e2: V res1 -> pterm)
+    : @pterm V res2 :=
+    match e1 with
+    | PHalt v => e2 v
+    | PApp _ f x => PApp _  f x
+    | PBind _ p f =>
+        PBind _ (splicePrim p e2) (fun x => splice (f x) e2)
+    end
+  with
+  splicePrim {V : ptype -> Type} {res1 res2 t : ptype} 
+    (p : @pprimop V res1 t) (e2 : V res1 -> @pterm V res2)
+    : @pprimop V res2 t :=
+    match p with
+    | PVar _ v => PVar _ v
+    | PTrue => PTrue
+    | PFalse => PFalse
+        (*| PAbs t f =>  *)
+    | PAbs f => PAbs (fun x => splice (f x) e2)
+    | PPair v1 v2 => PPair v1 v2
+    | PFst v => PFst v
+    | PSnd v => PSnd v
+    end.
+End splices.
+
+Fixpoint cpsType (t : type) : ptype :=
+  match t with
+  | Bool => PBool
+  | Arrow t1 t2 => PCont (PProd (cpsType t1) (PCont (cpsType t2)))
+  end.
+
+Notation "let x := e1 in e2" := (splice e1 (fun x => e2))
+  (at level 80).
+Check pterm.
+Check @term.
+(*
+#+BEGIN_OUTPUT (Info)
+term
+     : type -> Type
+where
+?V : [ |- type -> Type]
+#+END_OUTPUT (Info) *)
+
+Check PHalt.
+(*
+#+BEGIN_OUTPUT (Info)
+PHalt
+     : ?V ?res -> pterm
+where
+?V : [ |- ptype -> Type]
+?res : [ |- ptype]
+#+END_OUTPUT (Info) *)
+
+Section translation.
+  Variable V : ptype -> Type.
+  Notation V' := (fun (t : type) => V (cpsType t)).
+  Notation "x <-- e1 ; e2" := (splice e1 (fun x => e2))
+    (at level 76).  (* letTerm *)
+  Notation "x <- p ; e" := (PBind p (fun x => e))
+    (at level 76).  (* letBind *)
+  Notation "\ x , e" := (PAbs (fun x => e))
+    (at level 78).  (* fn/λ *)
+  (*
+  Notation "'letTerm' x ':=' e1 'inside' e2" :=
+    (splice e1 (fun x => e2)) (at level 70).
+  Notation "'letBind' x ':=' e1 'inside' e2" :=
+    (PBind e1 (fun x => e2)) (at level 70).
+  Notation "'fn' x ':=' e" := (PAbs (fun x => e)) (at level 70).
+   *)
+  Fixpoint cpsTerm {t : type} (e : @term V' t)
+    : @pterm V (cpsType t) :=
+    match e with
+    | Var _ x => PHalt x
+    | Tru => PBind PTrue (fun x => PHalt x)
+    | Fals => PBind PFalse (fun x => PHalt x)
+    | App _ _ e1 e2 =>
+        f <-- (cpsTerm e1) ;
+        x <-- (cpsTerm e2) ;
+        k <- \r, PHalt (V:=V) x ;
+        p <- (PPair x k) ;
+        (PApp f p)
+    | Abs _ _ e' => 
+        (*f <- \r , *)
+        f <- PAbs V (fun p =>
+          x <- PFst p ;
+          k <- PSnd p ;
+          r <-- cpsTerm (e' x0) ;
+          PApp k r) ;
+          PHalt f
+        (*
+        Let f := PAbs V (fun p =>
+          Let x := PFst p inside
+          Let k := PSnd p inside
+            splice (cpsTerm (e' x)) (fun x' => PApp k r))
+            PHalt f
+         *)
+    end.
+
+End translation.
+
+
+(*
+Definition foo (l m n:nat) : nat -> nat := plus n.
+Check foo.
+Check foo 3.
+*)
+
+Fixpoint ptermDenote {result : ptype}
+  (e : pterm ptypeDenote result)
+  (k : (ptypeDenote result) -> bool) : bool :=
+  match e with
+  | PHalt _ _ v => k v
+  | PApp _ _ _ f x => f x (* f is the continuation function *)
+  | PBind _ _ _ p f => ptermDenote (f (pprimopDenote p k)) k
+  end
+  with
+  pprimopDenote {result t : ptype}
+    (p : pprimop ptypeDenote result t)
+    (k : ptypeDenote result -> bool) : ptypeDenote t :=
+    match p with
+    | PVar _ _ t v => v
+    | PTrue _ _ => true
+    | PFalse _ _ => false
+    | PAbs _ _ t f => fun x => ptermDenote (f x) k
+    | PPair _ _ t1 t2 v1 v2 => (v1, v2)
+    | PFst _ _ t1 t2 v => fst v
+    | PSnd _ _ t1 t2 v => snd v
+    end.
+
+
+
+
+
+
+(***************************************************************)
+
+Inductive type : Type :=
+| Bool : type
+| Arrow : type -> type -> type.
+
+Section term.
+  Variable var : type -> Type.
+
+  Inductive term : type -> Type :=
+  | Var: forall (t : type), var t -> term t
+  | App: forall (t1 t2 : type),
+      term (Arrow  t1 t2) -> term t1 -> term t2
+  | Abs: forall (t1 t2 : type),
+      var t1 -> term t2 -> term (Arrow t1 t2)
+  | Tru: term Bool
+  | Fals: term Bool.
+End term.
+
+
+(* CPS syntax *)
+(* Types τ ::= bool | τ→0 | τxτ *)
+Inductive ctype : Type :=
+| TCBool : ctype
+| TCCont : ctype -> ctype
+| TCUnit : ctype
+| TCProd : ctype -> ctype -> ctype.
+
+Section var.
+  Variable var : ctype -> Type.
+  Variable result : ctype.
+  Inductive cterm : Type :=
+  (* CPS over *)
+  | CHalt : var result -> cterm
+  | CApp : forall (t : ctype),
+      var (TCCont t) -> var t -> cterm
+  (* let binding *)
+  | CBind : forall (t : ctype),
+      primop t -> (var t -> cterm) -> cterm
+  with 
+  primop : ctype -> Type :=
+  | CopVar : forall (t : ctype),
+      var t -> primop t
+  | CopTru : primop TCBool
+  | CopFals : primop TCBool
+  | CopAbs : forall (t : ctype),
+      (var t -> cterm) -> primop (TCCont t)
+  | CopPair : forall (t1 t2 : ctype),
+      var t1 -> var t2 -> primop (TCProd t1 t2)
+  | CopFst : forall (t1 t2 : ctype),
+      var (TCProd t1 t2) -> primop t1
+  | CopSnd : forall (t1 t2 : ctype),
+      var (TCProd t1 t2) -> primop t2.
+End var.
+
+(* CPS types to coq types *)
+Fixpoint ctypeDenote (t : ctype) : Type :=
+  match t with
+  | TCBool => bool
+
+  (* why to bool ?*)
+  | TCCont t' => ctypeDenote t' -> bool
+
+  | TCUnit => unit
+  | TCProd t1 t2 => ((ctypeDenote t1) * (ctypeDenote t2))%type
+  end.
+Check Var.
+(*
+Var
+     : forall (var : type -> Type) (t : type), var t -> term var t
+ *)
+Check App.
+(*
+App
+     : forall (var : type -> Type) (t1 t2 : type),
+       term var (Arrow t1 t2) -> term var t1 -> term var t2
+*)
+
+Fixpoint ctermDenote (t : cterm) : Type :=
+  match t with
+  | CHalt : var result -> cterm
+  | CApp : forall (t : ctype),
+      var (TCCont t) -> var t -> cterm
+  | CBind : forall (t : ctype),
+      primop t -> (var t -> cterm) -> cterm
+  end
+  with
+  primopDenote (result: ) (t: cterm) (op : primop) : ctermDenote t
+
+(**********************************************************)
+
+Inductive type : Type :=
+| Nat: type
+| Func: type -> type -> type.
+
+(* HOAS. Strict positivity failed!
+Inductive term : type -> Type :=
+| Const: term Nat
+| Plus: term Nat -> term Nat -> term Nat
+| Abs: forall (t1 t2 : type),
+    term t1 -> term t2 -> term (Func t1 t2)
+| App: forall (t1 t2 : type),
+    term (Func t1 t2) -> term t1 -> term t2
+(* let x = e1 in e2 *)
+(* λx.e2) e1 *)
+(* Let e1 (λx.e2) *)
+| Let: forall (t1 t2: type),
+    term t1 -> (term t1 -> term t2) -> term t2.
+*)
+
+
+Inductive term (var: type -> Type) :=
+| Var : forall t:type, var t -> term (var t).
+
+Section var.
+  Variable var : type -> Type.
+
+  Inductive term : type -> Type :=
+  | Var : forall t:type, var t -> term t.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(*************************************************************)
+
+(*
+Inductive term: Type :=
+| App: term -> term -> term
+| Abs: (term -> term) -> term.
+ *)
+
+(* PHOAS *)
+Inductive term (T: Type) : Type :=
+| Var: T -> term T
+| App: term T -> term T -> term T
+| Abs: (T -> term T) -> term T.
+
+Require Import List.
+Import ListNotations.
+Inductive member {A : Type} (elem: A) : list A -> Type :=
+| First : forall ls: list A, member elem (elem: ls).
+
+| Next: forall (x:A) (ls:list A),
+    member ls -> member (x :: ls).
+

coq/unfinished/pigeonhole.v

@@ -0,0 +1,61 @@
+Require Import List.
+Import ListNotations.
+
+Search (_ -> list _ -> bool).
+(*
+forallb: forall [A : Type], (A -> bool) -> list A -> bool
+
+existsb: forall [A : Type], (A -> bool) -> list A -> bool
+*)
+Search (list _ -> _ -> bool).
+Search (nat -> nat -> bool).
+Compute negb (Nat.ltb 1 0).
+
+Compute existsb (fun x:nat => negb (Nat.leb x 1)) [0;1;0].
+Check ~True.
+Compute in_nil.
+Search (In _ []).
+Check in_nil.
+Check @in_nil nat 3.
+Check not (not (2<3)).
+Check (@in_nil nat 3).
+(*
+in_nil (a:=3)
+     : ~ In 3 []
+*)
+Print In.
+Check In%list.
+Check in_nil%list.
+
+Require Import Lia.
+
+Theorem ph : forall l:list nat,
+	list_sum l > length l -> exists x:nat, x > 1 -> In x l.
+Proof.
+	intros.
+	induction l.
+  - simpl in H.
+		simpl.
+		lia.
+  - 
+
+
+
+Theorem ph: forall ls:list nat,
+   list_sum ls > length ls
+   -> exists x:nat,
+         x > 1
+      -> In x ls.
+Proof.
+	intros.
+	induction ls.
+  - discriminate H.
+
+  intros.
+  induction ls.
+  - exists 5.
+    intros H1. 
+    Search (In _ []).
+    (* in_nil: forall [A : Type] [a : A], ~ In a [] *)
+    apply (in_nil).
+    rewrite <- (not in_nil).

coq/unfinished/redblacktree.v

@@ -0,0 +1,18 @@
+
+
+
+Require Import OrderedType.
+Module Type Sets.
+  (* A module type named [Sets].
+     https://coq.inria.fr/refman/language/core/modules.html#coq:cmd.Module-Type
+   *)
+
+  Declare Module K: OrderedType.
+  (* [OrderedType] is a module type *)
+
+  Parameter A: Type.
+
+  Parameter In: K.t -> A -> Prop.
+  (* Check if an element is in a value of an ordered type. *)
+
+  Parameter insert: K.t -> A -> K.t.

coq/unfinished/reductions.v

@@ -0,0 +1,129 @@
+Check nat.
+
+Eval cbv zeta in
+  let i:=2 in i+1.
+(*
+= 2 + 1
+     : nat
+*)
+
+Eval cbv zeta in
+  let i:=(2+3*4) in i+1.
+(*
+
+= 2 + 3 * 4 + 1
+     : nat
+*)
+
+Eval cbv zeta in
+  let x:=6+1*8 in
+  let i:=(2+x*4) in i+1.
+(*
+= 2 + (6 + 1 * 8) * 4 + 1
+     : nat
+*)
+
+Eval cbv beta in
+  (fun x:nat => x+1) 5.
+(*
+= 5 + 1
+     : nat
+*)
+
+Eval cbv beta in
+  (fun x:nat =>
+    fun y:nat => x + y) 4.
+(*
+= fun y : nat => 4 + y
+     : nat -> nat
+*)
+
+Eval cbv beta in
+  (fun x:nat => 2*x+1) 5.
+(*
+= 2 * 5 + 1
+     : nat
+*)
+
+Definition incr (n:nat):nat:=S n.
+Eval cbv delta in
+  (fun x:nat => incr x) 5.
+(*
+= (fun x : nat => (fun n : nat => S n) x) 5
+     : nat
+*)
+
+Opaque incr.
+
+Eval cbv delta in
+  (fun x:nat => incr x) 5.
+(*
+= (fun x : nat => incr x) 5
+     : nat
+*)
+
+Transparent incr.
+
+Eval cbv delta in
+  (fun x:nat => incr x) 5.
+(*
+= (fun x : nat => (fun n : nat => S n) x) 5
+     : nat
+*)
+
+Definition plus_2 (n:nat):nat := S (S n).
+Opaque plus_2.
+
+Eval cbv delta in
+  (fun x:nat => incr x) 5.
+
+Transparent plus_2.
+
+Goal
+  3 + 2 = 5.
+Proof.
+(*
+  cbv delta.
+
+(fix add (n m : nat) {struct n} : nat :=
+   match n with
+   | 0 => m
+   | S p => S (add p m)
+   end) 3 2 = 5
+*)
+  cbv delta.
+  cbv fix.
+  repeat (cbv fix; cbv beta; cbv match).
+  constructor.
+Qed.
+
+Eval cbv fix in
+  (fix addition (n m:nat) : nat :=
+     match n with
+    | O => m
+    | S n' => S (addition n' m)
+    end) 3 2.
+(*
+= (fun n m : nat =>
+        match n with
+        | 0 => m
+        | S n' =>
+            S
+              ((fix addition (n0 m0 : nat) {struct n0} : nat :=
+                  match n0 with
+                  | 0 => m0
+                  | S n'0 => S (addition n'0 m0)
+                  end) n' m)
+        end) 3 2
+     : nat
+*)
+
+Eval cbv match in
+  (match 3 with
+   | O => true
+   | _ => false
+   end).
+(*
+= false
+     : bool
+*)

coq/unfinished/reflection.v

@@ -0,0 +1,39 @@
+Require Import ZArith.
+
+Inductive Exp : N -> Type :=
+| Const : forall M, N -> Exp M
+| Add : forall M, Exp M -> Exp M -> Exp M
+| Mul : forall M, Exp M -> Exp M -> Exp M
+| Mod : forall M, Exp M -> Exp M.
+
+Arguments Const {M}.
+Arguments Add {M}.
+Arguments Mul {M}.
+Arguments Mod {M}.
+
+Infix "+"    := Add.
+Infix "*"    := Mul.
+
+Fixpoint eval {M}(e : Exp M) : N :=
+  match e with
+  | Const x => x
+  | Add e1 e2 => eval e1 + eval e2
+  | Mul e1 e2 => eval e1 * eval e2
+  | Mod ep    => eval ep mod M
+  end.
+
+Ltac reify e M :=
+  match e with
+  | (?e1 + ?e2)%N =>
+  		let e1p := reify constr:(e1) M in
+      let e2p := reify constr:(e2) M in
+      constr:(Add (M:=M) e1p e2p)
+  | (?e1 * ?e2)%N =>
+			let e1p := reify constr:(e1) M in
+      let e2p := reify constr:(e2) M in
+      constr:(Mul (M:=M) e1p e2p)
+  | (?ep mod ?M)%N =>
+			let epp := reify ep M in
+      constr:(Mod (M:=M) epp)
+  | _  => constr:(Const (M:=M) e)
+  end.

coq/unfinished/semantic-style.v

@@ -0,0 +1,398 @@
+(*
+  https://github.com/coq-community/semantics/blob/master/little.v
+*)
+Require Import List String.
+Import ListNotations.
+
+(*
+ρ: env
+e: expr
+b: bool
+i: instr
+
+ρ := (var, val)::ρ | ∅
+e := var | val | e+e (only addition possible)
+b := e < e  (only < possible. But what about true,false??
+i := skip  (empty program. Does nothing. noop)
+   | x:=e (assignment to var)
+   | i;i
+   | while b do i done  (loop)
+
+All values are nat
+ *)
+
+Require Import String.
+
+Inductive aexpr : Type :=
+| Anum : nat -> aexpr
+| Avar : string -> aexpr
+| Aplus : aexpr -> aexpr -> aexpr.
+
+Inductive bexpr : Type :=
+| Lt : aexpr -> aexpr -> bexpr.
+
+Inductive instr : Type :=
+| Skip : instr
+| Let : string -> aexpr -> instr
+| Seq : instr -> instr -> instr
+| While : bexpr -> instr -> instr.
+
+Definition env : Type := list (string * nat).
+
+Inductive aeval : env -> aexpr -> nat -> Prop :=
+  (* ρ ⊢ n → n *)
+| AEnum : forall (en:env) (n:nat),
+    aeval en (Anum n) n
+  (* ((var, val)::ρ) ⊢ (var → val) *)
+| AEvar : forall (en:env) (val:nat) (var:string),
+    aeval ((var,val)::en)%list (Avar var) val   (* Found! *)
+  (* var1 ≠ var2
+     → (ρ ⊢ (var1 → val1))
+     → (((var2,val2)::ρ) ⊢ (var2 → val2))
+  *)
+| AEvarOther : forall (en:env) (val1 val2:nat) (var1 var2:string),
+    var1 <> var2
+    -> aeval en (Avar var1) val1
+      -> aeval ((var2,val2)::en)%list (Avar var1) val1 (* Even if we had another variable added to the env. *)
+  (*
+    (ρ ⊢ (e1 → val1))
+     → (ρ ⊢ (e2 → val2))
+     → (ρ ⊢ (e1 + e2) → (val1 + val2))
+   *)
+| AEplus : forall (en:env) (e1 e2 : aexpr) (val1 val2 : nat),
+    aeval en e1 val1
+    -> aeval en e2 val2
+    -> aeval en (Aplus e1 e2) (val1 + val2).
+
+Inductive beval : env -> bexpr -> bool -> Prop :=
+  (*
+  val1 < val2
+  → (ρ ⊢ (e1 → val1))
+  → (ρ ⊢ (e2 → val2))
+  → (ρ ⊢ ((e1 < e2) → true))
+   *)
+| BEltLeft : forall (en:env) (val1 val2 : nat) (e1 e2 : aexpr),
+    (val1 < val2)
+    -> aeval en e1 val1
+    -> aeval en e2 val2
+    -> beval en (Lt e1 e2) true
+  (*
+  ¬(val1 < val2)
+  → (ρ ⊢ (e1 → val1))
+  → (ρ ⊢ (e2 → val2))
+  → (ρ ⊢ ((e1 < e2) → false))
+   *)
+| BEltRight : forall (en:env) (val1 val2 : nat) (e1 e2 : aexpr),
+    (val2 >= val2)
+    -> aeval en e1 val1
+    -> aeval en e2 val2
+    -> beval en (Lt e1 e2) false.
+
+Inductive envupdate : env -> string -> nat -> env -> Prop :=
+(* Update a variable *)
+| EnvUpdNew : forall (en:env) (var:string) (val:nat),
+    envupdate en var val ((var,val)::en)
+(* New variable *)
+| EnvUpdOld : forall (en1 en2:env) (var1 var2:string) (val1 val2:nat),
+    envupdate en1 var1 val1 en2
+    -> var1 <> var2
+    (* en2 already has var1 *)
+    -> envupdate ((var2,val2)::en1) var1 val1 ((var2,val2)::en2).
+
+Inductive instrevalBS : env -> instr -> env -> Prop :=
+| IEBSSkip : forall (en:env), instrevalBS en Skip en
+| IEBSLet : forall (en en':env) (var:string) (val:nat) (ae:aexpr),
+    aeval en ae val
+    -> envupdate en var val en'
+    -> instrevalBS en (Let var ae) en'
+      (*
+    -> envupdate en var val en'
+    -> instrevalBS en (Let var ae) en'
+       *)
+| IEBSSeq : forall (en en1 en2:env) (i1 i2:instr),
+    (instrevalBS en i1 en1)
+    -> (instrevalBS en1 i2 en2)
+    -> instrevalBS en (Seq i1 i2) en2
+| IEBSWhileT : forall (en eni enw:env) (i:instr) (be:bexpr),
+    beval en be true
+    -> instrevalBS en i eni
+    -> instrevalBS eni (While be i) enw
+    -> instrevalBS en (While be i) enw
+| IEBSWhileF : forall (en eni enw:env) (i:instr) (be:bexpr),
+    beval en be false
+    -> instrevalBS en (While be i) en.
+
+
+Inductive instrevalSS : env -> instr -> instr -> env -> Prop :=
+| IESSLet : forall (en en':env) (var:string) (val:nat) (ae:aexpr),
+    aeval en ae val
+    -> envupdate en var val en'
+    -> instrevalSS en (Let var ae) Skip en'
+| IESSSeqOne : forall (en:env) (i:instr),
+    instrevalSS en (Seq Skip i) i en
+(* i1 reduces to i1' and i1' to i2. Then i1 reduces to i2 *)
+(* both i1 and i1' result it en'
+   then both i1;i2 and i1';i2 result in en'
+ *)
+| IESSSeqMany : forall (en en':env) (i1 i1' i2:instr),
+    instrevalSS en i1 i1' en'
+    -> instrevalSS en (Seq i1 i2) (Seq i1' i2) en'
+(* XXX: Only aexpr can be bound to vars, okay. But how can we say that env doesn't change after a while loop??? *)
+| IESSWhileT : forall (en:env) (i:instr) (be:bexpr),
+    beval en be true
+    -> instrevalSS en (While be i) (Seq i (While be i)) en
+| IESSWhileF : forall (en:env) (i:instr) (be:bexpr),
+    beval en be false
+    (* Says that 'give me (While be i), I'll give you skip' *)
+    -> instrevalSS en (While be i) Skip en.
+
+Fixpoint lookup (en:env) (var:string) : option nat :=
+  match en with
+  | []%list => None
+  | (x::xs)%list =>
+      let '(var', val') := x in
+      if (String.eqb var' var) then
+        Some val'
+      else
+        lookup xs var
+  end.
+
+Definition bind (A B:Type) (x:option A) (f:A->option B) : option B :=
+  match x with
+  | None => None
+  | Some x' => f x'
+  end.
+Arguments bind {A B}.
+
+(* XXX: Evaluate aexpr ?? *)
+Fixpoint af (en:env) (ae:aexpr) : option nat :=
+  match ae with
+  | Avar var => lookup en var
+  | Anum n => Some n
+  | Aplus e1 e2 =>
+      bind (af en e1)
+      (fun x => 
+       bind (af en e2) (fun y => Some(x+y)))
+  end.
+
+Example en1 : env := [("x"%string, 2)]%list.
+Example en2 : env := [("x"%string, 2); ("y"%string, 3)]%list.
+Example ae1 : aexpr := (Aplus (Avar "x"%string) (Avar "y"%string)).
+
+Compute (lookup en1 "x"%string).  (* Some 2 *)
+Compute (lookup en1 "a"%string).  (* None *)
+Compute (af en1 (Anum 3)).
+Compute (af en2 ae1).
+
+Definition bf (en:env) (b:bexpr) : option bool :=
+  match b with
+  | Lt e1 e2 =>
+      bind (af en e1) (fun x =>
+        bind (af en e2) (fun y => Some (Nat.ltb x y)))
+  end.
+
+(* Only update existing vars. Won't add new vars to env *)
+Fixpoint updatefn (en:env) (var:string) (val:nat) : option env :=
+  match en with
+  | []%list => None
+  | ((var',val')::ens)%list =>
+      if (string_dec var var') then
+        Some ((var, val)::ens)%list
+      else
+        bind (updatefn ens var val)
+          (fun x => Some ((var',val')::x)%list)
+      (*
+      match (String.eqb var var') with
+      | true => Some ((var, val)::ens)%list
+      | false =>
+          bind (updatefn ens var val)
+          (fun x => Some ((var',val')::x)%list)
+      end
+       *)
+  end.
+Compute en2.
+Compute updatefn en2 "y"%string 5.
+
+Check list nat -> Prop.
+Check (list nat) -> Prop.
+Check list (nat -> Prop).
+
+Inductive assert : Type :=
+| AssertBool (b:bexpr)
+| AssertNot (a:assert)
+| AssertConj (a1 a2:assert)
+| AssertPred (s:string) (n:nat).
+
+Inductive condition : Type :=
+| Condition (a1 a2 : assert).
+
+Definition eq_O (n:nat) : {n=O}+{n<>O}.
+Proof.
+  case n.
+  - left.
+    reflexivity.
+  - right.
+    discriminate.
+Restart.
+  case n.
+  auto.
+  right.
+  discriminate.
+Qed.
+
+
+Definition eq_skip (i:instr) : {i=Skip}+{i<>Skip}.
+Proof.
+  case i.
+  - left.
+    reflexivity.
+  - intros.
+    right.
+    discriminate.
+  - intros.
+    right.
+    discriminate.
+  - intros.
+    right.
+    discriminate.
+Restart.
+  (* [auto] takes care of the simple goal which needed [left] tactic *)
+  case i; auto; right; discriminate.
+Qed.
+
+Inductive integer : Set :=
+| Int (n:nat) : integer.
+
+(*
+Goal
+  forall (var varname:nat),
+    Int var = Int varname.
+Proof.
+  intros.
+  discriminate.
+ *)
+
+Goal
+  forall (n1 n2:nat),
+  Int n1 = Int n2 -> n1 = n2.
+Proof.
+  intros.
+  induction n1.
+  - .
+  discriminate.
+
+Lemma aeval_lookup :
+  forall (en:env) (e:aexpr) (n:nat) (var:string),
+  aeval en e n
+  -> e = (Avar var)
+  -> lookup en var = Some n.
+Proof.
+  intros en e n varname H.
+  induction H.
+  - intro H1.
+    induction en.
+    + discriminate.
+    + rewrite <- IHen.
+      discriminate.
+  - intro H1.
+    induction en.
+    + 
+
+
+(*
+
+Fixpoint aeval (en:env) (e:aexpr) : option nat :=
+  match e with
+  | Avar var => lookup en var
+  | Anum n => Some n
+  | Aplus e1 e2 =>
+     match (aeval en e1) with
+     | None => None
+     | Some val1 =>
+         match (aeval en e2) with
+         | None => None
+         | Some val2 => Some (val1 + val2)
+         end
+     end
+  end.
+
+Definition beval (en:env) (e:bexpr) : option bool :=
+  match e with
+  | Lt ae1 ae2 =>
+     match (aeval en ae1) with
+     | None => None
+     | Some val1 =>
+         match (aeval en ae2) with
+         | None => None
+         | Some val2 => Some (Nat.ltb val1 val2)
+         end
+     end
+  end.
+
+Check (lookup []%list "a"%string = Some 3).
+Print eq.
+Check eq_refl.
+
+Lemma lookup_aeval : forall (en:env) (var:string) (val:nat),
+  (lookup en var = Some val) -> aeval en (Avar var) val.
+Proof.
+  intros.
+  apply (AEvar en H).
+
+    (match H with
+     | eqrefl val' => val'
+     | None => None
+     end)
+  ).
+Qed.
+
+Fixpoint instreval (en:env) (i:instr) : env :=
+  match i with
+  | Let var ae =>
+      let res := (aeval en ae) in
+      match res with
+      | None => en
+      | Some val => ((var,val)::en)%list
+      end
+  | Seq i1 i2 =>
+      let en' := (instreval en i1) in
+      (instreval en' i2)
+  | While be i' =>
+      match (beval en be) with
+      | None => en
+      | Some true => instreval en (Seq i' (While be i'))
+      | Some false => en
+      end
+  end.
+ *)
+
+(*
+Inductive var : Set := string.
+Inductive val : Set := nat.
+
+Inductive expr : Set :=
+| Var : var -> expr
+| Val : val -> expr
+| Add : expr -> expr -> expr.
+
+Inductive boolean : Set :=
+| Lt : expr -> expr -> boolean.
+
+Inductive instr : Set :=
+| Skip : instr
+| Let : var -> expr -> instr
+| Seq : instr -> instr -> instr
+| While : bool -> instr -> instr.
+
+Inductive env : Set :=
+| Empty : env
+| NewVar : var * val -> env.
+
+(*
+ρ ⊢ n → n
+(var, val)::ρ ⊢ var → val
+ *)
+
+Inductive eval : env -> expr -> val -> Prop :=
+| ValEval : forall (en:env) (n:expr), 
+ *)

coq/unfinished/socrates-mortal.v

@@ -0,0 +1,15 @@
+Section socrates.
+  Variable Man : Set.
+  Variable Mortal : Man -> Prop.
+
+  (* Socrates is a Man *)
+  Axiom socrates : Man.
+
+  (* All men are mortal *)
+  Axiom menMortal : forall m:Man, Mortal m.
+
+  Theorem socratesMortal : Mortal socrates.
+  Proof.
+    apply (menMortal socrates).
+  Qed.
+End socrates.

coq/unfinished/stack.v

@@ -0,0 +1,24 @@
+Require Import Vector.
+Import VectorNotations.
+
+Check Vector.t nat 3.
+Check Vector.nil.
+Print t.
+
+Inductive stack {A:Type} (n:nat) : Type :=
+| stnil : Vector.t A 0 -> stack n
+| stcons : forall n':nat,
+    n' < n -> Vector.t A n' -> stack n.
+
+Compute stnil 2 (Vector.nil nat).
+Compute stcons stnil 2 (Vector.nil nat).
+Compute (stcons 3 (stnil)).
+
+Section stack.
+  (* stack of size [n] whose elements are of type [A] *)
+  Definition stack (A:Type) (n:nat): Type := Vector.t A n.
+
+  Check [1;2] : stack nat 2.
+End stack.
+
+

coq/unfinished/stlc.v

@@ -0,0 +1,93 @@
+(*
+sf-plf:
+
+https://softwarefoundations.cis.upenn.edu/plf-current/Stlc.html
+ *)
+Require Import String.
+
+Inductive ty : Type :=
+| Ty_Bool : ty
+| Ty_Arrow : ty -> ty -> ty.
+
+Inductive tm : Type :=
+| tm_var : string -> tm
+| tm_app : tm -> tm -> tm  (* a b *)
+
+(* Type explicitly mentioned. Not left for type inferene stage *)
+| tm_abs : string -> ty -> tm -> tm  (* λx.a *)
+
+| tm_tru : tm
+| tm_fls : tm
+| tm_if : tm -> tm -> tm -> tm.
+
+
+Declare Custom Entry stlc.
+Notation "<{ e >}" := (e) (e custom stlc at level 99).
+Notation "( x )" := x (in custom stlc, x at level 99).
+Notation "x" := x (in custom stlc at level 0,
+  x constr at level 0).
+Notation "S -> T" := (Ty_Arrow S T)
+  (in custom stlc at level 50, right associativity).
+Notation "x y" := (tm_app x y)
+  (in custom stlc at level 1, left associativity).
+Notation "\ x : T , y" := (tm_abs x T y)
+  (in custom stlc at level 90,
+   x at level 99,
+   T custom stlc at level 99,
+   y custom stlc at level 99,
+   left associativity).
+Coercion tm_var : string >-> tm.
+
+Notation "'Bool'" := Ty_Bool (in custom stlc at level 0).
+Notation "'if' x 'then' y 'else' z" :=
+  (tm_if x y z)
+  (in custom stlc at level 89,
+   x custom stlc at level 99,
+   y custom stlc at level 99,
+   z custom stlc at level 99,
+   left associativity).
+(*
+Notation "'true'" := true (at level 1).
+Notation "'false'" := false (at level 1).
+ *)
+Notation "'false'" := tm_fls (in custom stlc at level 0).
+Notation "'true'" := tm_tru (in custom stlc at level 0).
+
+Inductive value : tm -> Prop :=
+| v_abs : forall (x:string) (T:ty) (t:tm),
+    value (tm_abs x T t)
+| v_tru : value tm_tru
+| v_fls : value tm_fls.
+
+(* Subst nv in t with s *)
+Fixpoint subst (nv:string) (s t:tm) : tm :=
+  match t with
+  | tm_var v =>
+      if eqb nv v then s
+      else t
+  | tm_app e1 e2 => tm_app (subst nv s e1) (subst nv s e2)
+  | tm_abs v T e => 
+      if eqb nv v then (tm_abs nv T (subst nv v e))
+      else t
+  | tm_tru => tm_tru
+  | tm_fls => tm_fls
+  | tm_if cond e1 e2 => 
+      tm_if (subst nv s cond) (subst nv s e1) (subst nv s e2)
+  end.
+Notation "'[' x ':=' s ']' t" := (subst x s t)
+  (in custom stlc at level 20, x constr).
+
+Inductive substi (s:tm) (v:string) : tm -> tm -> Prop :=
+(* subst a variable with s => s itself if v matches *)
+| s_var1 : substi s v (tm_var v) s
+| s_var2 : forall v':string,
+    v <> v' -> substi s v (tm_var v') (tm_var v')
+| s_app : forall (e1 e2 e1' e2':tm),
+    substi s v e1 e1'
+    -> substi s v e2 e2'
+    -> substi s v (tm_app e1 e2) (tm_app e1' e2')
+| s_abs1 : 
+    -> substi s v (tm_abs e1 e2) (tm_abs e1' e2')
+| s_abs2 : 
+
+Check True <-> True.

coq/unfinished/stream-eq-casteran.v

@@ -0,0 +1,64 @@
+(* https://www.labri.fr/perso/casteran/RecTutorial.pdf *)
+
+CoInductive stream (A:Type) : Type :=
+| Cons : A -> stream A -> stream A.
+Arguments Cons {A}.
+
+Definition hd {A:Type} (s:stream A) : A :=
+  match s with
+  | Cons val _ => val
+  end.
+
+Definition tl {A:Type} (s:stream A) : stream A :=
+  match s with
+  | Cons _ ss => ss
+  end.
+
+CoFixpoint map {A B:Type} (f:A->B) (a:stream A) : stream B :=
+  match a with
+  | Cons val aa => Cons (f val) (map f aa)
+  end.
+
+CoFixpoint iterate {A:Type} (f:A->A) (start:A) : stream A :=
+  Cons start (iterate f (f start)).
+
+CoInductive EqSt {A:Type} : stream A -> stream A -> Prop :=
+| eqst : forall a b:stream A,
+    (hd a = hd b) -> EqSt (tl a) (tl b) -> EqSt a b.
+
+Section sec_park.
+  Context {A:Type}.
+  Variable R:stream A -> stream A -> Prop.
+  Hypothesis bisim_hd : forall a b:stream A,
+    R a b -> (hd a = hd b).
+  Hypothesis bisim_tl : forall a b:stream A,
+    R a b -> R (tl a) (tl b).
+  CoFixpoint park_ppl : forall (a b:stream A),
+    R a b -> EqSt a b := fun a b (prp:R a b) =>
+      eqst a b (bisim_hd a b prp)
+           (park_ppl (tl a) (tl b) (bisim_tl a b prp)).
+End sec_park.
+
+Theorem map_iterate : forall {A:Type} (f:A->A) (x:A),
+    EqSt (iterate f (f x)) (map f (iterate f x)).
+Proof.
+  intros.
+  apply park_ppl with
+    (R := fun a b =>
+      exists x:A, a = iterate f (f x)  /\
+                  b = map f (iterate f x)).
+  - intros.
+    destruct H as (ex_x, (eq_a, eq_b)).
+    rewrite eq_a.
+    rewrite eq_b.
+    reflexivity.
+  - intros a b (ex_x, (eq_a, eq_b)).
+    exists (f ex_x).
+    split.
+    * rewrite eq_a.
+      reflexivity.
+    * rewrite eq_b.
+      reflexivity.
+  - exists x.
+    split; reflexivity.
+Qed.

coq/unfinished/sudoku.v

@@ -0,0 +1,818 @@
+Require Import List.
+Import ListNotations.
+
+Search (list -> nat -> list).
+Search (nat -> list -> list).
+Search "take".
+
+(*
+Return the first n elements of the list l.
+
+Return whatever is there if n > len(l).
+ *)
+Fixpoint take (n : nat) (l : list nat) : list nat :=
+  match l, n with
+  | [], _ => []
+  | _, O => []
+  | (x::xs), S n' => (x :: take n' xs)
+  end.
+
+Compute take 3 [1;2;3].
+Compute take 2 [1;2;3].
+Compute take 0 [1;2;3].
+Compute take 1 [1;2;3].
+Compute take 5 [1;2;3].
+(* take ✓ *)
+
+(* Consume first n elements of the list l, return the remaining elements as a list *)
+Fixpoint jump (n : nat) (l : list nat) : list nat :=
+  match l, n with
+  | [], _ => []
+  | l', O => l'
+  | (_::xs), S n' => jump n' xs
+  end.
+
+Compute jump 1 [1;2;3].
+Compute jump 2 [1;2;3].
+Compute jump 0 [1;2;3].
+Compute jump 3 [1;2;3].
+Compute jump 4 [1;2;3].
+(* jump ✓ *)
+
+
+(*
+t: number of elements to take
+s: number of elements to skip
+n: number of iterations
+l: grid
+*)
+Fixpoint take_n_jump (t s n : nat) (l : list nat) : list nat :=
+  match n with
+  | O => []
+  | S n' => (take t l) ++ (take_n_jump t s n' (jump (t+s) l))
+  end.
+
+Compute take_n_jump 1 3 3 [1;2;3;4;5;6;7;8;9].
+(* 1;5;9 *)
+
+Compute take_n_jump 2 2 3 [1;2;3;4;5;6;7;8;9].
+(* 1;2;5;6;9 *)
+
+Compute take_n_jump 2 2 2 [1;2;3;4;5;6;7;8;9].
+(* 1;2;5;6 *)
+
+
+(*
+Grid is stored as a list. Row major form.
+
+A grid has size subrectangles.
+Each subrectangle has h rows and w cols.
+
+      w
+      |
+/-----+-----\
+
++-----------+-----------+-----------+  
+|    Sub    |    Sub    |    Sub    |  ⎫
+| rectangle | rectangle | rectangle |  ⎬ h
+|     1     |     2     |     3     |  ⎭
++-----------+-----------+-----------+  
+|    Sub    |    Sub    |    Sub    |
+| rectangle | rectangle | rectangle |
+|     4     |     5     |     6     |
++-----------+-----------+-----------+
+|    Sub    |    Sub    |    Sub    |
+| rectangle | rectangle | rectangle |
+|     7     |     8     |     9     |
++-----------+-----------+-----------+
+
+For a 9x9 sudoku, h=3, w=3 so there will be 9 'subsquares'.
+*)
+(*
+Variable h w : nat. (* height and width *)
+*)
+Definition h := 3.
+Definition w := 3.
+Definition size : nat := h * w. (* no of rows in a grid *)
+(*
+XXX: Can't we just say size = h * 3 ??
+
+Suppose h,w = 2,3
+size = 2 * 3 = 6 ✓
+
+Suppose h,w = 5,2
+size = 5 * 2 = 10
+h*3 = 5 * 3 = 15
+
+No, no.. I got it. The number of elements within a subrectangle should be same as the number of rows and number of columns.
+But then why bother to say sub-'rectangle'? It would always be sub-square, right?
+*)
+
+(*
+Get all elements of row i
+i: row index (starts from zero)
+l: grid.
+*)
+Definition row (i : nat) (l : list nat) : list nat := take size (jump (i * size) l).
+
+(*
+Get all elements of column i
+i: column index (starts from zero)
+l: grid.
+*)
+(* XXX: w was replaced by 3 *)
+Definition col_aux (l : list nat) : list nat := take_n_jump 1 (size-1) size l.
+Definition col (i : nat) (l : list nat) : list nat := col_aux (jump i l).
+
+Definition rect_aux (l : list nat) : list nat := take_n_jump w (size-w) h l.
+Require Import Arith.  (* Notation _ / _ for nat division *)
+Compute Nat.modulo 3 2.
+Search Nat.modulo.
+Definition rect (i : nat) (l : list nat) : list nat :=
+  rect_aux (jump ((Nat.div i h) * size * h + (Nat.modulo i w) * w) l).
+
+Require Import Permutation.
+
+(********* Permutation ************)
+(* Coq standard library has an inductive type named Permutation to denote permutations:
+https://coq.inria.fr/library/Coq.Sorting.Permutation.html
+https://github.com/coq/coq/blob/master/theories/Sorting/Permutation.v
+
+It looks something like:
+
+#+begin_src coq
+Inductive permutation {A : Type} : list A -> list A -> Prop :=
+(* An empty list is a permutation of itself *)
+| perm_nil : permutation [] []
+
+(* If two lists are permutations of some list, they'll remain permutations
+   of some (another) list even upon adding a new element at their heads *)
+| perm_same : forall (x : A) (l1 l2 : list A),
+    permutation l1 l2 -> permutation (x :: l1) (x :: l2)
+
+(* The list formed by swapping the positions of the first two elements of a list
+   is a permutation of the original list *)
+| perm_swap : forall (a b : A) (l : list A),  (* swapping position *)
+    permutation (a :: b :: l) (b :: a :: l)
+
+(* If two lists are permutations of some list and the second list is a permutation
+   of a third list, then the first and third lists are permutation of the same
+   list *)
+| perm_trans : forall (l1 l2 l3 : list A),
+   permutation l1 l2 -> permutation l2 l3 -> permutation l1 l3.
+#+end_src
+*)
+Compute Permutation [1;2] [2;1].
+Compute Permutation [1;2] [2;1;3].
+Compute Permutation [1;2] [2;1].
+(*Check perm_skip 0 [1;2] [2;1].
+Check perm_skip (Permutation [1;2] [2;1]) (Permutation [0;1;2] [0;2;1]). *)
+
+(* Function to get all values from 1 to size *)
+Fixpoint progression_aux (next z : nat) : list nat := 
+  match z with
+  | O => []
+  | S z' => next :: progression_aux (next+1) z'
+  end.
+Definition progression (z : nat) : list nat := progression_aux 1 z.
+Compute progression 10.
+(* ✓ *)
+
+Example grid : list nat := take 81 (0 :: progression 81).
+Compute take 3 grid.
+Compute col 3 grid.
+(* 3;12;21;30;39;48;57;66;75 *)
+Compute rect 3 grid.
+(* = [27; 28; 29; 36; 37; 38; 45; 46; 47] *)
+(* ✓ *)
+
+Definition ref_list : list nat := progression size.
+
+Definition sudoku (l : list nat) :=
+  (length l) = (size * size) /\
+  forall (i : nat), (i < size) -> Permutation (row i l) ref_list /\
+  forall (i : nat), (i < size) -> Permutation (col i l) ref_list /\
+  forall (i : nat), (i < size) -> Permutation (rect i l) ref_list.
+
+(****************************************************************************************)
+(*                                                                                      *)
+(****************************************************************************************)
+
+(* Position of cells in the grid. Indexing starts from zero *)
+Inductive pos : Set := 
+| Pos (x : nat) (y : nat).
+
+(* valid_pos *)
+(*
+Definition is_valid_pos (p : pos) : Prop :=
+  let (x, y) := p in
+  (x < size) /\ (y < size).
+*)
+Definition is_valid_pos (p : pos) : Prop :=
+  match p with
+  | Pos x y => (x < size) /\ (y < size)
+  end.
+
+Locate "_ == _".
+
+Compute pred 3.
+
+(* next. Doesn't check if the next position is valid in the grid. Just generates the next pos. c'est tout. *)
+Search (nat -> nat -> bool).
+Definition next_pos (p : pos) : pos :=
+  match p with
+  | Pos x y =>
+      if Nat.eqb y (size-1) then  (* Nat.eqb notation is =? *)
+        (Pos (x+1) 0)
+      else
+        (Pos x (y+1))
+  end.
+Compute next_pos (Pos 1 3).
+Compute next_pos (Pos 1 8).
+Compute next_pos (Pos 8 8).
+(* ✓ *)
+
+(* pos2n *)
+(* Convert a [pos] value to the corresponding [nat] index into the list representing the grid. *)
+Definition pos_to_idx (p : pos) : nat :=
+  match p with
+  | Pos x y => x*size + y
+  end.
+Compute pos_to_idx (Pos 3 1). (* 28 *)
+Compute pos_to_idx (Pos 0 0). (* 0 *)
+Compute pos_to_idx (Pos 8 8). (* 80 *)
+(* ✓ *)
+
+(* Get value at a position of the grid *)
+Definition get (p : pos) (l : list nat) : nat := List.nth 0 (jump (pos_to_idx p) l) 0. (* last 0 is the default value to be returned for List.nth *)
+
+Compute get (Pos 8 8) grid. (* 80 *)
+(* ✓ *)
+
+(*
+Update a cell.
+nval: new value
+p: cell position
+l: grid
+Returns new value of grid
+ *)
+Definition update (p : pos) (l : list nat) (nval : nat) : list nat :=
+  let idx := pos_to_idx p in
+  (take idx l) ++ [nval] ++ (jump (idx+1) l).
+Compute update (Pos 3 1) grid 42.
+(* ✓ *)
+
+(*
+Literal type
+Consists of a position and a value.
+ *)
+Inductive literal : Set :=
+| Literal (p : pos) (val : nat).
+
+(* Clause is a conjunction of literals. ie, at least one of the constituent literals need be satisfied for the clause to be satisfied. *)
+Definition clause : Set := list literal.
+
+Search (bool -> bool -> bool).
+
+Definition beq_pos (p1 p2 : pos) : bool :=
+  match p1, p2 with
+  | Pos x1 y1, Pos x2 y2 => andb (x1 =? x2) (y1 =? y2)
+  end.
+
+Definition beq_literal (l1 l2 : literal) : bool :=
+  match l1, l2 with
+  | Literal p1 v1, Literal p2 v2 => andb (beq_pos p1 p2) (v1 =? v2)
+  end.
+
+(* Checks whether a literal is in a clause *)
+Fixpoint is_lit_in_clause (lit : literal) (c : clause) : bool :=
+  match c with
+  | [] => false
+  | x::xs =>
+      if (beq_literal x lit) then
+        true
+      else
+        is_lit_in_clause lit xs
+  end.
+
+Example eg_clause := [Literal (Pos 1 2) 100; Literal (Pos 1 3) 200].
+Compute is_lit_in_clause (Literal (Pos 1 3) 200) eg_clause. (* true *)
+Compute is_lit_in_clause (Literal (Pos 4 3) 200) eg_clause. (* false *)
+(* ✓ *)
+
+(* Insert a literal into a clause *)
+(*Definition lit_insert (lit : literal) (c : clause) : clause := lit :: c.*)
+Definition lit_insert (lit : literal) (c : clause) : clause :=
+  match (is_lit_in_clause lit c) with
+  | true => c
+  | _    => lit :: c
+  end.
+Compute lit_insert (Literal (Pos 4 3) 200) eg_clause.
+
+
+(*
+c: a clause
+cno: clause having literals that need to be removed from c
+*)
+Fixpoint lit_rm (c cno : clause) : clause :=
+  match c with
+  | [] => []
+  | (x::xs) =>
+      match (is_lit_in_clause x cno) with
+      | true => lit_rm xs cno
+      | false => x :: lit_rm xs cno
+      end
+  end.
+Compute lit_rm eg_clause [Literal (Pos 1 3) 200].
+Compute lit_rm eg_clause [Literal (Pos 4 3) 200].
+(* ✓ *)
+
+(*
+Merge c1 and c2.
+*)
+(*Definition clause_merge (c1 c2 : clause) : clause := c1 ++ c2.*)
+Fixpoint clause_merge_aux (c1 c2 : clause) : clause :=
+  match c2 with
+  | [] => []
+  | (x::xs) =>
+      match (is_lit_in_clause x c1) with
+      | true => clause_merge_aux c1 xs
+      | false => x :: clause_merge_aux c1 xs
+      end
+  end.
+Definition clause_merge (c1 c2 : clause) : clause := c1 ++ clause_merge_aux c1 c2.
+Compute clause_merge [Literal (Pos 1 2) 10] [Literal (Pos 2 3) 20; Literal (Pos 3 4) 30].
+Compute clause_merge [Literal (Pos 1 2) 10] [Literal (Pos 2 3) 20; Literal (Pos 1 2) 10].
+(* ✓ *)
+
+
+(*
+Conjunction of clauses. All clauses need to be satisfied.
+
+the nat is the length of the clause. ie, number of literals making up the clause.
+ *)
+Definition clauses := list (nat * clause).
+
+Search (list _ -> _ -> bool).
+
+(*
+Check if an element is present inside a [nat] list.
+*)
+Fixpoint is_in (elem : nat) (l : list nat) : bool :=
+  match l with
+  | [] => false
+  | (x::xs) =>
+      if elem =? x then
+        true
+      else
+        is_in elem xs
+  end.
+
+Compute progression_aux 0 3. (* 0;1;2 *)
+
+(*
+Insert a clause to a clauses (the latter is a list of clause values).
+Assumes that [cs] is sorted in the ascending order of their [nat] values.
+ *)
+Definition clauses_insert (c : clause) (cs : clauses) : clauses :=
+  match cs with
+  | [] => [(length c, c)]
+  | (x::xs) => (length c, c) :: cs
+  end.
+
+(*
+Remove from [cs] all clauses that contain the literal [l] and remove from each element (which is a [clause]) of [cs] all literals occurring in [c].
+
+Used to update the list of constraints when a new fact ([l]) is known.
+
+l: new fact that we knows to hold.
+c: list of facts that we know doesn't hold.
+*)
+Fixpoint clauses_update (l : literal) (c : clause) (cs : clauses) : clauses :=
+  match cs with
+  | (_, x) :: xs => 
+      if (is_lit_in_clause l x) then
+        clauses_update l c xs
+      else
+        let res := (lit_rm c x) in
+        clauses_insert res (clauses_update l c xs)
+  | [] => []
+  end.
+
+(* List of all possible indices *)
+Definition indexes : list nat := progression_aux 0 size.
+Compute indexes.
+
+(* rect1cellids (renamed from cross) could thought of as all positions within the first sub-rectangle *)
+Definition rect1cellids :=
+  let p := progression_aux 0 h in 
+  let q := progression_aux 0 w in 
+  fold_right (fun x l =>
+    (map (fun y => (Pos x y)) q) ++ l)
+    nil p.
+Compute rect1cellids.
+(*
+(0,0), (0,1), (0,2), 
+(1,0), (1,1), (1,2), 
+(2,0), (2,1), (2,2), 
+ *)
+
+Compute indexes.
+Compute ref_list.
+Check lit_insert.
+
+(* gridcellids (renamed from cross) could be thought of as all positions within the entire grid *)
+Definition gridcellids := list_prod indexes indexes.
+(* ORIG Version
+Definition cross1 :=
+  fold_right (fun idx l =>
+    (map (fun val => (idx, val)) ref_list) ++ l) [] indexes.
+ *)
+Compute gridcellids.
+(*
+= [(0, 0); (0, 1); (0, 2); (0, 3); (0, 4); (0, 5); 
+       (0, 6); (0, 7); (0, 8); (1, 0); (1, 1); (1, 2); 
+       (1, 3); (1, 4); (1, 5); (1, 6); (1, 7); (1, 8); 
+       (2, 0); (2, 1); (2, 2); (2, 3); (2, 4); (2, 5); 
+       (2, 6); (2, 7); (2, 8); (3, 0); (3, 1); (3, 2); 
+       (3, 3); (3, 4); (3, 5); (3, 6); (3, 7); (3, 8); 
+       (4, 0); (4, 1); (4, 2); (4, 3); (4, 4); (4, 5); 
+       (4, 6); (4, 7); (4, 8); (5, 0); (5, 1); (5, 2); 
+       (5, 3); (5, 4); (5, 5); (5, 6); (5, 7); (5, 8); 
+       (6, 0); (6, 1); (6, 2); (6, 3); (6, 4); (6, 5); 
+       (6, 6); (6, 7); (6, 8); (7, 0); (7, 1); (7, 2); 
+       (7, 3); (7, 4); (7, 5); (7, 6); (7, 7); (7, 8); 
+       (8, 0); (8, 1); (8, 2); (8, 3); (8, 4); (8, 5); 
+       (8, 6); (8, 7); (8, 8)]
+     : list (nat * nat)
+#+END_OUTPUT (Info) *)
+Compute cross1.
+(*
+(0, 1); (0, 2); (0, 3); (0, 4); (0, 5); (0, 6); (0, 7); (0, 8); (0, 9);
+(1, 1); (1, 2); (1, 3); (1, 4); (1, 5); (1, 6); (1, 7); (1, 8); (1, 9);
+(2, 1); (2, 2); (2, 3); (2, 4); (2, 5); (2, 6); (2, 7); (2, 8); (2, 9);
+(3, 1); (3, 2); (3, 3); (3, 4); (3, 5); (3, 6); (3, 7); (3, 8); (3, 9);
+(4, 1); (4, 2); (4, 3); (4, 4); (4, 5); (4, 6); (4, 7); (4, 8); (4, 9);
+(5, 1); (5, 2); (5, 3); (5, 4); (5, 5); (5, 6); (5, 7); (5, 8); (5, 9);
+(6, 1); (6, 2); (6, 3); (6, 4); (6, 5); (6, 6); (6, 7); (6, 8); (6, 9);
+(7, 1); (7, 2); (7, 3); (7, 4); (7, 5); (7, 6); (7, 7); (7, 8); (7, 9);
+(8, 1); (8, 2); (8, 3); (8, 4); (8, 5); (8, 6); (8, 7); (8, 8); (8, 9)] 
+ *)
+(*
+(0,0), (0,1), (0,2),   (0,3), (0,4), (0,5),   (0,6), (0,7), (0,8) 
+(1,0), (1,1), (1,2),   (1,3), (1,4), (1,5),   (1,6), (1,7), (1,8) 
+(2,0), (2,1), (2,2),   (2,3), (2,4), (2,5),   (2,6), (2,7), (2,8) 
+
+(3,0), (3,1), (3,2),   (3,3), (3,4), (3,5),   (3,6), (3,7), (3,8) 
+(4,0), (4,1), (4,2),   (4,3), (4,4), (4,5),   (4,6), (4,7), (4,8) 
+(5,0), (5,1), (5,2),   (5,3), (5,4), (5,5),   (5,6), (5,7), (5,8) 
+
+(6,0), (6,1), (6,2),   (6,3), (6,4), (6,5),   (6,6), (6,7), (6,8) 
+(7,0), (7,1), (7,2),   (7,3), (7,4), (7,5),   (7,6), (7,7), (7,8) 
+(8,0), (8,1), (8,2),   (8,3), (8,4), (8,5),   (8,6), (8,7), (8,8) 
+*)
+
+
+Check fold_right.
+(*
+forall A B : Type, (B -> A -> A) -> A -> list B -> A
+*)
+Compute fold_right (fun x acc=>x::acc) [] [1;2]%list.
+(* Okay, fold_right is like
+
+fold_right f acc lst.
+where f takes a value from lst and the accumulator.
+fold_right finally returns the final value of accumulator.
+ *)
+
+(* generate constraints saying that row i has value val *)
+Definition gen_row (i val:nat) :=
+  fold_right
+  (fun idx acc => 
+    (lit_insert (Literal (Pos i idx) val) acc))
+  [] indexes.
+(* val are elements of indexes
+   l is the accumulator whose initial value is [] *)
+Compute gen_row 2 0.
+
+
+(* generate constraints saying that column i has value val *)
+Definition gen_column (i val:nat) :=
+  fold_right
+  (fun idx acc =>
+    (lit_insert (Literal (Pos idx i) val) acc))
+  [] indexes.
+Compute gen_column 2 0.
+
+Compute list_prod [1;2] [3;4].
+Compute progression_aux 0 3.
+Compute progression_aux 3 3.
+Search (list _ -> list _ -> list _).
+Search (nat -> nat -> nat).
+Compute Nat.modulo 3 2.
+
+Compute 
+  (fun xy:nat*nat =>
+    let '(x,y) := xy in
+    Literal (Pos x y) 3) (4,5).
+
+(* generate constraints saying that subrectangle i has value val *)
+Definition gen_rect (i val:nat) :=
+  let xs := progression_aux ((Nat.div i 3)*w) 3 in
+  let ys := progression_aux ((Nat.modulo i 3)*w) 3 in
+  let xys := list_prod xs ys in
+  map (fun xy:nat*nat =>
+        let '(x,y) := xy in
+        Literal (Pos x y) val)
+      xys.
+Compute gen_rect 5 0.
+(*
+= [Literal (Pos 3 6) 0; Literal (Pos 3 7) 0; 
+       Literal (Pos 3 8) 0; Literal (Pos 4 6) 0; Literal (Pos 4 7) 0;
+       Literal (Pos 4 8) 0; Literal (Pos 5 6) 0; Literal (Pos 5 7) 0;
+       Literal (Pos 5 8) 0]
+     : list literal
+*)
+  
+
+(* Generate constraint saying that the cell at a given position is not empty. ie, not zero as per our convention. *)
+Definition gen_cell (p:pos) :=
+  fold_right
+    (fun val acc => lit_insert (Literal p val) acc)
+    [] ref_list.
+Compute gen_cell (Pos 2 1).
+(*
+= [Literal (Pos 2 1) 1; Literal (Pos 2 1) 2; 
+       Literal (Pos 2 1) 3; Literal (Pos 2 1) 4; Literal (Pos 2 1) 5;
+       Literal (Pos 2 1) 6; Literal (Pos 2 1) 7; Literal (Pos 2 1) 8;
+       Literal (Pos 2 1) 9]
+     : clause
+*)
+
+(* Generate constraints saying that all cells are non-empty *)
+Definition all_cells :=
+  let cellids := list_prod indexes indexes in
+  fold_right
+    (fun cellid acc => 
+      let '(x,y) := cellid in
+      (gen_cell (Pos x y)) ++ acc)
+    [] cellids.
+Compute all_cells.
+(*
+= [Literal (Pos 0 0) 1; Literal (Pos 0 0) 2; 
+       Literal (Pos 0 0) 3; Literal (Pos 0 0) 4; Literal (Pos 0 0) 5;
+       Literal (Pos 0 0) 6; Literal (Pos 0 0) 7; Literal (Pos 0 0) 8;
+       Literal (Pos 0 0) 9; Literal (Pos 0 1) 1; Literal (Pos 0 1) 2;
+       Literal (Pos 0 1) 3; Literal (Pos 0 1) 4; Literal (Pos 0 1) 5;
+       Literal (Pos 0 1) 6; Literal (Pos 0 1) 7; Literal (Pos 0 1) 8;
+       Literal (Pos 0 1) 9; Literal (Pos 0 2) 1; Literal (Pos 0 2) 2;
+       Literal (Pos 0 2) 3; Literal (Pos 0 2) 4; Literal (Pos 0 2) 5;
+       Literal (Pos 0 2) 6; Literal (Pos 0 2) 7; Literal (Pos 0 2) 8;
+       Literal (Pos 0 2) 9; Literal (Pos 0 3) 1; Literal (Pos 0 3) 2;
+       Literal (Pos 0 3) 3; Literal (Pos 0 3) 4; Literal (Pos 0 3) 5;
+       Literal (Pos 0 3) 6; Literal (Pos 0 3) 7; Literal (Pos 0 3) 8;
+       Literal (Pos 0 3) 9; Literal (Pos 0 4) 1; Literal (Pos 0 4) 2;
+       Literal (Pos 0 4) 3; Literal (Pos 0 4) 4; Literal (Pos 0 4) 5;
+       Literal (Pos 0 4) 6; Literal (Pos 0 4) 7; Literal (Pos 0 4) 8;
+       Literal (Pos 0 4) 9; Literal (Pos 0 5) 1; Literal (Pos 0 5) 2;
+       Literal (Pos 0 5) 3; Literal (Pos 0 5) 4; Literal (Pos 0 5) 5;
+       Literal (Pos 0 5) 6; Literal (Pos 0 5) 7; Literal (Pos 0 5) 8;
+       Literal (Pos 0 5) 9; Literal (Pos 0 6) 1; Literal (Pos 0 6) 2;
+       Literal (Pos 0 6) 3; Literal (Pos 0 6) 4; Literal (Pos 0 6) 5;
+       Literal (Pos 0 6) 6; Literal (Pos 0 6) 7; Literal (Pos 0 6) 8;
+       Literal (Pos 0 6) 9; Literal (Pos 0 7) 1; Literal (Pos 0 7) 2;
+       Literal (Pos 0 7) 3; Literal (Pos 0 7) 4; Literal (Pos 0 7) 5;
+       Literal (Pos 0 7) 6; Literal (Pos 0 7) 7; Literal (Pos 0 7) 8;
+       Literal (Pos 0 7) 9; Literal (Pos 0 8) 1; Literal (Pos 0 8) 2;
+       Literal (Pos 0 8) 3; Literal (Pos 0 8) 4; Literal (Pos 0 8) 5;
+       Literal (Pos 0 8) 6; Literal (Pos 0 8) 7; Literal (Pos 0 8) 8;
+       Literal (Pos 0 8) 9; Literal (Pos 1 0) 1; Literal (Pos 1 0) 2;
+       Literal (Pos 1 0) 3; Literal (Pos 1 0) 4; Literal (Pos 1 0) 5;
+       Literal (Pos 1 0) 6; Literal (Pos 1 0) 7; Literal (Pos 1 0) 8;
+       Literal (Pos 1 0) 9; Literal (Pos 1 1) 1; Literal (Pos 1 1) 2;
+       Literal (Pos 1 1) 3; Literal (Pos 1 1) 4; Literal (Pos 1 1) 5;
+       Literal (Pos 1 1) 6; Literal (Pos 1 1) 7; Literal (Pos 1 1) 8;
+       Literal (Pos 1 1) 9; Literal (Pos 1 2) 1; Literal (Pos 1 2) 2;
+       Literal (Pos 1 2) 3; Literal (Pos 1 2) 4; Literal (Pos 1 2) 5;
+       Literal (Pos 1 2) 6; Literal (Pos 1 2) 7; Literal (Pos 1 2) 8;
+       Literal (Pos 1 2) 9; Literal (Pos 1 3) 1; Literal (Pos 1 3) 2;
+       Literal (Pos 1 3) 3; Literal (Pos 1 3) 4; Literal (Pos 1 3) 5;
+       Literal (Pos 1 3) 6; Literal (Pos 1 3) 7; Literal (Pos 1 3) 8;
+       Literal (Pos 1 3) 9; Literal (Pos 1 4) 1; Literal (Pos 1 4) 2;
+       Literal (Pos 1 4) 3; Literal (Pos 1 4) 4; Literal (Pos 1 4) 5;
+       Literal (Pos 1 4) 6; Literal (Pos 1 4) 7; Literal (Pos 1 4) 8;
+       Literal (Pos 1 4) 9; Literal (Pos 1 5) 1; Literal (Pos 1 5) 2;
+       Literal (Pos 1 5) 3; Literal (Pos 1 5) 4; Literal (Pos 1 5) 5;
+       Literal (Pos 1 5) 6; Literal (Pos 1 5) 7; Literal (Pos 1 5) 8;
+       Literal (Pos 1 5) 9; Literal (Pos 1 6) 1; Literal (Pos 1 6) 2;
+       Literal (Pos 1 6) 3; Literal (Pos 1 6) 4; Literal (Pos 1 6) 5;
+       Literal (Pos 1 6) 6; Literal (Pos 1 6) 7; Literal (Pos 1 6) 8;
+       Literal (Pos 1 6) 9; Literal (Pos 1 7) 1; Literal (Pos 1 7) 2;
+       Literal (Pos 1 7) 3; Literal (Pos 1 7) 4; Literal (Pos 1 7) 5;
+       Literal (Pos 1 7) 6; Literal (Pos 1 7) 7; Literal (Pos 1 7) 8;
+       Literal (Pos 1 7) 9; Literal (Pos 1 8) 1; Literal (Pos 1 8) 2;
+       Literal (Pos 1 8) 3; Literal (Pos 1 8) 4; Literal (Pos 1 8) 5;
+       Literal (Pos 1 8) 6; Literal (Pos 1 8) 7; Literal (Pos 1 8) 8;
+       Literal (Pos 1 8) 9; Literal (Pos 2 0) 1; Literal (Pos 2 0) 2;
+       Literal (Pos 2 0) 3; Literal (Pos 2 0) 4; Literal (Pos 2 0) 5;
+       Literal (Pos 2 0) 6; Literal (Pos 2 0) 7; Literal (Pos 2 0) 8;
+       Literal (Pos 2 0) 9; Literal (Pos 2 1) 1; Literal (Pos 2 1) 2;
+       Literal (Pos 2 1) 3; Literal (Pos 2 1) 4; Literal (Pos 2 1) 5;
+       Literal (Pos 2 1) 6; Literal (Pos 2 1) 7; Literal (Pos 2 1) 8;
+       Literal (Pos 2 1) 9; Literal (Pos 2 2) 1; Literal (Pos 2 2) 2;
+       Literal (Pos 2 2) 3; Literal (Pos 2 2) 4; Literal (Pos 2 2) 5;
+       Literal (Pos 2 2) 6; Literal (Pos 2 2) 7; Literal (Pos 2 2) 8;
+       Literal (Pos 2 2) 9; Literal (Pos 2 3) 1; Literal (Pos 2 3) 2;
+       Literal (Pos 2 3) 3; Literal (Pos 2 3) 4; Literal (Pos 2 3) 5;
+       Literal (Pos 2 3) 6; Literal (Pos 2 3) 7; Literal (Pos 2 3) 8;
+       Literal (Pos 2 3) 9; Literal (Pos 2 4) 1; Literal (Pos 2 4) 2;
+       Literal (Pos 2 4) 3; Literal (Pos 2 4) 4; Literal (Pos 2 4) 5;
+       Literal (Pos 2 4) 6; Literal (Pos 2 4) 7; Literal (Pos 2 4) 8;
+       Literal (Pos 2 4) 9; Literal (Pos 2 5) 1; Literal (Pos 2 5) 2;
+       Literal (Pos 2 5) 3; Literal (Pos 2 5) 4; Literal (Pos 2 5) 5;
+       Literal (Pos 2 5) 6; Literal (Pos 2 5) 7; Literal (Pos 2 5) 8;
+       Literal (Pos 2 5) 9; Literal (Pos 2 6) 1; Literal (Pos 2 6) 2;
+       Literal (Pos 2 6) 3; Literal (Pos 2 6) 4; Literal (Pos 2 6) 5;
+       Literal (Pos 2 6) 6; Literal (Pos 2 6) 7; Literal (Pos 2 6) 8;
+       Literal (Pos 2 6) 9; Literal (Pos 2 7) 1; Literal (Pos 2 7) 2;
+       Literal (Pos 2 7) 3; Literal (Pos 2 7) 4; Literal (Pos 2 7) 5;
+       Literal (Pos 2 7) 6; Literal (Pos 2 7) 7; Literal (Pos 2 7) 8;
+       Literal (Pos 2 7) 9; Literal (Pos 2 8) 1; Literal (Pos 2 8) 2;
+       Literal (Pos 2 8) 3; Literal (Pos 2 8) 4; Literal (Pos 2 8) 5;
+       Literal (Pos 2 8) 6; Literal (Pos 2 8) 7; Literal (Pos 2 8) 8;
+       Literal (Pos 2 8) 9; Literal (Pos 3 0) 1; Literal (Pos 3 0) 2;
+       Literal (Pos 3 0) 3; Literal (Pos 3 0) 4; Literal (Pos 3 0) 5;
+       Literal (Pos 3 0) 6; Literal (Pos 3 0) 7; Literal (Pos 3 0) 8;
+       Literal (Pos 3 0) 9; Literal (Pos 3 1) 1; Literal (Pos 3 1) 2;
+       Literal (Pos 3 1) 3; Literal (Pos 3 1) 4; Literal (Pos 3 1) 5;
+       Literal (Pos 3 1) 6; Literal (Pos 3 1) 7; Literal (Pos 3 1) 8;
+       Literal (Pos 3 1) 9; Literal (Pos 3 2) 1; Literal (Pos 3 2) 2;
+       Literal (Pos 3 2) 3; Literal (Pos 3 2) 4; Literal (Pos 3 2) 5;
+       Literal (Pos 3 2) 6; Literal (Pos 3 2) 7; Literal (Pos 3 2) 8;
+       Literal (Pos 3 2) 9; Literal (Pos 3 3) 1; Literal (Pos 3 3) 2;
+       Literal (Pos 3 3) 3; Literal (Pos 3 3) 4; Literal (Pos 3 3) 5;
+       Literal (Pos 3 3) 6; Literal (Pos 3 3) 7; Literal (Pos 3 3) 8;
+       Literal (Pos 3 3) 9; Literal (Pos 3 4) 1; Literal (Pos 3 4) 2;
+       Literal (Pos 3 4) 3; Literal (Pos 3 4) 4; Literal (Pos 3 4) 5;
+       Literal (Pos 3 4) 6; Literal (Pos 3 4) 7; Literal (Pos 3 4) 8;
+       Literal (Pos 3 4) 9; Literal (Pos 3 5) 1; Literal (Pos 3 5) 2;
+       Literal (Pos 3 5) 3; Literal (Pos 3 5) 4; Literal (Pos 3 5) 5;
+       Literal (Pos 3 5) 6; Literal (Pos 3 5) 7; Literal (Pos 3 5) 8;
+       Literal (Pos 3 5) 9; Literal (Pos 3 6) 1; Literal (Pos 3 6) 2;
+       Literal (Pos 3 6) 3; Literal (Pos 3 6) 4; Literal (Pos 3 6) 5;
+       Literal (Pos 3 6) 6; Literal (Pos 3 6) 7; Literal (Pos 3 6) 8;
+       Literal (Pos 3 6) 9; Literal (Pos 3 7) 1; Literal (Pos 3 7) 2;
+       Literal (Pos 3 7) 3; Literal (Pos 3 7) 4; Literal (Pos 3 7) 5;
+       Literal (Pos 3 7) 6; Literal (Pos 3 7) 7; Literal (Pos 3 7) 8;
+       Literal (Pos 3 7) 9; Literal (Pos 3 8) 1; Literal (Pos 3 8) 2;
+       Literal (Pos 3 8) 3; Literal (Pos 3 8) 4; Literal (Pos 3 8) 5;
+       Literal (Pos 3 8) 6; Literal (Pos 3 8) 7; Literal (Pos 3 8) 8;
+       Literal (Pos 3 8) 9; Literal (Pos 4 0) 1; Literal (Pos 4 0) 2;
+       Literal (Pos 4 0) 3; Literal (Pos 4 0) 4; Literal (Pos 4 0) 5;
+       Literal (Pos 4 0) 6; Literal (Pos 4 0) 7; Literal (Pos 4 0) 8;
+       Literal (Pos 4 0) 9; Literal (Pos 4 1) 1; Literal (Pos 4 1) 2;
+       Literal (Pos 4 1) 3; Literal (Pos 4 1) 4; Literal (Pos 4 1) 5;
+       Literal (Pos 4 1) 6; Literal (Pos 4 1) 7; Literal (Pos 4 1) 8;
+       Literal (Pos 4 1) 9; Literal (Pos 4 2) 1; Literal (Pos 4 2) 2;
+       Literal (Pos 4 2) 3; Literal (Pos 4 2) 4; Literal (Pos 4 2) 5;
+       Literal (Pos 4 2) 6; Literal (Pos 4 2) 7; Literal (Pos 4 2) 8;
+       Literal (Pos 4 2) 9; Literal (Pos 4 3) 1; Literal (Pos 4 3) 2;
+       Literal (Pos 4 3) 3; Literal (Pos 4 3) 4; Literal (Pos 4 3) 5;
+       Literal (Pos 4 3) 6; Literal (Pos 4 3) 7; Literal (Pos 4 3) 8;
+       Literal (Pos 4 3) 9; Literal (Pos 4 4) 1; Literal (Pos 4 4) 2;
+       Literal (Pos 4 4) 3; Literal (Pos 4 4) 4; Literal (Pos 4 4) 5;
+       Literal (Pos 4 4) 6; Literal (Pos 4 4) 7; Literal (Pos 4 4) 8;
+       Literal (Pos 4 4) 9; Literal (Pos 4 5) 1; Literal (Pos 4 5) 2;
+       Literal (Pos 4 5) 3; Literal (Pos 4 5) 4; Literal (Pos 4 5) 5;
+       Literal (Pos 4 5) 6; Literal (Pos 4 5) 7; Literal (Pos 4 5) 8;
+       Literal (Pos 4 5) 9; Literal (Pos 4 6) 1; Literal (Pos 4 6) 2;
+       Literal (Pos 4 6) 3; Literal (Pos 4 6) 4; Literal (Pos 4 6) 5;
+       Literal (Pos 4 6) 6; Literal (Pos 4 6) 7; Literal (Pos 4 6) 8;
+       Literal (Pos 4 6) 9; Literal (Pos 4 7) 1; Literal (Pos 4 7) 2;
+       Literal (Pos 4 7) 3; Literal (Pos 4 7) 4; Literal (Pos 4 7) 5;
+       Literal (Pos 4 7) 6; Literal (Pos 4 7) 7; Literal (Pos 4 7) 8;
+       Literal (Pos 4 7) 9; Literal (Pos 4 8) 1; Literal (Pos 4 8) 2;
+       Literal (Pos 4 8) 3; Literal (Pos 4 8) 4; Literal (Pos 4 8) 5;
+       Literal (Pos 4 8) 6; Literal (Pos 4 8) 7; Literal (Pos 4 8) 8;
+       Literal (Pos 4 8) 9; Literal (Pos 5 0) 1; Literal (Pos 5 0) 2;
+       Literal (Pos 5 0) 3; Literal (Pos 5 0) 4; Literal (Pos 5 0) 5;
+       Literal (Pos 5 0) 6; Literal (Pos 5 0) 7; Literal (Pos 5 0) 8;
+       Literal (Pos 5 0) 9; Literal (Pos 5 1) 1; Literal (Pos 5 1) 2;
+       Literal (Pos 5 1) 3; Literal (Pos 5 1) 4; Literal (Pos 5 1) 5;
+       Literal (Pos 5 1) 6; Literal (Pos 5 1) 7; Literal (Pos 5 1) 8;
+       Literal (Pos 5 1) 9; Literal (Pos 5 2) 1; Literal (Pos 5 2) 2;
+       Literal (Pos 5 2) 3; Literal (Pos 5 2) 4; Literal (Pos 5 2) 5;
+       Literal (Pos 5 2) 6; Literal (Pos 5 2) 7; Literal (Pos 5 2) 8;
+       Literal (Pos 5 2) 9; Literal (Pos 5 3) 1; Literal (Pos 5 3) 2;
+       Literal (Pos 5 3) 3; Literal (Pos 5 3) 4; Literal (Pos 5 3) 5;
+       Literal (Pos 5 3) 6; Literal (Pos 5 3) 7; Literal (Pos 5 3) 8;
+       Literal (Pos 5 3) 9; Literal (Pos 5 4) 1; Literal (Pos 5 4) 2;
+       Literal (Pos 5 4) 3; Literal (Pos 5 4) 4; Literal (Pos 5 4) 5;
+       Literal (Pos 5 4) 6; Literal (Pos 5 4) 7; Literal (Pos 5 4) 8;
+       Literal (Pos 5 4) 9; Literal (Pos 5 5) 1; Literal (Pos 5 5) 2;
+       Literal (Pos 5 5) 3; Literal (Pos 5 5) 4; Literal (Pos 5 5) 5;
+       Literal (Pos 5 5) 6; Literal (Pos 5 5) 7; Literal (Pos 5 5) 8;
+       Literal (Pos 5 5) 9; Literal (Pos 5 6) 1; Literal (Pos 5 6) 2;
+       Literal (Pos 5 6) 3; Literal (Pos 5 6) 4; Literal (Pos 5 6) 5;
+       Literal (Pos 5 6) 6; Literal (Pos 5 6) 7; Literal (Pos 5 6) 8;
+       Literal (Pos 5 6) 9; Literal (Pos 5 7) 1; Literal (Pos 5 7) 2;
+       Literal (Pos 5 7) 3; Literal (Pos 5 7) 4; Literal (Pos 5 7) 5;
+       Literal (Pos 5 7) 6; Literal (Pos 5 7) 7; Literal (Pos 5 7) 8;
+       Literal (Pos 5 7) 9; Literal (Pos 5 8) 1; Literal (Pos 5 8) 2;
+       Literal (Pos 5 8) 3; Literal (Pos 5 8) 4; Literal (Pos 5 8) 5;
+       Literal (Pos 5 8) 6; Literal (Pos 5 8) 7; Literal (Pos 5 8) 8;
+       Literal (Pos 5 8) 9; Literal (Pos 6 0) 1; Literal (Pos 6 0) 2;
+       Literal (Pos 6 0) 3; Literal (Pos 6 0) 4; Literal (Pos 6 0) 5;
+       Literal (Pos 6 0) 6; Literal (Pos 6 0) 7; Literal (Pos 6 0) 8;
+       Literal (Pos 6 0) 9; Literal (Pos 6 1) 1; Literal (Pos 6 1) 2;
+       Literal (Pos 6 1) 3; Literal (Pos 6 1) 4; Literal (Pos 6 1) 5;
+       Literal (Pos 6 1) 6; Literal (Pos 6 1) 7; Literal (Pos 6 1) 8;
+       Literal (Pos 6 1) 9; Literal (Pos 6 2) 1; Literal (Pos 6 2) 2;
+       Literal (Pos 6 2) 3; Literal (Pos 6 2) 4; Literal (Pos 6 2) 5;
+       Literal (Pos 6 2) 6; Literal (Pos 6 2) 7; Literal (Pos 6 2) 8;
+       Literal (Pos 6 2) 9; Literal (Pos 6 3) 1; Literal (Pos 6 3) 2;
+       Literal (Pos 6 3) 3; Literal (Pos 6 3) 4; Literal (Pos 6 3) 5;
+       Literal (Pos 6 3) 6; Literal (Pos 6 3) 7; Literal (Pos 6 3) 8;
+       Literal (Pos 6 3) 9; Literal (Pos 6 4) 1; Literal (Pos 6 4) 2;
+       Literal (Pos 6 4) 3; Literal (Pos 6 4) 4; Literal (Pos 6 4) 5;
+       Literal (Pos 6 4) 6; Literal (Pos 6 4) 7; Literal (Pos 6 4) 8;
+       Literal (Pos 6 4) 9; Literal (Pos 6 5) 1; Literal (Pos 6 5) 2;
+       Literal (Pos 6 5) 3; Literal (Pos 6 5) 4; Literal (Pos 6 5) 5;
+       Literal (Pos 6 5) 6; Literal (Pos 6 5) 7; Literal (Pos 6 5) 8;
+       Literal (Pos 6 5) 9; Literal (Pos 6 6) 1; Literal (Pos 6 6) 2;
+       Literal (Pos 6 6) 3; Literal (Pos 6 6) 4; Literal (Pos 6 6) 5;
+       Literal (Pos 6 6) 6; Literal (Pos 6 6) 7; Literal (Pos 6 6) 8;
+       Literal (Pos 6 6) 9; Literal (Pos 6 7) 1; Literal (Pos 6 7) 2;
+       Literal (Pos 6 7) 3; Literal (Pos 6 7) 4; Literal (Pos 6 7) 5;
+       Literal (Pos 6 7) 6; Literal (Pos 6 7) 7; Literal (Pos 6 7) 8;
+       Literal (Pos 6 7) 9; Literal (Pos 6 8) 1; Literal (Pos 6 8) 2;
+       Literal (Pos 6 8) 3; Literal (Pos 6 8) 4; Literal (Pos 6 8) 5;
+       Literal (Pos 6 8) 6; Literal (Pos 6 8) 7; Literal (Pos 6 8) 8;
+       Literal (Pos 6 8) 9; Literal (Pos 7 0) 1; Literal (Pos 7 0) 2;
+       Literal (Pos 7 0) 3; Literal (Pos 7 0) 4; Literal (Pos 7 0) 5;
+       Literal (Pos 7 0) 6; Literal (Pos 7 0) 7; Literal (Pos 7 0) 8;
+       Literal (Pos 7 0) 9; Literal (Pos 7 1) 1; Literal (Pos 7 1) 2;
+       Literal (Pos 7 1) 3; Literal (Pos 7 1) 4; Literal (Pos 7 1) 5;
+       Literal (Pos 7 1) 6; Literal (Pos 7 1) 7; Literal (Pos 7 1) 8;
+       Literal (Pos 7 1) 9; Literal (Pos 7 2) 1; Literal (Pos 7 2) 2;
+       Literal (Pos 7 2) 3; Literal (Pos 7 2) 4; Literal (Pos 7 2) 5;
+       Literal (Pos 7 2) 6; Literal (Pos 7 2) 7; Literal (Pos 7 2) 8;
+       Literal (Pos 7 2) 9; Literal (Pos 7 3) 1; Literal (Pos 7 3) 2;
+       Literal (Pos 7 3) 3; Literal (Pos 7 3) 4; Literal (Pos 7 3) 5;
+       Literal (Pos 7 3) 6; Literal (Pos 7 3) 7; Literal (Pos 7 3) 8;
+       Literal (Pos 7 3) 9; Literal (Pos 7 4) 1; Literal (Pos 7 4) 2;
+       Literal (Pos 7 4) 3; Literal (Pos 7 4) 4; Literal (Pos 7 4) 5;
+       Literal (Pos 7 4) 6; Literal (Pos 7 4) 7; Literal (Pos 7 4) 8;
+       Literal (Pos 7 4) 9; Literal (Pos 7 5) 1; Literal (Pos 7 5) 2;
+       Literal (Pos 7 5) 3; Literal (Pos 7 5) 4; Literal (Pos 7 5) 5;
+       Literal (Pos 7 5) 6; Literal (Pos 7 5) 7; Literal (Pos 7 5) 8;
+       Literal (Pos 7 5) 9; Literal (Pos 7 6) 1; Literal (Pos 7 6) 2;
+       Literal (Pos 7 6) 3; Literal (Pos 7 6) 4; Literal (Pos 7 6) 5;
+       Literal (Pos 7 6) 6; Literal (Pos 7 6) 7; Literal (Pos 7 6) 8;
+       Literal (Pos 7 6) 9; Literal (Pos 7 7) 1; Literal (Pos 7 7) 2;
+       Literal (Pos 7 7) 3; Literal (Pos 7 7) 4; Literal (Pos 7 7) 5;
+       Literal (Pos 7 7) 6; Literal (Pos 7 7) 7; Literal (Pos 7 7) 8;
+       Literal (Pos 7 7) 9; Literal (Pos 7 8) 1; Literal (Pos 7 8) 2;
+       Literal (Pos 7 8) 3; Literal (Pos 7 8) 4; Literal (Pos 7 8) 5;
+       Literal (Pos 7 8) 6; Literal (Pos 7 8) 7; Literal (Pos 7 8) 8;
+       Literal (Pos 7 8) 9; Literal (Pos 8 0) 1; Literal (Pos 8 0) 2;
+       Literal (Pos 8 0) 3; Literal (Pos 8 0) 4; Literal (Pos 8 0) 5;
+       Literal (Pos 8 0) 6; Literal (Pos 8 0) 7; Literal (Pos 8 0) 8;
+       Literal (Pos 8 0) 9; Literal (Pos 8 1) 1; Literal (Pos 8 1) 2;
+       Literal (Pos 8 1) 3; Literal (Pos 8 1) 4; Literal (Pos 8 1) 5;
+       Literal (Pos 8 1) 6; Literal (Pos 8 1) 7; Literal (Pos 8 1) 8;
+       Literal (Pos 8 1) 9; Literal (Pos 8 2) 1; Literal (Pos 8 2) 2;
+       Literal (Pos 8 2) 3; Literal (Pos 8 2) 4; Literal (Pos 8 2) 5;
+       Literal (Pos 8 2) 6; Literal (Pos 8 2) 7; Literal (Pos 8 2) 8;
+       Literal (Pos 8 2) 9; Literal (Pos 8 3) 1; Literal (Pos 8 3) 2;
+       Literal (Pos 8 3) 3; Literal (Pos 8 3) 4; Literal (Pos 8 3) 5;
+       Literal (Pos 8 3) 6; Literal (Pos 8 3) 7; Literal (Pos 8 3) 8;
+       Literal (Pos 8 3) 9; Literal (Pos 8 4) 1; Literal (Pos 8 4) 2;
+       Literal (Pos 8 4) 3; Literal (Pos 8 4) 4; Literal (Pos 8 4) 5;
+       Literal (Pos 8 4) 6; Literal (Pos 8 4) 7; Literal (Pos 8 4) 8;
+       Literal (Pos 8 4) 9; Literal (Pos 8 5) 1; Literal (Pos 8 5) 2;
+       Literal (Pos 8 5) 3; Literal (Pos 8 5) 4; Literal (Pos 8 5) 5;
+       Literal (Pos 8 5) 6; Literal (Pos 8 5) 7; Literal (Pos 8 5) 8;
+       Literal (Pos 8 5) 9; Literal (Pos 8 6) 1; Literal (Pos 8 6) 2;
+       Literal (Pos 8 6) 3; Literal (Pos 8 6) 4; Literal (Pos 8 6) 5;
+       Literal (Pos 8 6) 6; Literal (Pos 8 6) 7; Literal (Pos 8 6) 8;
+       Literal (Pos 8 6) 9; Literal (Pos 8 7) 1; Literal (Pos 8 7) 2;
+       Literal (Pos 8 7) 3; Literal (Pos 8 7) 4; Literal (Pos 8 7) 5;
+       Literal (Pos 8 7) 6; Literal (Pos 8 7) 7; Literal (Pos 8 7) 8;
+       Literal (Pos 8 7) 9; Literal (Pos 8 8) 1; Literal (Pos 8 8) 2;
+       Literal (Pos 8 8) 3; Literal (Pos 8 8) 4; Literal (Pos 8 8) 5;
+       Literal (Pos 8 8) 6; Literal (Pos 8 8) 7; Literal (Pos 8 8) 8;
+       Literal (Pos 8 8) 9]
+     : list literal
+*)
+
+
+
+(*
+Sort clauses in the ascending order of the nat part, which indicates the number of literals associated with the clause.
+
+XXX: TODO
+
+Definition sort_clauses
+*)
+

coq/unfinished/tessla-syn.v

@@ -0,0 +1,163 @@
+CoInductive stream (A : Type) : Type :=
+| scons : option A -> stream A -> stream A.
+Arguments scons {A}.
+
+CoFixpoint nullstream {A : Type} : stream A :=
+  scons None nullstream.
+
+Definition unitstream : stream unit := scons (Some tt) nullstream.
+
+CoFixpoint lift2 {A B C : Type}
+  (f : option A -> option B -> option C)
+  (s1 : stream A) (s2 : stream B) : stream C :=
+  match s1, s2 with
+  | scons x xs, scons y ys => scons (f x y) (lift2 f xs ys)
+  end.
+
+CoFixpoint lift1 {A B : Type}
+  (f : option A -> option B)
+  (s : stream A) : stream B :=
+  match s with
+  | scons x xs => scons (f x) (lift1 f xs)
+  end.
+
+Definition lift {A B C : Type}
+  (f : option A -> option B -> option C)
+  (s1 : stream A) (s2 : stream B) : stream C := lift2 f s1 s2.
+
+Definition helper_const {A B:Type} (c:A) (x:option B) : option A :=
+  match x with
+  | Some _ => Some c
+  | None   => None
+  end.
+
+CoFixpoint const {A B : Type} (c : A) (s : stream B) : stream A :=
+  lift1 (helper_const c) s.
+
+Definition helper_merge {A : Type} (a b : option A) : option A :=
+  match a with
+  | Some a' => a
+  | None => b
+  end.
+
+CoFixpoint merge {A : Type} (s1 s2 : stream A) : stream A :=
+  lift helper_merge s1 s2.
+
+CoFixpoint last_helper {A B : Type}
+  (s1 : stream A) (s2 : stream B) (lx : option A)
+  : stream A :=
+  match s1, s2 with
+  | scons x xs, scons y ys =>
+      let newx :=
+        match x with
+        | None => lx
+        | _ => x
+        end
+      in
+      match y with
+      | None => scons None (last_helper xs ys newx)
+      | _ => scons lx (last_helper  xs ys newx)
+      end
+  end.
+Definition last {A B: Type} (s1 : stream A) (s2 : stream B)
+  : stream A := last_helper s1 s2 None.
+
+CoFixpoint delay_helper {A:Type} (amt : stream nat)
+  (reset : stream A) (tick : option nat)
+  : stream unit :=
+  match amt, reset with
+  | scons None xs, scons None rs =>
+      match tick with
+      | Some O => scons (Some tt) (delay_helper xs rs None)
+      | Some (S t) => scons None (delay_helper xs rs (Some t))
+      | None => scons None (delay_helper xs rs None)
+      end
+  | scons (Some x) xs, scons (Some r) rs =>  (* set *)
+      match tick with
+      | Some O => scons (Some tt) (delay_helper xs rs (Some x))
+      | _ => scons None (delay_helper xs rs (Some x))
+      end
+  | scons None xs, scons (Some r) rs =>  (* reset *)
+      match tick with
+      | Some O => scons (Some tt) (delay_helper xs rs None)
+      | _ => scons None (delay_helper xs rs None)
+      end
+  | scons (Some x) xs, scons None rs =>
+      match tick with
+      | Some O => scons (Some tt) (delay_helper xs rs None)
+      | Some (S t) => scons None (delay_helper xs rs (Some t))
+      | None => scons None (delay_helper xs rs (Some x))
+      end
+  end.
+Definition delay {A:Type} (amt : stream nat) (reset : stream A)
+  : stream unit :=
+  delay_helper amt reset None.
+
+Fixpoint take {A : Type} (n : nat)
+              (s : stream A) : list (option A) :=
+  match n, s with
+  | O, _ => nil
+  | S n', scons x xs => cons x (take n' xs)
+  end.
+
+Inductive type : Set :=
+| Nat
+| Unit.
+Definition typeDenote (t:type) : Set :=
+  match t with
+  | Nat => nat
+  | Unit => unit
+  end.
+Compute typeDenote Nat.
+
+Inductive binop : type -> type -> type -> Set :=
+| Merge: forall t:type, binop t t t
+| Last: forall t1 t2:type, binop t1 t2 t1
+| Delay: forall t:type, binop Nat t Unit. 
+Definition binopDenote {t1 t2 t3:type} (op:binop t1 t2 t3)
+  : stream (typeDenote t1) -> stream (typeDenote t2)
+    -> stream (typeDenote t3) :=
+  match op with
+	| Merge _ => merge
+	| Last _ _ => last
+	| Delay _ => delay
+  end.
+
+Coercion Some_nat := (@Some nat).
+Coercion Some_unit := (@Some unit).
+
+
+Module StreamNotations.
+
+Declare Scope stream_scope.
+Delimit Scope stream_scope with stream.
+
+Notation "[ ]" := nullstream
+  : stream_scope.
+Notation "[[ x ]]" := (const x)
+  (at level 10) : stream_scope.
+
+Notation "[[ x , y , .. , z ]]" :=
+  (cofix t' := (scons x (scons y .. (scons z t') .. )))
+  (at level 10, x constr, y constr, z constr) : stream_scope.
+
+Notation "[ x , y , .. , z ]" :=
+  (scons x (scons y .. (scons z nullstream) .. ))
+  (at level 10, x constr, y constr, z constr) : stream_scope.
+
+Notation "[ x ]" := (scons x nullstream)
+  : stream_scope.
+
+Notation "x '[' ':' n ']'" := (take n x)
+  (at level 20, x constr, n constr) : stream_scope.
+
+End StreamNotations.
+
+Import StreamNotations.
+Example s1 := [1,2]%stream.
+Example s2 := [None,1]%stream.
+Compute take 3 (merge s1 s2).
+
+Check (binopDenote (Merge Nat)) s1 s2.
+Check (binopDenote (Merge _)) s1 s2.
+

coq/unfinished/typeclass-extr.v

@@ -0,0 +1,31 @@
+Require Import Extraction.
+Require Import ExtrHaskellBasic.
+Require Import ExtrHaskellNatInt.
+Extraction Language Haskell.         
+
+Class Functor (f: Type -> Type) := {                 
+  fmap : forall {A B:Type}, (A -> B) -> f A -> f B   
+}.                                                   
+                                                     
+Class Applicative (f: Type -> Type) `{Functor f} :=  
+{                                                    
+  pure: forall {A:Type}, A -> f A;                   
+  ap: forall {A B:Type}, f (A -> B) -> f A -> f B    
+}.                                                   
+
+#[export] Instance option_functor : Functor option := {
+  fmap {A B:Type} f x :=
+      match x with
+      | Some x' => Some (f x')
+      | None => None
+      end
+}.
+
+Definition optS (f:nat -> nat) (a: option nat): option nat :=
+  fmap f a.
+Compute optS S (Some 3).
+
+Recursive Extraction optS.
+Extract Inductive Functor => Functor [ fmap ].
+Recursive Extraction optS.
+

coq/unfinished/vectoranother.v

@@ -0,0 +1,10 @@
+Require Import List.
+Import ListNotations.
+
+Definition vector A n := {xs : list A | length xs = n}.
+
+Example list1 : list nat := [1;2].
+Compute {list1 | length list1 = 2}.
+Compute {list1 | length list1 = 2} : vector nat 2.
+
+Compute [1;2] : vector nat 2.

coq/unfinished/zarith.v

@@ -0,0 +1,51 @@
+Require Import ZArith Lia.
+
+Search (nat -> Z).
+
+Definition f (n:nat) : Z :=
+  if (Nat.eqb n 0) then 1
+  else if (Nat.even n) then (Z.of_nat (Nat.div n 2))
+  else -(Z.of_nat (Nat.div (n-1) 2)).
+Compute f 0.
+Compute f 1.
+Compute f 2.
+Compute f 3.
+Compute f 4.
+Compute f 5.
+
+Compute (1=?1)%bool.
+
+Theorem f_inj : forall a b:nat, (a > 0) -> (b > 0) ->
+  (f a = f b) -> (a = b). 
+Proof.
+  intros.
+  case_eq (Nat.eqb a 1). 
+  - intros.
+
+  intros.
+  destruct a.
+  - lia.   (* case: a = 0 *)
+  - destruct a.
+    * lia.    (* case: a = S a' = S 0 = 1 *)
+    *         (* case: a = S a' = S (S a'') *)
+Restart.
+  intros.
+  destruct (Nat.even a).
+  - destruct (Nat.odd a).
+
+Definition egfn (n:nat):nat := n + 1.
+Goal
+  (*let egfn := fun n:nat => n + 1 in*)
+  forall a b:nat, egfn a = egfn b -> a = b. 
+Proof.
+  intros.
+Abort.
+
+Definition f (val:{n:nat | n > 0}) : Z :=
+  let n':nat :=
+    match val with
+    | exists P x prf => x
+    end in
+  if (Nat.eqb 1 0) then 1
+  else if (Nat.even n) then (Z.of_nat (Nat.div n 2))
+  else -(Z.of_nat (Nat.div (n-1) 2)).

haskell/cps.hs

@@ -0,0 +1,33 @@
+{-
+ - Continuation Passing Style example.
+ -
+ -   √(x² + y²)
+ -
+ - From Wikipedia: https://en.wikipedia.org/wiki/Continuation-passing_style#CPS_in_Haskell
+ -}
+
+add2 :: Float -> Float -> (Float -> a) -> a
+add2 x2 y2 f = f (x2 + y2)
+
+sqre :: Float -> (Float -> a) -> a
+sqre x f = f (x * x)
+
+sqroot :: Float -> (Float -> a) -> a
+sqroot x f = f (sqrt x)
+
+halt :: Float -> IO ()
+halt x = print x
+
+example :: Float -> Float -> (Float -> a) -> a
+example x y cont =
+  sqre x
+  (\x2 -> sqre y
+          (\y2 -> add2 x2 y2
+                  (\x2y2 -> sqroot x2y2 cont)
+          )
+  )
+{-
+*Main> example 3 4 halt
+5.0
+-}
+

python/cps.py

@@ -0,0 +1,29 @@
+import math
+
+def pow2(val, cont):
+    print(f"{val}*{val} = {val*val}")
+    return cont(val * val)
+def add2(a, b, cont):
+    print(f"{a}*{b} = {a+b}")
+    return cont(a + b)
+def sqrt(val, cont):
+    print(f"√{val} = {math.sqrt(val)}")
+    return cont(math.sqrt(val))
+def halt(val):
+    print(f"Halt! {val}")
+    #return val
+
+def fn(x, y, cont):
+    pow2(x,
+         lambda x2:
+             pow2(y,
+                  lambda y2: add2(x2,
+                                  y2,
+                                  lambda x2y2: sqrt(x2y2, cont)
+                                 )
+                 )
+        )
+
+#a = fn(3, 4, halt)
+fn(3, 4, halt)
+#print(a)

vhdl/formal/Makefile

@@ -0,0 +1,21 @@
+NAME = ripple-ca
+GHDL_SO = /nix/store/z2qrc057pjbxcpbbsgz8f46wk0yv45b3-yosys-ghdl-2021.01.25/share/yosys/plugins/ghdl.so
+
+build: $(NAME).vhdl $(NAME)-tb.vhdl
+	ghdl -a --std=08 $(NAME).vhdl
+	ghdl -a --std=08 $(NAME)-tb.vhdl
+	ghdl -e --std=08 rca_tb_e
+
+PHONY: sim clean
+
+clean:
+	rm -rf dump.vcd *.cf
+
+sim:
+	ghdl -r --std=08 rca_tb_e --vcd=dump.vcd --stop-time=100ns
+
+sby: psl_symbio.sby
+	sby --yosys "yosys -m $(GHDL_SO)" -f psl_symbio.sby
+
+vcd: dump.vcd
+	~/Downloads/vcd-x86_64-linux-gnu-220131 < dump.vcd

vhdl/formal/psl_symbio.sby

@@ -0,0 +1,17 @@
+[tasks]
+bmc
+
+[options]
+depth 25
+bmc: mode cover
+
+[engines]
+bmc: smtbmc z3
+
+[script]
+bmc: ghdl --std=08 ripple-ca.vhdl ripple-ca-tb.vhdl -e rca_e
+prep -top rca_e
+
+[files]
+ripple-ca.vhdl
+ripple-ca-tb.vhdl

vhdl/formal/ripple-ca-tb.vhdl

@@ -0,0 +1,40 @@
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+entity rca_tb_e is
+  port(
+    t_clk : std_logic
+  );
+end rca_tb_e;
+
+architecture rca_tb_a of rca_tb_e is
+  signal t_a, t_b : std_logic_vector(3 downto 0);
+  signal t_cin    : std_logic;
+  signal t_s      : std_logic_vector(3 downto 0);
+  signal t_cout   : std_logic;
+begin
+  t_rca_e: entity work.rca_e port map(
+    t_a, t_b, t_cin, t_s, t_cout
+  );
+
+  -- clock for PSL directive
+  default clock is rising_edge(t_clk);
+
+  PROP1: assert always (
+    (t_a xor (t_b xor t_cin)) = "00"
+  );
+  --PROP2: assert always (((t_cin and (t_a xor t_b)) or (t_a and t_b)) = t_cout);
+
+--   process
+--   begin
+--     t_a <= "0100";
+--     t_b <= "0101";
+--     t_cin <= '0';
+--     wait for 10 ns;
+--     assert t_s = "1001"
+--       report "Expected 1001, got " & to_string(t_s)
+--       severity error;
+--     wait;
+--   end process;
+end architecture rca_tb_a;

vhdl/formal/ripple-ca.vhdl

@@ -0,0 +1,54 @@
+------------------------
+-- Full adder
+------------------------
+--
+-- no (explicit) clock
+
+library ieee;
+use ieee.std_logic_1164.all;
+
+entity fa_e is
+  port (
+    a, b, cin : in  std_logic;
+    s, cout   : out std_logic
+  );
+end entity fa_e;
+
+architecture fa_a of fa_e is
+begin
+  s    <= a xor b xor cin;
+  cout <= (a and b) or (b and cin) or (a and cin);
+end architecture fa_a;
+
+---------------------------
+-- 4-bit ripple carry adder
+---------------------------
+library ieee;
+use ieee.std_logic_1164.all;
+
+entity rca_e is
+  port (
+    a, b : in  std_logic_vector(3 downto 0);
+    cin  : in  std_logic;
+    s    : out std_logic_vector(3 downto 0);
+    cout : out  std_logic
+  );
+end entity rca_e;
+
+architecture rca_a of rca_e is
+  -- signals to store intermediate carry values
+  signal co0, co1, co2 : std_logic;
+begin
+  FA0: entity work.fa_e port map(
+    a(0), b(0), cin, s(0), co0
+--    a(0) => a,
+--    b(0) => b,
+--    cin  => cin,
+--    s(0) => s,
+--    co0  => cout
+  );
+
+  FA1: entity work.fa_e port map(a(1), b(1), co0, s(1), co1);
+  FA2: entity work.fa_e port map(a(2), b(2), co1, s(2), co2);
+  FA3: entity work.fa_e port map(a(3), b(3), co2, s(3), cout);
+end architecture rca_a;