chap9: progress

src/chap9.v

@@ -1,8 +1,17 @@
+(* NOTE:
+  go see:
+  - https://docs.rocq-prover.org/master/stdlib/
+  - https://docs.rocq-prover.org/master/stdlib/Stdlib.FSets.FMapInterface.html
+  - https://docs.rocq-prover.org/master/stdlib/Stdlib.FSets.FMapFacts.html
+*)
+
 From Stdlib Require Import
   Strings.String
   FSets.FMapInterface
   FSets.FMapList
   FSets.FMapFacts
+  Lists.List
+  Lists.ListSet
   Structures.OrderedTypeEx.
 
 Module Chap9.
@@ -128,6 +137,7 @@ Module Chap9.
   Hint Constructors step : core.
 
   Module M := FMapList.Make(String_as_OT).
+  Module F := FMapFacts.Facts(M).
   Definition context := M.t type.
   Definition empty_ctx : context := @M.empty type.
 
@@ -172,6 +182,29 @@ Module Chap9.
 
   (* End of definitions Software Foundations definitions of STLC *)
 
+  Definition dom (Γ : context) : set string :=
+    map fst (M.elements Γ).
+
+  Fixpoint size (t : term) : nat :=
+    match t with
+    | <{t1 t2}> => 1 + (size t1) + (size t2)
+    | <{\x:T, t1}> => 1 + (size t1)
+    | <{if t1 then t2 else t3}> => 1 + (size t1) + (size t2) + (size t3)
+    | <{true}> => 1
+    | <{false}> => 1
+    | term_var _ => 1
+    end.
+
+  Fixpoint depth (t : term) : nat :=
+    match t with
+    | <{t1 t2}> => S (max (depth t1) (depth t2))
+    | <{\x:T, t1}> => S (depth t1)
+    | <{if t1 then t2 else t3}> => S (max (depth t1) (max (depth t2) (depth t3)))
+    | <{true}> => 1
+    | <{false}> => 1
+    | term_var _ => 1
+    end.
+
   (* 9.2.2 *)
 
   Example typing_example_1 :
@@ -350,4 +383,156 @@ Module Chap9.
     - intros R.
   Admitted.
 
+  (* 9.3.4 *)
+
+  Lemma canonical_forms_bool :
+    forall (Γ : context) (t : term),
+      value t ->
+      <{ Γ |- t ∈ Bool }> ->
+      t = <{true}> \/ t = <{false}>.
+  Proof.
+    intros Γ t Hval Htyp.
+    inversion Hval.
+    2: left; reflexivity.
+    2: right; reflexivity.
+    inversion Htyp; subst.
+    all: discriminate.
+  Qed.
+
+  Lemma canonical_forms_fun :
+    forall (Γ : context) (t : term) (T1 T2 : type),
+      value t ->
+      <{ Γ |- t ∈ T1 -> T2 }> ->
+      exists (x : string) (t12 : term),
+        t = <{\x:T1, t12}>.
+  Proof.
+    intros Γ t T1 T2 Hval Htyp.
+    inversion Hval. subst.
+    - exists x0, t1.
+      inversion Htyp; subst.
+      reflexivity.
+    - inversion Htyp; subst.
+      all: discriminate.
+    - inversion Htyp; subst.
+      all: discriminate.
+  Qed.
+
+  (* 9.3.5 *)
+  Lemma progress :
+    forall (t : term) (T : type),
+      <{ empty |- t ∈ T }> ->
+      value t \/ exists t', t ---> t'.
+  Proof.
+    intros t T Htyp.
+    induction Htyp.
+    (* T_Var *)
+  Admitted.
+
+  Search (M.find _ (M.add _ _ _)).
+
+  (* 9.3.6 *)
+  (* Lemma find_constant_in_context :
+    forall (Γ : context) (x : string) (T : type),
+      (* <{ x )> T; Γ }> ->
+      M.find x Γ = Some T. *)
+    Proof. *)
+
+
+  Lemma permutation :
+    forall (Γ Δ : context) (t : term) (T : type),
+      <{ Γ |- t ∈ T }> ->
+      (forall x, M.find x Γ = M.find x Δ) ->
+      <{ Δ |- t ∈ T }>.
+  Proof.
+    intros Γ Δ t T Htyp Hperm.
+    generalize dependent Δ.
+    induction Htyp.
+    - intros Δ Hperm.
+      apply T_Var.
+      rewrite <- Hperm.
+      assumption.
+    - intros Δ Hperm.
+      apply T_Abs.
+      apply IHHtyp.
+      intro x1.
+      destruct (String.eqb x x1) eqn:Heq.
+      + apply String.eqb_eq in Heq.
+        subst.
+        f_equal.
+  Admitted.
+
+(* Search M.add. *)
+
+  (* 9.3.7 *)
+  Lemma weakening :
+    forall (Γ : context) (t : term) (T S : type) (x : string),
+      <{ Γ |- t ∈ T }> ->
+      M.find x Γ = None ->
+      <{ x )> S; Γ |- t ∈ T }>.
+  Proof.
+  Admitted.
+
+  (* Lemma weakening_depth_eq :
+    forall (Γ : context) (t : term) (T S : type) (x : string),
+      <{ Γ |- t ∈ T }> ->
+      M.find x Γ = None ->
+      depth
+  Proof. *)
+
+  (* 9.3.8 *)
+  Lemma substitution :
+    forall (Γ : context) (t s : term) (T S : type) (x : string),
+      <{ x )> S; Γ |- t ∈ T }> ->
+      <{ Γ |- s ∈ S }> ->
+      <{ Γ |- [x:=s] t ∈ T }>.
+  Proof.
+  Admitted.
+
+  (* 9.3.9 *)
+  Lemma preservation :
+    forall (Γ : context) (t t' : term) (T : type),
+      <{ Γ |- t ∈ T }> ->
+      t ---> t' ->
+      <{ Γ |- t' ∈ T }>.
+  Proof.
+  Admitted.
+
+  (* 9.3.10 *)
+  Lemma subject_expansion :
+    forall (Γ : context) (t t' : term) (T : type),
+      <{ Γ |- t' ∈ T }> ->
+      t ---> t' ->
+      <{ Γ |- t ∈ T }>.
+  Proof.
+  Admitted.
+
+  (* 9.5.1 *)
+  (* TODO: we should probably use a different type for the erased term,
+           since it's not possible to express it as a [term]
+  *)
+  Fixpoint erase (t : term) : term :=
+    match t with
+    | <{t1 t2}> => <{$(erase t1) $(erase t2)}>
+    | <{\x:T, t1}> => <{\x:Bool, $(erase t1)}>
+    | <{if t1 then t2 else t3}> => <{if $(erase t1) then $(erase t2) else $(erase t3)}>
+    | <{true}> => <{true}>
+    | <{false}> => <{false}>
+    | term_var x => term_var x
+    end.
+
+  (* 9.5.2 *)
+  Lemma eval_implies_eval_erase :
+    forall (t t' : term),
+      t ---> t' ->
+      erase t ---> erase t'.
+  Proof.
+  Admitted.
+
+  Lemma eval_erase_implies_eval :
+    forall (t  m' : term),
+      erase t ---> erase m' ->
+      exists t', t ---> t' /\ erase t' = erase m'.
+  Proof.
+  Admitted.
+
 End Chap9.