diff --git a/src/chap9.v b/src/chap9.v index 01fda60..2ce8f0b 100644 --- a/src/chap9.v +++ b/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. \ No newline at end of file