diff --git a/._.depend b/._.depend deleted file mode 100644 index 313e184..0000000 Binary files a/._.depend and /dev/null differ diff --git a/._Auto.html b/._Auto.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Auto.html and /dev/null differ diff --git a/._Auto.v b/._Auto.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Auto.v and /dev/null differ diff --git a/._Basics.html b/._Basics.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Basics.html and /dev/null differ diff --git a/._Basics.v b/._Basics.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Basics.v and /dev/null differ diff --git a/._Equiv.html b/._Equiv.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Equiv.html and /dev/null differ diff --git a/._Equiv.v b/._Equiv.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Equiv.v and /dev/null differ diff --git a/._Extraction.html b/._Extraction.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Extraction.html and /dev/null differ diff --git a/._Extraction.v b/._Extraction.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Extraction.v and /dev/null differ diff --git a/._Hoare.html b/._Hoare.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Hoare.html and /dev/null differ diff --git a/._Hoare.v b/._Hoare.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Hoare.v and /dev/null differ diff --git a/._Hoare2.html b/._Hoare2.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Hoare2.html and /dev/null differ diff --git a/._Hoare2.v b/._Hoare2.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Hoare2.v and /dev/null differ diff --git a/._Imp.html b/._Imp.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Imp.html and /dev/null differ diff --git a/._Imp.v b/._Imp.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Imp.v and /dev/null differ diff --git a/._ImpCEvalFun.html b/._ImpCEvalFun.html deleted file mode 100644 index 313e184..0000000 Binary files a/._ImpCEvalFun.html and /dev/null differ diff --git a/._ImpCEvalFun.v b/._ImpCEvalFun.v deleted file mode 100644 index 313e184..0000000 Binary files a/._ImpCEvalFun.v and /dev/null differ diff --git a/._ImpParser.html b/._ImpParser.html deleted file mode 100644 index 313e184..0000000 Binary files a/._ImpParser.html and /dev/null differ diff --git a/._ImpParser.v b/._ImpParser.v deleted file mode 100644 index 313e184..0000000 Binary files a/._ImpParser.v and /dev/null differ diff --git a/._Induction.html b/._Induction.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Induction.html and /dev/null differ diff --git a/._Induction.v b/._Induction.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Induction.v and /dev/null differ diff --git a/._LICENSE b/._LICENSE deleted file mode 100644 index 313e184..0000000 Binary files a/._LICENSE and /dev/null differ diff --git a/._Lists.html b/._Lists.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Lists.html and /dev/null differ diff --git a/._Lists.v b/._Lists.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Lists.v and /dev/null differ diff --git a/._Logic.html b/._Logic.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Logic.html and /dev/null differ diff --git a/._Logic.v b/._Logic.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Logic.v and /dev/null differ diff --git a/._Makefile b/._Makefile deleted file mode 100644 index 313e184..0000000 Binary files a/._Makefile and /dev/null differ diff --git a/._MoreCoq.html b/._MoreCoq.html deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreCoq.html and /dev/null differ diff --git a/._MoreCoq.v b/._MoreCoq.v deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreCoq.v and /dev/null differ diff --git a/._MoreInd.html b/._MoreInd.html deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreInd.html and /dev/null differ diff --git a/._MoreInd.v b/._MoreInd.v deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreInd.v and /dev/null differ diff --git a/._MoreLogic.html b/._MoreLogic.html deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreLogic.html and /dev/null differ diff --git a/._MoreLogic.v b/._MoreLogic.v deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreLogic.v and /dev/null differ diff --git a/._MoreStlc.html b/._MoreStlc.html deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreStlc.html and /dev/null differ diff --git a/._MoreStlc.v b/._MoreStlc.v deleted file mode 100644 index 313e184..0000000 Binary files a/._MoreStlc.v and /dev/null differ diff --git a/._Poly.html b/._Poly.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Poly.html and /dev/null differ diff --git a/._Poly.v b/._Poly.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Poly.v and /dev/null differ diff --git a/._Preface.html b/._Preface.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Preface.html and /dev/null differ diff --git a/._Preface.v b/._Preface.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Preface.v and /dev/null differ diff --git a/._ProofObjects.html b/._ProofObjects.html deleted file mode 100644 index 313e184..0000000 Binary files a/._ProofObjects.html and /dev/null differ diff --git a/._ProofObjects.v b/._ProofObjects.v deleted file mode 100644 index 313e184..0000000 Binary files a/._ProofObjects.v and /dev/null differ diff --git a/._Prop.html b/._Prop.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Prop.html and /dev/null differ diff --git a/._Prop.v b/._Prop.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Prop.v and /dev/null differ diff --git a/._Review1.html b/._Review1.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Review1.html and /dev/null differ diff --git a/._Review1.v b/._Review1.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Review1.v and /dev/null differ diff --git a/._Review2.html b/._Review2.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Review2.html and /dev/null differ diff --git a/._Review2.v b/._Review2.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Review2.v and /dev/null differ diff --git a/._SfLib.html b/._SfLib.html deleted file mode 100644 index 313e184..0000000 Binary files a/._SfLib.html and /dev/null differ diff --git a/._SfLib.v b/._SfLib.v deleted file mode 100644 index 313e184..0000000 Binary files a/._SfLib.v and /dev/null differ diff --git a/._Smallstep.html b/._Smallstep.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Smallstep.html and /dev/null differ diff --git a/._Smallstep.v b/._Smallstep.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Smallstep.v and /dev/null differ diff --git a/._Stlc.html b/._Stlc.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Stlc.html and /dev/null differ diff --git a/._Stlc.v b/._Stlc.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Stlc.v and /dev/null differ diff --git a/._StlcProp.html b/._StlcProp.html deleted file mode 100644 index 313e184..0000000 Binary files a/._StlcProp.html and /dev/null differ diff --git a/._StlcProp.v b/._StlcProp.v deleted file mode 100644 index 313e184..0000000 Binary files a/._StlcProp.v and /dev/null differ diff --git a/._Sub.html b/._Sub.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Sub.html and /dev/null differ diff --git a/._Sub.v b/._Sub.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Sub.v and /dev/null differ diff --git a/._Symbols.html b/._Symbols.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Symbols.html and /dev/null differ diff --git a/._Symbols.v b/._Symbols.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Symbols.v and /dev/null differ diff --git a/._Types.html b/._Types.html deleted file mode 100644 index 313e184..0000000 Binary files a/._Types.html and /dev/null differ diff --git a/._Types.v b/._Types.v deleted file mode 100644 index 313e184..0000000 Binary files a/._Types.v and /dev/null differ diff --git a/._coqdoc.css b/._coqdoc.css deleted file mode 100644 index 313e184..0000000 Binary files a/._coqdoc.css and /dev/null differ diff --git a/._coqindex.html b/._coqindex.html deleted file mode 100644 index 313e184..0000000 Binary files a/._coqindex.html and /dev/null differ diff --git a/._deps.gif b/._deps.gif deleted file mode 100644 index 313e184..0000000 Binary files a/._deps.gif and /dev/null differ diff --git a/._deps.html b/._deps.html deleted file mode 100644 index 313e184..0000000 Binary files a/._deps.html and /dev/null differ diff --git a/._deps.map b/._deps.map deleted file mode 100644 index 313e184..0000000 Binary files a/._deps.map and /dev/null differ diff --git a/._imp.ml b/._imp.ml deleted file mode 100644 index 313e184..0000000 Binary files a/._imp.ml and /dev/null differ diff --git a/._imp.mli b/._imp.mli deleted file mode 100644 index 313e184..0000000 Binary files a/._imp.mli and /dev/null differ diff --git a/._imp1.ml b/._imp1.ml deleted file mode 100644 index 313e184..0000000 Binary files a/._imp1.ml and /dev/null differ diff --git a/._imp1.mli b/._imp1.mli deleted file mode 100644 index 313e184..0000000 Binary files a/._imp1.mli and /dev/null differ diff --git a/._imp2.ml b/._imp2.ml deleted file mode 100644 index 313e184..0000000 Binary files a/._imp2.ml and /dev/null differ diff --git a/._imp2.mli b/._imp2.mli deleted file mode 100644 index 313e184..0000000 Binary files a/._imp2.mli and /dev/null differ diff --git a/._impdriver.ml b/._impdriver.ml deleted file mode 100644 index 313e184..0000000 Binary files a/._impdriver.ml and /dev/null differ diff --git a/._index-bg.jpg b/._index-bg.jpg deleted file mode 100644 index 313e184..0000000 Binary files a/._index-bg.jpg and /dev/null differ diff --git a/._index.html b/._index.html deleted file mode 100644 index 313e184..0000000 Binary files a/._index.html and /dev/null differ diff --git a/._jquery-1.8.3.js b/._jquery-1.8.3.js deleted file mode 100644 index 313e184..0000000 Binary files a/._jquery-1.8.3.js and /dev/null differ diff --git a/._jquery.maphilight.min.js b/._jquery.maphilight.min.js deleted file mode 100755 index 06d636e..0000000 Binary files a/._jquery.maphilight.min.js and /dev/null differ diff --git a/._main.js b/._main.js deleted file mode 100644 index 313e184..0000000 Binary files a/._main.js and /dev/null differ diff --git a/._normdriver.ml b/._normdriver.ml deleted file mode 100644 index 313e184..0000000 Binary files a/._normdriver.ml and /dev/null differ diff --git a/._sf b/._sf deleted file mode 100755 index bb87e14..0000000 Binary files a/._sf and /dev/null differ diff --git a/._slides.js b/._slides.js deleted file mode 100644 index 313e184..0000000 Binary files a/._slides.js and /dev/null differ diff --git a/._toc.html b/._toc.html deleted file mode 100644 index 313e184..0000000 Binary files a/._toc.html and /dev/null differ diff --git a/.depend b/.depend deleted file mode 100644 index c4c9853..0000000 --- a/.depend +++ /dev/null @@ -1,29 +0,0 @@ -Symbols.vo Symbols.glob Symbols.v.beautified: Symbols.v -Preface.vo Preface.glob Preface.v.beautified: Preface.v -Basics.vo Basics.glob Basics.v.beautified: Basics.v -Induction.vo Induction.glob Induction.v.beautified: Induction.v -Lists.vo Lists.glob Lists.v.beautified: Lists.v -Poly.vo Poly.glob Poly.v.beautified: Poly.v -MoreCoq.vo MoreCoq.glob MoreCoq.v.beautified: MoreCoq.v -Logic.vo Logic.glob Logic.v.beautified: Logic.v -Prop.vo Prop.glob Prop.v.beautified: Prop.v -MoreLogic.vo MoreLogic.glob MoreLogic.v.beautified: MoreLogic.v -ProofObjects.vo ProofObjects.glob ProofObjects.v.beautified: ProofObjects.v -MoreInd.vo MoreInd.glob MoreInd.v.beautified: MoreInd.v -Review1.vo Review1.glob Review1.v.beautified: Review1.v -SfLib.vo SfLib.glob SfLib.v.beautified: SfLib.v -Imp.vo Imp.glob Imp.v.beautified: Imp.v -ImpParser.vo ImpParser.glob ImpParser.v.beautified: ImpParser.v -ImpCEvalFun.vo ImpCEvalFun.glob ImpCEvalFun.v.beautified: ImpCEvalFun.v -Extraction.vo Extraction.glob Extraction.v.beautified: Extraction.v -Equiv.vo Equiv.glob Equiv.v.beautified: Equiv.v -Hoare.vo Hoare.glob Hoare.v.beautified: Hoare.v -Hoare2.vo Hoare2.glob Hoare2.v.beautified: Hoare2.v -Smallstep.vo Smallstep.glob Smallstep.v.beautified: Smallstep.v -Review2.vo Review2.glob Review2.v.beautified: Review2.v -Auto.vo Auto.glob Auto.v.beautified: Auto.v -Types.vo Types.glob Types.v.beautified: Types.v -Stlc.vo Stlc.glob Stlc.v.beautified: Stlc.v -StlcProp.vo StlcProp.glob StlcProp.v.beautified: StlcProp.v -MoreStlc.vo MoreStlc.glob MoreStlc.v.beautified: MoreStlc.v -Sub.vo Sub.glob Sub.v.beautified: Sub.v diff --git a/Auto.html b/Auto.html deleted file mode 100644 index b3215bc..0000000 --- a/Auto.html +++ /dev/null @@ -1,819 +0,0 @@ - - - - - -Auto: More Automation - - - - - - -
- - - -
- -

AutoMore Automation

- -
-
- -
- -
-
- -
-Require Export Imp.
- -
-
- -
-Up to now, we've continued to use a quite restricted set of -Coq's tactic facilities. In this chapter, we'll learn more about -two very powerful features of Coq's tactic language: -proof search via the auto and eauto tactics, and -automated forward reasoning via the Ltac hypothesis matching -machinery. Using these features together with Ltac's scripting facilities -will enable us to make our proofs startlingly short! Used properly, -they can also make proofs more maintainable and robust in the face -of incremental changes to underlying definitions. - -
- -There's a third major source of automation we haven't -fully studied yet, namely built-in decision procedures for specific -kinds of problems: omega is one example, but there are others. -This topic will be defered for a while longer. - -
- - -
- - Our motivating example will be this proof, repeated with - just a few small changes from Imp. We will try to simplify - this proof in several stages. -
-
- -
-Ltac inv H := inversion H; subst; clear H.
- -
-Theorem ceval_deterministic: ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2.
-  Case "E_Skip". reflexivity.
-  Case "E_Ass". reflexivity.
-  Case "E_Seq".
-    assert (st' = st'0) as EQ1.
-      SCase "Proof of assertion". apply IHE1_1; assumption.
-    subst st'0.
-    apply IHE1_2. assumption.
-  Case "E_IfTrue".
-    SCase "b evaluates to true".
-      apply IHE1. assumption.
-    SCase "b evaluates to false (contradiction)".
-      rewrite H in H5. inversion H5.
-  Case "E_IfFalse".
-    SCase "b evaluates to true (contradiction)".
-      rewrite H in H5. inversion H5.
-    SCase "b evaluates to false".
-      apply IHE1. assumption.
-  Case "E_WhileEnd".
-    SCase "b evaluates to false".
-      reflexivity.
-    SCase "b evaluates to true (contradiction)".
-      rewrite H in H2. inversion H2.
-  Case "E_WhileLoop".
-    SCase "b evaluates to false (contradiction)".
-      rewrite H in H4. inversion H4.
-    SCase "b evaluates to true".
-      assert (st' = st'0) as EQ1.
-        SSCase "Proof of assertion". apply IHE1_1; assumption.
-      subst st'0.
-      apply IHE1_2. assumption. Qed.
- -
-
- -
-

The auto and eauto tactics

- -
- - Thus far, we have (nearly) always written proof scripts that - apply relevant hypothoses or lemmas by name. In particular, when - a chain of hypothesis applications is needed, we have specified - them explicitly. (The only exceptions introduced so far are using - assumption to find a matching unqualified hypothesis - or (e)constructor to find a matching constructor.) -
-
- -
-Example auto_example_1 : ∀(P Q R: Prop), (P → Q) → (Q → R) → P → R.
-Proof.
-  intros P Q R H1 H2 H3.
-  apply H2. apply H1. assumption.
-Qed.
- -
-
- -
-The auto tactic frees us from this drudgery by searching - for a sequence of applications that will prove the goal -
-
- -
-Example auto_example_1' : ∀(P Q R: Prop), (P → Q) → (Q → R) → P → R.
-Proof.
-  intros P Q R H1 H2 H3.
-  auto.
-Qed.
- -
-
- -
-The auto tactic solves goals that are solvable by any combination of - -
- -
    -
  • intros, - -
    • -
  • apply (with a local hypothesis, by default). - -
    • -
- -
- - The eauto tactic works just like auto, except that it uses - eapply instead of apply. -
- - Using auto is always "safe" in the sense that it will never fail - and will never change the proof state: either it completely solves - the current goal, or it does nothing. - -
- - A more complicated example: -
-
- -
-Example auto_example_2 : ∀P Q R S T U : Prop,
-  (P → Q) →
-  (P → R) →
-  (T → R) →
-  (S → T → U) →
-  ((P→Q) → (P→S)) →
-  T →
-  P →
-  U.
-Proof. auto. Qed.
- -
-
- -
-Search can take an arbitrarily long time, so there are limits to - how far auto will search by default -
-
- -
-Example auto_example_3 : ∀(P Q R S T U: Prop),
-                           (P → Q) → (Q → R) → (R → S) →
-                           (S → T) → (T → U) → P → U.
-Proof.
-  auto. (* When it cannot solve the goal, does nothing! *)
-  auto 6. (* Optional argument says how deep to search (default depth is 5) *)
-Qed.
- -
-
- -
-When searching for potential proofs of the current goal, auto - and eauto consider the hypotheses in the current context - together with a hint database of other lemmas and constructors. - Some of the lemmas and constructors we've already seen — e.g., - eq_refl, conj, or_introl, and or_intror — are installed in this hint - database by default. -
-
- -
-Example auto_example_4 : ∀P Q R : Prop,
-  Q →
-  (Q → R) →
-  P ∨ (Q ∧ R).
-Proof.
-  auto. Qed.
- -
-
- -
-If we want to see which facts auto is using, we can use info_auto instead. -
-
- -
-Example auto_example_5: 2 = 2.
-Proof.
-  info_auto. (* subsumes reflexivity because eq_refl is in hint database *)
-Qed.
- -
-
- -
-We can extend the hint database just for the purposes of one - application of auto or eauto by writing auto using .... -
-
- -
-Lemma le_antisym : ∀n m: nat, (n ≤ m ∧ m ≤ n) → n = m.
-Proof. intros. omega. Qed.
- -
-Example auto_example_6 : ∀n m p : nat,
-  (n≤ p → (n ≤ m ∧ m ≤ n)) →
-  n ≤ p →
-  n = m.
-Proof.
-  intros.
-  auto. (* does nothing: auto doesn't destruct hypotheses! *)
-  auto using le_antisym.
-Qed.
- -
-
- -
-Of course, in any given development there will also be some of our - own specific constructors and lemmas that are used very often in - proofs. We can add these to the global hint database by writing - -
- -
-      Hint Resolve T. -
- -
- at the top level, where T is a top-level theorem or a - constructor of an inductively defined proposition (i.e., anything - whose type is an implication). As a shorthand, we can write - -
- -
-      Hint Constructors c. -
- -
- to tell Coq to do a Hint Resolve for all of the constructors - from the inductive definition of c. - -
- - It is also sometimes necessary to add - -
- -
-      Hint Unfold d. -
- -
- where d is a defined symbol, so that auto knows to expand - uses of d and enable further possibilities for applying - lemmas that it knows about. -
-
- -
-Hint Resolve le_antisym.
- -
-Example auto_example_6' : ∀n m p : nat,
-  (n≤ p → (n ≤ m ∧ m ≤ n)) →
-  n ≤ p →
-  n = m.
-Proof.
-  intros.
-  auto. (* picks up hint from database *)
-Qed.
- -
-Definition is_fortytwo x := x = 42.
- -
-Example auto_example_7: ∀x, (x ≤ 42 ∧ 42 ≤ x) → is_fortytwo x.
-Proof.
-  auto. (* does nothing *)
-Abort.
- -
-Hint Unfold is_fortytwo.
- -
-Example auto_example_7' : ∀x, (x ≤ 42 ∧ 42 ≤ x) → is_fortytwo x.
-Proof.
-  info_auto.
-Qed.
- -
-Hint Constructors ceval.
- -
-Definition st12 := update (update empty_state X 1) Y 2.
-Definition st21 := update (update empty_state X 2) Y 1.
- -
-Example auto_example_8 : ∃s',
-  (IFB (BLe (AId X) (AId Y))
-    THEN (Z ::= AMinus (AId Y) (AId X))
-    ELSE (Y ::= APlus (AId X) (AId Z))
-  FI) / st21 ⇓ s'.
-Proof.
-  eexists. info_auto.
-Qed.
- -
-Example auto_example_8' : ∃s',
-  (IFB (BLe (AId X) (AId Y))
-    THEN (Z ::= AMinus (AId Y) (AId X))
-    ELSE (Y ::= APlus (AId X) (AId Z))
-  FI) / st12 ⇓ s'.
-Proof.
-  eexists. info_auto.
-Qed.
- -
-
- -
-Now let's take a pass over ceval_deterministic using auto - to simplify the proof script. We see that all simple sequences of hypothesis - applications and all uses of reflexivity can be replaced by auto, - which we add to the default tactic to be applied to each case. - -
-
- -
-Theorem ceval_deterministic': ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; auto.
-  Case "E_Seq".
-    assert (st' = st'0) as EQ1.
-      SCase "Proof of assertion". auto.
-    subst st'0.
-    auto.
-  Case "E_IfTrue".
-    SCase "b evaluates to false (contradiction)".
-      rewrite H in H5. inversion H5.
-  Case "E_IfFalse".
-    SCase "b evaluates to true (contradiction)".
-      rewrite H in H5. inversion H5.
-  Case "E_WhileEnd".
-    SCase "b evaluates to true (contradiction)".
-      rewrite H in H2. inversion H2.
-  Case "E_WhileLoop".
-    SCase "b evaluates to false (contradiction)".
-      rewrite H in H4. inversion H4.
-    SCase "b evaluates to true".
-      assert (st' = st'0) as EQ1.
-        SSCase "Proof of assertion". auto.
-      subst st'0.
-      auto. Qed.
- -
-
- -
-

Searching Hypotheses

- -
- - The proof has become simpler, but there is still an annoying amount - of repetition. Let's start by tackling the contradiction cases. Each - of them occurs in a situation where we have both - -
- - H1: beval st b = false - -
- - and - -
- - H2: beval st b = true - -
- - as hypotheses. The contradiction is evident, but demonstrating it - is a little complicated: we have to locate the two hypotheses H1 and H2 - and do a rewrite following by an inversion. We'd like to automate - this process. - -
- - Note: In fact, Coq has a built-in tactic congruence that will do the - job. But we'll ignore the existence of this tactic for now, in order - to demonstrate how to build forward search tactics by hand. - -
- - -
- - As a first step, we can abstract out the piece of script in question by - writing a small amount of paramerized Ltac. -
-
- -
-Ltac rwinv H1 H2 := rewrite H1 in H2; inv H2.
- -
-Theorem ceval_deterministic'': ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; auto.
-  Case "E_Seq".
-    assert (st' = st'0) as EQ1.
-      SCase "Proof of assertion". auto.
-    subst st'0.
-    auto.
-  Case "E_IfTrue".
-    SCase "b evaluates to false (contradiction)".
-      rwinv H H5.
-  Case "E_IfFalse".
-    SCase "b evaluates to true (contradiction)".
-      rwinv H H5.
-  Case "E_WhileEnd".
-    SCase "b evaluates to true (contradiction)".
-      rwinv H H2.
-  Case "E_WhileLoop".
-    SCase "b evaluates to false (contradiction)".
-      rwinv H H4.
-    SCase "b evaluates to true".
-      assert (st' = st'0) as EQ1.
-        SSCase "Proof of assertion". auto.
-      subst st'0.
-      auto. Qed.
- -
-
- -
-But this is not much better. We really want Coq to discover - the relevant hypotheses for us. We can do this by using the - match goal with ... end facility of Ltac. -
-
- -
-Ltac find_rwinv :=
-  match goal with
-    H1: ?E = true, H2: ?E = false ⊢ _ ⇒ rwinv H1 H2
-  end.
- -
-
- -
-In words, this match goal looks for two (distinct) hypotheses that have - the form of equalities with the same arbitrary expression E on the - left and conflicting boolean values on the right; if such hypotheses are - found, it binds H1 and H2 to their names, and applies the tactic - after the ⇒. - -
- - Adding this tactic to our default string handles all the contradiction cases. -
-
- -
-Theorem ceval_deterministic''': ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; try find_rwinv; auto.
-  Case "E_Seq".
-    assert (st' = st'0) as EQ1.
-      SCase "Proof of assertion". auto.
-    subst st'0.
-    auto.
-  Case "E_WhileLoop".
-    SCase "b evaluates to true".
-      assert (st' = st'0) as EQ1.
-        SSCase "Proof of assertion". auto.
-      subst st'0.
-      auto. Qed.
- -
-
- -
-Finally, let's see about the remaining cases. Each of them involves - applying a conditional hypothesis to extract an equality. Currently - we have phrased these as assertions, so that we have to predict what - the resulting equality will be (although we can then use auto - to prove it.) An alternative is to pick the relevant - hypotheses to use, and then rewrite with them, as follows: - -
-
- -
-Theorem ceval_deterministic'''': ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; try find_rwinv; auto.
-  Case "E_Seq".
-    rewrite (IHE1_1 st'0 H1) in ×. auto.
-  Case "E_WhileLoop".
-    SCase "b evaluates to true".
-      rewrite (IHE1_1 st'0 H3) in ×. auto. Qed.
- -
-
- -
-Now we can automate the task of finding the relevant hypotheses to - rewrite with. -
-
- -
-Ltac find_eqn :=
-  match goal with
-    H1: ∀x, ?P x → ?L = ?R, H2: ?P ?X ⊢ _ ⇒
-         rewrite (H1 X H2) in ×
-  end.
- -
-
- -
-But there are several pairs of hypotheses that have the right - general form, and it seems tricky to pick out the ones we actually need. - A key trick is to realize that we can try them all! - Here's how this works: - -
- -
    -
  • rewrite will fail given a trivial equation of the form X = X. - -
    • -
  • each execution of match goal will keep trying to find a valid pair of - hypotheses until the tactic on the RHS of the match succeeds; - if there are no such pairs, it fails. - -
    • -
  • we can wrap the whole thing in a repeat which will keep - doing useful rewrites until only trivial ones are left. - -
    • -
- -
-
- -
- -
-Theorem ceval_deterministic''''': ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; try find_rwinv; repeat find_eqn; auto.
-  Qed.
- -
-
- -
-The big pay-off in this approach is that our proof script - should be robust in the face of modest changes to our language. - For example, we can add a REPEAT command to the language. - (This was an exercise in Hoare.v.) -
-
- -
-Module Repeat.
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAsgn : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com
-  | CRepeat : com → bexp → com.
- -
-
- -
-REPEAT behaves like WHILE, except that the loop guard is - checked after each execution of the body, with the loop - repeating as long as the guard stays false. Because of this, - the body will always execute at least once. -
-
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
-  | Case_aux c "IFB" | Case_aux c "WHILE"
-  | Case_aux c "CRepeat" ].
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "c1 ; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "X '::=' a" :=
-  (CAsgn X a) (at level 60).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
-  (CIf e1 e2 e3) (at level 80, right associativity).
-Notation "'REPEAT' e1 'UNTIL' b2 'END'" :=
-  (CRepeat e1 b2) (at level 80, right associativity).
- -
-Inductive ceval : state → com → state → Prop :=
-  | E_Skip : ∀st,
-      ceval st SKIP st
-  | E_Ass : ∀st a1 n X,
-      aeval st a1 = n →
-      ceval st (X ::= a1) (update st X n)
-  | E_Seq : ∀c1 c2 st st' st'',
-      ceval st c1 st' →
-      ceval st' c2 st'' →
-      ceval st (c1 ; c2) st''
-  | E_IfTrue : ∀st st' b1 c1 c2,
-      beval st b1 = true →
-      ceval st c1 st' →
-      ceval st (IFB b1 THEN c1 ELSE c2 FI) st'
-  | E_IfFalse : ∀st st' b1 c1 c2,
-      beval st b1 = false →
-      ceval st c2 st' →
-      ceval st (IFB b1 THEN c1 ELSE c2 FI) st'
-  | E_WhileEnd : ∀b1 st c1,
-      beval st b1 = false →
-      ceval st (WHILE b1 DO c1 END) st
-  | E_WhileLoop : ∀st st' st'' b1 c1,
-      beval st b1 = true →
-      ceval st c1 st' →
-      ceval st' (WHILE b1 DO c1 END) st'' →
-      ceval st (WHILE b1 DO c1 END) st''
-  | E_RepeatEnd : ∀st st' b1 c1,
-      ceval st c1 st' →
-      beval st' b1 = true →
-      ceval st (CRepeat c1 b1) st'
-  | E_RepeatLoop : ∀st st' st'' b1 c1,
-      ceval st c1 st' →
-      beval st' b1 = false →
-      ceval st' (CRepeat c1 b1) st'' →
-      ceval st (CRepeat c1 b1) st''
-.
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip" | Case_aux c "E_Ass"
-  | Case_aux c "E_Seq"
-  | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
-  | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop"
-  | Case_aux c "E_RepeatEnd" | Case_aux c "E_RepeatLoop"
-].
- -
-Notation "c1 '/' st '⇓' st'" := (ceval st c1 st')
-                                 (at level 40, st at level 39).
- -
-Theorem ceval_deterministic: ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; try find_rwinv; repeat find_eqn; auto.
-  Case "E_RepeatEnd".
-    SCase "b evaluates to false (contradiction)".
-       find_rwinv.
-       (* oops: why didn't find_rwinv solve this for us already? 
-          answer: we did things in the wrong order. *)
-  case "E_RepeatLoop".
-     SCase "b evaluates to true (contradiction)".
-        find_rwinv.
-Qed.
- -
-Theorem ceval_deterministic': ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 E1 E2;
-  generalize dependent st2;
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inv E2; repeat find_eqn; try find_rwinv; auto.
-Qed.
- -
-End Repeat.
- -
-
- -
-These examples just give a flavor of what "hyper-automation" can do... - -
- - The details of using match goal are tricky, and debugging is - not pleasant at all. But it is well worth adding at least simple - uses to your proofs to avoid tedium and "future proof" your scripts. - -
- - -
-
- -
-(* $Date: 2013-07-30 12:24:33 -0400 (Tue, 30 Jul 2013) $ *)
-
-
- - - -
- - - \ No newline at end of file diff --git a/Auto.v b/Auto.v deleted file mode 100644 index 871270b..0000000 --- a/Auto.v +++ /dev/null @@ -1,560 +0,0 @@ -(** * Auto: More Automation *) - -Require Export Imp. - -(** Up to now, we've continued to use a quite restricted set of -Coq's tactic facilities. In this chapter, we'll learn more about -two very powerful features of Coq's tactic language: -proof search via the [auto] and [eauto] tactics, and -automated forward reasoning via the [Ltac] hypothesis matching -machinery. Using these features together with Ltac's scripting facilities -will enable us to make our proofs startlingly short! Used properly, -they can also make proofs more maintainable and robust in the face -of incremental changes to underlying definitions. - -There's a third major source of automation we haven't -fully studied yet, namely built-in decision procedures for specific -kinds of problems: [omega] is one example, but there are others. -This topic will be defered for a while longer. - -*) - -(** Our motivating example will be this proof, repeated with - just a few small changes from [Imp]. We will try to simplify - this proof in several stages. *) - -Ltac inv H := inversion H; subst; clear H. - -Theorem ceval_deterministic: forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2. - Case "E_Skip". reflexivity. - Case "E_Ass". reflexivity. - Case "E_Seq". - assert (st' = st'0) as EQ1. - SCase "Proof of assertion". apply IHE1_1; assumption. - subst st'0. - apply IHE1_2. assumption. - Case "E_IfTrue". - SCase "b evaluates to true". - apply IHE1. assumption. - SCase "b evaluates to false (contradiction)". - rewrite H in H5. inversion H5. - Case "E_IfFalse". - SCase "b evaluates to true (contradiction)". - rewrite H in H5. inversion H5. - SCase "b evaluates to false". - apply IHE1. assumption. - Case "E_WhileEnd". - SCase "b evaluates to false". - reflexivity. - SCase "b evaluates to true (contradiction)". - rewrite H in H2. inversion H2. - Case "E_WhileLoop". - SCase "b evaluates to false (contradiction)". - rewrite H in H4. inversion H4. - SCase "b evaluates to true". - assert (st' = st'0) as EQ1. - SSCase "Proof of assertion". apply IHE1_1; assumption. - subst st'0. - apply IHE1_2. assumption. Qed. - -(** * The [auto] and [eauto] tactics *) - -(** Thus far, we have (nearly) always written proof scripts that - apply relevant hypothoses or lemmas by name. In particular, when - a chain of hypothesis applications is needed, we have specified - them explicitly. (The only exceptions introduced so far are using - [assumption] to find a matching unqualified hypothesis - or [(e)constructor] to find a matching constructor.) *) - - -Example auto_example_1 : forall (P Q R: Prop), (P -> Q) -> (Q -> R) -> P -> R. -Proof. - intros P Q R H1 H2 H3. - apply H2. apply H1. assumption. -Qed. - -(** The [auto] tactic frees us from this drudgery by _searching_ - for a sequence of applications that will prove the goal *) - -Example auto_example_1' : forall (P Q R: Prop), (P -> Q) -> (Q -> R) -> P -> R. -Proof. - intros P Q R H1 H2 H3. - auto. -Qed. - -(** The [auto] tactic solves goals that are solvable by any combination of - - [intros], - - [apply] (with a local hypothesis, by default). - - The [eauto] tactic works just like [auto], except that it uses - [eapply] instead of [apply]. *) - -(** Using [auto] is always "safe" in the sense that it will never fail - and will never change the proof state: either it completely solves - the current goal, or it does nothing. -*) - -(** A more complicated example: *) - -Example auto_example_2 : forall P Q R S T U : Prop, - (P -> Q) -> - (P -> R) -> - (T -> R) -> - (S -> T -> U) -> - ((P->Q) -> (P->S)) -> - T -> - P -> - U. -Proof. auto. Qed. - - -(** Search can take an arbitrarily long time, so there are limits to - how far [auto] will search by default *) - -Example auto_example_3 : forall (P Q R S T U: Prop), - (P -> Q) -> (Q -> R) -> (R -> S) -> - (S -> T) -> (T -> U) -> P -> U. -Proof. - auto. (* When it cannot solve the goal, does nothing! *) - auto 6. (* Optional argument says how deep to search (default depth is 5) *) -Qed. - - -(** When searching for potential proofs of the current goal, [auto] - and [eauto] consider the hypotheses in the current context - together with a _hint database_ of other lemmas and constructors. - Some of the lemmas and constructors we've already seen -- e.g., - [eq_refl], [conj], [or_introl], and [or_intror] -- are installed in this hint - database by default. *) - -Example auto_example_4 : forall P Q R : Prop, - Q -> - (Q -> R) -> - P \/ (Q /\ R). -Proof. - auto. Qed. - - -(** If we want to see which facts [auto] is using, we can use [info_auto] instead. *) - -Example auto_example_5: 2 = 2. -Proof. - info_auto. (* subsumes reflexivity because eq_refl is in hint database *) -Qed. - - -(** We can extend the hint database just for the purposes of one - application of [auto] or [eauto] by writing [auto using ...]. *) - -Lemma le_antisym : forall n m: nat, (n <= m /\ m <= n) -> n = m. -Proof. intros. omega. Qed. - -Example auto_example_6 : forall n m p : nat, - (n<= p -> (n <= m /\ m <= n)) -> - n <= p -> - n = m. -Proof. - intros. - auto. (* does nothing: auto doesn't destruct hypotheses! *) - auto using le_antisym. -Qed. - - -(** Of course, in any given development there will also be some of our - own specific constructors and lemmas that are used very often in - proofs. We can add these to the global hint database by writing - Hint Resolve T. - at the top level, where [T] is a top-level theorem or a - constructor of an inductively defined proposition (i.e., anything - whose type is an implication). As a shorthand, we can write - Hint Constructors c. - to tell Coq to do a [Hint Resolve] for _all_ of the constructors - from the inductive definition of [c]. - - It is also sometimes necessary to add - Hint Unfold d. - where [d] is a defined symbol, so that [auto] knows to expand - uses of [d] and enable further possibilities for applying - lemmas that it knows about. *) - -Hint Resolve le_antisym. - -Example auto_example_6' : forall n m p : nat, - (n<= p -> (n <= m /\ m <= n)) -> - n <= p -> - n = m. -Proof. - intros. - auto. (* picks up hint from database *) -Qed. - -Definition is_fortytwo x := x = 42. - -Example auto_example_7: forall x, (x <= 42 /\ 42 <= x) -> is_fortytwo x. -Proof. - auto. (* does nothing *) -Abort. - -Hint Unfold is_fortytwo. - -Example auto_example_7' : forall x, (x <= 42 /\ 42 <= x) -> is_fortytwo x. -Proof. - info_auto. -Qed. - -Hint Constructors ceval. - -Definition st12 := update (update empty_state X 1) Y 2. -Definition st21 := update (update empty_state X 2) Y 1. - -Example auto_example_8 : exists s', - (IFB (BLe (AId X) (AId Y)) - THEN (Z ::= AMinus (AId Y) (AId X)) - ELSE (Y ::= APlus (AId X) (AId Z)) - FI) / st21 || s'. -Proof. - eexists. info_auto. -Qed. - -Example auto_example_8' : exists s', - (IFB (BLe (AId X) (AId Y)) - THEN (Z ::= AMinus (AId Y) (AId X)) - ELSE (Y ::= APlus (AId X) (AId Z)) - FI) / st12 || s'. -Proof. - eexists. info_auto. -Qed. - - -(** Now let's take a pass over [ceval_deterministic] using [auto] - to simplify the proof script. We see that all simple sequences of hypothesis - applications and all uses of [reflexivity] can be replaced by [auto], - which we add to the default tactic to be applied to each case. -*) - -Theorem ceval_deterministic': forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; auto. - Case "E_Seq". - assert (st' = st'0) as EQ1. - SCase "Proof of assertion". auto. - subst st'0. - auto. - Case "E_IfTrue". - SCase "b evaluates to false (contradiction)". - rewrite H in H5. inversion H5. - Case "E_IfFalse". - SCase "b evaluates to true (contradiction)". - rewrite H in H5. inversion H5. - Case "E_WhileEnd". - SCase "b evaluates to true (contradiction)". - rewrite H in H2. inversion H2. - Case "E_WhileLoop". - SCase "b evaluates to false (contradiction)". - rewrite H in H4. inversion H4. - SCase "b evaluates to true". - assert (st' = st'0) as EQ1. - SSCase "Proof of assertion". auto. - subst st'0. - auto. Qed. - -(** * Searching Hypotheses *) - -(** The proof has become simpler, but there is still an annoying amount - of repetition. Let's start by tackling the contradiction cases. Each - of them occurs in a situation where we have both - - [H1: beval st b = false] - - and - - [H2: beval st b = true] - - as hypotheses. The contradiction is evident, but demonstrating it - is a little complicated: we have to locate the two hypotheses [H1] and [H2] - and do a [rewrite] following by an [inversion]. We'd like to automate - this process. - - Note: In fact, Coq has a built-in tactic [congruence] that will do the - job. But we'll ignore the existence of this tactic for now, in order - to demonstrate how to build forward search tactics by hand. - -*) - -(** As a first step, we can abstract out the piece of script in question by - writing a small amount of paramerized Ltac. *) - -Ltac rwinv H1 H2 := rewrite H1 in H2; inv H2. - -Theorem ceval_deterministic'': forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; auto. - Case "E_Seq". - assert (st' = st'0) as EQ1. - SCase "Proof of assertion". auto. - subst st'0. - auto. - Case "E_IfTrue". - SCase "b evaluates to false (contradiction)". - rwinv H H5. - Case "E_IfFalse". - SCase "b evaluates to true (contradiction)". - rwinv H H5. - Case "E_WhileEnd". - SCase "b evaluates to true (contradiction)". - rwinv H H2. - Case "E_WhileLoop". - SCase "b evaluates to false (contradiction)". - rwinv H H4. - SCase "b evaluates to true". - assert (st' = st'0) as EQ1. - SSCase "Proof of assertion". auto. - subst st'0. - auto. Qed. - - -(** But this is not much better. We really want Coq to discover - the relevant hypotheses for us. We can do this by using the - [match goal with ... end] facility of Ltac. *) - -Ltac find_rwinv := - match goal with - H1: ?E = true, H2: ?E = false |- _ => rwinv H1 H2 - end. - -(** In words, this [match goal] looks for two (distinct) hypotheses that have - the form of equalities with the same arbitrary expression [E] on the - left and conflicting boolean values on the right; if such hypotheses are - found, it binds [H1] and [H2] to their names, and applies the tactic - after the [=>]. - - Adding this tactic to our default string handles all the contradiction cases. *) - -Theorem ceval_deterministic''': forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; try find_rwinv; auto. - Case "E_Seq". - assert (st' = st'0) as EQ1. - SCase "Proof of assertion". auto. - subst st'0. - auto. - Case "E_WhileLoop". - SCase "b evaluates to true". - assert (st' = st'0) as EQ1. - SSCase "Proof of assertion". auto. - subst st'0. - auto. Qed. - -(** Finally, let's see about the remaining cases. Each of them involves - applying a conditional hypothesis to extract an equality. Currently - we have phrased these as assertions, so that we have to predict what - the resulting equality will be (although we can then use [auto] - to prove it.) An alternative is to pick the relevant - hypotheses to use, and then rewrite with them, as follows: -*) - -Theorem ceval_deterministic'''': forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; try find_rwinv; auto. - Case "E_Seq". - rewrite (IHE1_1 st'0 H1) in *. auto. - Case "E_WhileLoop". - SCase "b evaluates to true". - rewrite (IHE1_1 st'0 H3) in *. auto. Qed. - -(** Now we can automate the task of finding the relevant hypotheses to - rewrite with. *) - -Ltac find_eqn := - match goal with - H1: forall x, ?P x -> ?L = ?R, H2: ?P ?X |- _ => - rewrite (H1 X H2) in * - end. - -(** But there are several pairs of hypotheses that have the right - general form, and it seems tricky to pick out the ones we actually need. - A key trick is to realize that we can _try them all_! - Here's how this works: - - - [rewrite] will fail given a trivial equation of the form [X = X]. - - each execution of [match goal] will keep trying to find a valid pair of - hypotheses until the tactic on the RHS of the match succeeds; - if there are no such pairs, it fails. - - we can wrap the whole thing in a [repeat] which will keep - doing useful rewrites until only trivial ones are left. -*) - - -Theorem ceval_deterministic''''': forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; try find_rwinv; repeat find_eqn; auto. - Qed. - -(** The big pay-off in this approach is that our proof script - should be robust in the face of modest changes to our language. - For example, we can add a [REPEAT] command to the language. - (This was an exercise in [Hoare.v].) *) - -Module Repeat. - -Inductive com : Type := - | CSkip : com - | CAsgn : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com - | CRepeat : com -> bexp -> com. - -(** [REPEAT] behaves like [WHILE], except that the loop guard is - checked _after_ each execution of the body, with the loop - repeating as long as the guard stays _false_. Because of this, - the body will always execute at least once. *) - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";" - | Case_aux c "IFB" | Case_aux c "WHILE" - | Case_aux c "CRepeat" ]. - -Notation "'SKIP'" := - CSkip. -Notation "c1 ; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "X '::=' a" := - (CAsgn X a) (at level 60). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := - (CIf e1 e2 e3) (at level 80, right associativity). -Notation "'REPEAT' e1 'UNTIL' b2 'END'" := - (CRepeat e1 b2) (at level 80, right associativity). - -Inductive ceval : state -> com -> state -> Prop := - | E_Skip : forall st, - ceval st SKIP st - | E_Ass : forall st a1 n X, - aeval st a1 = n -> - ceval st (X ::= a1) (update st X n) - | E_Seq : forall c1 c2 st st' st'', - ceval st c1 st' -> - ceval st' c2 st'' -> - ceval st (c1 ; c2) st'' - | E_IfTrue : forall st st' b1 c1 c2, - beval st b1 = true -> - ceval st c1 st' -> - ceval st (IFB b1 THEN c1 ELSE c2 FI) st' - | E_IfFalse : forall st st' b1 c1 c2, - beval st b1 = false -> - ceval st c2 st' -> - ceval st (IFB b1 THEN c1 ELSE c2 FI) st' - | E_WhileEnd : forall b1 st c1, - beval st b1 = false -> - ceval st (WHILE b1 DO c1 END) st - | E_WhileLoop : forall st st' st'' b1 c1, - beval st b1 = true -> - ceval st c1 st' -> - ceval st' (WHILE b1 DO c1 END) st'' -> - ceval st (WHILE b1 DO c1 END) st'' - | E_RepeatEnd : forall st st' b1 c1, - ceval st c1 st' -> - beval st' b1 = true -> - ceval st (CRepeat c1 b1) st' - | E_RepeatLoop : forall st st' st'' b1 c1, - ceval st c1 st' -> - beval st' b1 = false -> - ceval st' (CRepeat c1 b1) st'' -> - ceval st (CRepeat c1 b1) st'' -. - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" | Case_aux c "E_Ass" - | Case_aux c "E_Seq" - | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" - | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" - | Case_aux c "E_RepeatEnd" | Case_aux c "E_RepeatLoop" -]. - -Notation "c1 '/' st '||' st'" := (ceval st c1 st') - (at level 40, st at level 39). - - -Theorem ceval_deterministic: forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; try find_rwinv; repeat find_eqn; auto. - Case "E_RepeatEnd". - SCase "b evaluates to false (contradiction)". - find_rwinv. - (* oops: why didn't [find_rwinv] solve this for us already? - answer: we did things in the wrong order. *) - case "E_RepeatLoop". - SCase "b evaluates to true (contradiction)". - find_rwinv. -Qed. - -Theorem ceval_deterministic': forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2; - generalize dependent st2; - ceval_cases (induction E1) Case; - intros st2 E2; inv E2; repeat find_eqn; try find_rwinv; auto. -Qed. - -End Repeat. - -(** These examples just give a flavor of what "hyper-automation" can do... - - The details of using [match goal] are tricky, and debugging is - not pleasant at all. But it is well worth adding at least simple - uses to your proofs to avoid tedium and "future proof" your scripts. - -*) - -(* $Date: 2013-07-30 12:24:33 -0400 (Tue, 30 Jul 2013) $ *) diff --git a/Basics.html b/Basics.html deleted file mode 100644 index 1f998a6..0000000 --- a/Basics.html +++ /dev/null @@ -1,1534 +0,0 @@ - - - - - -Basics: Functional Programming in Coq - - - - - - -
- - - -
- -

BasicsFunctional Programming in Coq

- -
-
- -
- -
-
- -
-
- -
-

Introduction

- -
- - The functional programming style brings programming closer to - mathematics: If a procedure or method has no side effects, then - pretty much all you need to understand about it is how it maps - inputs to outputs — that is, you can think of its behavior as - just computing a mathematical function. This is one reason for - the word "functional" in "functional programming." This direct - connection between programs and simple mathematical objects - supports both sound informal reasoning and formal proofs of - correctness. - -
- - The other sense in which functional programming is "functional" is - that it emphasizes the use of functions (or methods) as - first-class values — i.e., values that can be passed as - arguments to other functions, returned as results, stored in data - structures, etc. The recognition that functions can be treated as - data in this way enables a host of useful idioms, as we will see. - -
- - Other common features of functional languages include algebraic - data types and pattern matching, which make it easy to construct - and manipulate rich data structures, and sophisticated - polymorphic type systems that support abstraction and code - reuse. Coq shares all of these features. - -
-
- -
-
- -
-

Enumerated Types

- -
- - One unusual aspect of Coq is that its set of built-in - features is extremely small. For example, instead of providing - the usual palette of atomic data types (booleans, integers, - strings, etc.), Coq offers an extremely powerful mechanism for - defining new data types from scratch — so powerful that all these - familiar types arise as instances. - -
- - Naturally, the Coq distribution comes with an extensive standard - library providing definitions of booleans, numbers, and many - common data structures like lists and hash tables. But there is - nothing magic or primitive about these library definitions: they - are ordinary user code. - -
- - To see how this works, let's start with a very simple example. -
-
- -
-
- -
-

Days of the Week

- -
- - The following declaration tells Coq that we are defining - a new set of data values — a type. -
-
- -
-Inductive day : Type :=
-  | monday : day
-  | tuesday : day
-  | wednesday : day
-  | thursday : day
-  | friday : day
-  | saturday : day
-  | sunday : day.
- -
-
- -
-The type is called day, and its members are monday, - tuesday, etc. The second through eighth lines of the definition - can be read "monday is a day, tuesday is a day, etc." - -
- - Having defined day, we can write functions that operate on - days. -
-
- -
-Definition next_weekday (d:day) : day :=
-  match d with
-  | monday ⇒ tuesday
-  | tuesday ⇒ wednesday
-  | wednesday ⇒ thursday
-  | thursday ⇒ friday
-  | friday ⇒ monday
-  | saturday ⇒ monday
-  | sunday ⇒ monday
-  end.
- -
-
- -
-One thing to note is that the argument and return types of - this function are explicitly declared. Like most functional - programming languages, Coq can often work out these types even if - they are not given explicitly — i.e., it performs some type - inference — but we'll always include them to make reading - easier. -
- - Having defined a function, we should check that it works on - some examples. There are actually three different ways to do this - in Coq. First, we can use the command Eval compute to evaluate a - compound expression involving next_weekday. -
-
- -
-Eval compute in (next_weekday friday).
-   (* ==> monday : day *)
-Eval compute in (next_weekday (next_weekday saturday)).
-   (* ==> tuesday : day *)
- -
-
- -
-If you have a computer handy, now would be an excellent - moment to fire up the Coq interpreter under your favorite IDE — - either CoqIde or Proof General — and try this for yourself. Load - this file (Basics.v) from the book's accompanying Coq sources, - find the above example, submit it to Coq, and observe the - result. -
- - The keyword compute tells Coq precisely how to - evaluate the expression we give it. For the moment, compute is - the only one we'll need; later on we'll see some alternatives that - are sometimes useful. -
- - Second, we can record what we expect the result to be in - the form of a Coq example: -
-
- -
-Example test_next_weekday:
-  (next_weekday (next_weekday saturday)) = tuesday.
- -
-
- -
-This declaration does two things: it makes an - assertion (that the second weekday after saturday is tuesday), - and it gives the assertion a name that can be used to refer to it - later. Having made the assertion, we can also ask Coq to verify it, - like this: -
-
- -
-Proof. simpl. reflexivity. Qed.
- -
-
- -
-The details are not important for now (we'll come back to - them in a bit), but essentially this can be read as "The assertion - we've just made can be proved by observing that both sides of the - equality evaluate to the same thing, after some simplification." -
- - Third, we can ask Coq to "extract," from a Definition, a - program in some other, more conventional, programming - language (OCaml, Scheme, or Haskell) with a high-performance - compiler. This facility is very interesting, since it gives us a - way to construct fully certified programs in mainstream - languages. Indeed, this is one of the main uses for which Coq was - developed. We'll come back to this topic in later chapters. - More information can also be found in the Coq'Art book by Bertot - and Casteran, as well as the Coq reference manual. -
-
- -
-
- -
-

Booleans

- -
- - In a similar way, we can define the type bool of booleans, - with members true and false. -
-
- -
-Inductive bool : Type :=
-  | true : bool
-  | false : bool.
- -
-
- -
-Although we are rolling our own booleans here for the sake - of building up everything from scratch, Coq does, of course, - provide a default implementation of the booleans in its standard - library, together with a multitude of useful functions and - lemmas. (Take a look at Coq.Init.Datatypes in the Coq library - documentation if you're interested.) Whenever possible, we'll - name our own definitions and theorems so that they exactly - coincide with the ones in the standard library. -
- - Functions over booleans can be defined in the same way as - above: -
-
- -
-Definition negb (b:bool) : bool :=
-  match b with
-  | true ⇒ false
-  | false ⇒ true
-  end.
- -
-Definition andb (b1:bool) (b2:bool) : bool :=
-  match b1 with
-  | true ⇒ b2
-  | false ⇒ false
-  end.
- -
-Definition orb (b1:bool) (b2:bool) : bool :=
-  match b1 with
-  | true ⇒ true
-  | false ⇒ b2
-  end.
- -
-
- -
-The last two illustrate the syntax for multi-argument - function definitions. -
- - The following four "unit tests" constitute a complete - specification — a truth table — for the orb function: -
-
- -
-Example test_orb1: (orb true false) = true.
-Proof. reflexivity. Qed.
-Example test_orb2: (orb false false) = false.
-Proof. reflexivity. Qed.
-Example test_orb3: (orb false true) = true.
-Proof. reflexivity. Qed.
-Example test_orb4: (orb true true) = true.
-Proof. reflexivity. Qed.
- -
-
- -
-(Note that we've dropped the simpl in the proofs. It's not - actually needed because reflexivity will automatically perform - simplification.) -
- - A note on notation: We use square brackets to delimit - fragments of Coq code in comments in .v files; this convention, - also used by the coqdoc documentation tool, keeps them visually - separate from the surrounding text. In the html version of the - files, these pieces of text appear in a different font. -
- - The values Admitted and admit can be used to fill - a hole in an incomplete definition or proof. We'll use them in the - following exercises. In general, your job in the exercises is - to replace admit or Admitted with real definitions or proofs. -
- -

Exercise: 1 star (nandb)

- Complete the definition of the following function, then make - sure that the Example assertions below can each be verified by - Coq. -
- - This function should return true if either or both of - its inputs are false. -
-
- -
-Definition nandb (b1:bool) (b2:bool) : bool :=
-  (* FILL IN HERE *) admit.
- -
-
- -
-Remove "Admitted." and fill in each proof with - "Proof. reflexivity. Qed." -
-
- -
-Example test_nandb1: (nandb true false) = true.
-(* FILL IN HERE *) Admitted.
-Example test_nandb2: (nandb false false) = true.
-(* FILL IN HERE *) Admitted.
-Example test_nandb3: (nandb false true) = true.
-(* FILL IN HERE *) Admitted.
-Example test_nandb4: (nandb true true) = false.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (andb3)

- Do the same for the andb3 function below. This function should - return true when all of its inputs are true, and false - otherwise. -
-
- -
-Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
-  (* FILL IN HERE *) admit.
- -
-Example test_andb31: (andb3 true true true) = true.
-(* FILL IN HERE *) Admitted.
-Example test_andb32: (andb3 false true true) = false.
-(* FILL IN HERE *) Admitted.
-Example test_andb33: (andb3 true false true) = false.
-(* FILL IN HERE *) Admitted.
-Example test_andb34: (andb3 true true false) = false.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Function Types

- -
- - The Check command causes Coq to print the type of an - expression. For example, the type of negb true is bool. -
-
- -
-Check true.
-(* ===> true : bool *)
-Check (negb true).
-(* ===> negb true : bool *)
- -
-
- -
-Functions like negb itself are also data values, just like - true and false. Their types are called function types, and - they are written with arrows. -
-
- -
-Check negb.
-(* ===> negb : bool -> bool *)
- -
-
- -
-The type of negb, written bool → bool and pronounced - "bool arrow bool," can be read, "Given an input of type - bool, this function produces an output of type bool." - Similarly, the type of andb, written bool → bool → bool, can - be read, "Given two inputs, both of type bool, this function - produces an output of type bool." -
-
- -
-
- -
-

Numbers

- -
- - Technical digression: Coq provides a fairly sophisticated - module system, to aid in organizing large developments. In this - course we won't need most of its features, but one is useful: If - we enclose a collection of declarations between Module X and - End X markers, then, in the remainder of the file after the - End, these definitions will be referred to by names like X.foo - instead of just foo. Here, we use this feature to introduce the - definition of the type nat in an inner module so that it does - not shadow the one from the standard library. -
-
- -
-Module Playground1.
- -
-
- -
-The types we have defined so far are examples of "enumerated - types": their definitions explicitly enumerate a finite set of - elements. A more interesting way of defining a type is to give a - collection of "inductive rules" describing its elements. For - example, we can define the natural numbers as follows: -
-
- -
-Inductive nat : Type :=
-  | O : nat
-  | S : nat → nat.
- -
-
- -
-The clauses of this definition can be read: - -
- -
    -
  • O is a natural number (note that this is the letter "O," not - the numeral "0"). - -
    • -
  • S is a "constructor" that takes a natural number and yields - another one — that is, if n is a natural number, then S n - is too. - -
    • -
- -
- - Let's look at this in a little more detail. - -
- - Every inductively defined set (day, nat, bool, etc.) is - actually a set of expressions. The definition of nat says how - expressions in the set nat can be constructed: - -
- -
    -
  • the expression O belongs to the set nat; - -
    • -
  • if n is an expression belonging to the set nat, then S n - is also an expression belonging to the set nat; and - -
    • -
  • expressions formed in these two ways are the only ones belonging - to the set nat. - -
    • -
- The same rules apply for our definitions of day and bool. The - annotations we used for their constructors are analogous to the - one for the O constructor, and indicate that each of those - constructors doesn't take any arguments. -
- - These three conditions are the precise force of the - Inductive declaration. They imply that the expression O, the - expression S O, the expression S (S O), the expression - S (S (S O)), and so on all belong to the set nat, while other - expressions like true, andb true false, and S (S false) do - not. - -
- - We can write simple functions that pattern match on natural - numbers just as we did above — for example, the predecessor - function: -
-
- -
-Definition pred (n : nat) : nat :=
-  match n with
-    | O ⇒ O
-    | S n' ⇒ n'
-  end.
- -
-
- -
-The second branch can be read: "if n has the form S n' - for some n', then return n'." -
-
- -
-End Playground1.
- -
-Definition minustwo (n : nat) : nat :=
-  match n with
-    | O ⇒ O
-    | S O ⇒ O
-    | S (S n') ⇒ n'
-  end.
- -
-
- -
-Because natural numbers are such a pervasive form of data, - Coq provides a tiny bit of built-in magic for parsing and printing - them: ordinary arabic numerals can be used as an alternative to - the "unary" notation defined by the constructors S and O. Coq - prints numbers in arabic form by default: -
-
- -
-Check (S (S (S (S O)))).
-Eval compute in (minustwo 4).
- -
-
- -
-The constructor S has the type nat → nat, just like the - functions minustwo and pred: -
-
- -
-Check S.
-Check pred.
-Check minustwo.
- -
-
- -
-These are all things that can be applied to a number to yield a - number. However, there is a fundamental difference: functions - like pred and minustwo come with computation rules — e.g., - the definition of pred says that pred 2 can be simplified to - 1 — while the definition of S has no such behavior attached. - Although it is like a function in the sense that it can be applied - to an argument, it does not do anything at all! -
- - For most function definitions over numbers, pure pattern - matching is not enough: we also need recursion. For example, to - check that a number n is even, we may need to recursively check - whether n-2 is even. To write such functions, we use the - keyword Fixpoint. -
-
- -
-Fixpoint evenb (n:nat) : bool :=
-  match n with
-  | O ⇒ true
-  | S O ⇒ false
-  | S (S n') ⇒ evenb n'
-  end.
- -
-
- -
-We can define oddb by a similar Fixpoint declaration, but here - is a simpler definition that will be a bit easier to work with: -
-
- -
-Definition oddb (n:nat) : bool := negb (evenb n).
- -
-Example test_oddb1: (oddb (S O)) = true.
-Proof. reflexivity. Qed.
-Example test_oddb2: (oddb (S (S (S (S O))))) = false.
-Proof. reflexivity. Qed.
- -
-
- -
-Naturally, we can also define multi-argument functions by - recursion. (Once again, we use a module to avoid polluting the - namespace.) -
-
- -
-Module Playground2.
- -
-Fixpoint plus (n : nat) (m : nat) : nat :=
-  match n with
-    | O ⇒ m
-    | S n' ⇒ S (plus n' m)
-  end.
- -
-
- -
-Adding three to two now gives us five, as we'd expect. -
-
- -
-Eval compute in (plus (S (S (S O))) (S (S O))).
- -
-
- -
-The simplification that Coq performs to reach this conclusion can - be visualized as follows: -
-
- -
-(*  plus (S (S (S O))) (S (S O))    
-==> S (plus (S (S O)) (S (S O))) by the second clause of the match
-==> S (S (plus (S O) (S (S O)))) by the second clause of the match
-==> S (S (S (plus O (S (S O))))) by the second clause of the match
-==> S (S (S (S (S O))))          by the first clause of the match
-*)
- -
-
- -
-As a notational convenience, if two or more arguments have - the same type, they can be written together. In the following - definition, (n m : nat) means just the same as if we had written - (n : nat) (m : nat). -
-
- -
-Fixpoint mult (n m : nat) : nat :=
-  match n with
-    | O ⇒ O
-    | S n' ⇒ plus m (mult n' m)
-  end.
- -
-Example test_mult1: (mult 3 3) = 9.
-Proof. reflexivity. Qed.
- -
-
- -
-You can match two expressions at once by putting a comma - between them: -
-
- -
-Fixpoint minus (n m:nat) : nat :=
-  match n, m with
-  | O , _ ⇒ O
-  | S _ , O ⇒ n
-  | S n', S m' ⇒ minus n' m'
-  end.
- -
-
- -
-The _ in the first line is a wildcard pattern. Writing _ in a - pattern is the same as writing some variable that doesn't get used - on the right-hand side. This avoids the need to invent a bogus - variable name. -
-
- -
-End Playground2.
- -
-Fixpoint exp (base power : nat) : nat :=
-  match power with
-    | O ⇒ S O
-    | S p ⇒ mult base (exp base p)
-  end.
- -
-
- -
-

Exercise: 1 star (factorial)

- Recall the standard factorial function: -
-    factorial(0)  =  1 
-    factorial(n)  =  n * factorial(n-1)     (if n>0)
-
- Translate this into Coq. -
-
- -
-Fixpoint factorial (n:nat) : nat :=
-(* FILL IN HERE *) admit.
- -
-Example test_factorial1: (factorial 3) = 6.
-(* FILL IN HERE *) Admitted.
-Example test_factorial2: (factorial 5) = (mult 10 12).
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - We can make numerical expressions a little easier to read and - write by introducing "notations" for addition, multiplication, and - subtraction. -
-
- -
-Notation "x + y" := (plus x y)
-                       (at level 50, left associativity)
-                       : nat_scope.
-Notation "x - y" := (minus x y)
-                       (at level 50, left associativity)
-                       : nat_scope.
-Notation "x × y" := (mult x y)
-                       (at level 40, left associativity)
-                       : nat_scope.
- -
-Check ((0 + 1) + 1).
- -
-
- -
-(The level, associativity, and nat_scope annotations - control how these notations are treated by Coq's parser. The - details are not important, but interested readers can refer to the - "More on Notation" subsection in the "Optional Material" section at - the end of this chapter.) -
- - Note that these do not change the definitions we've already - made: they are simply instructions to the Coq parser to accept x - + y in place of plus x y and, conversely, to the Coq - pretty-printer to display plus x y as x + y. -
- - When we say that Coq comes with nothing built-in, we really - mean it: even equality testing for numbers is a user-defined - operation! The beq_nat function tests natural numbers for equality, - yielding a boolean. Note the use of nested matches (we could - also have used a simultaneous match, as we did in minus.) -
-
- -
-Fixpoint beq_nat (n m : nat) : bool :=
-  match n with
-  | O ⇒ match m with
-         | O ⇒ true
-         | S m' ⇒ false
-         end
-  | S n' ⇒ match m with
-            | O ⇒ false
-            | S m' ⇒ beq_nat n' m'
-            end
-  end.
- -
-
- -
-Similarly, the ble_nat function tests natural numbers for - less-or-equal, yielding a boolean. -
-
- -
-Fixpoint ble_nat (n m : nat) : bool :=
-  match n with
-  | O ⇒ true
-  | S n' ⇒
-      match m with
-      | O ⇒ false
-      | S m' ⇒ ble_nat n' m'
-      end
-  end.
- -
-Example test_ble_nat1: (ble_nat 2 2) = true.
-Proof. reflexivity. Qed.
-Example test_ble_nat2: (ble_nat 2 4) = true.
-Proof. reflexivity. Qed.
-Example test_ble_nat3: (ble_nat 4 2) = false.
-Proof. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (blt_nat)

- The blt_nat function tests natural numbers for less-than, - yielding a boolean. Instead of making up a new Fixpoint for - this one, define it in terms of a previously defined function. - -
- - Note: If you have trouble with the simpl tactic, try using - compute, which is like simpl on steroids. However, there is a - simple, elegant solution for which simpl suffices. -
-
- -
-Definition blt_nat (n m : nat) : bool :=
-  (* FILL IN HERE *) admit.
- -
-Example test_blt_nat1: (blt_nat 2 2) = false.
-(* FILL IN HERE *) Admitted.
-Example test_blt_nat2: (blt_nat 2 4) = true.
-(* FILL IN HERE *) Admitted.
-Example test_blt_nat3: (blt_nat 4 2) = false.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Proof by Simplification

- -
- - Now that we've defined a few datatypes and functions, let's - turn to the question of how to state and prove properties of their - behavior. Actually, in a sense, we've already started doing this: - each Example in the previous sections makes a precise claim - about the behavior of some function on some particular inputs. - The proofs of these claims were always the same: use reflexivity - to check that both sides of the = simplify to identical values. - -
- - (By the way, it will be useful later to know that - reflexivity actually does somewhat more simplification than simpl - does — for example, it tries "unfolding" defined terms, replacing them with - their right-hand sides. The reason for this difference is that, - when reflexivity succeeds, the whole goal is finished and we don't - need to look at whatever expanded expressions reflexivity has - found; by contrast, simpl is used in situations where we may - have to read and understand the new goal, so we would not want it - blindly expanding definitions.) - -
- - The same sort of "proof by simplification" can be used to prove - more interesting properties as well. For example, the fact that - 0 is a "neutral element" for + on the left can be proved - just by observing that 0 + n reduces to n no matter what - n is, a fact that can be read directly off the definition of plus. -
-
- -
-Theorem plus_O_n : ∀n : nat, 0 + n = n.
-Proof.
-  intros n. reflexivity. Qed.
- -
-
- -
-(Note: You may notice that the above statement looks - different in the original source file and the final html output. In Coq - files, we write the ∀ universal quantifier using the - "forall" reserved identifier. This gets printed as an - upside-down "A", the familiar symbol used in logic.) -
- - The form of this theorem and proof are almost exactly the - same as the examples above; there are just a few differences. - -
- - First, we've used the keyword Theorem instead of - Example. Indeed, the difference is purely a matter of - style; the keywords Example and Theorem (and a few others, - including Lemma, Fact, and Remark) mean exactly the same - thing to Coq. - -
- - Secondly, we've added the quantifier ∀ n:nat, so that our - theorem talks about all natural numbers n. In order to prove - theorems of this form, we need to to be able to reason by - assuming the existence of an arbitrary natural number n. This - is achieved in the proof by intros n, which moves the quantifier - from the goal to a "context" of current assumptions. In effect, we - start the proof by saying "OK, suppose n is some arbitrary number." - -
- - The keywords intros, simpl, and reflexivity are examples of - tactics. A tactic is a command that is used between Proof and - Qed to tell Coq how it should check the correctness of some - claim we are making. We will see several more tactics in the rest - of this lecture, and yet more in future lectures. -
- - Step through these proofs in Coq and notice how the goal and - context change. -
-
- -
-Theorem plus_1_l : ∀n:nat, 1 + n = S n.
-Proof.
-  intros n. reflexivity. Qed.
- -
-Theorem mult_0_l : ∀n:nat, 0 × n = 0.
-Proof.
-  intros n. reflexivity. Qed.
- -
-
- -
-The _l suffix in the names of these theorems is - pronounced "on the left." -
-
- -
-
- -
-

Proof by Rewriting

- -
- - Here is a slightly more interesting theorem: -
-
- -
-Theorem plus_id_example : ∀n m:nat,
-  n = m →
-  n + n = m + m.
- -
-
- -
-Instead of making a completely universal claim about all numbers - n and m, this theorem talks about a more specialized property - that only holds when n = m. The arrow symbol is pronounced - "implies." - -
- - As before, we need to be able to reason by assuming the existence - of some numbers n and m. We also need to assume the hypothesis - n = m. The intros tactic will serve to move all three of these - from the goal into assumptions in the current context. - -
- - Since n and m are arbitrary numbers, we can't just use - simplification to prove this theorem. Instead, we prove it by - observing that, if we are assuming n = m, then we can replace - n with m in the goal statement and obtain an equality with the - same expression on both sides. The tactic that tells Coq to - perform this replacement is called rewrite. -
-
- -
-Proof.
-  intros n m. (* move both quantifiers into the context *)
-  intros H. (* move the hypothesis into the context *)
-  rewrite → H. (* Rewrite the goal using the hypothesis *)
-  reflexivity. Qed.
- -
-
- -
-The first line of the proof moves the universally quantified - variables n and m into the context. The second moves the - hypothesis n = m into the context and gives it the (arbitrary) - name H. The third tells Coq to rewrite the current goal (n + n - = m + m) by replacing the left side of the equality hypothesis - H with the right side. - -
- - (The arrow symbol in the rewrite has nothing to do with - implication: it tells Coq to apply the rewrite from left to right. - To rewrite from right to left, you can use rewrite ←. Try - making this change in the above proof and see what difference it - makes in Coq's behavior.) -
- -

Exercise: 1 star (plus_id_exercise)

- Remove "Admitted." and fill in the proof. -
-
- -
-Theorem plus_id_exercise : ∀n m o : nat,
-  n = m → m = o → n + m = m + o.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - As we've seen in earlier examples, the Admitted command - tells Coq that we want to skip trying to prove this theorem and - just accept it as a given. This can be useful for developing - longer proofs, since we can state subsidiary facts that we believe - will be useful for making some larger argument, use Admitted to - accept them on faith for the moment, and continue thinking about - the larger argument until we are sure it makes sense; then we can - go back and fill in the proofs we skipped. Be careful, though: - every time you say Admitted (or admit) you are leaving a door - open for total nonsense to enter Coq's nice, rigorous, formally - checked world! -
- - We can also use the rewrite tactic with a previously proved - theorem instead of a hypothesis from the context. -
-
- -
-Theorem mult_0_plus : ∀n m : nat,
-  (0 + n) × m = n × m.
-Proof.
-  intros n m.
-  rewrite → plus_O_n.
-  reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (mult_S_1)

- -
-
-Theorem mult_S_1 : ∀n m : nat,
-  m = S n →
-  m × (1 + n) = m × m.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Proof by Case Analysis

- -
- - Of course, not everything can be proved by simple - calculation: In general, unknown, hypothetical values (arbitrary - numbers, booleans, lists, etc.) can block the calculation. - For example, if we try to prove the following fact using the - simpl tactic as above, we get stuck. -
-
- -
-Theorem plus_1_neq_0_firsttry : ∀n : nat,
-  beq_nat (n + 1) 0 = false.
-Proof.
-  intros n.
-  simpl. (* does nothing! *)
-Abort.
- -
-
- -
-The reason for this is that the definitions of both - beq_nat and + begin by performing a match on their first - argument. But here, the first argument to + is the unknown - number n and the argument to beq_nat is the compound - expression n + 1; neither can be simplified. - -
- - What we need is to be able to consider the possible forms of n - separately. If n is O, then we can calculate the final result - of beq_nat (n + 1) 0 and check that it is, indeed, false. - And if n = S n' for some n', then, although we don't know - exactly what number n + 1 yields, we can calculate that, at - least, it will begin with one S, and this is enough to calculate - that, again, beq_nat (n + 1) 0 will yield false. - -
- - The tactic that tells Coq to consider, separately, the cases where - n = O and where n = S n' is called destruct. -
-
- -
-Theorem plus_1_neq_0 : ∀n : nat,
-  beq_nat (n + 1) 0 = false.
-Proof.
-  intros n. destruct n as [| n'].
-    reflexivity.
-    reflexivity. Qed.
- -
-
- -
-The destruct generates two subgoals, which we must then - prove, separately, in order to get Coq to accept the theorem as - proved. (No special command is needed for moving from one subgoal - to the other. When the first subgoal has been proved, it just - disappears and we are left with the other "in focus.") In this - proof, each of the subgoals is easily proved by a single use of - reflexivity. - -
- - The annotation "as [| n']" is called an intro pattern. It - tells Coq what variable names to introduce in each subgoal. In - general, what goes between the square brackets is a list of - lists of names, separated by |. Here, the first component is - empty, since the O constructor is nullary (it doesn't carry any - data). The second component gives a single name, n', since S - is a unary constructor. - -
- - The destruct tactic can be used with any inductively defined - datatype. For example, we use it here to prove that boolean - negation is involutive — i.e., that negation is its own - inverse. -
-
- -
-Theorem negb_involutive : ∀b : bool,
-  negb (negb b) = b.
-Proof.
-  intros b. destruct b.
-    reflexivity.
-    reflexivity. Qed.
- -
-
- -
-Note that the destruct here has no as clause because - none of the subcases of the destruct need to bind any variables, - so there is no need to specify any names. (We could also have - written as [|], or as [].) In fact, we can omit the as - clause from any destruct and Coq will fill in variable names - automatically. Although this is convenient, it is arguably bad - style, since Coq often makes confusing choices of names when left - to its own devices. -
- -

Exercise: 1 star (zero_nbeq_plus_1)

- -
-
-Theorem zero_nbeq_plus_1 : ∀n : nat,
-  beq_nat 0 (n + 1) = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

More Exercises

- -
- -

Exercise: 2 stars (boolean functions)

- Use the tactics you have learned so far to prove the following - theorem about boolean functions. -
-
- -
-Theorem identity_fn_applied_twice :
-  ∀(f : bool → bool),
-  (∀(x : bool), f x = x) →
-  ∀(b : bool), f (f b) = b.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Now state and prove a theorem negation_fn_applied_twice similar - to the previous one but where the second hypothesis says that the - function f has the property that f x = negb x. -
-
- -
-(* FILL IN HERE *)
- -
-
- -
-

Exercise: 2 stars (andb_eq_orb)

- Prove the following theorem. (You may want to first prove a - subsidiary lemma or two. Alternatively, remember that you do - not have to introduce all hypotheses at the same time.) -
-
- -
-Theorem andb_eq_orb :
-  ∀(b c : bool),
-  (andb b c = orb b c) →
-  b = c.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 3 stars (binary)

- Consider a different, more efficient representation of natural - numbers using a binary rather than unary system. That is, instead - of saying that each natural number is either zero or the successor - of a natural number, we can say that each binary number is either - -
- -
    -
  • zero, - -
    • -
  • twice a binary number, or - -
    • -
  • one more than twice a binary number. - -
    • -
- -
- - (a) First, write an inductive definition of the type bin - corresponding to this description of binary numbers. - -
- - (Hint: Recall that the definition of nat from class, - -
- -
-    Inductive nat : Type :=
-      | O : nat
-      | S : nat → nat. -
- -
- says nothing about what O and S "mean." It just says "O is - in the set called nat, and if n is in the set then so is S - n." The interpretation of O as zero and S as successor/plus - one comes from the way that we use nat values, by writing - functions to do things with them, proving things about them, and - so on. Your definition of bin should be correspondingly simple; - it is the functions you will write next that will give it - mathematical meaning.) - -
- - (b) Next, write an increment function for binary numbers, and a - function to convert binary numbers to unary numbers. - -
- - (c) Write some unit tests for your increment and binary-to-unary - functions. Notice that incrementing a binary number and - then converting it to unary should yield the same result as first - converting it to unary and then incrementing. - -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Optional Material

- -
- -

More on Notation

- -
-
- -
-Notation "x + y" := (plus x y)
-                       (at level 50, left associativity)
-                       : nat_scope.
-Notation "x × y" := (mult x y)
-                       (at level 40, left associativity)
-                       : nat_scope.
- -
-
- -
-For each notation-symbol in Coq we can specify its precedence level - and its associativity. The precedence level n can be specified by the - keywords at level n and it is helpful to disambiguate - expressions containing different symbols. The associativity is helpful - to disambiguate expressions containing more occurrences of the same - symbol. For example, the parameters specified above for + and × - say that the expression 1+2×3×4 is a shorthand for the expression - (1+((2×3)×4)). Coq uses precedence levels from 0 to 100, and - left, right, or no associativity. - -
- - Each notation-symbol in Coq is also active in a notation scope. - Coq tries to guess what scope you mean, so when you write S(O×O) - it guesses nat_scope, but when you write the cartesian - product (tuple) type bool×bool it guesses type_scope. - Occasionally you have to help it out with percent-notation by - writing (x×y)%nat, and sometimes in Coq's feedback to you it - will use %nat to indicate what scope a notation is in. - -
- - Notation scopes also apply to numeral notation (3,4,5, etc.), so you - may sometimes see 0%nat which means O, or 0%Z which means the - Integer zero. - -
- -

Fixpoints and Structural Recursion

- -
-
- -
-Fixpoint plus' (n : nat) (m : nat) : nat :=
-  match n with
-    | O ⇒ m
-    | S n' ⇒ S (plus' n' m)
-  end.
- -
-
- -
-When Coq checks this definition, it notes that plus' is - "decreasing on 1st argument." What this means is that we are - performing a structural recursion over the argument n — i.e., - that we make recursive calls only on strictly smaller values of - n. This implies that all calls to plus' will eventually - terminate. Coq demands that some argument of every Fixpoint - definition is "decreasing". - -
- - This requirement is a fundamental feature of Coq's design: In - particular, it guarantees that every function that can be defined - in Coq will terminate on all inputs. However, because Coq's - "decreasing analysis" is not very sophisticated, it is sometimes - necessary to write functions in slightly unnatural ways. -
- -

Exercise: 2 stars, optional (decreasing)

- To get a concrete sense of this, find a way to write a sensible - Fixpoint definition (of a simple function on numbers, say) that - does terminate on all inputs, but that Coq will not accept - because of this restriction. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-(* $Date: 2013-12-03 07:45:41 -0500 (Tue, 03 Dec 2013) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Basics.v b/Basics.v deleted file mode 100644 index 2fc2a68..0000000 --- a/Basics.v +++ /dev/null @@ -1,967 +0,0 @@ -(** * Basics: Functional Programming in Coq *) - -(* - [Admitted] is Coq's "escape hatch" that says accept this definition - without proof. We use it to mark the 'holes' in the development - that should be completed as part of your homework exercises. In - practice, [Admitted] is useful when you're incrementally developing - large proofs. - - As of Coq 8.4 [admit] is in the standard library, but we include - it here for backwards compatibility. -*) -Definition admit {T: Type} : T. Admitted. - -(* ###################################################################### *) -(** * Introduction *) - -(** The functional programming style brings programming closer to - mathematics: If a procedure or method has no side effects, then - pretty much all you need to understand about it is how it maps - inputs to outputs -- that is, you can think of its behavior as - just computing a mathematical function. This is one reason for - the word "functional" in "functional programming." This direct - connection between programs and simple mathematical objects - supports both sound informal reasoning and formal proofs of - correctness. - - The other sense in which functional programming is "functional" is - that it emphasizes the use of functions (or methods) as - _first-class_ values -- i.e., values that can be passed as - arguments to other functions, returned as results, stored in data - structures, etc. The recognition that functions can be treated as - data in this way enables a host of useful idioms, as we will see. - - Other common features of functional languages include _algebraic - data types_ and _pattern matching_, which make it easy to construct - and manipulate rich data structures, and sophisticated - _polymorphic type systems_ that support abstraction and code - reuse. Coq shares all of these features. -*) - - -(* ###################################################################### *) -(** * Enumerated Types *) - -(** One unusual aspect of Coq is that its set of built-in - features is _extremely_ small. For example, instead of providing - the usual palette of atomic data types (booleans, integers, - strings, etc.), Coq offers an extremely powerful mechanism for - defining new data types from scratch -- so powerful that all these - familiar types arise as instances. - - Naturally, the Coq distribution comes with an extensive standard - library providing definitions of booleans, numbers, and many - common data structures like lists and hash tables. But there is - nothing magic or primitive about these library definitions: they - are ordinary user code. - - To see how this works, let's start with a very simple example. *) - -(* ###################################################################### *) -(** ** Days of the Week *) - -(** The following declaration tells Coq that we are defining - a new set of data values -- a _type_. *) - -Inductive day : Type := - | monday : day - | tuesday : day - | wednesday : day - | thursday : day - | friday : day - | saturday : day - | sunday : day. - -(** The type is called [day], and its members are [monday], - [tuesday], etc. The second through eighth lines of the definition - can be read "[monday] is a [day], [tuesday] is a [day], etc." - - Having defined [day], we can write functions that operate on - days. *) - -Definition next_weekday (d:day) : day := - match d with - | monday => tuesday - | tuesday => wednesday - | wednesday => thursday - | thursday => friday - | friday => monday - | saturday => monday - | sunday => monday - end. - -(** One thing to note is that the argument and return types of - this function are explicitly declared. Like most functional - programming languages, Coq can often work out these types even if - they are not given explicitly -- i.e., it performs some _type - inference_ -- but we'll always include them to make reading - easier. *) - -(** Having defined a function, we should check that it works on - some examples. There are actually three different ways to do this - in Coq. First, we can use the command [Eval compute] to evaluate a - compound expression involving [next_weekday]. *) - -Eval compute in (next_weekday friday). - (* ==> monday : day *) -Eval compute in (next_weekday (next_weekday saturday)). - (* ==> tuesday : day *) - -(** If you have a computer handy, now would be an excellent - moment to fire up the Coq interpreter under your favorite IDE -- - either CoqIde or Proof General -- and try this for yourself. Load - this file ([Basics.v]) from the book's accompanying Coq sources, - find the above example, submit it to Coq, and observe the - result. *) - -(** The keyword [compute] tells Coq precisely how to - evaluate the expression we give it. For the moment, [compute] is - the only one we'll need; later on we'll see some alternatives that - are sometimes useful. *) - -(** Second, we can record what we _expect_ the result to be in - the form of a Coq example: *) - -Example test_next_weekday: - (next_weekday (next_weekday saturday)) = tuesday. - -(** This declaration does two things: it makes an - assertion (that the second weekday after [saturday] is [tuesday]), - and it gives the assertion a name that can be used to refer to it - later. *) -(** Having made the assertion, we can also ask Coq to verify it, - like this: *) - -Proof. simpl. reflexivity. Qed. - - -(** The details are not important for now (we'll come back to - them in a bit), but essentially this can be read as "The assertion - we've just made can be proved by observing that both sides of the - equality evaluate to the same thing, after some simplification." *) - -(** Third, we can ask Coq to "extract," from a [Definition], a - program in some other, more conventional, programming - language (OCaml, Scheme, or Haskell) with a high-performance - compiler. This facility is very interesting, since it gives us a - way to construct _fully certified_ programs in mainstream - languages. Indeed, this is one of the main uses for which Coq was - developed. We'll come back to this topic in later chapters. - More information can also be found in the Coq'Art book by Bertot - and Casteran, as well as the Coq reference manual. *) - - -(* ###################################################################### *) -(** ** Booleans *) - -(** In a similar way, we can define the type [bool] of booleans, - with members [true] and [false]. *) - -Inductive bool : Type := - | true : bool - | false : bool. - -(** Although we are rolling our own booleans here for the sake - of building up everything from scratch, Coq does, of course, - provide a default implementation of the booleans in its standard - library, together with a multitude of useful functions and - lemmas. (Take a look at [Coq.Init.Datatypes] in the Coq library - documentation if you're interested.) Whenever possible, we'll - name our own definitions and theorems so that they exactly - coincide with the ones in the standard library. *) - -(** Functions over booleans can be defined in the same way as - above: *) - -Definition negb (b:bool) : bool := - match b with - | true => false - | false => true - end. - -Definition andb (b1:bool) (b2:bool) : bool := - match b1 with - | true => b2 - | false => false - end. - -Definition orb (b1:bool) (b2:bool) : bool := - match b1 with - | true => true - | false => b2 - end. - -(** The last two illustrate the syntax for multi-argument - function definitions. *) - -(** The following four "unit tests" constitute a complete - specification -- a truth table -- for the [orb] function: *) - -Example test_orb1: (orb true false) = true. -Proof. reflexivity. Qed. -Example test_orb2: (orb false false) = false. -Proof. reflexivity. Qed. -Example test_orb3: (orb false true) = true. -Proof. reflexivity. Qed. -Example test_orb4: (orb true true) = true. -Proof. reflexivity. Qed. - -(** (Note that we've dropped the [simpl] in the proofs. It's not - actually needed because [reflexivity] will automatically perform - simplification.) *) - -(** _A note on notation_: We use square brackets to delimit - fragments of Coq code in comments in .v files; this convention, - also used by the [coqdoc] documentation tool, keeps them visually - separate from the surrounding text. In the html version of the - files, these pieces of text appear in a [different font]. *) - -(** The values [Admitted] and [admit] can be used to fill - a hole in an incomplete definition or proof. We'll use them in the - following exercises. In general, your job in the exercises is - to replace [admit] or [Admitted] with real definitions or proofs. *) - -(** **** Exercise: 1 star (nandb) *) -(** Complete the definition of the following function, then make - sure that the [Example] assertions below can each be verified by - Coq. *) - -(** This function should return [true] if either or both of - its inputs are [false]. *) - -Definition nandb (b1:bool) (b2:bool) : bool := - (* FILL IN HERE *) admit. - -(** Remove "[Admitted.]" and fill in each proof with - "[Proof. reflexivity. Qed.]" *) - -Example test_nandb1: (nandb true false) = true. -(* FILL IN HERE *) Admitted. -Example test_nandb2: (nandb false false) = true. -(* FILL IN HERE *) Admitted. -Example test_nandb3: (nandb false true) = true. -(* FILL IN HERE *) Admitted. -Example test_nandb4: (nandb true true) = false. -(* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star (andb3) *) -(** Do the same for the [andb3] function below. This function should - return [true] when all of its inputs are [true], and [false] - otherwise. *) - -Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool := - (* FILL IN HERE *) admit. - -Example test_andb31: (andb3 true true true) = true. -(* FILL IN HERE *) Admitted. -Example test_andb32: (andb3 false true true) = false. -(* FILL IN HERE *) Admitted. -Example test_andb33: (andb3 true false true) = false. -(* FILL IN HERE *) Admitted. -Example test_andb34: (andb3 true true false) = false. -(* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** ** Function Types *) - -(** The [Check] command causes Coq to print the type of an - expression. For example, the type of [negb true] is [bool]. *) - -Check true. -(* ===> true : bool *) -Check (negb true). -(* ===> negb true : bool *) - -(** Functions like [negb] itself are also data values, just like - [true] and [false]. Their types are called _function types_, and - they are written with arrows. *) - -Check negb. -(* ===> negb : bool -> bool *) - -(** The type of [negb], written [bool -> bool] and pronounced - "[bool] arrow [bool]," can be read, "Given an input of type - [bool], this function produces an output of type [bool]." - Similarly, the type of [andb], written [bool -> bool -> bool], can - be read, "Given two inputs, both of type [bool], this function - produces an output of type [bool]." *) - -(* ###################################################################### *) -(** ** Numbers *) - -(** _Technical digression_: Coq provides a fairly sophisticated - _module system_, to aid in organizing large developments. In this - course we won't need most of its features, but one is useful: If - we enclose a collection of declarations between [Module X] and - [End X] markers, then, in the remainder of the file after the - [End], these definitions will be referred to by names like [X.foo] - instead of just [foo]. Here, we use this feature to introduce the - definition of the type [nat] in an inner module so that it does - not shadow the one from the standard library. *) - -Module Playground1. - -(** The types we have defined so far are examples of "enumerated - types": their definitions explicitly enumerate a finite set of - elements. A more interesting way of defining a type is to give a - collection of "inductive rules" describing its elements. For - example, we can define the natural numbers as follows: *) - -Inductive nat : Type := - | O : nat - | S : nat -> nat. - -(** The clauses of this definition can be read: - - [O] is a natural number (note that this is the letter "[O]," not - the numeral "[0]"). - - [S] is a "constructor" that takes a natural number and yields - another one -- that is, if [n] is a natural number, then [S n] - is too. - - Let's look at this in a little more detail. - - Every inductively defined set ([day], [nat], [bool], etc.) is - actually a set of _expressions_. The definition of [nat] says how - expressions in the set [nat] can be constructed: - - - the expression [O] belongs to the set [nat]; - - if [n] is an expression belonging to the set [nat], then [S n] - is also an expression belonging to the set [nat]; and - - expressions formed in these two ways are the only ones belonging - to the set [nat]. - - The same rules apply for our definitions of [day] and [bool]. The - annotations we used for their constructors are analogous to the - one for the [O] constructor, and indicate that each of those - constructors doesn't take any arguments. *) - -(** These three conditions are the precise force of the - [Inductive] declaration. They imply that the expression [O], the - expression [S O], the expression [S (S O)], the expression - [S (S (S O))], and so on all belong to the set [nat], while other - expressions like [true], [andb true false], and [S (S false)] do - not. - - We can write simple functions that pattern match on natural - numbers just as we did above -- for example, the predecessor - function: *) - -Definition pred (n : nat) : nat := - match n with - | O => O - | S n' => n' - end. - -(** The second branch can be read: "if [n] has the form [S n'] - for some [n'], then return [n']." *) - -End Playground1. - -Definition minustwo (n : nat) : nat := - match n with - | O => O - | S O => O - | S (S n') => n' - end. - -(** Because natural numbers are such a pervasive form of data, - Coq provides a tiny bit of built-in magic for parsing and printing - them: ordinary arabic numerals can be used as an alternative to - the "unary" notation defined by the constructors [S] and [O]. Coq - prints numbers in arabic form by default: *) - -Check (S (S (S (S O)))). -Eval compute in (minustwo 4). - -(** The constructor [S] has the type [nat -> nat], just like the - functions [minustwo] and [pred]: *) - -Check S. -Check pred. -Check minustwo. - -(** These are all things that can be applied to a number to yield a - number. However, there is a fundamental difference: functions - like [pred] and [minustwo] come with _computation rules_ -- e.g., - the definition of [pred] says that [pred 2] can be simplified to - [1] -- while the definition of [S] has no such behavior attached. - Although it is like a function in the sense that it can be applied - to an argument, it does not _do_ anything at all! *) - -(** For most function definitions over numbers, pure pattern - matching is not enough: we also need recursion. For example, to - check that a number [n] is even, we may need to recursively check - whether [n-2] is even. To write such functions, we use the - keyword [Fixpoint]. *) - -Fixpoint evenb (n:nat) : bool := - match n with - | O => true - | S O => false - | S (S n') => evenb n' - end. - -(** We can define [oddb] by a similar [Fixpoint] declaration, but here - is a simpler definition that will be a bit easier to work with: *) - -Definition oddb (n:nat) : bool := negb (evenb n). - -Example test_oddb1: (oddb (S O)) = true. -Proof. reflexivity. Qed. -Example test_oddb2: (oddb (S (S (S (S O))))) = false. -Proof. reflexivity. Qed. - -(** Naturally, we can also define multi-argument functions by - recursion. (Once again, we use a module to avoid polluting the - namespace.) *) - -Module Playground2. - -Fixpoint plus (n : nat) (m : nat) : nat := - match n with - | O => m - | S n' => S (plus n' m) - end. - -(** Adding three to two now gives us five, as we'd expect. *) - -Eval compute in (plus (S (S (S O))) (S (S O))). - -(** The simplification that Coq performs to reach this conclusion can - be visualized as follows: *) - -(* [plus (S (S (S O))) (S (S O))] -==> [S (plus (S (S O)) (S (S O)))] by the second clause of the [match] -==> [S (S (plus (S O) (S (S O))))] by the second clause of the [match] -==> [S (S (S (plus O (S (S O)))))] by the second clause of the [match] -==> [S (S (S (S (S O))))] by the first clause of the [match] -*) - -(** As a notational convenience, if two or more arguments have - the same type, they can be written together. In the following - definition, [(n m : nat)] means just the same as if we had written - [(n : nat) (m : nat)]. *) - -Fixpoint mult (n m : nat) : nat := - match n with - | O => O - | S n' => plus m (mult n' m) - end. - -Example test_mult1: (mult 3 3) = 9. -Proof. reflexivity. Qed. - -(** You can match two expressions at once by putting a comma - between them: *) - -Fixpoint minus (n m:nat) : nat := - match n, m with - | O , _ => O - | S _ , O => n - | S n', S m' => minus n' m' - end. - -(** The _ in the first line is a _wildcard pattern_. Writing _ in a - pattern is the same as writing some variable that doesn't get used - on the right-hand side. This avoids the need to invent a bogus - variable name. *) - -End Playground2. - -Fixpoint exp (base power : nat) : nat := - match power with - | O => S O - | S p => mult base (exp base p) - end. - -(** **** Exercise: 1 star (factorial) *) -(** Recall the standard factorial function: -<< - factorial(0) = 1 - factorial(n) = n * factorial(n-1) (if n>0) ->> - Translate this into Coq. *) - -Fixpoint factorial (n:nat) : nat := -(* FILL IN HERE *) admit. - -Example test_factorial1: (factorial 3) = 6. -(* FILL IN HERE *) Admitted. -Example test_factorial2: (factorial 5) = (mult 10 12). -(* FILL IN HERE *) Admitted. -(** [] *) - -(** We can make numerical expressions a little easier to read and - write by introducing "notations" for addition, multiplication, and - subtraction. *) - -Notation "x + y" := (plus x y) - (at level 50, left associativity) - : nat_scope. -Notation "x - y" := (minus x y) - (at level 50, left associativity) - : nat_scope. -Notation "x * y" := (mult x y) - (at level 40, left associativity) - : nat_scope. - -Check ((0 + 1) + 1). - -(** (The [level], [associativity], and [nat_scope] annotations - control how these notations are treated by Coq's parser. The - details are not important, but interested readers can refer to the - "More on Notation" subsection in the "Optional Material" section at - the end of this chapter.) *) - -(** Note that these do not change the definitions we've already - made: they are simply instructions to the Coq parser to accept [x - + y] in place of [plus x y] and, conversely, to the Coq - pretty-printer to display [plus x y] as [x + y]. *) - -(** When we say that Coq comes with nothing built-in, we really - mean it: even equality testing for numbers is a user-defined - operation! *) -(** The [beq_nat] function tests [nat]ural numbers for [eq]uality, - yielding a [b]oolean. Note the use of nested [match]es (we could - also have used a simultaneous match, as we did in [minus].) *) - -Fixpoint beq_nat (n m : nat) : bool := - match n with - | O => match m with - | O => true - | S m' => false - end - | S n' => match m with - | O => false - | S m' => beq_nat n' m' - end - end. - -(** Similarly, the [ble_nat] function tests [nat]ural numbers for - [l]ess-or-[e]qual, yielding a [b]oolean. *) - -Fixpoint ble_nat (n m : nat) : bool := - match n with - | O => true - | S n' => - match m with - | O => false - | S m' => ble_nat n' m' - end - end. - -Example test_ble_nat1: (ble_nat 2 2) = true. -Proof. reflexivity. Qed. -Example test_ble_nat2: (ble_nat 2 4) = true. -Proof. reflexivity. Qed. -Example test_ble_nat3: (ble_nat 4 2) = false. -Proof. reflexivity. Qed. - -(** **** Exercise: 2 stars (blt_nat) *) -(** The [blt_nat] function tests [nat]ural numbers for [l]ess-[t]han, - yielding a [b]oolean. Instead of making up a new [Fixpoint] for - this one, define it in terms of a previously defined function. - - Note: If you have trouble with the [simpl] tactic, try using - [compute], which is like [simpl] on steroids. However, there is a - simple, elegant solution for which [simpl] suffices. *) - -Definition blt_nat (n m : nat) : bool := - (* FILL IN HERE *) admit. - -Example test_blt_nat1: (blt_nat 2 2) = false. -(* FILL IN HERE *) Admitted. -Example test_blt_nat2: (blt_nat 2 4) = true. -(* FILL IN HERE *) Admitted. -Example test_blt_nat3: (blt_nat 4 2) = false. -(* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** * Proof by Simplification *) - -(** Now that we've defined a few datatypes and functions, let's - turn to the question of how to state and prove properties of their - behavior. Actually, in a sense, we've already started doing this: - each [Example] in the previous sections makes a precise claim - about the behavior of some function on some particular inputs. - The proofs of these claims were always the same: use [reflexivity] - to check that both sides of the [=] simplify to identical values. - - (By the way, it will be useful later to know that - [reflexivity] actually does somewhat more simplification than [simpl] - does -- for example, it tries "unfolding" defined terms, replacing them with - their right-hand sides. The reason for this difference is that, - when reflexivity succeeds, the whole goal is finished and we don't - need to look at whatever expanded expressions [reflexivity] has - found; by contrast, [simpl] is used in situations where we may - have to read and understand the new goal, so we would not want it - blindly expanding definitions.) - - The same sort of "proof by simplification" can be used to prove - more interesting properties as well. For example, the fact that - [0] is a "neutral element" for [+] on the left can be proved - just by observing that [0 + n] reduces to [n] no matter what - [n] is, a fact that can be read directly off the definition of [plus].*) - -Theorem plus_O_n : forall n : nat, 0 + n = n. -Proof. - intros n. reflexivity. Qed. - - -(** (_Note_: You may notice that the above statement looks - different in the original source file and the final html output. In Coq - files, we write the [forall] universal quantifier using the - "_forall_" reserved identifier. This gets printed as an - upside-down "A", the familiar symbol used in logic.) *) - -(** The form of this theorem and proof are almost exactly the - same as the examples above; there are just a few differences. - - First, we've used the keyword [Theorem] instead of - [Example]. Indeed, the difference is purely a matter of - style; the keywords [Example] and [Theorem] (and a few others, - including [Lemma], [Fact], and [Remark]) mean exactly the same - thing to Coq. - - Secondly, we've added the quantifier [forall n:nat], so that our - theorem talks about _all_ natural numbers [n]. In order to prove - theorems of this form, we need to to be able to reason by - _assuming_ the existence of an arbitrary natural number [n]. This - is achieved in the proof by [intros n], which moves the quantifier - from the goal to a "context" of current assumptions. In effect, we - start the proof by saying "OK, suppose [n] is some arbitrary number." - - The keywords [intros], [simpl], and [reflexivity] are examples of - _tactics_. A tactic is a command that is used between [Proof] and - [Qed] to tell Coq how it should check the correctness of some - claim we are making. We will see several more tactics in the rest - of this lecture, and yet more in future lectures. *) - - -(** Step through these proofs in Coq and notice how the goal and - context change. *) - -Theorem plus_1_l : forall n:nat, 1 + n = S n. -Proof. - intros n. reflexivity. Qed. - -Theorem mult_0_l : forall n:nat, 0 * n = 0. -Proof. - intros n. reflexivity. Qed. - -(** The [_l] suffix in the names of these theorems is - pronounced "on the left." *) - - -(* ###################################################################### *) -(** * Proof by Rewriting *) - -(** Here is a slightly more interesting theorem: *) - -Theorem plus_id_example : forall n m:nat, - n = m -> - n + n = m + m. - -(** Instead of making a completely universal claim about all numbers - [n] and [m], this theorem talks about a more specialized property - that only holds when [n = m]. The arrow symbol is pronounced - "implies." - - As before, we need to be able to reason by assuming the existence - of some numbers [n] and [m]. We also need to assume the hypothesis - [n = m]. The [intros] tactic will serve to move all three of these - from the goal into assumptions in the current context. - - Since [n] and [m] are arbitrary numbers, we can't just use - simplification to prove this theorem. Instead, we prove it by - observing that, if we are assuming [n = m], then we can replace - [n] with [m] in the goal statement and obtain an equality with the - same expression on both sides. The tactic that tells Coq to - perform this replacement is called [rewrite]. *) - -Proof. - intros n m. (* move both quantifiers into the context *) - intros H. (* move the hypothesis into the context *) - rewrite -> H. (* Rewrite the goal using the hypothesis *) - reflexivity. Qed. - -(** The first line of the proof moves the universally quantified - variables [n] and [m] into the context. The second moves the - hypothesis [n = m] into the context and gives it the (arbitrary) - name [H]. The third tells Coq to rewrite the current goal ([n + n - = m + m]) by replacing the left side of the equality hypothesis - [H] with the right side. - - (The arrow symbol in the [rewrite] has nothing to do with - implication: it tells Coq to apply the rewrite from left to right. - To rewrite from right to left, you can use [rewrite <-]. Try - making this change in the above proof and see what difference it - makes in Coq's behavior.) *) - -(** **** Exercise: 1 star (plus_id_exercise) *) -(** Remove "[Admitted.]" and fill in the proof. *) - -Theorem plus_id_exercise : forall n m o : nat, - n = m -> m = o -> n + m = m + o. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** As we've seen in earlier examples, the [Admitted] command - tells Coq that we want to skip trying to prove this theorem and - just accept it as a given. This can be useful for developing - longer proofs, since we can state subsidiary facts that we believe - will be useful for making some larger argument, use [Admitted] to - accept them on faith for the moment, and continue thinking about - the larger argument until we are sure it makes sense; then we can - go back and fill in the proofs we skipped. Be careful, though: - every time you say [Admitted] (or [admit]) you are leaving a door - open for total nonsense to enter Coq's nice, rigorous, formally - checked world! *) - -(** We can also use the [rewrite] tactic with a previously proved - theorem instead of a hypothesis from the context. *) - -Theorem mult_0_plus : forall n m : nat, - (0 + n) * m = n * m. -Proof. - intros n m. - rewrite -> plus_O_n. - reflexivity. Qed. - -(** **** Exercise: 2 stars (mult_S_1) *) -Theorem mult_S_1 : forall n m : nat, - m = S n -> - m * (1 + n) = m * m. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - -(* ###################################################################### *) -(** * Proof by Case Analysis *) - -(** Of course, not everything can be proved by simple - calculation: In general, unknown, hypothetical values (arbitrary - numbers, booleans, lists, etc.) can block the calculation. - For example, if we try to prove the following fact using the - [simpl] tactic as above, we get stuck. *) - -Theorem plus_1_neq_0_firsttry : forall n : nat, - beq_nat (n + 1) 0 = false. -Proof. - intros n. - simpl. (* does nothing! *) -Abort. - -(** The reason for this is that the definitions of both - [beq_nat] and [+] begin by performing a [match] on their first - argument. But here, the first argument to [+] is the unknown - number [n] and the argument to [beq_nat] is the compound - expression [n + 1]; neither can be simplified. - - What we need is to be able to consider the possible forms of [n] - separately. If [n] is [O], then we can calculate the final result - of [beq_nat (n + 1) 0] and check that it is, indeed, [false]. - And if [n = S n'] for some [n'], then, although we don't know - exactly what number [n + 1] yields, we can calculate that, at - least, it will begin with one [S], and this is enough to calculate - that, again, [beq_nat (n + 1) 0] will yield [false]. - - The tactic that tells Coq to consider, separately, the cases where - [n = O] and where [n = S n'] is called [destruct]. *) - -Theorem plus_1_neq_0 : forall n : nat, - beq_nat (n + 1) 0 = false. -Proof. - intros n. destruct n as [| n']. - reflexivity. - reflexivity. Qed. - -(** The [destruct] generates _two_ subgoals, which we must then - prove, separately, in order to get Coq to accept the theorem as - proved. (No special command is needed for moving from one subgoal - to the other. When the first subgoal has been proved, it just - disappears and we are left with the other "in focus.") In this - proof, each of the subgoals is easily proved by a single use of - [reflexivity]. - - The annotation "[as [| n']]" is called an _intro pattern_. It - tells Coq what variable names to introduce in each subgoal. In - general, what goes between the square brackets is a _list_ of - lists of names, separated by [|]. Here, the first component is - empty, since the [O] constructor is nullary (it doesn't carry any - data). The second component gives a single name, [n'], since [S] - is a unary constructor. - - The [destruct] tactic can be used with any inductively defined - datatype. For example, we use it here to prove that boolean - negation is involutive -- i.e., that negation is its own - inverse. *) - -Theorem negb_involutive : forall b : bool, - negb (negb b) = b. -Proof. - intros b. destruct b. - reflexivity. - reflexivity. Qed. - -(** Note that the [destruct] here has no [as] clause because - none of the subcases of the [destruct] need to bind any variables, - so there is no need to specify any names. (We could also have - written [as [|]], or [as []].) In fact, we can omit the [as] - clause from _any_ [destruct] and Coq will fill in variable names - automatically. Although this is convenient, it is arguably bad - style, since Coq often makes confusing choices of names when left - to its own devices. *) - -(** **** Exercise: 1 star (zero_nbeq_plus_1) *) -Theorem zero_nbeq_plus_1 : forall n : nat, - beq_nat 0 (n + 1) = false. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** * More Exercises *) - -(** **** Exercise: 2 stars (boolean functions) *) -(** Use the tactics you have learned so far to prove the following - theorem about boolean functions. *) - -Theorem identity_fn_applied_twice : - forall (f : bool -> bool), - (forall (x : bool), f x = x) -> - forall (b : bool), f (f b) = b. -Proof. - (* FILL IN HERE *) Admitted. - -(** Now state and prove a theorem [negation_fn_applied_twice] similar - to the previous one but where the second hypothesis says that the - function [f] has the property that [f x = negb x].*) - -(* FILL IN HERE *) - -(** **** Exercise: 2 stars (andb_eq_orb) *) -(** Prove the following theorem. (You may want to first prove a - subsidiary lemma or two. Alternatively, remember that you do - not have to introduce all hypotheses at the same time.) *) - -Theorem andb_eq_orb : - forall (b c : bool), - (andb b c = orb b c) -> - b = c. -Proof. - (* FILL IN HERE *) Admitted. - -(** **** Exercise: 3 stars (binary) *) -(** Consider a different, more efficient representation of natural - numbers using a binary rather than unary system. That is, instead - of saying that each natural number is either zero or the successor - of a natural number, we can say that each binary number is either - - - zero, - - twice a binary number, or - - one more than twice a binary number. - - (a) First, write an inductive definition of the type [bin] - corresponding to this description of binary numbers. - - (Hint: Recall that the definition of [nat] from class, - Inductive nat : Type := - | O : nat - | S : nat -> nat. - says nothing about what [O] and [S] "mean." It just says "[O] is - in the set called [nat], and if [n] is in the set then so is [S - n]." The interpretation of [O] as zero and [S] as successor/plus - one comes from the way that we _use_ [nat] values, by writing - functions to do things with them, proving things about them, and - so on. Your definition of [bin] should be correspondingly simple; - it is the functions you will write next that will give it - mathematical meaning.) - - (b) Next, write an increment function for binary numbers, and a - function to convert binary numbers to unary numbers. - - (c) Write some unit tests for your increment and binary-to-unary - functions. Notice that incrementing a binary number and - then converting it to unary should yield the same result as first - converting it to unary and then incrementing. -*) - -(* FILL IN HERE *) -(** [] *) - -(* ###################################################################### *) -(** * Optional Material *) - -(** ** More on Notation *) - -Notation "x + y" := (plus x y) - (at level 50, left associativity) - : nat_scope. -Notation "x * y" := (mult x y) - (at level 40, left associativity) - : nat_scope. - -(** For each notation-symbol in Coq we can specify its _precedence level_ - and its _associativity_. The precedence level n can be specified by the - keywords [at level n] and it is helpful to disambiguate - expressions containing different symbols. The associativity is helpful - to disambiguate expressions containing more occurrences of the same - symbol. For example, the parameters specified above for [+] and [*] - say that the expression [1+2*3*4] is a shorthand for the expression - [(1+((2*3)*4))]. Coq uses precedence levels from 0 to 100, and - _left_, _right_, or _no_ associativity. - - Each notation-symbol in Coq is also active in a _notation scope_. - Coq tries to guess what scope you mean, so when you write [S(O*O)] - it guesses [nat_scope], but when you write the cartesian - product (tuple) type [bool*bool] it guesses [type_scope]. - Occasionally you have to help it out with percent-notation by - writing [(x*y)%nat], and sometimes in Coq's feedback to you it - will use [%nat] to indicate what scope a notation is in. - - Notation scopes also apply to numeral notation (3,4,5, etc.), so you - may sometimes see [0%nat] which means [O], or [0%Z] which means the - Integer zero. -*) - -(** ** [Fixpoint]s and Structural Recursion *) - -Fixpoint plus' (n : nat) (m : nat) : nat := - match n with - | O => m - | S n' => S (plus' n' m) - end. - -(** When Coq checks this definition, it notes that [plus'] is - "decreasing on 1st argument." What this means is that we are - performing a _structural recursion_ over the argument [n] -- i.e., - that we make recursive calls only on strictly smaller values of - [n]. This implies that all calls to [plus'] will eventually - terminate. Coq demands that some argument of _every_ [Fixpoint] - definition is "decreasing". - - This requirement is a fundamental feature of Coq's design: In - particular, it guarantees that every function that can be defined - in Coq will terminate on all inputs. However, because Coq's - "decreasing analysis" is not very sophisticated, it is sometimes - necessary to write functions in slightly unnatural ways. *) - -(** **** Exercise: 2 stars, optional (decreasing) *) -(** To get a concrete sense of this, find a way to write a sensible - [Fixpoint] definition (of a simple function on numbers, say) that - _does_ terminate on all inputs, but that Coq will _not_ accept - because of this restriction. *) - -(* FILL IN HERE *) -(** [] *) - -(* $Date: 2013-12-03 07:45:41 -0500 (Tue, 03 Dec 2013) $ *) - diff --git a/Equiv.html b/Equiv.html deleted file mode 100644 index 49be689..0000000 --- a/Equiv.html +++ /dev/null @@ -1,2911 +0,0 @@ - - - - - -Equiv: Program Equivalence - - - - - - -
- - - -
- -

EquivProgram Equivalence

- -
-
- -
- -
-
- -
-Require Export Imp.
- -
-
- -
-

Some general advice for working on exercises:

- - -
- -
    -
  • Most of the Coq proofs we ask you to do are similar to proofs - that we've provided. Before starting to work on the homework - problems, take the time to work through our proofs (both - informally, on paper, and in Coq) and make sure you understand - them in detail. This will save you a lot of time. - -
    - - -
    • -
  • The Coq proofs we're doing now are sufficiently complicated that - it is more or less impossible to complete them simply by random - experimentation or "following your nose." You need to start - with an idea about why the property is true and how the proof is - going to go. The best way to do this is to write out at least a - sketch of an informal proof on paper — one that intuitively - convinces you of the truth of the theorem — before starting to - work on the formal one. Alternately, grab a friend and try to - convince them that the theorem is true; then try to formalize - your explanation. - -
    - - -
    • -
  • Use automation to save work! Some of the proofs in this - chapter's exercises are pretty long if you try to write out all - the cases explicitly. -
    • -
- -
-
- -
-
- -
-

Behavioral Equivalence

- -
- - In the last chapter, we investigated the correctness of a very - simple program transformation: the optimize_0plus function. The - programming language we were considering was the first version of - the language of arithmetic expressions — with no variables — so - in that setting it was very easy to define what it means for a - program transformation to be correct: it should always yield a - program that evaluates to the same number as the original. - -
- - To go further and talk about the correctness of program - transformations in the full Imp language, we need to consider the - role of variables and state. -
-
- -
-
- -
-

Definitions

- -
- - For aexps and bexps with variables, the definition we want is - clear. We say - that two aexps or bexps are behaviorally equivalent if they - evaluate to the same result in every state. -
-
- -
-Definition aequiv (a1 a2 : aexp) : Prop :=
-  ∀(st:state),
-    aeval st a1 = aeval st a2.
- -
-Definition bequiv (b1 b2 : bexp) : Prop :=
-  ∀(st:state),
-    beval st b1 = beval st b2.
- -
-
- -
-For commands, the situation is a little more subtle. We can't - simply say "two commands are behaviorally equivalent if they - evaluate to the same ending state whenever they are started in the - same initial state," because some commands (in some starting - states) don't terminate in any final state at all! What we need - instead is this: two commands are behaviorally equivalent if, for - any given starting state, they either both diverge or both - terminate in the same final state. A compact way to express this - is "if the first one terminates in a particular state then so does - the second, and vice versa." -
-
- -
-Definition cequiv (c1 c2 : com) : Prop :=
-  ∀(st st' : state),
-    (c1 / st ⇓ st') ↔ (c2 / st ⇓ st').
- -
-
- -
-

Exercise: 2 stars (equiv_classes)

- -
- - Given the following programs, group together those that are - equivalent in Imp. For example, if you think programs (a) - through (h) are all equivalent to each other, but not to (i), your - answer should look like this: {a,b,c,d,e,f,g,h} {i}. - -
- -(a) - -
- -
-    WHILE X > 0 DO
-      X ::= X + 1
-    END -
- -
- -
- -(b) - -
- -
-    IFB X = 0 THEN
-      X ::= X + 1;;
-      Y ::= 1
-    ELSE
-      Y ::= 0
-    FI;;
-    X ::= X - Y;;
-    Y ::= 0 -
- -
- -
- -(c) - -
- -
-    SKIP -
- -
- -
- -(d) - -
- -
-    WHILE X ≠ 0 DO
-      X ::= X × Y + 1
-    END -
- -
- -
- -(e) - -
- -
-    Y ::= 0 -
- -
- -
- -(f) - -
- -
-    Y ::= X + 1;;
-    WHILE X ≠ Y DO
-      Y ::= X + 1
-    END -
- -
- -
- -(g) - -
- -
-    WHILE TRUE DO
-      SKIP
-    END -
- -
- -
- -(h) - -
- -
-    WHILE X ≠ X DO
-      X ::= X + 1
-    END -
- -
- -
- -(i) - -
- -
-    WHILE X ≠ Y DO
-      X ::= Y + 1
-    END -
- -
- -
- -(* FILL IN HERE *)
-☐ -
-
- -
-
- -
-

Examples

- -
- - Here are some simple examples of equivalences of arithmetic - and boolean expressions. -
-
- -
-Theorem aequiv_example:
-  aequiv (AMinus (AId X) (AId X)) (ANum 0).
-
-
-Proof.
-  intros st. simpl. omega.
-Qed.
-
- -
-Theorem bequiv_example:
-  bequiv (BEq (AMinus (AId X) (AId X)) (ANum 0)) BTrue.
-
-
-Proof.
-  intros st. unfold beval.
-  rewrite aequiv_example. reflexivity.
-Qed.
-
- -
-
- -
-For examples of command equivalence, let's start by looking at - some trivial program transformations involving SKIP: -
-
- -
-Theorem skip_left: ∀c,
-  cequiv
-     (SKIP;; c)
-     c.
-Proof.
-  (* WORKED IN CLASS *)
-  intros c st st'.
-  split; intros H.
-  Case "→".
-    inversion H. subst.
-    inversion H2. subst.
-    assumption.
-  Case "←".
-    apply E_Seq with st.
-    apply E_Skip.
-    assumption.
-Qed.
- -
-
- -
-

Exercise: 2 stars (skip_right)

- Prove that adding a SKIP after a command results in an equivalent - program -
-
- -
-Theorem skip_right: ∀c,
-  cequiv
-    (c;; SKIP)
-    c.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Similarly, here is a simple transformations that simplifies IFB - commands: -
-
- -
-Theorem IFB_true_simple: ∀c1 c2,
-  cequiv
-    (IFB BTrue THEN c1 ELSE c2 FI)
-    c1.
-
-
-Proof.
-  intros c1 c2.
-  split; intros H.
-  Case "→".
-    inversion H; subst. assumption. inversion H5.
-  Case "←".
-    apply E_IfTrue. reflexivity. assumption. Qed.
-
- -
-
- -
-Of course, few programmers would be tempted to write a conditional - whose guard is literally BTrue. A more interesting case is when - the guard is equivalent to true: - -
- - Theorem: If b is equivalent to BTrue, then IFB b THEN c1 - ELSE c2 FI is equivalent to c1. -

- -
- - Proof: - -
- -
    -
  • (→) We must show, for all st and st', that if IFB b - THEN c1 ELSE c2 FI / st ⇓ st' then c1 / st ⇓ st'. - -
    - - Proceed by cases on the rules that could possibly have been - used to show IFB b THEN c1 ELSE c2 FI / st ⇓ st', namely - E_IfTrue and E_IfFalse. - -
    - -
      -
    • Suppose the final rule rule in the derivation of IFB b THEN - c1 ELSE c2 FI / st ⇓ st' was E_IfTrue. We then have, by - the premises of E_IfTrue, that c1 / st ⇓ st'. This is - exactly what we set out to prove. - -
      - - -
      • -
    • On the other hand, suppose the final rule in the derivation - of IFB b THEN c1 ELSE c2 FI / st ⇓ st' was E_IfFalse. - We then know that beval st b = false and c2 / st ⇓ st'. - -
      - - Recall that b is equivalent to BTrue, i.e. forall st, - beval st b = beval st BTrue. In particular, this means - that beval st b = true, since beval st BTrue = true. But - this is a contradiction, since E_IfFalse requires that - beval st b = false. Thus, the final rule could not have - been E_IfFalse. - -
      - - -
      • -
    - -
    • -
  • (←) We must show, for all st and st', that if c1 / st - ⇓ st' then IFB b THEN c1 ELSE c2 FI / st ⇓ st'. - -
    - - Since b is equivalent to BTrue, we know that beval st b = - beval st BTrue = true. Together with the assumption that - c1 / st ⇓ st', we can apply E_IfTrue to derive IFB b THEN - c1 ELSE c2 FI / st ⇓ st'. ☐ - -
    • -
- -
- - Here is the formal version of this proof: -
-
- -
-Theorem IFB_true: ∀b c1 c2,
-     bequiv b BTrue →
-     cequiv
-       (IFB b THEN c1 ELSE c2 FI)
-       c1.
-Proof.
-  intros b c1 c2 Hb.
-  split; intros H.
-  Case "→".
-    inversion H; subst.
-    SCase "b evaluates to true".
-      assumption.
-    SCase "b evaluates to false (contradiction)".
-      unfold bequiv in Hb. simpl in Hb.
-      rewrite Hb in H5.
-      inversion H5.
-  Case "←".
-    apply E_IfTrue; try assumption.
-    unfold bequiv in Hb. simpl in Hb.
-    rewrite Hb. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (IFB_false)

- -
-
-Theorem IFB_false: ∀b c1 c2,
-  bequiv b BFalse →
-  cequiv
-    (IFB b THEN c1 ELSE c2 FI)
-    c2.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (swap_if_branches)

- Show that we can swap the branches of an IF by negating its - condition -
-
- -
-Theorem swap_if_branches: ∀b e1 e2,
-  cequiv
-    (IFB b THEN e1 ELSE e2 FI)
-    (IFB BNot b THEN e2 ELSE e1 FI).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

- -
- - For WHILE loops, we can give a similar pair of theorems. A loop - whose guard is equivalent to BFalse is equivalent to SKIP, - while a loop whose guard is equivalent to BTrue is equivalent to - WHILE BTrue DO SKIP END (or any other non-terminating program). - The first of these facts is easy. -
-
- -
-Theorem WHILE_false : ∀b c,
-     bequiv b BFalse →
-     cequiv
-       (WHILE b DO c END)
-       SKIP.
-
-
-Proof.
-  intros b c Hb. split; intros H.
-  Case "→".
-    inversion H; subst.
-    SCase "E_WhileEnd".
-      apply E_Skip.
-    SCase "E_WhileLoop".
-      rewrite Hb in H2. inversion H2.
-  Case "←".
-    inversion H; subst.
-    apply E_WhileEnd.
-    rewrite Hb.
-    reflexivity. Qed.
-
- -
-
- -
-

Exercise: 2 stars, advanced, optional (WHILE_false_informal)

- Write an informal proof of WHILE_false. - -
- -(* FILL IN HERE *)
-☐ - -
- -

- To prove the second fact, we need an auxiliary lemma stating that - WHILE loops whose guards are equivalent to BTrue never - terminate: - -
- - Lemma: If b is equivalent to BTrue, then it cannot be the - case that (WHILE b DO c END) / st ⇓ st'. - -
- - Proof: Suppose that (WHILE b DO c END) / st ⇓ st'. We show, - by induction on a derivation of (WHILE b DO c END) / st ⇓ st', - that this assumption leads to a contradiction. - -
- -
    -
  • Suppose (WHILE b DO c END) / st ⇓ st' is proved using rule - E_WhileEnd. Then by assumption beval st b = false. But - this contradicts the assumption that b is equivalent to - BTrue. - -
    - - -
    • -
  • Suppose (WHILE b DO c END) / st ⇓ st' is proved using rule - E_WhileLoop. Then we are given the induction hypothesis - that (WHILE b DO c END) / st ⇓ st' is contradictory, which - is exactly what we are trying to prove! - -
    - - -
    • -
  • Since these are the only rules that could have been used to - prove (WHILE b DO c END) / st ⇓ st', the other cases of - the induction are immediately contradictory. ☐ -
    • -
- -
-
- -
-Lemma WHILE_true_nonterm : ∀b c st st',
-     bequiv b BTrue →
-     ~( (WHILE b DO c END) / st ⇓ st' ).
-Proof.
-  (* WORKED IN CLASS *)
-  intros b c st st' Hb.
-  intros H.
-  remember (WHILE b DO c END) as cw eqn:Heqcw.
-  ceval_cases (induction H) Case;
-    (* Most rules don't apply, and we can rule them out 
-       by inversion *)
-    inversion Heqcw; subst; clear Heqcw.
-  (* The two interesting cases are the ones for WHILE loops: *)
-  Case "E_WhileEnd". (* contradictory -- b is always true! *)
-    unfold bequiv in Hb.
-    (* rewrite is able to instantiate the quantifier in st *)
-    rewrite Hb in H. inversion H.
-  Case "E_WhileLoop". (* immediate from the IH *)
-    apply IHceval2. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars, optional (WHILE_true_nonterm_informal)

- Explain what the lemma WHILE_true_nonterm means in English. - -
- -(* FILL IN HERE *)
- ☐ -
- -

Exercise: 2 stars (WHILE_true)

- Prove the following theorem. Hint: You'll want to use - WHILE_true_nonterm here. -
-
- -
-Theorem WHILE_true: ∀b c,
-     bequiv b BTrue →
-     cequiv
-       (WHILE b DO c END)
-       (WHILE BTrue DO SKIP END).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-Theorem loop_unrolling: ∀b c,
-  cequiv
-    (WHILE b DO c END)
-    (IFB b THEN (c;; WHILE b DO c END) ELSE SKIP FI).
-Proof.
-  (* WORKED IN CLASS *)
-
-
-  intros b c st st'.
-  split; intros Hce.
-  Case "→".
-    inversion Hce; subst.
-    SCase "loop doesn't run".
-      apply E_IfFalse. assumption. apply E_Skip.
-    SCase "loop runs".
-      apply E_IfTrue. assumption.
-      apply E_Seq with (st' := st'0). assumption. assumption.
-  Case "←".
-    inversion Hce; subst.
-    SCase "loop runs".
-      inversion H5; subst.
-      apply E_WhileLoop with (st' := st'0).
-      assumption. assumption. assumption.
-    SCase "loop doesn't run".
-      inversion H5; subst. apply E_WhileEnd. assumption. Qed.
-
- -
-
- -
-

Exercise: 2 stars, optional (seq_assoc)

- -
-
-Theorem seq_assoc : ∀c1 c2 c3,
-  cequiv ((c1;;c2);;c3) (c1;;(c2;;c3)).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

The Functional Equivalence Axiom

- -
- - Finally, let's look at simple equivalences involving assignments. - For example, we might expect to be able to show that X ::= AId X - is equivalent to SKIP. However, when we try to show it, we get - stuck in an interesting way. -
-
- -
-Theorem identity_assignment_first_try : ∀(X:id),
-  cequiv (X ::= AId X) SKIP.
-Proof.
-   intros. split; intro H.
-     Case "→".
-       inversion H; subst. simpl.
-       replace (update st X (st X)) with st.
-       constructor.
-       (* Stuck... *) Abort.
- -
-
- -
-Here we're stuck. The goal looks reasonable, but in fact it is not - provable! If we look back at the set of lemmas we proved about - update in the last chapter, we can see that lemma update_same - almost does the job, but not quite: it says that the original and - updated states agree at all values, but this is not the same thing - as saying that they are = in Coq's sense! -
- - What is going on here? Recall that our states are just - functions from identifiers to values. For Coq, functions are only - equal when their definitions are syntactically the same, modulo - simplification. (This is the only way we can legally apply the - refl_equal constructor of the inductively defined proposition - eq!) In practice, for functions built up by repeated uses of the - update operation, this means that two functions can be proven - equal only if they were constructed using the same update - operations, applied in the same order. In the theorem above, the - sequence of updates on the first parameter cequiv is one longer - than for the second parameter, so it is no wonder that the - equality doesn't hold. -
- -

- This problem is actually quite general. If we try to prove other - simple facts, such as - -
- -
-    cequiv (X ::= X + 1;;
-            X ::= X + 1)
-           (X ::= X + 2) -
- -
- or - -
- -
-    cequiv (X ::= 1;; Y ::= 2)
-           (y ::= 2;; X ::= 1)
-   -
- -
- we'll get stuck in the same way: we'll have two functions that - behave the same way on all inputs, but cannot be proven to be eq - to each other. - -
- - The reasoning principle we would like to use in these situations - is called functional extensionality: -
- - - - - - - - - - -
∀x, f x = g x -   -
f = g
Although this principle is not derivable in Coq's built-in logic, - it is safe to add it as an additional axiom. -
-
- -
-Axiom functional_extensionality : ∀{X Y: Type} {f g : X → Y},
-    (∀(x: X), f x = g x) → f = g.
- -
-
- -
-It can be shown that adding this axiom doesn't introduce any - inconsistencies into Coq. (In this way, it is similar to adding - one of the classical logic axioms, such as excluded_middle.) -
- - With the benefit of this axiom we can prove our theorem. -
-
- -
-Theorem identity_assignment : ∀(X:id),
-  cequiv
-    (X ::= AId X)
-    SKIP.
-Proof.
-   intros. split; intro H.
-     Case "→".
-       inversion H; subst. simpl.
-       replace (update st X (st X)) with st.
-       constructor.
-       apply functional_extensionality. intro.
-       rewrite update_same; reflexivity.
-     Case "←".
-       inversion H; subst.
-       assert (st' = (update st' X (st' X))).
-          apply functional_extensionality. intro.
-          rewrite update_same; reflexivity.
-       rewrite H0 at 2.
-       constructor. reflexivity.
-Qed.
- -
-
- -
-

Exercise: 2 stars (assign_aequiv)

- -
-
-Theorem assign_aequiv : ∀X e,
-  aequiv (AId X) e →
-  cequiv SKIP (X ::= e).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Properties of Behavioral Equivalence

- -
- - We now turn to developing some of the properties of the program - equivalences we have defined. -
-
- -
-
- -
-

Behavioral Equivalence is an Equivalence

- -
- - First, we verify that the equivalences on aexps, bexps, and - coms really are equivalences — i.e., that they are reflexive, - symmetric, and transitive. The proofs are all easy. -
-
- -
-Lemma refl_aequiv : ∀(a : aexp), aequiv a a.
-
-
-Proof.
-  intros a st. reflexivity. Qed.
-
- -
-Lemma sym_aequiv : ∀(a1 a2 : aexp),
-  aequiv a1 a2 → aequiv a2 a1.
-
-
-Proof.
-  intros a1 a2 H. intros st. symmetry. apply H. Qed.
-
- -
-Lemma trans_aequiv : ∀(a1 a2 a3 : aexp),
-  aequiv a1 a2 → aequiv a2 a3 → aequiv a1 a3.
-
-
-Proof.
-  unfold aequiv. intros a1 a2 a3 H12 H23 st.
-  rewrite (H12 st). rewrite (H23 st). reflexivity. Qed.
-
- -
-Lemma refl_bequiv : ∀(b : bexp), bequiv b b.
-
-
-Proof.
-  unfold bequiv. intros b st. reflexivity. Qed.
-
- -
-Lemma sym_bequiv : ∀(b1 b2 : bexp),
-  bequiv b1 b2 → bequiv b2 b1.
-
-
-Proof.
-  unfold bequiv. intros b1 b2 H. intros st. symmetry. apply H. Qed.
-
- -
-Lemma trans_bequiv : ∀(b1 b2 b3 : bexp),
-  bequiv b1 b2 → bequiv b2 b3 → bequiv b1 b3.
-
-
-Proof.
-  unfold bequiv. intros b1 b2 b3 H12 H23 st.
-  rewrite (H12 st). rewrite (H23 st). reflexivity. Qed.
-
- -
-Lemma refl_cequiv : ∀(c : com), cequiv c c.
-
-
-Proof.
-  unfold cequiv. intros c st st'. apply iff_refl. Qed.
-
- -
-Lemma sym_cequiv : ∀(c1 c2 : com),
-  cequiv c1 c2 → cequiv c2 c1.
-
-
-Proof.
-  unfold cequiv. intros c1 c2 H st st'.
-  assert (c1 / st ⇓ st' ↔ c2 / st ⇓ st') as H'.
-    SCase "Proof of assertion". apply H.
-  apply iff_sym. assumption.
-Qed.
-
- -
-Lemma iff_trans : ∀(P1 P2 P3 : Prop),
-  (P1 ↔ P2) → (P2 ↔ P3) → (P1 ↔ P3).
-
-
-Proof.
-  intros P1 P2 P3 H12 H23.
-  inversion H12. inversion H23.
-  split; intros A.
-    apply H1. apply H. apply A.
-    apply H0. apply H2. apply A. Qed.
-
- -
-Lemma trans_cequiv : ∀(c1 c2 c3 : com),
-  cequiv c1 c2 → cequiv c2 c3 → cequiv c1 c3.
-
-
-Proof.
-  unfold cequiv. intros c1 c2 c3 H12 H23 st st'.
-  apply iff_trans with (c2 / st ⇓ st'). apply H12. apply H23. Qed.
-
- -
-
- -
-

Behavioral Equivalence is a Congruence

- -
- - Less obviously, behavioral equivalence is also a congruence. - That is, the equivalence of two subprograms implies the - equivalence of the larger programs in which they are embedded: -
- - - - - - - - - - -
aequiv a1 a1' -   -
cequiv (i ::= a1) (i ::= a1')
- - - - - - - - - - - - - - -
cequiv c1 c1'
cequiv c2 c2' -   -
cequiv (c1;;c2) (c1';;c2')
...and so on. - -
- - (Note that we are using the inference rule notation here not as - part of a definition, but simply to write down some valid - implications in a readable format. We prove these implications - below.) -
- - We will see a concrete example of why these congruence - properties are important in the following section (in the proof of - fold_constants_com_sound), but the main idea is that they allow - us to replace a small part of a large program with an equivalent - small part and know that the whole large programs are equivalent - without doing an explicit proof about the non-varying parts — - i.e., the "proof burden" of a small change to a large program is - proportional to the size of the change, not the program. -
-
- -
-Theorem CAss_congruence : ∀i a1 a1',
-  aequiv a1 a1' →
-  cequiv (CAss i a1) (CAss i a1').
-
-
-Proof.
-  intros i a1 a2 Heqv st st'.
-  split; intros Hceval.
-  Case "→".
-    inversion Hceval. subst. apply E_Ass.
-    rewrite Heqv. reflexivity.
-  Case "←".
-    inversion Hceval. subst. apply E_Ass.
-    rewrite Heqv. reflexivity. Qed.
-
- -
-
- -
-The congruence property for loops is a little more interesting, - since it requires induction. - -
- - Theorem: Equivalence is a congruence for WHILE — that is, if - b1 is equivalent to b1' and c1 is equivalent to c1', then - WHILE b1 DO c1 END is equivalent to WHILE b1' DO c1' END. - -
- - Proof: Suppose b1 is equivalent to b1' and c1 is - equivalent to c1'. We must show, for every st and st', that - WHILE b1 DO c1 END / st ⇓ st' iff WHILE b1' DO c1' END / st - ⇓ st'. We consider the two directions separately. - -
- -
    -
  • (→) We show that WHILE b1 DO c1 END / st ⇓ st' implies - WHILE b1' DO c1' END / st ⇓ st', by induction on a - derivation of WHILE b1 DO c1 END / st ⇓ st'. The only - nontrivial cases are when the final rule in the derivation is - E_WhileEnd or E_WhileLoop. - -
    - -
      -
    • E_WhileEnd: In this case, the form of the rule gives us - beval st b1 = false and st = st'. But then, since - b1 and b1' are equivalent, we have beval st b1' = - false, and E-WhileEnd applies, giving us WHILE b1' DO - c1' END / st ⇓ st', as required. - -
      - - -
      • -
    • E_WhileLoop: The form of the rule now gives us beval st - b1 = true, with c1 / st ⇓ st'0 and WHILE b1 DO c1 - END / st'0 ⇓ st' for some state st'0, with the - induction hypothesis WHILE b1' DO c1' END / st'0 ⇓ - st'. - -
      - - Since c1 and c1' are equivalent, we know that c1' / - st ⇓ st'0. And since b1 and b1' are equivalent, we - have beval st b1' = true. Now E-WhileLoop applies, - giving us WHILE b1' DO c1' END / st ⇓ st', as - required. - -
      - - -
      • -
    - -
    • -
  • (←) Similar. ☐ -
    • -
- -
-
- -
-Theorem CWhile_congruence : ∀b1 b1' c1 c1',
-  bequiv b1 b1' → cequiv c1 c1' →
-  cequiv (WHILE b1 DO c1 END) (WHILE b1' DO c1' END).
-Proof.
-  (* WORKED IN CLASS *)
-  unfold bequiv,cequiv.
-  intros b1 b1' c1 c1' Hb1e Hc1e st st'.
-  split; intros Hce.
-  Case "→".
-    remember (WHILE b1 DO c1 END) as cwhile eqn:Heqcwhile.
-    induction Hce; inversion Heqcwhile; subst.
-    SCase "E_WhileEnd".
-      apply E_WhileEnd. rewrite ← Hb1e. apply H.
-    SCase "E_WhileLoop".
-      apply E_WhileLoop with (st' := st').
-      SSCase "show loop runs". rewrite ← Hb1e. apply H.
-      SSCase "body execution".
-        apply (Hc1e st st'). apply Hce1.
-      SSCase "subsequent loop execution".
-        apply IHHce2. reflexivity.
-  Case "←".
-    remember (WHILE b1' DO c1' END) as c'while eqn:Heqc'while.
-    induction Hce; inversion Heqc'while; subst.
-    SCase "E_WhileEnd".
-      apply E_WhileEnd. rewrite → Hb1e. apply H.
-    SCase "E_WhileLoop".
-      apply E_WhileLoop with (st' := st').
-      SSCase "show loop runs". rewrite → Hb1e. apply H.
-      SSCase "body execution".
-        apply (Hc1e st st'). apply Hce1.
-      SSCase "subsequent loop execution".
-        apply IHHce2. reflexivity. Qed.
- -
-
- -
-

Exercise: 3 stars, optional (CSeq_congruence)

- -
-
-Theorem CSeq_congruence : ∀c1 c1' c2 c2',
-  cequiv c1 c1' → cequiv c2 c2' →
-  cequiv (c1;;c2) (c1';;c2').
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (CIf_congruence)

- -
-
-Theorem CIf_congruence : ∀b b' c1 c1' c2 c2',
-  bequiv b b' → cequiv c1 c1' → cequiv c2 c2' →
-  cequiv (IFB b THEN c1 ELSE c2 FI) (IFB b' THEN c1' ELSE c2' FI).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

- -
- - For example, here are two equivalent programs and a proof of their - equivalence... -
-
- -
-Example congruence_example:
-  cequiv
-    (* Program 1: *)
-    (X ::= ANum 0;;
-     IFB (BEq (AId X) (ANum 0))
-     THEN
-       Y ::= ANum 0
-     ELSE
-       Y ::= ANum 42
-     FI)
-    (* Program 2: *)
-    (X ::= ANum 0;;
-     IFB (BEq (AId X) (ANum 0))
-     THEN
-       Y ::= AMinus (AId X) (AId X) (* <--- changed here *)
-     ELSE
-       Y ::= ANum 42
-     FI).
-Proof.
-  apply CSeq_congruence.
-    apply refl_cequiv.
-    apply CIf_congruence.
-      apply refl_bequiv.
-      apply CAss_congruence. unfold aequiv. simpl.
-        symmetry. apply minus_diag.
-      apply refl_cequiv.
-Qed.
- -
-
- -
-

Program Transformations

- -
- - A program transformation is a function that takes a program - as input and produces some variant of the program as its - output. Compiler optimizations such as constant folding are - a canonical example, but there are many others. -
- - A program transformation is sound if it preserves the - behavior of the original program. - -
- - We can define a notion of soundness for translations of - aexps, bexps, and coms. -
-
- -
-Definition atrans_sound (atrans : aexp → aexp) : Prop :=
-  ∀(a : aexp),
-    aequiv a (atrans a).
- -
-Definition btrans_sound (btrans : bexp → bexp) : Prop :=
-  ∀(b : bexp),
-    bequiv b (btrans b).
- -
-Definition ctrans_sound (ctrans : com → com) : Prop :=
-  ∀(c : com),
-    cequiv c (ctrans c).
- -
-
- -
-

The Constant-Folding Transformation

- -
- - An expression is constant when it contains no variable - references. - -
- - Constant folding is an optimization that finds constant - expressions and replaces them by their values. -
-
- -
-Fixpoint fold_constants_aexp (a : aexp) : aexp :=
-  match a with
-  | ANum n ⇒ ANum n
-  | AId i ⇒ AId i
-  | APlus a1 a2 ⇒
-      match (fold_constants_aexp a1, fold_constants_aexp a2) with
-      | (ANum n1, ANum n2) ⇒ ANum (n1 + n2)
-      | (a1', a2') ⇒ APlus a1' a2'
-      end
-  | AMinus a1 a2 ⇒
-      match (fold_constants_aexp a1, fold_constants_aexp a2) with
-      | (ANum n1, ANum n2) ⇒ ANum (n1 - n2)
-      | (a1', a2') ⇒ AMinus a1' a2'
-      end
-  | AMult a1 a2 ⇒
-      match (fold_constants_aexp a1, fold_constants_aexp a2) with
-      | (ANum n1, ANum n2) ⇒ ANum (n1 × n2)
-      | (a1', a2') ⇒ AMult a1' a2'
-      end
-  end.
- -
-Example fold_aexp_ex1 :
-    fold_constants_aexp
-      (AMult (APlus (ANum 1) (ANum 2)) (AId X))
-  = AMult (ANum 3) (AId X).
-Proof. reflexivity. Qed.
- -
-
- -
-Note that this version of constant folding doesn't eliminate - trivial additions, etc. — we are focusing attention on a single - optimization for the sake of simplicity. It is not hard to - incorporate other ways of simplifying expressions; the definitions - and proofs just get longer. -
-
- -
-Example fold_aexp_ex2 :
-    fold_constants_aexp
-      (AMinus (AId X) (APlus (AMult (ANum 0) (ANum 6)) (AId Y)))
-  = AMinus (AId X) (APlus (ANum 0) (AId Y)).
-Proof. reflexivity. Qed.
- -
-
- -
-

- Not only can we lift fold_constants_aexp to bexps (in the - BEq and BLe cases), we can also find constant boolean - expressions and reduce them in-place. -
-
- -
-Fixpoint fold_constants_bexp (b : bexp) : bexp :=
-  match b with
-  | BTrue ⇒ BTrue
-  | BFalse ⇒ BFalse
-  | BEq a1 a2 ⇒
-      match (fold_constants_aexp a1, fold_constants_aexp a2) with
-      | (ANum n1, ANum n2) ⇒ if beq_nat n1 n2 then BTrue else BFalse
-      | (a1', a2') ⇒ BEq a1' a2'
-      end
-  | BLe a1 a2 ⇒
-      match (fold_constants_aexp a1, fold_constants_aexp a2) with
-      | (ANum n1, ANum n2) ⇒ if ble_nat n1 n2 then BTrue else BFalse
-      | (a1', a2') ⇒ BLe a1' a2'
-      end
-  | BNot b1 ⇒
-      match (fold_constants_bexp b1) with
-      | BTrue ⇒ BFalse
-      | BFalse ⇒ BTrue
-      | b1' ⇒ BNot b1'
-      end
-  | BAnd b1 b2 ⇒
-      match (fold_constants_bexp b1, fold_constants_bexp b2) with
-      | (BTrue, BTrue) ⇒ BTrue
-      | (BTrue, BFalse) ⇒ BFalse
-      | (BFalse, BTrue) ⇒ BFalse
-      | (BFalse, BFalse) ⇒ BFalse
-      | (b1', b2') ⇒ BAnd b1' b2'
-      end
-  end.
- -
-Example fold_bexp_ex1 :
-    fold_constants_bexp (BAnd BTrue (BNot (BAnd BFalse BTrue)))
-  = BTrue.
-Proof. reflexivity. Qed.
- -
-Example fold_bexp_ex2 :
-    fold_constants_bexp
-      (BAnd (BEq (AId X) (AId Y))
-            (BEq (ANum 0)
-                 (AMinus (ANum 2) (APlus (ANum 1) (ANum 1)))))
-  = BAnd (BEq (AId X) (AId Y)) BTrue.
-Proof. reflexivity. Qed.
- -
-
- -
-

- To fold constants in a command, we apply the appropriate folding - functions on all embedded expressions. -
-
- -
-Fixpoint fold_constants_com (c : com) : com :=
-  match c with
-  | SKIP ⇒
-      SKIP
-  | i ::= a ⇒
-      CAss i (fold_constants_aexp a)
-  | c1 ;; c2 ⇒
-      (fold_constants_com c1) ;; (fold_constants_com c2)
-  | IFB b THEN c1 ELSE c2 FI ⇒
-      match fold_constants_bexp b with
-      | BTrue ⇒ fold_constants_com c1
-      | BFalse ⇒ fold_constants_com c2
-      | b' ⇒ IFB b' THEN fold_constants_com c1
-                     ELSE fold_constants_com c2 FI
-      end
-  | WHILE b DO c END ⇒
-      match fold_constants_bexp b with
-      | BTrue ⇒ WHILE BTrue DO SKIP END
-      | BFalse ⇒ SKIP
-      | b' ⇒ WHILE b' DO (fold_constants_com c) END
-      end
-  end.
- -
-
- -
-

- -
-
-Example fold_com_ex1 :
-  fold_constants_com
-    (* Original program: *)
-    (X ::= APlus (ANum 4) (ANum 5);;
-     Y ::= AMinus (AId X) (ANum 3);;
-     IFB BEq (AMinus (AId X) (AId Y)) (APlus (ANum 2) (ANum 4)) THEN
-       SKIP
-     ELSE
-       Y ::= ANum 0
-     FI;;
-     IFB BLe (ANum 0) (AMinus (ANum 4) (APlus (ANum 2) (ANum 1))) THEN
-       Y ::= ANum 0
-     ELSE
-       SKIP
-     FI;;
-     WHILE BEq (AId Y) (ANum 0) DO
-       X ::= APlus (AId X) (ANum 1)
-     END)
-  = (* After constant folding: *)
-    (X ::= ANum 9;;
-     Y ::= AMinus (AId X) (ANum 3);;
-     IFB BEq (AMinus (AId X) (AId Y)) (ANum 6) THEN
-       SKIP
-     ELSE
-       (Y ::= ANum 0)
-     FI;;
-     Y ::= ANum 0;;
-     WHILE BEq (AId Y) (ANum 0) DO
-       X ::= APlus (AId X) (ANum 1)
-     END).
-Proof. reflexivity. Qed.
- -
-
- -
-

Soundness of Constant Folding

- -
- - Now we need to show that what we've done is correct. -
- - Here's the proof for arithmetic expressions: -
-
- -
-Theorem fold_constants_aexp_sound :
-  atrans_sound fold_constants_aexp.
-
-
-Proof.
-  unfold atrans_sound. intros a. unfold aequiv. intros st.
-  aexp_cases (induction a) Case; simpl;
-    (* ANum and AId follow immediately *)
-    try reflexivity;
-    (* APlus, AMinus, and AMult follow from the IH
-       and the observation that
-              aeval st (APlus a1 a2) 
-            = ANum ((aeval st a1) + (aeval st a2)) 
-            = aeval st (ANum ((aeval st a1) + (aeval st a2)))
-       (and similarly for AMinus/minus and AMult/mult) *)
-    try (destruct (fold_constants_aexp a1);
-         destruct (fold_constants_aexp a2);
-         rewrite IHa1; rewrite IHa2; reflexivity). Qed.
-
- -
-
- -
-

Exercise: 3 stars, optional (fold_bexp_Eq_informal)

- Here is an informal proof of the BEq case of the soundness - argument for boolean expression constant folding. Read it - carefully and compare it to the formal proof that follows. Then - fill in the BLe case of the formal proof (without looking at the - BEq case, if possible). - -
- - Theorem: The constant folding function for booleans, - fold_constants_bexp, is sound. - -
- - Proof: We must show that b is equivalent to fold_constants_bexp, - for all boolean expressions b. Proceed by induction on b. We - show just the case where b has the form BEq a1 a2. - -
- - In this case, we must show - -
- -
-       beval st (BEq a1 a2) 
-     = beval st (fold_constants_bexp (BEq a1 a2)). -
- -
- There are two cases to consider: - -
- -
    -
  • First, suppose fold_constants_aexp a1 = ANum n1 and - fold_constants_aexp a2 = ANum n2 for some n1 and n2. - -
    - - In this case, we have - -
    - -
    -    fold_constants_bexp (BEq a1 a2) 
    -  = if beq_nat n1 n2 then BTrue else BFalse -
    - -
    - and - -
    - -
    -    beval st (BEq a1 a2) 
    -  = beq_nat (aeval st a1) (aeval st a2). -
    - -
    - By the soundness of constant folding for arithmetic - expressions (Lemma fold_constants_aexp_sound), we know - -
    - -
    -    aeval st a1 
    -  = aeval st (fold_constants_aexp a1) 
    -  = aeval st (ANum n1) 
    -  = n1 -
    - -
    - and - -
    - -
    -    aeval st a2 
    -  = aeval st (fold_constants_aexp a2) 
    -  = aeval st (ANum n2) 
    -  = n2, -
    - -
    - so - -
    - -
    -    beval st (BEq a1 a2) 
    -  = beq_nat (aeval a1) (aeval a2)
    -  = beq_nat n1 n2. -
    - -
    - Also, it is easy to see (by considering the cases n1 = n2 and - n1 ≠ n2 separately) that - -
    - -
    -    beval st (if beq_nat n1 n2 then BTrue else BFalse)
    -  = if beq_nat n1 n2 then beval st BTrue else beval st BFalse
    -  = if beq_nat n1 n2 then true else false
    -  = beq_nat n1 n2. -
    - -
    - So - -
    - -
    -    beval st (BEq a1 a2) 
    -  = beq_nat n1 n2.
    -  = beval st (if beq_nat n1 n2 then BTrue else BFalse), -
    - -
    - as required. - -
    - - -
    • -
  • Otherwise, one of fold_constants_aexp a1 and - fold_constants_aexp a2 is not a constant. In this case, we - must show - -
    - -
    -    beval st (BEq a1 a2) 
    -  = beval st (BEq (fold_constants_aexp a1)
    -                  (fold_constants_aexp a2)), -
    - -
    - which, by the definition of beval, is the same as showing - -
    - -
    -    beq_nat (aeval st a1) (aeval st a2) 
    -  = beq_nat (aeval st (fold_constants_aexp a1))
    -            (aeval st (fold_constants_aexp a2)). -
    - -
    - But the soundness of constant folding for arithmetic - expressions (fold_constants_aexp_sound) gives us - -
    - -
    -  aeval st a1 = aeval st (fold_constants_aexp a1)
    -  aeval st a2 = aeval st (fold_constants_aexp a2), -
    - -
    - completing the case. ☐ - -
    • -
- -
-
- -
-Theorem fold_constants_bexp_sound:
-  btrans_sound fold_constants_bexp.
-Proof.
-  unfold btrans_sound. intros b. unfold bequiv. intros st.
-  bexp_cases (induction b) Case;
-    (* BTrue and BFalse are immediate *)
-    try reflexivity.
-  Case "BEq".
-    (* Doing induction when there are a lot of constructors makes
-       specifying variable names a chore, but Coq doesn't always
-       choose nice variable names.  We can rename entries in the
-       context with the rename tactic: rename a into a1 will
-       change a to a1 in the current goal and context. *)
-    rename a into a1. rename a0 into a2. simpl.
-    remember (fold_constants_aexp a1) as a1' eqn:Heqa1'.
-    remember (fold_constants_aexp a2) as a2' eqn:Heqa2'.
-    replace (aeval st a1) with (aeval st a1') by
-       (subst a1'; rewrite ← fold_constants_aexp_sound; reflexivity).
-    replace (aeval st a2) with (aeval st a2') by
-       (subst a2'; rewrite ← fold_constants_aexp_sound; reflexivity).
-    destruct a1'; destruct a2'; try reflexivity.
-      (* The only interesting case is when both a1 and a2 
-         become constants after folding *)
-      simpl. destruct (beq_nat n n0); reflexivity.
-  Case "BLe".
-    (* FILL IN HERE *) admit.
-  Case "BNot".
-    simpl. remember (fold_constants_bexp b) as b' eqn:Heqb'.
-    rewrite IHb.
-    destruct b'; reflexivity.
-  Case "BAnd".
-    simpl.
-    remember (fold_constants_bexp b1) as b1' eqn:Heqb1'.
-    remember (fold_constants_bexp b2) as b2' eqn:Heqb2'.
-    rewrite IHb1. rewrite IHb2.
-    destruct b1'; destruct b2'; reflexivity. Qed.
-
- -
-☐ -
- -

Exercise: 3 stars (fold_constants_com_sound)

- Complete the WHILE case of the following proof. -
-
- -
-Theorem fold_constants_com_sound :
-  ctrans_sound fold_constants_com.
-Proof.
-  unfold ctrans_sound. intros c.
-  com_cases (induction c) Case; simpl.
-  Case "SKIP". apply refl_cequiv.
-  Case "::=". apply CAss_congruence. apply fold_constants_aexp_sound.
-  Case ";;". apply CSeq_congruence; assumption.
-  Case "IFB".
-    assert (bequiv b (fold_constants_bexp b)).
-      SCase "Pf of assertion". apply fold_constants_bexp_sound.
-    destruct (fold_constants_bexp b) eqn:Heqb;
-      (* If the optimization doesn't eliminate the if, then the result
-         is easy to prove from the IH and fold_constants_bexp_sound *)
-      try (apply CIf_congruence; assumption).
-    SCase "b always true".
-      apply trans_cequiv with c1; try assumption.
-      apply IFB_true; assumption.
-    SCase "b always false".
-      apply trans_cequiv with c2; try assumption.
-      apply IFB_false; assumption.
-  Case "WHILE".
-    (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Soundness of (0 + n) Elimination, Redux

- -
- -

Exercise: 4 stars, advanced, optional (optimize_0plus)

- Recall the definition optimize_0plus from Imp.v: - -
- -
-    Fixpoint optimize_0plus (e:aexp) : aexp := 
-      match e with
-      | ANum n ⇒ 
-          ANum n
-      | APlus (ANum 0) e2 ⇒ 
-          optimize_0plus e2
-      | APlus e1 e2 ⇒ 
-          APlus (optimize_0plus e1) (optimize_0plus e2)
-      | AMinus e1 e2 ⇒ 
-          AMinus (optimize_0plus e1) (optimize_0plus e2)
-      | AMult e1 e2 ⇒ 
-          AMult (optimize_0plus e1) (optimize_0plus e2)
-      end. -
- -
- Note that this function is defined over the old aexps, - without states. - -
- - Write a new version of this function that accounts for variables, - and analogous ones for bexps and commands: - -
- -
-     optimize_0plus_aexp
-     optimize_0plus_bexp
-     optimize_0plus_com -
- -
- Prove that these three functions are sound, as we did for - fold_constants_×. (Make sure you use the congruence lemmas in - the proof of optimize_0plus_com — otherwise it will be long!) - -
- - Then define an optimizer on commands that first folds - constants (using fold_constants_com) and then eliminates 0 + n - terms (using optimize_0plus_com). - -
- -
    -
  • Give a meaningful example of this optimizer's output. - -
    - - -
    • -
  • Prove that the optimizer is sound. (This part should be very - easy.) -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Proving That Programs Are Not Equivalent

- -
- - Suppose that c1 is a command of the form X ::= a1;; Y ::= a2 - and c2 is the command X ::= a1;; Y ::= a2', where a2' is - formed by substituting a1 for all occurrences of X in a2. - For example, c1 and c2 might be: - -
- -
-       c1  =  (X ::= 42 + 53;; 
-               Y ::= Y + X)
-       c2  =  (X ::= 42 + 53;; 
-               Y ::= Y + (42 + 53)) -
- -
- Clearly, this particular c1 and c2 are equivalent. Is this - true in general? -
- - We will see in a moment that it is not, but it is worthwhile - to pause, now, and see if you can find a counter-example on your - own. -
- - Here, formally, is the function that substitutes an arithmetic - expression for each occurrence of a given variable in another - expression: -
-
- -
-Fixpoint subst_aexp (i : id) (u : aexp) (a : aexp) : aexp :=
-  match a with
-  | ANum n ⇒ ANum n
-  | AId i' ⇒ if eq_id_dec i i' then u else AId i'
-  | APlus a1 a2 ⇒ APlus (subst_aexp i u a1) (subst_aexp i u a2)
-  | AMinus a1 a2 ⇒ AMinus (subst_aexp i u a1) (subst_aexp i u a2)
-  | AMult a1 a2 ⇒ AMult (subst_aexp i u a1) (subst_aexp i u a2)
-  end.
- -
-Example subst_aexp_ex :
-  subst_aexp X (APlus (ANum 42) (ANum 53)) (APlus (AId Y) (AId X)) =
-  (APlus (AId Y) (APlus (ANum 42) (ANum 53))).
-Proof. reflexivity. Qed.
- -
-
- -
-And here is the property we are interested in, expressing the - claim that commands c1 and c2 as described above are - always equivalent. -
-
- -
-Definition subst_equiv_property := ∀i1 i2 a1 a2,
-  cequiv (i1 ::= a1;; i2 ::= a2)
-         (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2).
- -
-
- -
-

- Sadly, the property does not always hold. - -
- - Theorem: It is not the case that, for all i1, i2, a1, - and a2, - -
- -
-         cequiv (i1 ::= a1;; i2 ::= a2)
-                (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). -
- -
- Proof: Suppose, for a contradiction, that for all i1, i2, - a1, and a2, we have - -
- -
-      cequiv (i1 ::= a1;; i2 ::= a2) 
-             (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). -
- -
- Consider the following program: - -
- -
-         X ::= APlus (AId X) (ANum 1);; Y ::= AId X -
- -
- Note that - -
- -
-         (X ::= APlus (AId X) (ANum 1);; Y ::= AId X)
-         / empty_state ⇓ st1, -
- -
- where st1 = { X ↦ 1, Y ↦ 1 }. - -
- - By our assumption, we know that - -
- -
-        cequiv (X ::= APlus (AId X) (ANum 1);; Y ::= AId X)
-               (X ::= APlus (AId X) (ANum 1);; Y ::= APlus (AId X) (ANum 1)) -
- -
- so, by the definition of cequiv, we have - -
- -
-        (X ::= APlus (AId X) (ANum 1);; Y ::= APlus (AId X) (ANum 1))
-        / empty_state ⇓ st1. -
- -
- But we can also derive - -
- -
-        (X ::= APlus (AId X) (ANum 1);; Y ::= APlus (AId X) (ANum 1))
-        / empty_state ⇓ st2, -
- -
- where st2 = { X ↦ 1, Y ↦ 2 }. Note that st1 ≠ st2; this - is a contradiction, since ceval is deterministic! ☐ -
-
- -
-Theorem subst_inequiv :
-  ¬ subst_equiv_property.
-
-
-Proof.
-  unfold subst_equiv_property.
-  intros Contra.
- -
-  (* Here is the counterexample: assuming that subst_equiv_property
-     holds allows us to prove that these two programs are
-     equivalent... *)
-  remember (X ::= APlus (AId X) (ANum 1);;
-            Y ::= AId X)
-      as c1.
-  remember (X ::= APlus (AId X) (ANum 1);;
-            Y ::= APlus (AId X) (ANum 1))
-      as c2.
-  assert (cequiv c1 c2) by (subst; apply Contra).
- -
-  (* ... allows us to show that the command c2 can terminate 
-     in two different final states: 
-        st1 = {X |-> 1, Y |-> 1} 
-        st2 = {X |-> 1, Y |-> 2}. *)
-  remember (update (update empty_state X 1) Y 1) as st1.
-  remember (update (update empty_state X 1) Y 2) as st2.
-  assert (H1: c1 / empty_state ⇓ st1);
-  assert (H2: c2 / empty_state ⇓ st2);
-  try (subst;
-       apply E_Seq with (st' := (update empty_state X 1));
-       apply E_Ass; reflexivity).
-  apply H in H1.
- -
-  (* Finally, we use the fact that evaluation is deterministic
-     to obtain a contradiction. *)
-  assert (Hcontra: st1 = st2)
-    by (apply (ceval_deterministic c2 empty_state); assumption).
-  assert (Hcontra': st1 Y = st2 Y)
-    by (rewrite Hcontra; reflexivity).
-  subst. inversion Hcontra'. Qed.
-
- -
-
- -
-

Exercise: 4 stars, optional (better_subst_equiv)

- The equivalence we had in mind above was not complete nonsense — - it was actually almost right. To make it correct, we just need to - exclude the case where the variable X occurs in the - right-hand-side of the first assignment statement. -
-
- -
-Inductive var_not_used_in_aexp (X:id) : aexp → Prop :=
-  | VNUNum: ∀n, var_not_used_in_aexp X (ANum n)
-  | VNUId: ∀Y, X ≠ Y → var_not_used_in_aexp X (AId Y)
-  | VNUPlus: ∀a1 a2,
-      var_not_used_in_aexp X a1 →
-      var_not_used_in_aexp X a2 →
-      var_not_used_in_aexp X (APlus a1 a2)
-  | VNUMinus: ∀a1 a2,
-      var_not_used_in_aexp X a1 →
-      var_not_used_in_aexp X a2 →
-      var_not_used_in_aexp X (AMinus a1 a2)
-  | VNUMult: ∀a1 a2,
-      var_not_used_in_aexp X a1 →
-      var_not_used_in_aexp X a2 →
-      var_not_used_in_aexp X (AMult a1 a2).
- -
-Lemma aeval_weakening : ∀i st a ni,
-  var_not_used_in_aexp i a →
-  aeval (update st i ni) a = aeval st a.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Using var_not_used_in_aexp, formalize and prove a correct verson - of subst_equiv_property. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars, optional (inequiv_exercise)

- Prove that an infinite loop is not equivalent to SKIP -
-
- -
-Theorem inequiv_exercise:
-  ¬ cequiv (WHILE BTrue DO SKIP END) SKIP.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Extended exercise: Non-deterministic Imp

- -
- - As we have seen (in theorem ceval_deterministic in the Imp - chapter), Imp's evaluation relation is deterministic. However, - non-determinism is an important part of the definition of many - real programming languages. For example, in many imperative - languages (such as C and its relatives), the order in which - function arguments are evaluated is unspecified. The program - fragment - -
- -
-      x = 0;;
-      f(++x, x) -
- -
- might call f with arguments (1, 0) or (1, 1), depending how - the compiler chooses to order things. This can be a little - confusing for programmers, but it gives the compiler writer useful - freedom. - -
- - In this exercise, we will extend Imp with a simple - non-deterministic command and study how this change affects - program equivalence. The new command has the syntax HAVOC X, - where X is an identifier. The effect of executing HAVOC X is - to assign an arbitrary number to the variable X, - non-deterministically. For example, after executing the program: - -
- -
-      HAVOC Y;;
-      Z ::= Y × 2 -
- -
- the value of Y can be any number, while the value of Z is - twice that of Y (so Z is always even). Note that we are not - saying anything about the probabilities of the outcomes — just - that there are (infinitely) many different outcomes that can - possibly happen after executing this non-deterministic code. - -
- - In a sense a variable on which we do HAVOC roughly corresponds - to an unitialized variable in the C programming language. After - the HAVOC the variable holds a fixed but arbitrary number. Most - sources of nondeterminism in language definitions are there - precisely because programmers don't care which choice is made (and - so it is good to leave it open to the compiler to choose whichever - will run faster). - -
- - We call this new language Himp (``Imp extended with HAVOC''). -
-
- -
-Module Himp.
- -
-
- -
-To formalize the language, we first add a clause to the definition of - commands. -
-
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAss : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com
-  | CHavoc : id → com. (* <---- new *)
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";;"
-  | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "HAVOC" ].
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "X '::=' a" :=
-  (CAss X a) (at level 60).
-Notation "c1 ;; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
-  (CIf e1 e2 e3) (at level 80, right associativity).
-Notation "'HAVOC' l" := (CHavoc l) (at level 60).
- -
-
- -
-

Exercise: 2 stars (himp_ceval)

- Now, we must extend the operational semantics. We have provided - a template for the ceval relation below, specifying the big-step - semantics. What rule(s) must be added to the definition of ceval - to formalize the behavior of the HAVOC command? -
-
- -
-Reserved Notation "c1 '/' st '⇓' st'" (at level 40, st at level 39).
- -
-Inductive ceval : com → state → state → Prop :=
-  | E_Skip : ∀st : state, SKIP / st ⇓ st
-  | E_Ass : ∀(st : state) (a1 : aexp) (n : nat) (X : id),
-            aeval st a1 = n → (X ::= a1) / st ⇓ update st X n
-  | E_Seq : ∀(c1 c2 : com) (st st' st'' : state),
-            c1 / st ⇓ st' → c2 / st' ⇓ st'' → (c1 ;; c2) / st ⇓ st''
-  | E_IfTrue : ∀(st st' : state) (b1 : bexp) (c1 c2 : com),
-               beval st b1 = true →
-               c1 / st ⇓ st' → (IFB b1 THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_IfFalse : ∀(st st' : state) (b1 : bexp) (c1 c2 : com),
-                beval st b1 = false →
-                c2 / st ⇓ st' → (IFB b1 THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_WhileEnd : ∀(b1 : bexp) (st : state) (c1 : com),
-                 beval st b1 = false → (WHILE b1 DO c1 END) / st ⇓ st
-  | E_WhileLoop : ∀(st st' st'' : state) (b1 : bexp) (c1 : com),
-                  beval st b1 = true →
-                  c1 / st ⇓ st' →
-                  (WHILE b1 DO c1 END) / st' ⇓ st'' →
-                  (WHILE b1 DO c1 END) / st ⇓ st''
-(* FILL IN HERE *)
-
-  where "c1 '/' st '⇓' st'" := (ceval c1 st st').
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq"
-  | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
-  | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop"
-(* FILL IN HERE *)
-].
- -
-
- -
-As a sanity check, the following claims should be provable for - your definition: -
-
- -
-Example havoc_example1 : (HAVOC X) / empty_state ⇓ update empty_state X 0.
-Proof.
-(* FILL IN HERE *) Admitted.
- -
-Example havoc_example2 :
-  (SKIP;; HAVOC Z) / empty_state ⇓ update empty_state Z 42.
-Proof.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Finally, we repeat the definition of command equivalence from above: -
-
- -
-Definition cequiv (c1 c2 : com) : Prop := ∀st st' : state,
-  c1 / st ⇓ st' ↔ c2 / st ⇓ st'.
- -
-
- -
-This definition still makes perfect sense in the case of always - terminating programs, so let's apply it to prove some - non-deterministic programs equivalent or non-equivalent. -
- -

Exercise: 3 stars (havoc_swap)

- Are the following two programs equivalent? -
-
- -
-Definition pXY :=
-  HAVOC X;; HAVOC Y.
- -
-Definition pYX :=
-  HAVOC Y;; HAVOC X.
- -
-
- -
-If you think they are equivalent, prove it. If you think they are - not, prove that. -
-
- -
-Theorem pXY_cequiv_pYX :
-  cequiv pXY pYX ∨ ¬cequiv pXY pYX.
-Proof. (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 4 stars, optional (havoc_copy)

- Are the following two programs equivalent? -
-
- -
-Definition ptwice :=
-  HAVOC X;; HAVOC Y.
- -
-Definition pcopy :=
-  HAVOC X;; Y ::= AId X.
- -
-
- -
-If you think they are equivalent, then prove it. If you think they - are not, then prove that. (Hint: You may find the assert tactic - useful.) -
-
- -
-Theorem ptwice_cequiv_pcopy :
-  cequiv ptwice pcopy ∨ ¬cequiv ptwice pcopy.
-Proof. (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - The definition of program equivalence we are using here has some - subtle consequences on programs that may loop forever. What - cequiv says is that the set of possible terminating outcomes - of two equivalent programs is the same. However, in a language - with non-determinism, like Himp, some programs always terminate, - some programs always diverge, and some programs can - non-deterministically terminate in some runs and diverge in - others. The final part of the following exercise illustrates this - phenomenon. - -
- -

Exercise: 5 stars, advanced (p1_p2_equiv)

- Prove that p1 and p2 are equivalent. In this and the following - exercises, try to understand why the cequiv definition has the - behavior it has on these examples. -
-
- -
-Definition p1 : com :=
-  WHILE (BNot (BEq (AId X) (ANum 0))) DO
-    HAVOC Y;;
-    X ::= APlus (AId X) (ANum 1)
-  END.
- -
-Definition p2 : com :=
-  WHILE (BNot (BEq (AId X) (ANum 0))) DO
-    SKIP
-  END.
- -
-
- -
-Intuitively, the programs have the same termination - behavior: either they loop forever, or they terminate in the - same state they started in. We can capture the termination - behavior of p1 and p2 individually with these lemmas: -
-
- -
-Lemma p1_may_diverge : ∀st st', st X ≠ 0 →
-  ¬ p1 / st ⇓ st'.
-Proof. (* FILL IN HERE *) Admitted.
- -
-Lemma p2_may_diverge : ∀st st', st X ≠ 0 →
-  ¬ p2 / st ⇓ st'.
-Proof.
-(* FILL IN HERE *) Admitted.
- -
-
- -
-You should use these lemmas to prove that p1 and p2 are actually - equivalent. -
-
- -
-Theorem p1_p2_equiv : cequiv p1 p2.
-Proof. (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 4 stars, advanced (p3_p4_inquiv)

- -
- - Prove that the following programs are not equivalent. -
-
- -
-Definition p3 : com :=
-  Z ::= ANum 1;;
-  WHILE (BNot (BEq (AId X) (ANum 0))) DO
-    HAVOC X;;
-    HAVOC Z
-  END.
- -
-Definition p4 : com :=
-  X ::= (ANum 0);;
-  Z ::= (ANum 1).
- -
-Theorem p3_p4_inequiv : ¬ cequiv p3 p4.
-Proof. (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 5 stars, advanced, optional (p5_p6_equiv)

- -
-
- -
-Definition p5 : com :=
-  WHILE (BNot (BEq (AId X) (ANum 1))) DO
-    HAVOC X
-  END.
- -
-Definition p6 : com :=
-  X ::= ANum 1.
- -
-Theorem p5_p6_equiv : cequiv p5 p6.
-Proof. (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-End Himp.
- -
-
- -
-

Doing Without Extensionality (Optional)

- -
- - Purists might object to using the functional_extensionality - axiom. In general, it can be quite dangerous to add axioms, - particularly several at once (as they may be mutually - inconsistent). In fact, functional_extensionality and - excluded_middle can both be assumed without any problems, but - some Coq users prefer to avoid such "heavyweight" general - techniques, and instead craft solutions for specific problems that - stay within Coq's standard logic. - -
- - For our particular problem here, rather than extending the - definition of equality to do what we want on functions - representing states, we could instead give an explicit notion of - equivalence on states. For example: -
-
- -
-Definition stequiv (st1 st2 : state) : Prop :=
-  ∀(X:id), st1 X = st2 X.
- -
-Notation "st1 '¬' st2" := (stequiv st1 st2) (at level 30).
- -
-
- -
-It is easy to prove that stequiv is an equivalence (i.e., it - is reflexive, symmetric, and transitive), so it partitions the set - of all states into equivalence classes. -
- -

Exercise: 1 star, optional (stequiv_refl)

- -
-
-Lemma stequiv_refl : ∀(st : state),
-  st ¬ st.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (stequiv_sym)

- -
-
-Lemma stequiv_sym : ∀(st1 st2 : state),
-  st1 ¬ st2 →
-  st2 ¬ st1.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (stequiv_trans)

- -
-
-Lemma stequiv_trans : ∀(st1 st2 st3 : state),
-  st1 ¬ st2 →
-  st2 ¬ st3 →
-  st1 ¬ st3.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Another useful fact...

Exercise: 1 star, optional (stequiv_update)

- -
-
-Lemma stequiv_update : ∀(st1 st2 : state),
-  st1 ¬ st2 →
-  ∀(X:id) (n:nat),
-  update st1 X n ¬ update st2 X n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - It is then straightforward to show that aeval and beval behave - uniformly on all members of an equivalence class: -
- -

Exercise: 2 stars, optional (stequiv_aeval)

- -
-
-Lemma stequiv_aeval : ∀(st1 st2 : state),
-  st1 ¬ st2 →
-  ∀(a:aexp), aeval st1 a = aeval st2 a.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (stequiv_beval)

- -
-
-Lemma stequiv_beval : ∀(st1 st2 : state),
-  st1 ¬ st2 →
-  ∀(b:bexp), beval st1 b = beval st2 b.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - We can also characterize the behavior of ceval on equivalent - states (this result is a bit more complicated to write down - because ceval is a relation). -
-
- -
-Lemma stequiv_ceval: ∀(st1 st2 : state),
-  st1 ¬ st2 →
-  ∀(c: com) (st1': state),
-    (c / st1 ⇓ st1') →
-    ∃st2' : state,
-    ((c / st2 ⇓ st2') ∧ st1' ¬ st2').
-Proof.
-  intros st1 st2 STEQV c st1' CEV1. generalize dependent st2.
-  induction CEV1; intros st2 STEQV.
-  Case "SKIP".
-    ∃st2. split.
-      constructor.
-      assumption.
-  Case ":=".
-    ∃(update st2 x n). split.
-       constructor. rewrite ← H. symmetry. apply stequiv_aeval.
-       assumption. apply stequiv_update. assumption.
-  Case ";".
-    destruct (IHCEV1_1 st2 STEQV) as [st2' [P1 EQV1]].
-    destruct (IHCEV1_2 st2' EQV1) as [st2'' [P2 EQV2]].
-    ∃st2''. split.
-      apply E_Seq with st2'; assumption.
-      assumption.
-  Case "IfTrue".
-    destruct (IHCEV1 st2 STEQV) as [st2' [P EQV]].
-    ∃st2'. split.
-      apply E_IfTrue. rewrite ← H. symmetry. apply stequiv_beval.
-      assumption. assumption. assumption.
-  Case "IfFalse".
-    destruct (IHCEV1 st2 STEQV) as [st2' [P EQV]].
-    ∃st2'. split.
-     apply E_IfFalse. rewrite ← H. symmetry. apply stequiv_beval.
-     assumption. assumption. assumption.
-  Case "WhileEnd".
-    ∃st2. split.
-      apply E_WhileEnd. rewrite ← H. symmetry. apply stequiv_beval.
-      assumption. assumption.
-  Case "WhileLoop".
-    destruct (IHCEV1_1 st2 STEQV) as [st2' [P1 EQV1]].
-    destruct (IHCEV1_2 st2' EQV1) as [st2'' [P2 EQV2]].
-    ∃st2''. split.
-      apply E_WhileLoop with st2'. rewrite ← H. symmetry.
-      apply stequiv_beval. assumption. assumption. assumption.
-      assumption.
-Qed.
- -
-
- -
-Now we need to redefine cequiv to use ¬ instead of =. It is - not completely trivial to do this in a way that keeps the - definition simple and symmetric, but here is one approach (thanks - to Andrew McCreight). We first define a looser variant of ⇓ - that "folds in" the notion of equivalence. -
-
- -
-Reserved Notation "c1 '/' st '⇓'' st'" (at level 40, st at level 39).
- -
-Inductive ceval' : com → state → state → Prop :=
-  | E_equiv : ∀c st st' st'',
-    c / st ⇓ st' →
-    st' ¬ st'' →
-    c / st ⇓' st''
-  where "c1 '/' st '⇓'' st'" := (ceval' c1 st st').
- -
-
- -
-Now the revised definition of cequiv' looks familiar: -
-
- -
-Definition cequiv' (c1 c2 : com) : Prop :=
-  ∀(st st' : state),
-    (c1 / st ⇓' st') ↔ (c2 / st ⇓' st').
- -
-
- -
-A sanity check shows that the original notion of command - equivalence is at least as strong as this new one. (The converse - is not true, naturally.) -
-
- -
-Lemma cequiv__cequiv' : ∀(c1 c2: com),
-  cequiv c1 c2 → cequiv' c1 c2.
-Proof.
-  unfold cequiv, cequiv'; split; intros.
-    inversion H0 ; subst. apply E_equiv with st'0.
-    apply (H st st'0); assumption. assumption.
-    inversion H0 ; subst. apply E_equiv with st'0.
-    apply (H st st'0). assumption. assumption.
-Qed.
- -
-
- -
-

Exercise: 2 stars, optional (identity_assignment')

- Finally, here is our example once more... (You can complete the - proof.) -
-
- -
-Example identity_assignment' :
-  cequiv' SKIP (X ::= AId X).
-Proof.
-    unfold cequiv'. intros. split; intros.
-    Case "→".
-      inversion H; subst; clear H. inversion H0; subst.
-      apply E_equiv with (update st'0 X (st'0 X)).
-      constructor. reflexivity. apply stequiv_trans with st'0.
-      unfold stequiv. intros. apply update_same.
-      reflexivity. assumption.
-    Case "←".
-      (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - On the whole, this explicit equivalence approach is considerably - harder to work with than relying on functional - extensionality. (Coq does have an advanced mechanism called - "setoids" that makes working with equivalences somewhat easier, by - allowing them to be registered with the system so that standard - rewriting tactics work for them almost as well as for equalities.) - But it is worth knowing about, because it applies even in - situations where the equivalence in question is not over - functions. For example, if we chose to represent state mappings - as binary search trees, we would need to use an explicit - equivalence of this kind. -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 4 stars, optional (for_while_equiv)

- This exercise extends the optional add_for_loop exercise from - Imp.v, where you were asked to extend the language of commands - with C-style for loops. Prove that the command: - -
- -
-      for (c1 ; b ; c2) {
-          c3
-      } -
- -
- is equivalent to: - -
- -
-       c1 ; 
-       WHILE b DO
-         c3 ;
-         c2
-       END -
- -
- -
-
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars, optional (swap_noninterfering_assignments)

- -
-
-Theorem swap_noninterfering_assignments: ∀l1 l2 a1 a2,
-  l1 ≠ l2 →
-  var_not_used_in_aexp l1 a2 →
-  var_not_used_in_aexp l2 a1 →
-  cequiv
-    (l1 ::= a1;; l2 ::= a2)
-    (l2 ::= a2;; l1 ::= a1).
-Proof.
-(* Hint: You'll need functional_extensionality *)
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Equiv.v b/Equiv.v deleted file mode 100644 index 45ba5ef..0000000 --- a/Equiv.v +++ /dev/null @@ -1,1773 +0,0 @@ -(** * Equiv: Program Equivalence *) - - - -Require Export Imp. - -(** *** Some general advice for working on exercises: - - - Most of the Coq proofs we ask you to do are similar to proofs - that we've provided. Before starting to work on the homework - problems, take the time to work through our proofs (both - informally, on paper, and in Coq) and make sure you understand - them in detail. This will save you a lot of time. - - - The Coq proofs we're doing now are sufficiently complicated that - it is more or less impossible to complete them simply by random - experimentation or "following your nose." You need to start - with an idea about why the property is true and how the proof is - going to go. The best way to do this is to write out at least a - sketch of an informal proof on paper -- one that intuitively - convinces you of the truth of the theorem -- before starting to - work on the formal one. Alternately, grab a friend and try to - convince them that the theorem is true; then try to formalize - your explanation. - - - Use automation to save work! Some of the proofs in this - chapter's exercises are pretty long if you try to write out all - the cases explicitly. *) - -(* ####################################################### *) -(** * Behavioral Equivalence *) - -(** In the last chapter, we investigated the correctness of a very - simple program transformation: the [optimize_0plus] function. The - programming language we were considering was the first version of - the language of arithmetic expressions -- with no variables -- so - in that setting it was very easy to define what it _means_ for a - program transformation to be correct: it should always yield a - program that evaluates to the same number as the original. - - To go further and talk about the correctness of program - transformations in the full Imp language, we need to consider the - role of variables and state. *) - -(* ####################################################### *) -(** ** Definitions *) - -(** For [aexp]s and [bexp]s with variables, the definition we want is - clear. We say - that two [aexp]s or [bexp]s are _behaviorally equivalent_ if they - evaluate to the same result _in every state_. *) - -Definition aequiv (a1 a2 : aexp) : Prop := - forall (st:state), - aeval st a1 = aeval st a2. - -Definition bequiv (b1 b2 : bexp) : Prop := - forall (st:state), - beval st b1 = beval st b2. - -(** For commands, the situation is a little more subtle. We can't - simply say "two commands are behaviorally equivalent if they - evaluate to the same ending state whenever they are started in the - same initial state," because some commands (in some starting - states) don't terminate in any final state at all! What we need - instead is this: two commands are behaviorally equivalent if, for - any given starting state, they either both diverge or both - terminate in the same final state. A compact way to express this - is "if the first one terminates in a particular state then so does - the second, and vice versa." *) - -Definition cequiv (c1 c2 : com) : Prop := - forall (st st' : state), - (c1 / st || st') <-> (c2 / st || st'). - - - -(** **** Exercise: 2 stars (equiv_classes) *) - -(** Given the following programs, group together those that are - equivalent in [Imp]. For example, if you think programs (a) - through (h) are all equivalent to each other, but not to (i), your - answer should look like this: {a,b,c,d,e,f,g,h} {i}. - -(a) - WHILE X > 0 DO - X ::= X + 1 - END - -(b) - IFB X = 0 THEN - X ::= X + 1;; - Y ::= 1 - ELSE - Y ::= 0 - FI;; - X ::= X - Y;; - Y ::= 0 - -(c) - SKIP - -(d) - WHILE X <> 0 DO - X ::= X * Y + 1 - END - -(e) - Y ::= 0 - -(f) - Y ::= X + 1;; - WHILE X <> Y DO - Y ::= X + 1 - END - -(g) - WHILE TRUE DO - SKIP - END - -(h) - WHILE X <> X DO - X ::= X + 1 - END - -(i) - WHILE X <> Y DO - X ::= Y + 1 - END - -(* FILL IN HERE *) -[] *) - - -(* ####################################################### *) -(** ** Examples *) - -(** Here are some simple examples of equivalences of arithmetic - and boolean expressions. *) - -Theorem aequiv_example: - aequiv (AMinus (AId X) (AId X)) (ANum 0). -Proof. - intros st. simpl. omega. -Qed. - -Theorem bequiv_example: - bequiv (BEq (AMinus (AId X) (AId X)) (ANum 0)) BTrue. -Proof. - intros st. unfold beval. - rewrite aequiv_example. reflexivity. -Qed. - -(** For examples of command equivalence, let's start by looking at - some trivial program transformations involving [SKIP]: *) - -Theorem skip_left: forall c, - cequiv - (SKIP;; c) - c. -Proof. - (* WORKED IN CLASS *) - intros c st st'. - split; intros H. - Case "->". - inversion H. subst. - inversion H2. subst. - assumption. - Case "<-". - apply E_Seq with st. - apply E_Skip. - assumption. -Qed. - -(** **** Exercise: 2 stars (skip_right) *) -(** Prove that adding a SKIP after a command results in an equivalent - program *) - -Theorem skip_right: forall c, - cequiv - (c;; SKIP) - c. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Similarly, here is a simple transformations that simplifies [IFB] - commands: *) - -Theorem IFB_true_simple: forall c1 c2, - cequiv - (IFB BTrue THEN c1 ELSE c2 FI) - c1. -Proof. - intros c1 c2. - split; intros H. - Case "->". - inversion H; subst. assumption. inversion H5. - Case "<-". - apply E_IfTrue. reflexivity. assumption. Qed. - - -(** Of course, few programmers would be tempted to write a conditional - whose guard is literally [BTrue]. A more interesting case is when - the guard is _equivalent_ to true: - - _Theorem_: If [b] is equivalent to [BTrue], then [IFB b THEN c1 - ELSE c2 FI] is equivalent to [c1]. -*) -(** ** *) -(** - _Proof_: - - - ([->]) We must show, for all [st] and [st'], that if [IFB b - THEN c1 ELSE c2 FI / st || st'] then [c1 / st || st']. - - Proceed by cases on the rules that could possibly have been - used to show [IFB b THEN c1 ELSE c2 FI / st || st'], namely - [E_IfTrue] and [E_IfFalse]. - - - Suppose the final rule rule in the derivation of [IFB b THEN - c1 ELSE c2 FI / st || st'] was [E_IfTrue]. We then have, by - the premises of [E_IfTrue], that [c1 / st || st']. This is - exactly what we set out to prove. - - - On the other hand, suppose the final rule in the derivation - of [IFB b THEN c1 ELSE c2 FI / st || st'] was [E_IfFalse]. - We then know that [beval st b = false] and [c2 / st || st']. - - Recall that [b] is equivalent to [BTrue], i.e. forall [st], - [beval st b = beval st BTrue]. In particular, this means - that [beval st b = true], since [beval st BTrue = true]. But - this is a contradiction, since [E_IfFalse] requires that - [beval st b = false]. Thus, the final rule could not have - been [E_IfFalse]. - - - ([<-]) We must show, for all [st] and [st'], that if [c1 / st - || st'] then [IFB b THEN c1 ELSE c2 FI / st || st']. - - Since [b] is equivalent to [BTrue], we know that [beval st b] = - [beval st BTrue] = [true]. Together with the assumption that - [c1 / st || st'], we can apply [E_IfTrue] to derive [IFB b THEN - c1 ELSE c2 FI / st || st']. [] - - Here is the formal version of this proof: *) - -Theorem IFB_true: forall b c1 c2, - bequiv b BTrue -> - cequiv - (IFB b THEN c1 ELSE c2 FI) - c1. -Proof. - intros b c1 c2 Hb. - split; intros H. - Case "->". - inversion H; subst. - SCase "b evaluates to true". - assumption. - SCase "b evaluates to false (contradiction)". - unfold bequiv in Hb. simpl in Hb. - rewrite Hb in H5. - inversion H5. - Case "<-". - apply E_IfTrue; try assumption. - unfold bequiv in Hb. simpl in Hb. - rewrite Hb. reflexivity. Qed. - -(** **** Exercise: 2 stars (IFB_false) *) -Theorem IFB_false: forall b c1 c2, - bequiv b BFalse -> - cequiv - (IFB b THEN c1 ELSE c2 FI) - c2. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (swap_if_branches) *) -(** Show that we can swap the branches of an IF by negating its - condition *) - -Theorem swap_if_branches: forall b e1 e2, - cequiv - (IFB b THEN e1 ELSE e2 FI) - (IFB BNot b THEN e2 ELSE e1 FI). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** ** *) - -(** For [WHILE] loops, we can give a similar pair of theorems. A loop - whose guard is equivalent to [BFalse] is equivalent to [SKIP], - while a loop whose guard is equivalent to [BTrue] is equivalent to - [WHILE BTrue DO SKIP END] (or any other non-terminating program). - The first of these facts is easy. *) - -Theorem WHILE_false : forall b c, - bequiv b BFalse -> - cequiv - (WHILE b DO c END) - SKIP. -Proof. - intros b c Hb. split; intros H. - Case "->". - inversion H; subst. - SCase "E_WhileEnd". - apply E_Skip. - SCase "E_WhileLoop". - rewrite Hb in H2. inversion H2. - Case "<-". - inversion H; subst. - apply E_WhileEnd. - rewrite Hb. - reflexivity. Qed. - -(** **** Exercise: 2 stars, advanced, optional (WHILE_false_informal) *) -(** Write an informal proof of [WHILE_false]. - -(* FILL IN HERE *) -[] -*) - -(** ** *) -(** To prove the second fact, we need an auxiliary lemma stating that - [WHILE] loops whose guards are equivalent to [BTrue] never - terminate: - - _Lemma_: If [b] is equivalent to [BTrue], then it cannot be the - case that [(WHILE b DO c END) / st || st']. - - _Proof_: Suppose that [(WHILE b DO c END) / st || st']. We show, - by induction on a derivation of [(WHILE b DO c END) / st || st'], - that this assumption leads to a contradiction. - - - Suppose [(WHILE b DO c END) / st || st'] is proved using rule - [E_WhileEnd]. Then by assumption [beval st b = false]. But - this contradicts the assumption that [b] is equivalent to - [BTrue]. - - - Suppose [(WHILE b DO c END) / st || st'] is proved using rule - [E_WhileLoop]. Then we are given the induction hypothesis - that [(WHILE b DO c END) / st || st'] is contradictory, which - is exactly what we are trying to prove! - - - Since these are the only rules that could have been used to - prove [(WHILE b DO c END) / st || st'], the other cases of - the induction are immediately contradictory. [] *) - -Lemma WHILE_true_nonterm : forall b c st st', - bequiv b BTrue -> - ~( (WHILE b DO c END) / st || st' ). -Proof. - (* WORKED IN CLASS *) - intros b c st st' Hb. - intros H. - remember (WHILE b DO c END) as cw eqn:Heqcw. - ceval_cases (induction H) Case; - (* Most rules don't apply, and we can rule them out - by inversion *) - inversion Heqcw; subst; clear Heqcw. - (* The two interesting cases are the ones for WHILE loops: *) - Case "E_WhileEnd". (* contradictory -- b is always true! *) - unfold bequiv in Hb. - (* [rewrite] is able to instantiate the quantifier in [st] *) - rewrite Hb in H. inversion H. - Case "E_WhileLoop". (* immediate from the IH *) - apply IHceval2. reflexivity. Qed. - -(** **** Exercise: 2 stars, optional (WHILE_true_nonterm_informal) *) -(** Explain what the lemma [WHILE_true_nonterm] means in English. - -(* FILL IN HERE *) -*) -(** [] *) - -(** **** Exercise: 2 stars (WHILE_true) *) -(** Prove the following theorem. _Hint_: You'll want to use - [WHILE_true_nonterm] here. *) - -Theorem WHILE_true: forall b c, - bequiv b BTrue -> - cequiv - (WHILE b DO c END) - (WHILE BTrue DO SKIP END). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -Theorem loop_unrolling: forall b c, - cequiv - (WHILE b DO c END) - (IFB b THEN (c;; WHILE b DO c END) ELSE SKIP FI). -Proof. - (* WORKED IN CLASS *) - intros b c st st'. - split; intros Hce. - Case "->". - inversion Hce; subst. - SCase "loop doesn't run". - apply E_IfFalse. assumption. apply E_Skip. - SCase "loop runs". - apply E_IfTrue. assumption. - apply E_Seq with (st' := st'0). assumption. assumption. - Case "<-". - inversion Hce; subst. - SCase "loop runs". - inversion H5; subst. - apply E_WhileLoop with (st' := st'0). - assumption. assumption. assumption. - SCase "loop doesn't run". - inversion H5; subst. apply E_WhileEnd. assumption. Qed. - -(** **** Exercise: 2 stars, optional (seq_assoc) *) -Theorem seq_assoc : forall c1 c2 c3, - cequiv ((c1;;c2);;c3) (c1;;(c2;;c3)). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** ** The Functional Equivalence Axiom *) - -(** Finally, let's look at simple equivalences involving assignments. - For example, we might expect to be able to show that [X ::= AId X] - is equivalent to [SKIP]. However, when we try to show it, we get - stuck in an interesting way. *) - -Theorem identity_assignment_first_try : forall (X:id), - cequiv (X ::= AId X) SKIP. -Proof. - intros. split; intro H. - Case "->". - inversion H; subst. simpl. - replace (update st X (st X)) with st. - constructor. - (* Stuck... *) Abort. - -(** Here we're stuck. The goal looks reasonable, but in fact it is not - provable! If we look back at the set of lemmas we proved about - [update] in the last chapter, we can see that lemma [update_same] - almost does the job, but not quite: it says that the original and - updated states agree at all values, but this is not the same thing - as saying that they are [=] in Coq's sense! *) - -(** What is going on here? Recall that our states are just - functions from identifiers to values. For Coq, functions are only - equal when their definitions are syntactically the same, modulo - simplification. (This is the only way we can legally apply the - [refl_equal] constructor of the inductively defined proposition - [eq]!) In practice, for functions built up by repeated uses of the - [update] operation, this means that two functions can be proven - equal only if they were constructed using the _same_ [update] - operations, applied in the same order. In the theorem above, the - sequence of updates on the first parameter [cequiv] is one longer - than for the second parameter, so it is no wonder that the - equality doesn't hold. *) - -(** ** *) -(** This problem is actually quite general. If we try to prove other - simple facts, such as - cequiv (X ::= X + 1;; - X ::= X + 1) - (X ::= X + 2) - or - cequiv (X ::= 1;; Y ::= 2) - (y ::= 2;; X ::= 1) - - we'll get stuck in the same way: we'll have two functions that - behave the same way on all inputs, but cannot be proven to be [eq] - to each other. - - The reasoning principle we would like to use in these situations - is called _functional extensionality_: - forall x, f x = g x - ------------------- - f = g - Although this principle is not derivable in Coq's built-in logic, - it is safe to add it as an additional _axiom_. *) - -Axiom functional_extensionality : forall {X Y: Type} {f g : X -> Y}, - (forall (x: X), f x = g x) -> f = g. - -(** It can be shown that adding this axiom doesn't introduce any - inconsistencies into Coq. (In this way, it is similar to adding - one of the classical logic axioms, such as [excluded_middle].) *) - -(** With the benefit of this axiom we can prove our theorem. *) - -Theorem identity_assignment : forall (X:id), - cequiv - (X ::= AId X) - SKIP. -Proof. - intros. split; intro H. - Case "->". - inversion H; subst. simpl. - replace (update st X (st X)) with st. - constructor. - apply functional_extensionality. intro. - rewrite update_same; reflexivity. - Case "<-". - inversion H; subst. - assert (st' = (update st' X (st' X))). - apply functional_extensionality. intro. - rewrite update_same; reflexivity. - rewrite H0 at 2. - constructor. reflexivity. -Qed. - -(** **** Exercise: 2 stars (assign_aequiv) *) -Theorem assign_aequiv : forall X e, - aequiv (AId X) e -> - cequiv SKIP (X ::= e). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ####################################################### *) -(** * Properties of Behavioral Equivalence *) - -(** We now turn to developing some of the properties of the program - equivalences we have defined. *) - -(* ####################################################### *) -(** ** Behavioral Equivalence is an Equivalence *) - -(** First, we verify that the equivalences on [aexps], [bexps], and - [com]s really are _equivalences_ -- i.e., that they are reflexive, - symmetric, and transitive. The proofs are all easy. *) - -Lemma refl_aequiv : forall (a : aexp), aequiv a a. -Proof. - intros a st. reflexivity. Qed. - -Lemma sym_aequiv : forall (a1 a2 : aexp), - aequiv a1 a2 -> aequiv a2 a1. -Proof. - intros a1 a2 H. intros st. symmetry. apply H. Qed. - -Lemma trans_aequiv : forall (a1 a2 a3 : aexp), - aequiv a1 a2 -> aequiv a2 a3 -> aequiv a1 a3. -Proof. - unfold aequiv. intros a1 a2 a3 H12 H23 st. - rewrite (H12 st). rewrite (H23 st). reflexivity. Qed. - -Lemma refl_bequiv : forall (b : bexp), bequiv b b. -Proof. - unfold bequiv. intros b st. reflexivity. Qed. - -Lemma sym_bequiv : forall (b1 b2 : bexp), - bequiv b1 b2 -> bequiv b2 b1. -Proof. - unfold bequiv. intros b1 b2 H. intros st. symmetry. apply H. Qed. - -Lemma trans_bequiv : forall (b1 b2 b3 : bexp), - bequiv b1 b2 -> bequiv b2 b3 -> bequiv b1 b3. -Proof. - unfold bequiv. intros b1 b2 b3 H12 H23 st. - rewrite (H12 st). rewrite (H23 st). reflexivity. Qed. - -Lemma refl_cequiv : forall (c : com), cequiv c c. -Proof. - unfold cequiv. intros c st st'. apply iff_refl. Qed. - -Lemma sym_cequiv : forall (c1 c2 : com), - cequiv c1 c2 -> cequiv c2 c1. -Proof. - unfold cequiv. intros c1 c2 H st st'. - assert (c1 / st || st' <-> c2 / st || st') as H'. - SCase "Proof of assertion". apply H. - apply iff_sym. assumption. -Qed. - -Lemma iff_trans : forall (P1 P2 P3 : Prop), - (P1 <-> P2) -> (P2 <-> P3) -> (P1 <-> P3). -Proof. - intros P1 P2 P3 H12 H23. - inversion H12. inversion H23. - split; intros A. - apply H1. apply H. apply A. - apply H0. apply H2. apply A. Qed. - -Lemma trans_cequiv : forall (c1 c2 c3 : com), - cequiv c1 c2 -> cequiv c2 c3 -> cequiv c1 c3. -Proof. - unfold cequiv. intros c1 c2 c3 H12 H23 st st'. - apply iff_trans with (c2 / st || st'). apply H12. apply H23. Qed. - -(* ######################################################## *) -(** ** Behavioral Equivalence is a Congruence *) - -(** Less obviously, behavioral equivalence is also a _congruence_. - That is, the equivalence of two subprograms implies the - equivalence of the larger programs in which they are embedded: - aequiv a1 a1' - ----------------------------- - cequiv (i ::= a1) (i ::= a1') - - cequiv c1 c1' - cequiv c2 c2' - ------------------------ - cequiv (c1;;c2) (c1';;c2') - ...and so on. - - (Note that we are using the inference rule notation here not as - part of a definition, but simply to write down some valid - implications in a readable format. We prove these implications - below.) *) - -(** We will see a concrete example of why these congruence - properties are important in the following section (in the proof of - [fold_constants_com_sound]), but the main idea is that they allow - us to replace a small part of a large program with an equivalent - small part and know that the whole large programs are equivalent - _without_ doing an explicit proof about the non-varying parts -- - i.e., the "proof burden" of a small change to a large program is - proportional to the size of the change, not the program. *) - -Theorem CAss_congruence : forall i a1 a1', - aequiv a1 a1' -> - cequiv (CAss i a1) (CAss i a1'). -Proof. - intros i a1 a2 Heqv st st'. - split; intros Hceval. - Case "->". - inversion Hceval. subst. apply E_Ass. - rewrite Heqv. reflexivity. - Case "<-". - inversion Hceval. subst. apply E_Ass. - rewrite Heqv. reflexivity. Qed. - -(** The congruence property for loops is a little more interesting, - since it requires induction. - - _Theorem_: Equivalence is a congruence for [WHILE] -- that is, if - [b1] is equivalent to [b1'] and [c1] is equivalent to [c1'], then - [WHILE b1 DO c1 END] is equivalent to [WHILE b1' DO c1' END]. - - _Proof_: Suppose [b1] is equivalent to [b1'] and [c1] is - equivalent to [c1']. We must show, for every [st] and [st'], that - [WHILE b1 DO c1 END / st || st'] iff [WHILE b1' DO c1' END / st - || st']. We consider the two directions separately. - - - ([->]) We show that [WHILE b1 DO c1 END / st || st'] implies - [WHILE b1' DO c1' END / st || st'], by induction on a - derivation of [WHILE b1 DO c1 END / st || st']. The only - nontrivial cases are when the final rule in the derivation is - [E_WhileEnd] or [E_WhileLoop]. - - - [E_WhileEnd]: In this case, the form of the rule gives us - [beval st b1 = false] and [st = st']. But then, since - [b1] and [b1'] are equivalent, we have [beval st b1' = - false], and [E-WhileEnd] applies, giving us [WHILE b1' DO - c1' END / st || st'], as required. - - - [E_WhileLoop]: The form of the rule now gives us [beval st - b1 = true], with [c1 / st || st'0] and [WHILE b1 DO c1 - END / st'0 || st'] for some state [st'0], with the - induction hypothesis [WHILE b1' DO c1' END / st'0 || - st']. - - Since [c1] and [c1'] are equivalent, we know that [c1' / - st || st'0]. And since [b1] and [b1'] are equivalent, we - have [beval st b1' = true]. Now [E-WhileLoop] applies, - giving us [WHILE b1' DO c1' END / st || st'], as - required. - - - ([<-]) Similar. [] *) - -Theorem CWhile_congruence : forall b1 b1' c1 c1', - bequiv b1 b1' -> cequiv c1 c1' -> - cequiv (WHILE b1 DO c1 END) (WHILE b1' DO c1' END). -Proof. - (* WORKED IN CLASS *) - unfold bequiv,cequiv. - intros b1 b1' c1 c1' Hb1e Hc1e st st'. - split; intros Hce. - Case "->". - remember (WHILE b1 DO c1 END) as cwhile eqn:Heqcwhile. - induction Hce; inversion Heqcwhile; subst. - SCase "E_WhileEnd". - apply E_WhileEnd. rewrite <- Hb1e. apply H. - SCase "E_WhileLoop". - apply E_WhileLoop with (st' := st'). - SSCase "show loop runs". rewrite <- Hb1e. apply H. - SSCase "body execution". - apply (Hc1e st st'). apply Hce1. - SSCase "subsequent loop execution". - apply IHHce2. reflexivity. - Case "<-". - remember (WHILE b1' DO c1' END) as c'while eqn:Heqc'while. - induction Hce; inversion Heqc'while; subst. - SCase "E_WhileEnd". - apply E_WhileEnd. rewrite -> Hb1e. apply H. - SCase "E_WhileLoop". - apply E_WhileLoop with (st' := st'). - SSCase "show loop runs". rewrite -> Hb1e. apply H. - SSCase "body execution". - apply (Hc1e st st'). apply Hce1. - SSCase "subsequent loop execution". - apply IHHce2. reflexivity. Qed. - -(** **** Exercise: 3 stars, optional (CSeq_congruence) *) -Theorem CSeq_congruence : forall c1 c1' c2 c2', - cequiv c1 c1' -> cequiv c2 c2' -> - cequiv (c1;;c2) (c1';;c2'). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (CIf_congruence) *) -Theorem CIf_congruence : forall b b' c1 c1' c2 c2', - bequiv b b' -> cequiv c1 c1' -> cequiv c2 c2' -> - cequiv (IFB b THEN c1 ELSE c2 FI) (IFB b' THEN c1' ELSE c2' FI). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** ** *) - -(** For example, here are two equivalent programs and a proof of their - equivalence... *) - -Example congruence_example: - cequiv - (* Program 1: *) - (X ::= ANum 0;; - IFB (BEq (AId X) (ANum 0)) - THEN - Y ::= ANum 0 - ELSE - Y ::= ANum 42 - FI) - (* Program 2: *) - (X ::= ANum 0;; - IFB (BEq (AId X) (ANum 0)) - THEN - Y ::= AMinus (AId X) (AId X) (* <--- changed here *) - ELSE - Y ::= ANum 42 - FI). -Proof. - apply CSeq_congruence. - apply refl_cequiv. - apply CIf_congruence. - apply refl_bequiv. - apply CAss_congruence. unfold aequiv. simpl. - symmetry. apply minus_diag. - apply refl_cequiv. -Qed. - -(* ####################################################### *) -(** * Program Transformations *) - -(** A _program transformation_ is a function that takes a program - as input and produces some variant of the program as its - output. Compiler optimizations such as constant folding are - a canonical example, but there are many others. *) - -(** A program transformation is _sound_ if it preserves the - behavior of the original program. - - We can define a notion of soundness for translations of - [aexp]s, [bexp]s, and [com]s. *) - -Definition atrans_sound (atrans : aexp -> aexp) : Prop := - forall (a : aexp), - aequiv a (atrans a). - -Definition btrans_sound (btrans : bexp -> bexp) : Prop := - forall (b : bexp), - bequiv b (btrans b). - -Definition ctrans_sound (ctrans : com -> com) : Prop := - forall (c : com), - cequiv c (ctrans c). - -(* ######################################################## *) -(** ** The Constant-Folding Transformation *) - -(** An expression is _constant_ when it contains no variable - references. - - Constant folding is an optimization that finds constant - expressions and replaces them by their values. *) - -Fixpoint fold_constants_aexp (a : aexp) : aexp := - match a with - | ANum n => ANum n - | AId i => AId i - | APlus a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp a2) with - | (ANum n1, ANum n2) => ANum (n1 + n2) - | (a1', a2') => APlus a1' a2' - end - | AMinus a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp a2) with - | (ANum n1, ANum n2) => ANum (n1 - n2) - | (a1', a2') => AMinus a1' a2' - end - | AMult a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp a2) with - | (ANum n1, ANum n2) => ANum (n1 * n2) - | (a1', a2') => AMult a1' a2' - end - end. - -Example fold_aexp_ex1 : - fold_constants_aexp - (AMult (APlus (ANum 1) (ANum 2)) (AId X)) - = AMult (ANum 3) (AId X). -Proof. reflexivity. Qed. - -(** Note that this version of constant folding doesn't eliminate - trivial additions, etc. -- we are focusing attention on a single - optimization for the sake of simplicity. It is not hard to - incorporate other ways of simplifying expressions; the definitions - and proofs just get longer. *) - -Example fold_aexp_ex2 : - fold_constants_aexp - (AMinus (AId X) (APlus (AMult (ANum 0) (ANum 6)) (AId Y))) - = AMinus (AId X) (APlus (ANum 0) (AId Y)). -Proof. reflexivity. Qed. - -(** ** *) -(** Not only can we lift [fold_constants_aexp] to [bexp]s (in the - [BEq] and [BLe] cases), we can also find constant _boolean_ - expressions and reduce them in-place. *) - -Fixpoint fold_constants_bexp (b : bexp) : bexp := - match b with - | BTrue => BTrue - | BFalse => BFalse - | BEq a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp a2) with - | (ANum n1, ANum n2) => if beq_nat n1 n2 then BTrue else BFalse - | (a1', a2') => BEq a1' a2' - end - | BLe a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp a2) with - | (ANum n1, ANum n2) => if ble_nat n1 n2 then BTrue else BFalse - | (a1', a2') => BLe a1' a2' - end - | BNot b1 => - match (fold_constants_bexp b1) with - | BTrue => BFalse - | BFalse => BTrue - | b1' => BNot b1' - end - | BAnd b1 b2 => - match (fold_constants_bexp b1, fold_constants_bexp b2) with - | (BTrue, BTrue) => BTrue - | (BTrue, BFalse) => BFalse - | (BFalse, BTrue) => BFalse - | (BFalse, BFalse) => BFalse - | (b1', b2') => BAnd b1' b2' - end - end. - -Example fold_bexp_ex1 : - fold_constants_bexp (BAnd BTrue (BNot (BAnd BFalse BTrue))) - = BTrue. -Proof. reflexivity. Qed. - -Example fold_bexp_ex2 : - fold_constants_bexp - (BAnd (BEq (AId X) (AId Y)) - (BEq (ANum 0) - (AMinus (ANum 2) (APlus (ANum 1) (ANum 1))))) - = BAnd (BEq (AId X) (AId Y)) BTrue. -Proof. reflexivity. Qed. - -(** ** *) -(** To fold constants in a command, we apply the appropriate folding - functions on all embedded expressions. *) - -Fixpoint fold_constants_com (c : com) : com := - match c with - | SKIP => - SKIP - | i ::= a => - CAss i (fold_constants_aexp a) - | c1 ;; c2 => - (fold_constants_com c1) ;; (fold_constants_com c2) - | IFB b THEN c1 ELSE c2 FI => - match fold_constants_bexp b with - | BTrue => fold_constants_com c1 - | BFalse => fold_constants_com c2 - | b' => IFB b' THEN fold_constants_com c1 - ELSE fold_constants_com c2 FI - end - | WHILE b DO c END => - match fold_constants_bexp b with - | BTrue => WHILE BTrue DO SKIP END - | BFalse => SKIP - | b' => WHILE b' DO (fold_constants_com c) END - end - end. - -(** ** *) -Example fold_com_ex1 : - fold_constants_com - (* Original program: *) - (X ::= APlus (ANum 4) (ANum 5);; - Y ::= AMinus (AId X) (ANum 3);; - IFB BEq (AMinus (AId X) (AId Y)) (APlus (ANum 2) (ANum 4)) THEN - SKIP - ELSE - Y ::= ANum 0 - FI;; - IFB BLe (ANum 0) (AMinus (ANum 4) (APlus (ANum 2) (ANum 1))) THEN - Y ::= ANum 0 - ELSE - SKIP - FI;; - WHILE BEq (AId Y) (ANum 0) DO - X ::= APlus (AId X) (ANum 1) - END) - = (* After constant folding: *) - (X ::= ANum 9;; - Y ::= AMinus (AId X) (ANum 3);; - IFB BEq (AMinus (AId X) (AId Y)) (ANum 6) THEN - SKIP - ELSE - (Y ::= ANum 0) - FI;; - Y ::= ANum 0;; - WHILE BEq (AId Y) (ANum 0) DO - X ::= APlus (AId X) (ANum 1) - END). -Proof. reflexivity. Qed. - -(* ################################################### *) -(** ** Soundness of Constant Folding *) - -(** Now we need to show that what we've done is correct. *) - -(** Here's the proof for arithmetic expressions: *) - -Theorem fold_constants_aexp_sound : - atrans_sound fold_constants_aexp. -Proof. - unfold atrans_sound. intros a. unfold aequiv. intros st. - aexp_cases (induction a) Case; simpl; - (* ANum and AId follow immediately *) - try reflexivity; - (* APlus, AMinus, and AMult follow from the IH - and the observation that - aeval st (APlus a1 a2) - = ANum ((aeval st a1) + (aeval st a2)) - = aeval st (ANum ((aeval st a1) + (aeval st a2))) - (and similarly for AMinus/minus and AMult/mult) *) - try (destruct (fold_constants_aexp a1); - destruct (fold_constants_aexp a2); - rewrite IHa1; rewrite IHa2; reflexivity). Qed. - -(** **** Exercise: 3 stars, optional (fold_bexp_Eq_informal) *) -(** Here is an informal proof of the [BEq] case of the soundness - argument for boolean expression constant folding. Read it - carefully and compare it to the formal proof that follows. Then - fill in the [BLe] case of the formal proof (without looking at the - [BEq] case, if possible). - - _Theorem_: The constant folding function for booleans, - [fold_constants_bexp], is sound. - - _Proof_: We must show that [b] is equivalent to [fold_constants_bexp], - for all boolean expressions [b]. Proceed by induction on [b]. We - show just the case where [b] has the form [BEq a1 a2]. - - In this case, we must show - beval st (BEq a1 a2) - = beval st (fold_constants_bexp (BEq a1 a2)). - There are two cases to consider: - - - First, suppose [fold_constants_aexp a1 = ANum n1] and - [fold_constants_aexp a2 = ANum n2] for some [n1] and [n2]. - - In this case, we have - fold_constants_bexp (BEq a1 a2) - = if beq_nat n1 n2 then BTrue else BFalse - and - beval st (BEq a1 a2) - = beq_nat (aeval st a1) (aeval st a2). - By the soundness of constant folding for arithmetic - expressions (Lemma [fold_constants_aexp_sound]), we know - aeval st a1 - = aeval st (fold_constants_aexp a1) - = aeval st (ANum n1) - = n1 - and - aeval st a2 - = aeval st (fold_constants_aexp a2) - = aeval st (ANum n2) - = n2, - so - beval st (BEq a1 a2) - = beq_nat (aeval a1) (aeval a2) - = beq_nat n1 n2. - Also, it is easy to see (by considering the cases [n1 = n2] and - [n1 <> n2] separately) that - beval st (if beq_nat n1 n2 then BTrue else BFalse) - = if beq_nat n1 n2 then beval st BTrue else beval st BFalse - = if beq_nat n1 n2 then true else false - = beq_nat n1 n2. - So - beval st (BEq a1 a2) - = beq_nat n1 n2. - = beval st (if beq_nat n1 n2 then BTrue else BFalse), -]] - as required. - - - Otherwise, one of [fold_constants_aexp a1] and - [fold_constants_aexp a2] is not a constant. In this case, we - must show - beval st (BEq a1 a2) - = beval st (BEq (fold_constants_aexp a1) - (fold_constants_aexp a2)), - which, by the definition of [beval], is the same as showing - beq_nat (aeval st a1) (aeval st a2) - = beq_nat (aeval st (fold_constants_aexp a1)) - (aeval st (fold_constants_aexp a2)). - But the soundness of constant folding for arithmetic - expressions ([fold_constants_aexp_sound]) gives us - aeval st a1 = aeval st (fold_constants_aexp a1) - aeval st a2 = aeval st (fold_constants_aexp a2), - completing the case. [] -*) - -Theorem fold_constants_bexp_sound: - btrans_sound fold_constants_bexp. -Proof. - unfold btrans_sound. intros b. unfold bequiv. intros st. - bexp_cases (induction b) Case; - (* BTrue and BFalse are immediate *) - try reflexivity. - Case "BEq". - (* Doing induction when there are a lot of constructors makes - specifying variable names a chore, but Coq doesn't always - choose nice variable names. We can rename entries in the - context with the [rename] tactic: [rename a into a1] will - change [a] to [a1] in the current goal and context. *) - rename a into a1. rename a0 into a2. simpl. - remember (fold_constants_aexp a1) as a1' eqn:Heqa1'. - remember (fold_constants_aexp a2) as a2' eqn:Heqa2'. - replace (aeval st a1) with (aeval st a1') by - (subst a1'; rewrite <- fold_constants_aexp_sound; reflexivity). - replace (aeval st a2) with (aeval st a2') by - (subst a2'; rewrite <- fold_constants_aexp_sound; reflexivity). - destruct a1'; destruct a2'; try reflexivity. - (* The only interesting case is when both a1 and a2 - become constants after folding *) - simpl. destruct (beq_nat n n0); reflexivity. - Case "BLe". - (* FILL IN HERE *) admit. - Case "BNot". - simpl. remember (fold_constants_bexp b) as b' eqn:Heqb'. - rewrite IHb. - destruct b'; reflexivity. - Case "BAnd". - simpl. - remember (fold_constants_bexp b1) as b1' eqn:Heqb1'. - remember (fold_constants_bexp b2) as b2' eqn:Heqb2'. - rewrite IHb1. rewrite IHb2. - destruct b1'; destruct b2'; reflexivity. Qed. -(** [] *) - -(** **** Exercise: 3 stars (fold_constants_com_sound) *) -(** Complete the [WHILE] case of the following proof. *) - -Theorem fold_constants_com_sound : - ctrans_sound fold_constants_com. -Proof. - unfold ctrans_sound. intros c. - com_cases (induction c) Case; simpl. - Case "SKIP". apply refl_cequiv. - Case "::=". apply CAss_congruence. apply fold_constants_aexp_sound. - Case ";;". apply CSeq_congruence; assumption. - Case "IFB". - assert (bequiv b (fold_constants_bexp b)). - SCase "Pf of assertion". apply fold_constants_bexp_sound. - destruct (fold_constants_bexp b) eqn:Heqb; - (* If the optimization doesn't eliminate the if, then the result - is easy to prove from the IH and fold_constants_bexp_sound *) - try (apply CIf_congruence; assumption). - SCase "b always true". - apply trans_cequiv with c1; try assumption. - apply IFB_true; assumption. - SCase "b always false". - apply trans_cequiv with c2; try assumption. - apply IFB_false; assumption. - Case "WHILE". - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ########################################################## *) -(** *** Soundness of (0 + n) Elimination, Redux *) - -(** **** Exercise: 4 stars, advanced, optional (optimize_0plus) *) -(** Recall the definition [optimize_0plus] from Imp.v: - Fixpoint optimize_0plus (e:aexp) : aexp := - match e with - | ANum n => - ANum n - | APlus (ANum 0) e2 => - optimize_0plus e2 - | APlus e1 e2 => - APlus (optimize_0plus e1) (optimize_0plus e2) - | AMinus e1 e2 => - AMinus (optimize_0plus e1) (optimize_0plus e2) - | AMult e1 e2 => - AMult (optimize_0plus e1) (optimize_0plus e2) - end. - Note that this function is defined over the old [aexp]s, - without states. - - Write a new version of this function that accounts for variables, - and analogous ones for [bexp]s and commands: - optimize_0plus_aexp - optimize_0plus_bexp - optimize_0plus_com - Prove that these three functions are sound, as we did for - [fold_constants_*]. (Make sure you use the congruence lemmas in - the proof of [optimize_0plus_com] -- otherwise it will be _long_!) - - Then define an optimizer on commands that first folds - constants (using [fold_constants_com]) and then eliminates [0 + n] - terms (using [optimize_0plus_com]). - - - Give a meaningful example of this optimizer's output. - - - Prove that the optimizer is sound. (This part should be _very_ - easy.) *) - -(* FILL IN HERE *) -(** [] *) - -(* ####################################################### *) -(** * Proving That Programs Are _Not_ Equivalent *) - -(** Suppose that [c1] is a command of the form [X ::= a1;; Y ::= a2] - and [c2] is the command [X ::= a1;; Y ::= a2'], where [a2'] is - formed by substituting [a1] for all occurrences of [X] in [a2]. - For example, [c1] and [c2] might be: - c1 = (X ::= 42 + 53;; - Y ::= Y + X) - c2 = (X ::= 42 + 53;; - Y ::= Y + (42 + 53)) - Clearly, this _particular_ [c1] and [c2] are equivalent. Is this - true in general? *) - -(** We will see in a moment that it is not, but it is worthwhile - to pause, now, and see if you can find a counter-example on your - own. *) - -(** Here, formally, is the function that substitutes an arithmetic - expression for each occurrence of a given variable in another - expression: *) - -Fixpoint subst_aexp (i : id) (u : aexp) (a : aexp) : aexp := - match a with - | ANum n => ANum n - | AId i' => if eq_id_dec i i' then u else AId i' - | APlus a1 a2 => APlus (subst_aexp i u a1) (subst_aexp i u a2) - | AMinus a1 a2 => AMinus (subst_aexp i u a1) (subst_aexp i u a2) - | AMult a1 a2 => AMult (subst_aexp i u a1) (subst_aexp i u a2) - end. - -Example subst_aexp_ex : - subst_aexp X (APlus (ANum 42) (ANum 53)) (APlus (AId Y) (AId X)) = - (APlus (AId Y) (APlus (ANum 42) (ANum 53))). -Proof. reflexivity. Qed. - -(** And here is the property we are interested in, expressing the - claim that commands [c1] and [c2] as described above are - always equivalent. *) - -Definition subst_equiv_property := forall i1 i2 a1 a2, - cequiv (i1 ::= a1;; i2 ::= a2) - (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). - -(** ** *) -(** Sadly, the property does _not_ always hold. - - _Theorem_: It is not the case that, for all [i1], [i2], [a1], - and [a2], - cequiv (i1 ::= a1;; i2 ::= a2) - (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). -]] - _Proof_: Suppose, for a contradiction, that for all [i1], [i2], - [a1], and [a2], we have - cequiv (i1 ::= a1;; i2 ::= a2) - (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). - Consider the following program: - X ::= APlus (AId X) (ANum 1);; Y ::= AId X - Note that - (X ::= APlus (AId X) (ANum 1);; Y ::= AId X) - / empty_state || st1, - where [st1 = { X |-> 1, Y |-> 1 }]. - - By our assumption, we know that - cequiv (X ::= APlus (AId X) (ANum 1);; Y ::= AId X) - (X ::= APlus (AId X) (ANum 1);; Y ::= APlus (AId X) (ANum 1)) - so, by the definition of [cequiv], we have - (X ::= APlus (AId X) (ANum 1);; Y ::= APlus (AId X) (ANum 1)) - / empty_state || st1. - But we can also derive - (X ::= APlus (AId X) (ANum 1);; Y ::= APlus (AId X) (ANum 1)) - / empty_state || st2, - where [st2 = { X |-> 1, Y |-> 2 }]. Note that [st1 <> st2]; this - is a contradiction, since [ceval] is deterministic! [] *) - - -Theorem subst_inequiv : - ~ subst_equiv_property. -Proof. - unfold subst_equiv_property. - intros Contra. - - (* Here is the counterexample: assuming that [subst_equiv_property] - holds allows us to prove that these two programs are - equivalent... *) - remember (X ::= APlus (AId X) (ANum 1);; - Y ::= AId X) - as c1. - remember (X ::= APlus (AId X) (ANum 1);; - Y ::= APlus (AId X) (ANum 1)) - as c2. - assert (cequiv c1 c2) by (subst; apply Contra). - - (* ... allows us to show that the command [c2] can terminate - in two different final states: - st1 = {X |-> 1, Y |-> 1} - st2 = {X |-> 1, Y |-> 2}. *) - remember (update (update empty_state X 1) Y 1) as st1. - remember (update (update empty_state X 1) Y 2) as st2. - assert (H1: c1 / empty_state || st1); - assert (H2: c2 / empty_state || st2); - try (subst; - apply E_Seq with (st' := (update empty_state X 1)); - apply E_Ass; reflexivity). - apply H in H1. - - (* Finally, we use the fact that evaluation is deterministic - to obtain a contradiction. *) - assert (Hcontra: st1 = st2) - by (apply (ceval_deterministic c2 empty_state); assumption). - assert (Hcontra': st1 Y = st2 Y) - by (rewrite Hcontra; reflexivity). - subst. inversion Hcontra'. Qed. - -(** **** Exercise: 4 stars, optional (better_subst_equiv) *) -(** The equivalence we had in mind above was not complete nonsense -- - it was actually almost right. To make it correct, we just need to - exclude the case where the variable [X] occurs in the - right-hand-side of the first assignment statement. *) - -Inductive var_not_used_in_aexp (X:id) : aexp -> Prop := - | VNUNum: forall n, var_not_used_in_aexp X (ANum n) - | VNUId: forall Y, X <> Y -> var_not_used_in_aexp X (AId Y) - | VNUPlus: forall a1 a2, - var_not_used_in_aexp X a1 -> - var_not_used_in_aexp X a2 -> - var_not_used_in_aexp X (APlus a1 a2) - | VNUMinus: forall a1 a2, - var_not_used_in_aexp X a1 -> - var_not_used_in_aexp X a2 -> - var_not_used_in_aexp X (AMinus a1 a2) - | VNUMult: forall a1 a2, - var_not_used_in_aexp X a1 -> - var_not_used_in_aexp X a2 -> - var_not_used_in_aexp X (AMult a1 a2). - -Lemma aeval_weakening : forall i st a ni, - var_not_used_in_aexp i a -> - aeval (update st i ni) a = aeval st a. -Proof. - (* FILL IN HERE *) Admitted. - -(** Using [var_not_used_in_aexp], formalize and prove a correct verson - of [subst_equiv_property]. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars, optional (inequiv_exercise) *) -(** Prove that an infinite loop is not equivalent to [SKIP] *) - -Theorem inequiv_exercise: - ~ cequiv (WHILE BTrue DO SKIP END) SKIP. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** * Extended exercise: Non-deterministic Imp *) - -(** As we have seen (in theorem [ceval_deterministic] in the Imp - chapter), Imp's evaluation relation is deterministic. However, - _non_-determinism is an important part of the definition of many - real programming languages. For example, in many imperative - languages (such as C and its relatives), the order in which - function arguments are evaluated is unspecified. The program - fragment - x = 0;; - f(++x, x) - might call [f] with arguments [(1, 0)] or [(1, 1)], depending how - the compiler chooses to order things. This can be a little - confusing for programmers, but it gives the compiler writer useful - freedom. - - In this exercise, we will extend Imp with a simple - non-deterministic command and study how this change affects - program equivalence. The new command has the syntax [HAVOC X], - where [X] is an identifier. The effect of executing [HAVOC X] is - to assign an _arbitrary_ number to the variable [X], - non-deterministically. For example, after executing the program: - HAVOC Y;; - Z ::= Y * 2 - the value of [Y] can be any number, while the value of [Z] is - twice that of [Y] (so [Z] is always even). Note that we are not - saying anything about the _probabilities_ of the outcomes -- just - that there are (infinitely) many different outcomes that can - possibly happen after executing this non-deterministic code. - - In a sense a variable on which we do [HAVOC] roughly corresponds - to an unitialized variable in the C programming language. After - the [HAVOC] the variable holds a fixed but arbitrary number. Most - sources of nondeterminism in language definitions are there - precisely because programmers don't care which choice is made (and - so it is good to leave it open to the compiler to choose whichever - will run faster). - - We call this new language _Himp_ (``Imp extended with [HAVOC]''). *) - -Module Himp. - -(** To formalize the language, we first add a clause to the definition of - commands. *) - -Inductive com : Type := - | CSkip : com - | CAss : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com - | CHavoc : id -> com. (* <---- new *) - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";;" - | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "HAVOC" ]. - -Notation "'SKIP'" := - CSkip. -Notation "X '::=' a" := - (CAss X a) (at level 60). -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := - (CIf e1 e2 e3) (at level 80, right associativity). -Notation "'HAVOC' l" := (CHavoc l) (at level 60). - -(** **** Exercise: 2 stars (himp_ceval) *) -(** Now, we must extend the operational semantics. We have provided - a template for the [ceval] relation below, specifying the big-step - semantics. What rule(s) must be added to the definition of [ceval] - to formalize the behavior of the [HAVOC] command? *) - -Reserved Notation "c1 '/' st '||' st'" (at level 40, st at level 39). - -Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st : state, SKIP / st || st - | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : id), - aeval st a1 = n -> (X ::= a1) / st || update st X n - | E_Seq : forall (c1 c2 : com) (st st' st'' : state), - c1 / st || st' -> c2 / st' || st'' -> (c1 ;; c2) / st || st'' - | E_IfTrue : forall (st st' : state) (b1 : bexp) (c1 c2 : com), - beval st b1 = true -> - c1 / st || st' -> (IFB b1 THEN c1 ELSE c2 FI) / st || st' - | E_IfFalse : forall (st st' : state) (b1 : bexp) (c1 c2 : com), - beval st b1 = false -> - c2 / st || st' -> (IFB b1 THEN c1 ELSE c2 FI) / st || st' - | E_WhileEnd : forall (b1 : bexp) (st : state) (c1 : com), - beval st b1 = false -> (WHILE b1 DO c1 END) / st || st - | E_WhileLoop : forall (st st' st'' : state) (b1 : bexp) (c1 : com), - beval st b1 = true -> - c1 / st || st' -> - (WHILE b1 DO c1 END) / st' || st'' -> - (WHILE b1 DO c1 END) / st || st'' -(* FILL IN HERE *) - - where "c1 '/' st '||' st'" := (ceval c1 st st'). - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq" - | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" - | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" -(* FILL IN HERE *) -]. - -(** As a sanity check, the following claims should be provable for - your definition: *) - -Example havoc_example1 : (HAVOC X) / empty_state || update empty_state X 0. -Proof. -(* FILL IN HERE *) Admitted. - -Example havoc_example2 : - (SKIP;; HAVOC Z) / empty_state || update empty_state Z 42. -Proof. -(* FILL IN HERE *) Admitted. -(** [] *) - -(** Finally, we repeat the definition of command equivalence from above: *) - -Definition cequiv (c1 c2 : com) : Prop := forall st st' : state, - c1 / st || st' <-> c2 / st || st'. - -(** This definition still makes perfect sense in the case of always - terminating programs, so let's apply it to prove some - non-deterministic programs equivalent or non-equivalent. *) - -(** **** Exercise: 3 stars (havoc_swap) *) -(** Are the following two programs equivalent? *) - -Definition pXY := - HAVOC X;; HAVOC Y. - -Definition pYX := - HAVOC Y;; HAVOC X. - -(** If you think they are equivalent, prove it. If you think they are - not, prove that. *) - - -Theorem pXY_cequiv_pYX : - cequiv pXY pYX \/ ~cequiv pXY pYX. -Proof. (* FILL IN HERE *) Admitted. - -(** **** Exercise: 4 stars, optional (havoc_copy) *) -(** Are the following two programs equivalent? *) - -Definition ptwice := - HAVOC X;; HAVOC Y. - -Definition pcopy := - HAVOC X;; Y ::= AId X. - -(** If you think they are equivalent, then prove it. If you think they - are not, then prove that. (Hint: You may find the [assert] tactic - useful.) *) - -Theorem ptwice_cequiv_pcopy : - cequiv ptwice pcopy \/ ~cequiv ptwice pcopy. -Proof. (* FILL IN HERE *) Admitted. -(** [] *) - -(** The definition of program equivalence we are using here has some - subtle consequences on programs that may loop forever. What - [cequiv] says is that the set of possible _terminating_ outcomes - of two equivalent programs is the same. However, in a language - with non-determinism, like Himp, some programs always terminate, - some programs always diverge, and some programs can - non-deterministically terminate in some runs and diverge in - others. The final part of the following exercise illustrates this - phenomenon. -*) - -(** **** Exercise: 5 stars, advanced (p1_p2_equiv) *) -(** Prove that p1 and p2 are equivalent. In this and the following - exercises, try to understand why the [cequiv] definition has the - behavior it has on these examples. *) - -Definition p1 : com := - WHILE (BNot (BEq (AId X) (ANum 0))) DO - HAVOC Y;; - X ::= APlus (AId X) (ANum 1) - END. - -Definition p2 : com := - WHILE (BNot (BEq (AId X) (ANum 0))) DO - SKIP - END. - - -(** Intuitively, the programs have the same termination - behavior: either they loop forever, or they terminate in the - same state they started in. We can capture the termination - behavior of p1 and p2 individually with these lemmas: *) - -Lemma p1_may_diverge : forall st st', st X <> 0 -> - ~ p1 / st || st'. -Proof. (* FILL IN HERE *) Admitted. - -Lemma p2_may_diverge : forall st st', st X <> 0 -> - ~ p2 / st || st'. -Proof. -(* FILL IN HERE *) Admitted. - -(** You should use these lemmas to prove that p1 and p2 are actually - equivalent. *) - -Theorem p1_p2_equiv : cequiv p1 p2. -Proof. (* FILL IN HERE *) Admitted. - -(** **** Exercise: 4 stars, advanced (p3_p4_inquiv) *) - -(** Prove that the following programs are _not_ equivalent. *) - -Definition p3 : com := - Z ::= ANum 1;; - WHILE (BNot (BEq (AId X) (ANum 0))) DO - HAVOC X;; - HAVOC Z - END. - -Definition p4 : com := - X ::= (ANum 0);; - Z ::= (ANum 1). - - -Theorem p3_p4_inequiv : ~ cequiv p3 p4. -Proof. (* FILL IN HERE *) Admitted. - -(** **** Exercise: 5 stars, advanced, optional (p5_p6_equiv) *) - -Definition p5 : com := - WHILE (BNot (BEq (AId X) (ANum 1))) DO - HAVOC X - END. - -Definition p6 : com := - X ::= ANum 1. - - -Theorem p5_p6_equiv : cequiv p5 p6. -Proof. (* FILL IN HERE *) Admitted. -(** [] *) - -End Himp. - -(* ####################################################### *) -(** * Doing Without Extensionality (Optional) *) - -(** Purists might object to using the [functional_extensionality] - axiom. In general, it can be quite dangerous to add axioms, - particularly several at once (as they may be mutually - inconsistent). In fact, [functional_extensionality] and - [excluded_middle] can both be assumed without any problems, but - some Coq users prefer to avoid such "heavyweight" general - techniques, and instead craft solutions for specific problems that - stay within Coq's standard logic. - - For our particular problem here, rather than extending the - definition of equality to do what we want on functions - representing states, we could instead give an explicit notion of - _equivalence_ on states. For example: *) - -Definition stequiv (st1 st2 : state) : Prop := - forall (X:id), st1 X = st2 X. - -Notation "st1 '~' st2" := (stequiv st1 st2) (at level 30). - -(** It is easy to prove that [stequiv] is an _equivalence_ (i.e., it - is reflexive, symmetric, and transitive), so it partitions the set - of all states into equivalence classes. *) - -(** **** Exercise: 1 star, optional (stequiv_refl) *) -Lemma stequiv_refl : forall (st : state), - st ~ st. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (stequiv_sym) *) -Lemma stequiv_sym : forall (st1 st2 : state), - st1 ~ st2 -> - st2 ~ st1. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (stequiv_trans) *) -Lemma stequiv_trans : forall (st1 st2 st3 : state), - st1 ~ st2 -> - st2 ~ st3 -> - st1 ~ st3. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Another useful fact... *) -(** **** Exercise: 1 star, optional (stequiv_update) *) -Lemma stequiv_update : forall (st1 st2 : state), - st1 ~ st2 -> - forall (X:id) (n:nat), - update st1 X n ~ update st2 X n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** It is then straightforward to show that [aeval] and [beval] behave - uniformly on all members of an equivalence class: *) - -(** **** Exercise: 2 stars, optional (stequiv_aeval) *) -Lemma stequiv_aeval : forall (st1 st2 : state), - st1 ~ st2 -> - forall (a:aexp), aeval st1 a = aeval st2 a. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, optional (stequiv_beval) *) -Lemma stequiv_beval : forall (st1 st2 : state), - st1 ~ st2 -> - forall (b:bexp), beval st1 b = beval st2 b. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** We can also characterize the behavior of [ceval] on equivalent - states (this result is a bit more complicated to write down - because [ceval] is a relation). *) - -Lemma stequiv_ceval: forall (st1 st2 : state), - st1 ~ st2 -> - forall (c: com) (st1': state), - (c / st1 || st1') -> - exists st2' : state, - ((c / st2 || st2') /\ st1' ~ st2'). -Proof. - intros st1 st2 STEQV c st1' CEV1. generalize dependent st2. - induction CEV1; intros st2 STEQV. - Case "SKIP". - exists st2. split. - constructor. - assumption. - Case ":=". - exists (update st2 x n). split. - constructor. rewrite <- H. symmetry. apply stequiv_aeval. - assumption. apply stequiv_update. assumption. - Case ";". - destruct (IHCEV1_1 st2 STEQV) as [st2' [P1 EQV1]]. - destruct (IHCEV1_2 st2' EQV1) as [st2'' [P2 EQV2]]. - exists st2''. split. - apply E_Seq with st2'; assumption. - assumption. - Case "IfTrue". - destruct (IHCEV1 st2 STEQV) as [st2' [P EQV]]. - exists st2'. split. - apply E_IfTrue. rewrite <- H. symmetry. apply stequiv_beval. - assumption. assumption. assumption. - Case "IfFalse". - destruct (IHCEV1 st2 STEQV) as [st2' [P EQV]]. - exists st2'. split. - apply E_IfFalse. rewrite <- H. symmetry. apply stequiv_beval. - assumption. assumption. assumption. - Case "WhileEnd". - exists st2. split. - apply E_WhileEnd. rewrite <- H. symmetry. apply stequiv_beval. - assumption. assumption. - Case "WhileLoop". - destruct (IHCEV1_1 st2 STEQV) as [st2' [P1 EQV1]]. - destruct (IHCEV1_2 st2' EQV1) as [st2'' [P2 EQV2]]. - exists st2''. split. - apply E_WhileLoop with st2'. rewrite <- H. symmetry. - apply stequiv_beval. assumption. assumption. assumption. - assumption. -Qed. - -(** Now we need to redefine [cequiv] to use [~] instead of [=]. It is - not completely trivial to do this in a way that keeps the - definition simple and symmetric, but here is one approach (thanks - to Andrew McCreight). We first define a looser variant of [||] - that "folds in" the notion of equivalence. *) - -Reserved Notation "c1 '/' st '||'' st'" (at level 40, st at level 39). - -Inductive ceval' : com -> state -> state -> Prop := - | E_equiv : forall c st st' st'', - c / st || st' -> - st' ~ st'' -> - c / st ||' st'' - where "c1 '/' st '||'' st'" := (ceval' c1 st st'). - -(** Now the revised definition of [cequiv'] looks familiar: *) - -Definition cequiv' (c1 c2 : com) : Prop := - forall (st st' : state), - (c1 / st ||' st') <-> (c2 / st ||' st'). - -(** A sanity check shows that the original notion of command - equivalence is at least as strong as this new one. (The converse - is not true, naturally.) *) - -Lemma cequiv__cequiv' : forall (c1 c2: com), - cequiv c1 c2 -> cequiv' c1 c2. -Proof. - unfold cequiv, cequiv'; split; intros. - inversion H0 ; subst. apply E_equiv with st'0. - apply (H st st'0); assumption. assumption. - inversion H0 ; subst. apply E_equiv with st'0. - apply (H st st'0). assumption. assumption. -Qed. - -(** **** Exercise: 2 stars, optional (identity_assignment') *) -(** Finally, here is our example once more... (You can complete the - proof.) *) - -Example identity_assignment' : - cequiv' SKIP (X ::= AId X). -Proof. - unfold cequiv'. intros. split; intros. - Case "->". - inversion H; subst; clear H. inversion H0; subst. - apply E_equiv with (update st'0 X (st'0 X)). - constructor. reflexivity. apply stequiv_trans with st'0. - unfold stequiv. intros. apply update_same. - reflexivity. assumption. - Case "<-". - (* FILL IN HERE *) Admitted. -(** [] *) - -(** On the whole, this explicit equivalence approach is considerably - harder to work with than relying on functional - extensionality. (Coq does have an advanced mechanism called - "setoids" that makes working with equivalences somewhat easier, by - allowing them to be registered with the system so that standard - rewriting tactics work for them almost as well as for equalities.) - But it is worth knowing about, because it applies even in - situations where the equivalence in question is _not_ over - functions. For example, if we chose to represent state mappings - as binary search trees, we would need to use an explicit - equivalence of this kind. *) - -(* ####################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 4 stars, optional (for_while_equiv) *) -(** This exercise extends the optional [add_for_loop] exercise from - Imp.v, where you were asked to extend the language of commands - with C-style [for] loops. Prove that the command: - for (c1 ; b ; c2) { - c3 - } - is equivalent to: - c1 ; - WHILE b DO - c3 ; - c2 - END -*) -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars, optional (swap_noninterfering_assignments) *) -Theorem swap_noninterfering_assignments: forall l1 l2 a1 a2, - l1 <> l2 -> - var_not_used_in_aexp l1 a2 -> - var_not_used_in_aexp l2 a1 -> - cequiv - (l1 ::= a1;; l2 ::= a2) - (l2 ::= a2;; l1 ::= a1). -Proof. -(* Hint: You'll need [functional_extensionality] *) -(* FILL IN HERE *) Admitted. -(** [] *) - diff --git a/Extraction.html b/Extraction.html deleted file mode 100644 index 5012ca6..0000000 --- a/Extraction.html +++ /dev/null @@ -1,287 +0,0 @@ - - - - - -Extraction: Extracting ML from Coq - - - - - - -
- - - -
- -

ExtractionExtracting ML from Coq

- -
-
- -
- -
-
- -
-(* $Date: 2013-01-16 22:29:57 -0500 (Wed, 16 Jan 2013) $ *)
- -
-
- -
-

Basic Extraction

- -
- - In its simplest form, program extraction from Coq is completely straightforward. -
- - First we say what language we want to extract into. Options are OCaml (the - most mature), Haskell (which mostly works), and Scheme (a bit out - of date). -
-
- -
-Extraction Language Ocaml.
- -
-
- -
-Now we load up the Coq environment with some definitions, either - directly or by importing them from other modules. -
-
- -
-Require Import SfLib.
-Require Import ImpCEvalFun.
- -
-
- -
-Finally, we tell Coq the name of a definition to extract and the - name of a file to put the extracted code into. -
-
- -
-Extraction "imp1.ml" ceval_step.
- -
-
- -
-When Coq processes this command, it generates a file imp1.ml - containing an extracted version of ceval_step, together with - everything that it recursively depends on. Have a look at this - file now. -
-
- -
-
- -
-

Controlling Extraction of Specific Types

- -
- - We can tell Coq to extract certain Inductive definitions to - specific OCaml types. For each one, we must say - -
- -
    -
  • how the Coq type itself should be represented in OCaml, and - -
    • -
  • how each constructor should be translated. -
    • -
- -
-
- -
-Extract Inductive bool ⇒ "bool" [ "true" "false" ].
- -
-
- -
-Also, for non-enumeration types (where the constructors take - arguments), we give an OCaml expression that can be used as a - "recursor" over elements of the type. (Think Church numerals.) -
-
- -
-Extract Inductive nat ⇒ "int"
-  [ "0" "(fun x → x + 1)" ]
-  "(fun zero succ n →
-      if n=0 then zero () else succ (n-1))".
- -
-
- -
-We can also extract defined constants to specific OCaml terms or - operators. -
-
- -
-Extract Constant plus ⇒ "( + )".
-Extract Constant mult ⇒ "( × )".
-Extract Constant beq_nat ⇒ "( = )".
- -
-
- -
-Important: It is entirely your responsibility to make sure that - the translations you're proving make sense. For example, it might - be tempting to include this one - -
- -
-      Extract Constant minus ⇒ "( - )". -
- -
- but doing so could lead to serious confusion! (Why?) - -
-
- -
-Extraction "imp2.ml" ceval_step.
- -
-
- -
-Have a look at the file imp2.ml. Notice how the fundamental - definitions have changed from imp1.ml. -
-
- -
-
- -
-

A Complete Example

- -
- - To use our extracted evaluator to run Imp programs, all we need to - add is a tiny driver program that calls the evaluator and somehow - prints out the result. - -
- - For simplicity, we'll print results by dumping out the first four - memory locations in the final state. - -
- - Also, to make it easier to type in examples, let's extract a - parser from the ImpParser Coq module. To do this, we need a few - more declarations to set up the right correspondence between Coq - strings and lists of OCaml characters. -
-
- -
-Require Import Ascii String.
-Extract Inductive ascii ⇒ char
-[
-"(× If this appears, you're using Ascii internals. Please don't *) (fun (b0,b1,b2,b3,b4,b5,b6,b7) → let f b i = if b then 1 lsl i else 0 in Char.chr (f b0 0 + f b1 1 + f b2 2 + f b3 3 + f b4 4 + f b5 5 + f b6 6 + f b7 7))"
-]
-"(× If this appears, you're using Ascii internals. Please don't *) (fun f c → let n = Char.code c in let h i = (n land (1 lsl i)) ≠ 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7))".
-Extract Constant zero ⇒ "'\000'".
-Extract Constant one ⇒ "'\001'".
-Extract Constant shift ⇒
- "fun b c → Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)".
-Extract Inlined Constant ascii_dec ⇒ "(=)".
- -
-
- -
-We also need one more variant of booleans. -
-
- -
-Extract Inductive sumbool ⇒ "bool" ["true" "false"].
- -
-
- -
-The extraction is the same as always. -
-
- -
-Require Import Imp.
-Require Import ImpParser.
-Extraction "imp.ml" empty_state ceval_step parse.
- -
-
- -
-Now let's run our generated Imp evaluator. First, have a look at - impdriver.ml. (This was written by hand, not extracted.) - -
- - Next, compile the driver together with the extracted code and - execute it, as follows. -
-	ocamlc -w -20 -w -26 -o impdriver imp.mli imp.ml impdriver.ml
-	./impdriver
-
- (The -w flags to ocamlc are just there to suppress a few - spurious warnings.) -
-
- -
-
- -
-

Discussion

- -
- - Since we've proved that the ceval_step function behaves the same - as the ceval relation in an appropriate sense, the extracted - program can be viewed as a certified Imp interpreter. (Of - course, the parser is not certified in any interesting sense, - since we didn't prove anything about it.) -
-
-
-
- - - -
- - - \ No newline at end of file diff --git a/Extraction.v b/Extraction.v deleted file mode 100644 index f0a8679..0000000 --- a/Extraction.v +++ /dev/null @@ -1,125 +0,0 @@ -(** * Extraction: Extracting ML from Coq *) - -(* $Date: 2013-01-16 22:29:57 -0500 (Wed, 16 Jan 2013) $ *) - -(** * Basic Extraction *) - -(** In its simplest form, program extraction from Coq is completely straightforward. *) - -(** First we say what language we want to extract into. Options are OCaml (the - most mature), Haskell (which mostly works), and Scheme (a bit out - of date). *) - -Extraction Language Ocaml. - -(** Now we load up the Coq environment with some definitions, either - directly or by importing them from other modules. *) - -Require Import SfLib. -Require Import ImpCEvalFun. - -(** Finally, we tell Coq the name of a definition to extract and the - name of a file to put the extracted code into. *) - -Extraction "imp1.ml" ceval_step. - -(** When Coq processes this command, it generates a file [imp1.ml] - containing an extracted version of [ceval_step], together with - everything that it recursively depends on. Have a look at this - file now. *) - -(* ############################################################## *) -(** * Controlling Extraction of Specific Types *) - -(** We can tell Coq to extract certain [Inductive] definitions to - specific OCaml types. For each one, we must say - - how the Coq type itself should be represented in OCaml, and - - how each constructor should be translated. *) - -Extract Inductive bool => "bool" [ "true" "false" ]. - -(** Also, for non-enumeration types (where the constructors take - arguments), we give an OCaml expression that can be used as a - "recursor" over elements of the type. (Think Church numerals.) *) - -Extract Inductive nat => "int" - [ "0" "(fun x -> x + 1)" ] - "(fun zero succ n -> - if n=0 then zero () else succ (n-1))". - -(** We can also extract defined constants to specific OCaml terms or - operators. *) - -Extract Constant plus => "( + )". -Extract Constant mult => "( * )". -Extract Constant beq_nat => "( = )". - -(** Important: It is entirely _your responsibility_ to make sure that - the translations you're proving make sense. For example, it might - be tempting to include this one - Extract Constant minus => "( - )". - but doing so could lead to serious confusion! (Why?) -*) - -Extraction "imp2.ml" ceval_step. - -(** Have a look at the file [imp2.ml]. Notice how the fundamental - definitions have changed from [imp1.ml]. *) - -(* ############################################################## *) -(** * A Complete Example *) - -(** To use our extracted evaluator to run Imp programs, all we need to - add is a tiny driver program that calls the evaluator and somehow - prints out the result. - - For simplicity, we'll print results by dumping out the first four - memory locations in the final state. - - Also, to make it easier to type in examples, let's extract a - parser from the [ImpParser] Coq module. To do this, we need a few - more declarations to set up the right correspondence between Coq - strings and lists of OCaml characters. *) - -Require Import Ascii String. -Extract Inductive ascii => char -[ -"(* If this appears, you're using Ascii internals. Please don't *) (fun (b0,b1,b2,b3,b4,b5,b6,b7) -> let f b i = if b then 1 lsl i else 0 in Char.chr (f b0 0 + f b1 1 + f b2 2 + f b3 3 + f b4 4 + f b5 5 + f b6 6 + f b7 7))" -] -"(* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7))". -Extract Constant zero => "'\000'". -Extract Constant one => "'\001'". -Extract Constant shift => - "fun b c -> Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)". -Extract Inlined Constant ascii_dec => "(=)". - -(** We also need one more variant of booleans. *) - -Extract Inductive sumbool => "bool" ["true" "false"]. - -(** The extraction is the same as always. *) - -Require Import Imp. -Require Import ImpParser. -Extraction "imp.ml" empty_state ceval_step parse. - -(** Now let's run our generated Imp evaluator. First, have a look at - [impdriver.ml]. (This was written by hand, not extracted.) - - Next, compile the driver together with the extracted code and - execute it, as follows. -<< - ocamlc -w -20 -w -26 -o impdriver imp.mli imp.ml impdriver.ml - ./impdriver ->> - (The [-w] flags to [ocamlc] are just there to suppress a few - spurious warnings.) *) - -(* ############################################################## *) -(** * Discussion *) - -(** Since we've proved that the [ceval_step] function behaves the same - as the [ceval] relation in an appropriate sense, the extracted - program can be viewed as a _certified_ Imp interpreter. (Of - course, the parser is not certified in any interesting sense, - since we didn't prove anything about it.) *) diff --git a/Hoare.html b/Hoare.html deleted file mode 100644 index fa1dd00..0000000 --- a/Hoare.html +++ /dev/null @@ -1,2846 +0,0 @@ - - - - - -Hoare: Hoare Logic, Part I - - - - - - -
- - - -
- -

HoareHoare Logic, Part I

- -
-
- -
- -
-
- -
-Require Export Imp.
- -
-
- -
-In the past couple of chapters, we've begun applying the - mathematical tools developed in the first part of the course to - studying the theory of a small programming language, Imp. - -
- -
    -
  • We defined a type of abstract syntax trees for Imp, together - with an evaluation relation (a partial function on states) - that specifies the operational semantics of programs. - -
    - - The language we defined, though small, captures some of the key - features of full-blown languages like C, C++, and Java, - including the fundamental notion of mutable state and some - common control structures. - -
    - - -
    • -
  • We proved a number of metatheoretic properties — "meta" in - the sense that they are properties of the language as a whole, - rather than properties of particular programs in the language. - These included: - -
    - -
      -
    • determinism of evaluation - -
      - - -
      • -
    • equivalence of some different ways of writing down the - definitions (e.g. functional and relational definitions of - arithmetic expression evaluation) - -
      - - -
      • -
    • guaranteed termination of certain classes of programs - -
      - - -
      • -
    • correctness (in the sense of preserving meaning) of a number - of useful program transformations - -
      - - -
      • -
    • behavioral equivalence of programs (in the Equiv chapter). - -
      • -
    - -
    • -
- If we stopped here, we would already have something useful: a set - of tools for defining and discussing programming languages and - language features that are mathematically precise, flexible, and - easy to work with, applied to a set of key properties. All of - these properties are things that language designers, compiler - writers, and users might care about knowing. Indeed, many of them - are so fundamental to our understanding of the programming - languages we deal with that we might not consciously recognize - them as "theorems." But properties that seem intuitively obvious - can sometimes be quite subtle (in some cases, even subtly wrong!). - -
- - We'll return to the theme of metatheoretic properties of whole - languages later in the course when we discuss types and type - soundness. In this chapter, though, we'll turn to a different - set of issues. - -
- - Our goal is to see how to carry out some simple examples of - program verification — i.e., using the precise definition of - Imp to prove formally that particular programs satisfy particular - specifications of their behavior. We'll develop a reasoning system - called Floyd-Hoare Logic — often shortened to just Hoare - Logic — in which each of the syntactic constructs of Imp is - equipped with a single, generic "proof rule" that can be used to - reason compositionally about the correctness of programs involving - this construct. - -
- - Hoare Logic originates in the 1960s, and it continues to be the - subject of intensive research right up to the present day. It - lies at the core of a multitude of tools that are being used in - academia and industry to specify and verify real software - systems. -
-
- -
- -
-
- -
-

Hoare Logic

- -
- - Hoare Logic combines two beautiful ideas: a natural way of - writing down specifications of programs, and a compositional - proof technique for proving that programs are correct with - respect to such specifications — where by "compositional" we mean - that the structure of proofs directly mirrors the structure of the - programs that they are about. -
-
- -
-
- -
-

Assertions

- -
- - To talk about specifications of programs, the first thing we - need is a way of making assertions about properties that hold at - particular points during a program's execution — i.e., claims - about the current state of the memory when program execution - reaches that point. Formally, an assertion is just a family of - propositions indexed by a state. -
-
- -
-Definition Assertion := state → Prop.
- -
-
- -
-

Exercise: 1 star, optional (assertions)

- -
-
- -
-
- -
-Paraphrase the following assertions in English. -
-
- -
-Definition as1 : Assertion := fun st ⇒ st X = 3.
-Definition as2 : Assertion := fun st ⇒ st X ≤ st Y.
-Definition as3 : Assertion :=
-  fun st ⇒ st X = 3 ∨ st X ≤ st Y.
-Definition as4 : Assertion :=
-  fun st ⇒ st Z × st Z ≤ st X ∧
-            ¬ (((S (st Z)) × (S (st Z))) ≤ st X).
-Definition as5 : Assertion := fun st ⇒ True.
-Definition as6 : Assertion := fun st ⇒ False.
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- - This way of writing assertions can be a little bit heavy, - for two reasons: (1) every single assertion that we ever write is - going to begin with fun st ⇒ ; and (2) this state st is the - only one that we ever use to look up variables (we will never need - to talk about two different memory states at the same time). For - discussing examples informally, we'll adopt some simplifying - conventions: we'll drop the initial fun st ⇒, and we'll write - just X to mean st X. Thus, instead of writing -
- - -
- -
-      fun st ⇒ (st Z) × (st Z) ≤ m ∧
-                ¬ ((S (st Z)) × (S (st Z)) ≤ m) -
- -
- we'll write just - -
- -
-         Z × Z ≤ m ∧ ~((S Z) × (S Z) ≤ m). -
- -
- -
- - Given two assertions P and Q, we say that P implies Q, - written P ⇾ Q (in ASCII, P ->> Q), if, whenever P - holds in some state st, Q also holds. -
-
- -
-Definition assert_implies (P Q : Assertion) : Prop :=
-  ∀st, P st → Q st.
- -
-Notation "P ⇾ Q" :=
-  (assert_implies P Q) (at level 80) : hoare_spec_scope.
-Open Scope hoare_spec_scope.
- -
-
- -
-We'll also have occasion to use the "iff" variant of implication - between assertions: -
-
- -
-Notation "P ⇿ Q" :=
-  (P ⇾ Q ∧ Q ⇾ P) (at level 80) : hoare_spec_scope.
- -
-
- -
-

Hoare Triples

- -
- - Next, we need a way of making formal claims about the - behavior of commands. -
- - Since the behavior of a command is to transform one state to - another, it is natural to express claims about commands in terms - of assertions that are true before and after the command executes: - -
- -
    -
  • "If command c is started in a state satisfying assertion - P, and if c eventually terminates in some final state, - then this final state will satisfy the assertion Q." - -
    • -
- -
- - Such a claim is called a Hoare Triple. The property P is - called the precondition of c, while Q is the - postcondition. Formally: -
-
- -
-Definition hoare_triple
-           (P:Assertion) (c:com) (Q:Assertion) : Prop :=
-  ∀st st',
-       c / st ⇓ st' →
-       P st →
-       Q st'.
- -
-
- -
-Since we'll be working a lot with Hoare triples, it's useful to - have a compact notation: - -
- -
-       {{P}} c {{Q}}. -
- -
- (The traditional notation is {P} c {Q}, but single braces - are already used for other things in Coq.) -
-
- -
-Notation "{{ P }} c {{ Q }}" :=
-  (hoare_triple P c Q) (at level 90, c at next level)
-  : hoare_spec_scope.
- -
-
- -
-(The hoare_spec_scope annotation here tells Coq that this - notation is not global but is intended to be used in particular - contexts. The Open Scope tells Coq that this file is one such - context.) -
- -

Exercise: 1 star, optional (triples)

- Paraphrase the following Hoare triples in English. - -
- -
-   1) {{True}} c {{X = 5}}
-
-   2) {{X = m}} c {{X = m + 5)}}
-
-   3) {{X ≤ Y}} c {{Y ≤ X}}
-
-   4) {{True}} c {{False}}
-
-   5) {{X = m}} 
-      c
-      {{Y = real_fact m}}.
-
-   6) {{True}} 
-      c 
-      {{(Z × Z) ≤ m ∧ ¬ (((S Z) × (S Z)) ≤ m)}} -
- -
- -
- - -
- - ☐ -
- -

Exercise: 1 star, optional (valid_triples)

- Which of the following Hoare triples are valid — i.e., the - claimed relation between P, c, and Q is true? - -
- -
-   1) {{True}} X ::= 5 {{X = 5}}
-
-   2) {{X = 2}} X ::= X + 1 {{X = 3}}
-
-   3) {{True}} X ::= 5; Y ::= 0 {{X = 5}}
-
-   4) {{X = 2 ∧ X = 3}} X ::= 5 {{X = 0}}
-
-   5) {{True}} SKIP {{False}}
-
-   6) {{False}} SKIP {{True}}
-
-   7) {{True}} WHILE True DO SKIP END {{False}}
-
-   8) {{X = 0}}
-      WHILE X == 0 DO X ::= X + 1 END
-      {{X = 1}}
-
-   9) {{X = 1}}
-      WHILE X ≠ 0 DO X ::= X + 1 END
-      {{X = 100}} -
- -
- -
- - -
-
-(* FILL IN HERE *)
-
- -
-☐ -
- - (Note that we're using informal mathematical notations for - expressions inside of commands, for readability, rather than their - formal aexp and bexp encodings. We'll continue doing so - throughout the chapter.) -
- - To get us warmed up for what's coming, here are two simple - facts about Hoare triples. -
-
- -
-Theorem hoare_post_true : ∀(P Q : Assertion) c,
-  (∀st, Q st) →
-  {{P}} c {{Q}}.
-
-
-Proof.
-  intros P Q c H. unfold hoare_triple.
-  intros st st' Heval HP.
-  apply H. Qed.
-
- -
-Theorem hoare_pre_false : ∀(P Q : Assertion) c,
-  (∀st, ~(P st)) →
-  {{P}} c {{Q}}.
-
-
-Proof.
-  intros P Q c H. unfold hoare_triple.
-  intros st st' Heval HP.
-  unfold not in H. apply H in HP.
-  inversion HP. Qed.
-
- -
-
- -
-

Proof Rules

- -
- - The goal of Hoare logic is to provide a compositional - method for proving the validity of Hoare triples. That is, the - structure of a program's correctness proof should mirror the - structure of the program itself. To this end, in the sections - below, we'll introduce one rule for reasoning about each of the - different syntactic forms of commands in Imp — one for - assignment, one for sequencing, one for conditionals, etc. — plus - a couple of "structural" rules that are useful for gluing things - together. We will prove programs correct using these proof rules, - without ever unfolding the definition of hoare_triple. -
-
- -
-
- -
-

Assignment

- -
- - The rule for assignment is the most fundamental of the Hoare logic - proof rules. Here's how it works. - -
- - Consider this (valid) Hoare triple: - -
- -
-       {{ Y = 1 }}  X ::= Y  {{ X = 1 }} -
- -
- In English: if we start out in a state where the value of Y - is 1 and we assign Y to X, then we'll finish in a - state where X is 1. That is, the property of being equal - to 1 gets transferred from Y to X. - -
- - Similarly, in - -
- -
-       {{ Y + Z = 1 }}  X ::= Y + Z  {{ X = 1 }} -
- -
- the same property (being equal to one) gets transferred to - X from the expression Y + Z on the right-hand side of - the assignment. - -
- - More generally, if a is any arithmetic expression, then - -
- -
-       {{ a = 1 }}  X ::= a {{ X = 1 }} -
- -
- is a valid Hoare triple. - -
- - This can be made even more general. To conclude that an - arbitrary property Q holds after X ::= a, we need to assume - that Q holds before X ::= a, but with all occurrences of X - replaced by a in Q. This leads to the Hoare rule for - assignment - -
- -
-      {{ Q [X ↦ a] }} X ::= a {{ Q }} -
- -
- where "Q [X ↦ a]" is pronounced "Q where a is substituted - for X". - -
- - For example, these are valid applications of the assignment - rule: - -
- -
-      {{ (X ≤ 5) [X ↦ X + 1]
-         i.e., X + 1 ≤ 5 }}  
-      X ::= X + 1  
-      {{ X ≤ 5 }}
-
-      {{ (X = 3) [X ↦ 3]
-         i.e., 3 = 3}}  
-      X ::= 3  
-      {{ X = 3 }}
-
-      {{ (0 ≤ X ∧ X ≤ 5) [X ↦ 3]
-         i.e., (0 ≤ 3 ∧ 3 ≤ 5)}}  
-      X ::= 3  
-      {{ 0 ≤ X ∧ X ≤ 5 }} -
- -
- -
- - To formalize the rule, we must first formalize the idea of - "substituting an expression for an Imp variable in an assertion." - That is, given a proposition P, a variable X, and an - arithmetic expression a, we want to derive another proposition - P' that is just the same as P except that, wherever P - mentions X, P' should instead mention a. - -
- - Since P is an arbitrary Coq proposition, we can't directly - "edit" its text. Instead, we can achieve the effect we want by - evaluating P in an updated state: -
-
- -
-Definition assn_sub X a P : Assertion :=
-  fun (st : state) ⇒
-    P (update st X (aeval st a)).
- -
-Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10).
- -
-
- -
-That is, P [X ↦ a] is an assertion P' that is just like P - except that, wherever P looks up the variable X in the current - state, P' instead uses the value of the expression a. - -
- - To see how this works, let's calculate what happens with a couple - of examples. First, suppose P' is (X ≤ 5) [X ↦ 3] — that - is, more formally, P' is the Coq expression - -
- -
-    fun st ⇒ 
-      (fun st' ⇒ st' X ≤ 5) 
-      (update st X (aeval st (ANum 3))), -
- -
- which simplifies to - -
- -
-    fun st ⇒ 
-      (fun st' ⇒ st' X ≤ 5) 
-      (update st X 3) -
- -
- and further simplifies to - -
- -
-    fun st ⇒ 
-      ((update st X 3) X) ≤ 5) -
- -
- and by further simplification to - -
- -
-    fun st ⇒ 
-      (3 ≤ 5). -
- -
- That is, P' is the assertion that 3 is less than or equal to - 5 (as expected). - -
- - For a more interesting example, suppose P' is (X ≤ 5) [X ↦ - X+1]. Formally, P' is the Coq expression - -
- -
-    fun st ⇒ 
-      (fun st' ⇒ st' X ≤ 5) 
-      (update st X (aeval st (APlus (AId X) (ANum 1)))), -
- -
- which simplifies to - -
- -
-    fun st ⇒ 
-      (((update st X (aeval st (APlus (AId X) (ANum 1))))) X) ≤ 5 -
- -
- and further simplifies to - -
- -
-    fun st ⇒ 
-      (aeval st (APlus (AId X) (ANum 1))) ≤ 5. -
- -
- That is, P' is the assertion that X+1 is at most 5. - -
- - -
- - Now we can give the precise proof rule for assignment: -
- - - - - - - - - - -
   - (hoare_asgn)   -
{{Q [X ↦ a]}} X ::= a {{Q}}
-
- - We can prove formally that this rule is indeed valid. -
-
- -
-Theorem hoare_asgn : ∀Q X a,
-  {{Q [X ↦ a]}} (X ::= a) {{Q}}.
-
-
-Proof.
-  unfold hoare_triple.
-  intros Q X a st st' HE HQ.
-  inversion HE. subst.
-  unfold assn_sub in HQ. assumption. Qed.
-
- -
-
- -
-Here's a first formal proof using this rule. -
-
- -
-Example assn_sub_example :
-  {{(fun st ⇒ st X = 3) [X ↦ ANum 3]}}
-  (X ::= (ANum 3))
-  {{fun st ⇒ st X = 3}}.
-Proof.
-  apply hoare_asgn. Qed.
- -
-
- -
-

Exercise: 2 stars (hoare_asgn_examples)

- Translate these informal Hoare triples... - -
- -
-    1) {{ (X ≤ 5) [X ↦ X + 1] }}
-       X ::= X + 1
-       {{ X ≤ 5 }}
-
-    2) {{ (0 ≤ X ∧ X ≤ 5) [X ↦ 3] }}
-       X ::= 3
-       {{ 0 ≤ X ∧ X ≤ 5 }} -
- -
- ...into formal statements and use hoare_asgn to prove them. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 2 stars (hoare_asgn_wrong)

- The assignment rule looks backward to almost everyone the first - time they see it. If it still seems backward to you, it may help - to think a little about alternative "forward" rules. Here is a - seemingly natural one: -
- - - - - - - - - - -
   - (hoare_asgn_wrong)   -
{{ True }} X ::= a {{ X = a }}
Give a counterexample showing that this rule is incorrect - (informally). Hint: The rule universally quantifies over the - arithmetic expression a, and your counterexample needs to - exhibit an a for which the rule doesn't work. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (hoare_asgn_fwd)

- However, using an auxiliary variable m to remember the original - value of X we can define a Hoare rule for assignment that does, - intuitively, "work forwards" rather than backwards. -
- - - - - - - - - - - - - - - - - - - - - - -
   - (hoare_asgn_fwd)   -
{{fun st ⇒ P st ∧ st X = m}}
X ::= a
{{fun st ⇒ P st' ∧ st X = aeval st' a }}
(where st' = update st X m)
Note that we use the original value of X to reconstruct the - state st' before the assignment took place. Prove that this rule - is correct (the first hypothesis is the functional extensionality - axiom, which you will need at some point). Also note that this - rule is more complicated than hoare_asgn. - -
-
- -
-Theorem hoare_asgn_fwd :
-  (∀{X Y: Type} {f g : X → Y},
-     (∀(x: X), f x = g x) → f = g) →
-  ∀m a P,
-  {{fun st ⇒ P st ∧ st X = m}}
-    X ::= a
-  {{fun st ⇒ P (update st X m) ∧ st X = aeval (update st X m) a }}.
-Proof.
-  intros functional_extensionality m a P.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, advanced (hoare_asgn_fwd_exists)

- Another way to define a forward rule for assignment is to - existentially quantify over the previous value of the assigned - variable. -
- - - - - - - - - - - - - - - - - - - - - - -
   - (hoare_asgn_fwd_exists)   -
{{fun st ⇒ P st}}
X ::= a
{{fun st ⇒ ∃m, P (update st X m) ∧
st X = aeval (update st X m) a }}
-
-
-(* This rule was proposed by Nick Giannarakis and Zoe Paraskevopoulou. *)
- -
-Theorem hoare_asgn_fwd_exists :
-  (∀{X Y: Type} {f g : X → Y},
-     (∀(x: X), f x = g x) → f = g) →
-  ∀a P,
-  {{fun st ⇒ P st}}
-    X ::= a
-  {{fun st ⇒ ∃m, P (update st X m) ∧
-                st X = aeval (update st X m) a }}.
-Proof.
-  intros functional_extensionality a P.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Consequence

- -
- - Sometimes the preconditions and postconditions we get from the - Hoare rules won't quite be the ones we want in the particular - situation at hand — they may be logically equivalent but have a - different syntactic form that fails to unify with the goal we are - trying to prove, or they actually may be logically weaker (for - preconditions) or stronger (for postconditions) than what we need. - -
- - For instance, while - -
- -
-      {{(X = 3) [X ↦ 3]}} X ::= 3 {{X = 3}}, -
- -
- follows directly from the assignment rule, - -
- -
-      {{True}} X ::= 3 {{X = 3}}. -
- -
- does not. This triple is valid, but it is not an instance of - hoare_asgn because True and (X = 3) [X ↦ 3] are not - syntactically equal assertions. However, they are logically - equivalent, so if one triple is valid, then the other must - certainly be as well. We might capture this observation with the - following rule: -
- - - - - - - - - - - - - - -
{{P'}} c {{Q}}
P ⇿ P' - (hoare_consequence_pre_equiv)   -
{{P}} c {{Q}}
Taking this line of thought a bit further, we can see that - strengthening the precondition or weakening the postcondition of a - valid triple always produces another valid triple. This - observation is captured by two Rules of Consequence. -
- - - - - - - - - - - - - - -
{{P'}} c {{Q}}
P ⇾ P' - (hoare_consequence_pre)   -
{{P}} c {{Q}}
- - - - - - - - - - - - - - -
{{P}} c {{Q'}}
Q' ⇾ Q - (hoare_consequence_post)   -
{{P}} c {{Q}}
-
- - Here are the formal versions: -
-
- -
-Theorem hoare_consequence_pre : ∀(P P' Q : Assertion) c,
-  {{P'}} c {{Q}} →
-  P ⇾ P' →
-  {{P}} c {{Q}}.
-
-
-Proof.
-  intros P P' Q c Hhoare Himp.
-  intros st st' Hc HP. apply (Hhoare st st').
-  assumption. apply Himp. assumption. Qed.
-
- -
-Theorem hoare_consequence_post : ∀(P Q Q' : Assertion) c,
-  {{P}} c {{Q'}} →
-  Q' ⇾ Q →
-  {{P}} c {{Q}}.
-
-
-Proof.
-  intros P Q Q' c Hhoare Himp.
-  intros st st' Hc HP.
-  apply Himp.
-  apply (Hhoare st st').
-  assumption. assumption. Qed.
-
- -
-
- -
-For example, we might use the first consequence rule like this: - -
- -
-                {{ True }} ⇾
-                {{ 1 = 1 }} 
-    X ::= 1
-                {{ X = 1 }} -
- -
- Or, formally... - -
-
- -
-Example hoare_asgn_example1 :
-  {{fun st ⇒ True}} (X ::= (ANum 1)) {{fun st ⇒ st X = 1}}.
-Proof.
-  apply hoare_consequence_pre
-    with (P' := (fun st ⇒ st X = 1) [X ↦ ANum 1]).
-  apply hoare_asgn.
-  intros st H. unfold assn_sub, update. simpl. reflexivity.
-Qed.
- -
-
- -
-Finally, for convenience in some proofs, we can state a "combined" - rule of consequence that allows us to vary both the precondition - and the postcondition. -
- - - - - - - - - - - - - - - - - - -
{{P'}} c {{Q'}}
P ⇾ P'
Q' ⇾ Q - (hoare_consequence)   -
{{P}} c {{Q}}
-
-
- -
-Theorem hoare_consequence : ∀(P P' Q Q' : Assertion) c,
-  {{P'}} c {{Q'}} →
-  P ⇾ P' →
-  Q' ⇾ Q →
-  {{P}} c {{Q}}.
-
-
-Proof.
-  intros P P' Q Q' c Hht HPP' HQ'Q.
-  apply hoare_consequence_pre with (P' := P').
-  apply hoare_consequence_post with (Q' := Q').
-  assumption. assumption. assumption. Qed.
-
- -
-
- -
-

Digression: The eapply Tactic

- -
- - This is a good moment to introduce another convenient feature of - Coq. We had to write "with (P' := ...)" explicitly in the proof - of hoare_asgn_example1 and hoare_consequence above, to make - sure that all of the metavariables in the premises to the - hoare_consequence_pre rule would be set to specific - values. (Since P' doesn't appear in the conclusion of - hoare_consequence_pre, the process of unifying the conclusion - with the current goal doesn't constrain P' to a specific - assertion.) - -
- - This is a little annoying, both because the assertion is a bit - long and also because for hoare_asgn_example1 the very next - thing we are going to do — applying the hoare_asgn rule — will - tell us exactly what it should be! We can use eapply instead of - apply to tell Coq, essentially, "Be patient: The missing part is - going to be filled in soon." -
-
- -
-Example hoare_asgn_example1' :
-  {{fun st ⇒ True}}
-  (X ::= (ANum 1))
-  {{fun st ⇒ st X = 1}}.
-Proof.
-  eapply hoare_consequence_pre.
-  apply hoare_asgn.
-  intros st H. reflexivity. Qed.
- -
-
- -
-In general, eapply H tactic works just like apply H except - that, instead of failing if unifying the goal with the conclusion - of H does not determine how to instantiate all of the variables - appearing in the premises of H, eapply H will replace these - variables with so-called existential variables (written ?nnn) - as placeholders for expressions that will be determined (by - further unification) later in the proof. -
- - In order for Qed to succeed, all existential variables need to - be determined by the end of the proof. Otherwise Coq - will (rightly) refuse to accept the proof. Remember that the Coq - tactics build proof objects, and proof objects containing - existential variables are not complete. -
-
- -
-Lemma silly1 : ∀(P : nat → nat → Prop) (Q : nat → Prop),
-  (∀x y : nat, P x y) →
-  (∀x y : nat, P x y → Q x) →
-  Q 42.
-Proof.
-  intros P Q HP HQ. eapply HQ. apply HP.
- -
-
- -
-Coq gives a warning after apply HP: - -
- -
-     No more subgoals but non-instantiated existential variables:
-     Existential 1 =
-     ?171 : [P : nat → nat → Prop
-             Q : nat → Prop
-             HP : ∀x y : nat, P x y
-             HQ : ∀x y : nat, P x y → Q x ⊢ nat] 
-  
-     (dependent evars: ?171 open,)
-
-     You can use Grab Existential Variables. -
- -
- Trying to finish the proof with Qed gives an error: -
-    Error: Attempt to save a proof with existential variables still
-    non-instantiated
-
- -
-
- -
-Abort.
- -
-
- -
-An additional constraint is that existential variables cannot be - instantiated with terms containing (ordinary) variables that did - not exist at the time the existential variable was created. -
-
- -
-Lemma silly2 :
-  ∀(P : nat → nat → Prop) (Q : nat → Prop),
-  (∃y, P 42 y) →
-  (∀x y : nat, P x y → Q x) →
-  Q 42.
-Proof.
-  intros P Q HP HQ. eapply HQ. destruct HP as [y HP'].
-
- -
-Doing apply HP' above fails with the following error: - -
- -
-     Error: Impossible to unify "?175" with "y". -
- -
- In this case there is an easy fix: - doing destruct HP before doing eapply HQ. - -
-
- -
-Abort.
- -
-Lemma silly2_fixed :
-  ∀(P : nat → nat → Prop) (Q : nat → Prop),
-  (∃y, P 42 y) →
-  (∀x y : nat, P x y → Q x) →
-  Q 42.
-Proof.
-  intros P Q HP HQ. destruct HP as [y HP'].
-  eapply HQ. apply HP'.
-Qed.
- -
-
- -
-In the last step we did apply HP' which unifies the existential - variable in the goal with the variable y. The assumption - tactic doesn't work in this case, since it cannot handle - existential variables. However, Coq also provides an eassumption - tactic that solves the goal if one of the premises matches the - goal up to instantiations of existential variables. We can use - it instead of apply HP'. -
-
- -
-Lemma silly2_eassumption : ∀(P : nat → nat → Prop) (Q : nat → Prop),
-  (∃y, P 42 y) →
-  (∀x y : nat, P x y → Q x) →
-  Q 42.
-Proof.
-  intros P Q HP HQ. destruct HP as [y HP']. eapply HQ. eassumption.
-Qed.
- -
- -
-
- -
-

Exercise: 2 stars (hoare_asgn_examples_2)

- Translate these informal Hoare triples... - -
- -
-       {{ X + 1 ≤ 5 }}  X ::= X + 1  {{ X ≤ 5 }}
-       {{ 0 ≤ 3 ∧ 3 ≤ 5 }}  X ::= 3  {{ 0 ≤ X ∧ X ≤ 5 }} -
- -
- ...into formal statements and use hoare_asgn and - hoare_consequence_pre to prove them. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Skip

- -
- - Since SKIP doesn't change the state, it preserves any - property P: -
- - - - - - - - - - -
   - (hoare_skip)   -
{{ P }} SKIP {{ P }}
-
-
- -
-Theorem hoare_skip : ∀P,
-     {{P}} SKIP {{P}}.
-
-
-Proof.
-  intros P st st' H HP. inversion H. subst.
-  assumption. Qed.
-
- -
-
- -
-

Sequencing

- -
- - More interestingly, if the command c1 takes any state where - P holds to a state where Q holds, and if c2 takes any - state where Q holds to one where R holds, then doing c1 - followed by c2 will take any state where P holds to one - where R holds: -
- - - - - - - - - - - - - - -
{{ P }} c1 {{ Q }}
{{ Q }} c2 {{ R }} - (hoare_seq)   -
{{ P }} c1;;c2 {{ R }}
-
-
- -
-Theorem hoare_seq : ∀P Q R c1 c2,
-     {{Q}} c2 {{R}} →
-     {{P}} c1 {{Q}} →
-     {{P}} c1;;c2 {{R}}.
-
-
-Proof.
-  intros P Q R c1 c2 H1 H2 st st' H12 Pre.
-  inversion H12; subst.
-  apply (H1 st'0 st'); try assumption.
-  apply (H2 st st'0); assumption. Qed.
-
- -
-
- -
-Note that, in the formal rule hoare_seq, the premises are - given in "backwards" order (c2 before c1). This matches the - natural flow of information in many of the situations where we'll - use the rule: the natural way to construct a Hoare-logic proof is - to begin at the end of the program (with the final postcondition) - and push postconditions backwards through commands until we reach - the beginning. -
- - Informally, a nice way of recording a proof using the sequencing - rule is as a "decorated program" where the intermediate assertion - Q is written between c1 and c2: - -
- -
-      {{ a = n }}
-    X ::= a;;
-      {{ X = n }}      <---- decoration for Q
-    SKIP
-      {{ X = n }} -
- -
- -
-
- -
-Example hoare_asgn_example3 : ∀a n,
-  {{fun st ⇒ aeval st a = n}}
-  (X ::= a;; SKIP)
-  {{fun st ⇒ st X = n}}.
-
-
-Proof.
-  intros a n. eapply hoare_seq.
-  Case "right part of seq".
-    apply hoare_skip.
-  Case "left part of seq".
-    eapply hoare_consequence_pre. apply hoare_asgn.
-    intros st H. subst. reflexivity. Qed.
-
- -
-
- -
-You will most often use hoare_seq and - hoare_consequence_pre in conjunction with the eapply tactic, - as done above. -
- -

Exercise: 2 stars (hoare_asgn_example4)

- Translate this "decorated program" into a formal proof: - -
- -
-                   {{ True }} ⇾
-                   {{ 1 = 1 }}
-    X ::= 1;;
-                   {{ X = 1 }} ⇾
-                   {{ X = 1 ∧ 2 = 2 }}
-    Y ::= 2
-                   {{ X = 1 ∧ Y = 2 }} -
- -
- -
-
- -
-Example hoare_asgn_example4 :
-  {{fun st ⇒ True}} (X ::= (ANum 1);; Y ::= (ANum 2))
-  {{fun st ⇒ st X = 1 ∧ st Y = 2}}.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (swap_exercise)

- Write an Imp program c that swaps the values of X and Y - and show (in Coq) that it satisfies the following - specification: - -
- -
-      {{X ≤ Y}} c {{Y ≤ X}} -
- -
- -
-
- -
-Definition swap_program : com :=
-  (* FILL IN HERE *) admit.
- -
-Theorem swap_exercise :
-  {{fun st ⇒ st X ≤ st Y}}
-  swap_program
-  {{fun st ⇒ st Y ≤ st X}}.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (hoarestate1)

- Explain why the following proposition can't be proven: - -
- -
-      ∀(a : aexp) (n : nat),
-         {{fun st ⇒ aeval st a = n}}
-         (X ::= (ANum 3);; Y ::= a)
-         {{fun st ⇒ st Y = n}}. -
- -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Conditionals

- -
- - What sort of rule do we want for reasoning about conditional - commands? Certainly, if the same assertion Q holds after - executing either branch, then it holds after the whole - conditional. So we might be tempted to write: -
- - - - - - - - - - - - - - -
{{P}} c1 {{Q}}
{{P}} c2 {{Q}} -   -
{{P}} IFB b THEN c1 ELSE c2 {{Q}}
However, this is rather weak. For example, using this rule, - we cannot show that: - -
- -
-     {{ True }} 
-     IFB X == 0
-     THEN Y ::= 2
-     ELSE Y ::= X + 1 
-     FI
-     {{ X ≤ Y }} -
- -
- since the rule tells us nothing about the state in which the - assignments take place in the "then" and "else" branches. -
- - But we can actually say something more precise. In the - "then" branch, we know that the boolean expression b evaluates to - true, and in the "else" branch, we know it evaluates to false. - Making this information available in the premises of the rule gives - us more information to work with when reasoning about the behavior - of c1 and c2 (i.e., the reasons why they establish the - postcondition Q). -
- -
- - - - - - - - - - - - - - -
{{P ∧  b}} c1 {{Q}}
{{P ∧ ~b}} c2 {{Q}} - (hoare_if)   -
{{P}} IFB b THEN c1 ELSE c2 FI {{Q}}
-
- - To interpret this rule formally, we need to do a little work. - Strictly speaking, the assertion we've written, P ∧ b, is the - conjunction of an assertion and a boolean expression — i.e., it - doesn't typecheck. To fix this, we need a way of formally - "lifting" any bexp b to an assertion. We'll write bassn b for - the assertion "the boolean expression b evaluates to true (in - the given state)." -
-
- -
-Definition bassn b : Assertion :=
-  fun st ⇒ (beval st b = true).
- -
-
- -
-A couple of useful facts about bassn: -
-
- -
-Lemma bexp_eval_true : ∀b st,
-  beval st b = true → (bassn b) st.
-
-
-Proof.
-  intros b st Hbe.
-  unfold bassn. assumption. Qed.
-
- -
-Lemma bexp_eval_false : ∀b st,
-  beval st b = false → ¬ ((bassn b) st).
-
-
-Proof.
-  intros b st Hbe contra.
-  unfold bassn in contra.
-  rewrite → contra in Hbe. inversion Hbe. Qed.
-
- -
-
- -
-Now we can formalize the Hoare proof rule for conditionals - and prove it correct. -
-
- -
-Theorem hoare_if : ∀P Q b c1 c2,
-  {{fun st ⇒ P st ∧ bassn b st}} c1 {{Q}} →
-  {{fun st ⇒ P st ∧ ~(bassn b st)}} c2 {{Q}} →
-  {{P}} (IFB b THEN c1 ELSE c2 FI) {{Q}}.
-
-
-Proof.
-  intros P Q b c1 c2 HTrue HFalse st st' HE HP.
-  inversion HE; subst.
-  Case "b is true".
-    apply (HTrue st st').
-      assumption.
-      split. assumption.
-             apply bexp_eval_true. assumption.
-  Case "b is false".
-    apply (HFalse st st').
-      assumption.
-      split. assumption.
-             apply bexp_eval_false. assumption. Qed.
-
- -
- -
-
- -
-

Hoare Logic: So Far

- -
- - -
- -Idea: create a domain specific logic for reasoning about properties of Imp programs. - -
- -
    -
  • This hides the low-level details of the semantics of the program - -
    • -
  • Leads to a compositional reasoning process - -
    • -
- -
- -The basic structure is given by Hoare triples of the form: - -
- -
-  {{P}} c {{Q}} -
- -
- -
- -
    -
  • P and Q are predicates about the state of the Imp program - -
    • -
  • "If command c is started in a state satisfying assertion - P, and if c eventually terminates in some final state, - then this final state will satisfy the assertion Q." - -
    • -
- -
- -

Hoare Logic Rules (so far)

- -
- - -
- -
- - - - - - - - - - -
   - (hoare_asgn)   -
{{Q [X ↦ a]}} X::=a {{Q}}
- - - - - - - - - - -
   - (hoare_skip)   -
{{ P }} SKIP {{ P }}
- - - - - - - - - - - - - - -
{{ P }} c1 {{ Q }}
{{ Q }} c2 {{ R }} - (hoare_seq)   -
{{ P }} c1;;c2 {{ R }}
- - - - - - - - - - - - - - -
{{P ∧  b}} c1 {{Q}}
{{P ∧ ~b}} c2 {{Q}} - (hoare_if)   -
{{P}} IFB b THEN c1 ELSE c2 FI {{Q}}
- - - - - - - - - - - - - - - - - - -
{{P'}} c {{Q'}}
P ⇾ P'
Q' ⇾ Q - (hoare_consequence)   -
{{P}} c {{Q}}
-
- -

Example

- Here is a formal proof that the program we used to motivate the - rule satisfies the specification we gave. -
-
- -
-Example if_example :
-    {{fun st ⇒ True}}
-  IFB (BEq (AId X) (ANum 0))
-    THEN (Y ::= (ANum 2))
-    ELSE (Y ::= APlus (AId X) (ANum 1))
-  FI
-    {{fun st ⇒ st X ≤ st Y}}.
-
-
-Proof.
-  (* WORKED IN CLASS *)
-  apply hoare_if.
-  Case "Then".
-    eapply hoare_consequence_pre. apply hoare_asgn.
-    unfold bassn, assn_sub, update, assert_implies.
-    simpl. intros st [_ H].
-    apply beq_nat_true in H.
-    rewrite H. omega.
-  Case "Else".
-    eapply hoare_consequence_pre. apply hoare_asgn.
-    unfold assn_sub, update, assert_implies.
-    simpl; intros st _. omega.
-Qed.
-
- -
-
- -
-

Exercise: 2 stars (if_minus_plus)

- Prove the following hoare triple using hoare_if: -
-
- -
-Theorem if_minus_plus :
-  {{fun st ⇒ True}}
-  IFB (BLe (AId X) (AId Y))
-    THEN (Z ::= AMinus (AId Y) (AId X))
-    ELSE (Y ::= APlus (AId X) (AId Z))
-  FI
-  {{fun st ⇒ st Y = st X + st Z}}.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: One-sided conditionals

- -
- -

Exercise: 4 stars (if1_hoare)

- -
- - In this exercise we consider extending Imp with "one-sided - conditionals" of the form IF1 b THEN c FI. Here b is a - boolean expression, and c is a command. If b evaluates to - true, then command c is evaluated. If b evaluates to - false, then IF1 b THEN c FI does nothing. - -
- - We recommend that you do this exercise before the ones that - follow, as it should help solidify your understanding of the - material. -
- - The first step is to extend the syntax of commands and introduce - the usual notations. (We've done this for you. We use a separate - module to prevent polluting the global name space.) -
-
- -
-Module If1.
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAss : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com
-  | CIf1 : bexp → com → com.
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
-  | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "CIF1" ].
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "c1 ;; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "X '::=' a" :=
-  (CAss X a) (at level 60).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
-  (CIf e1 e2 e3) (at level 80, right associativity).
-Notation "'IF1' b 'THEN' c 'FI'" :=
-  (CIf1 b c) (at level 80, right associativity).
- -
-
- -
-Next we need to extend the evaluation relation to accommodate - IF1 branches. This is for you to do... What rule(s) need to be - added to ceval to evaluate one-sided conditionals? -
-
- -
-Reserved Notation "c1 '/' st '⇓' st'" (at level 40, st at level 39).
- -
-Inductive ceval : com → state → state → Prop :=
-  | E_Skip : ∀st : state, SKIP / st ⇓ st
-  | E_Ass : ∀(st : state) (a1 : aexp) (n : nat) (X : id),
-            aeval st a1 = n → (X ::= a1) / st ⇓ update st X n
-  | E_Seq : ∀(c1 c2 : com) (st st' st'' : state),
-            c1 / st ⇓ st' → c2 / st' ⇓ st'' → (c1 ;; c2) / st ⇓ st''
-  | E_IfTrue : ∀(st st' : state) (b1 : bexp) (c1 c2 : com),
-               beval st b1 = true →
-               c1 / st ⇓ st' → (IFB b1 THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_IfFalse : ∀(st st' : state) (b1 : bexp) (c1 c2 : com),
-                beval st b1 = false →
-                c2 / st ⇓ st' → (IFB b1 THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_WhileEnd : ∀(b1 : bexp) (st : state) (c1 : com),
-                 beval st b1 = false → (WHILE b1 DO c1 END) / st ⇓ st
-  | E_WhileLoop : ∀(st st' st'' : state) (b1 : bexp) (c1 : com),
-                  beval st b1 = true →
-                  c1 / st ⇓ st' →
-                  (WHILE b1 DO c1 END) / st' ⇓ st'' →
-                  (WHILE b1 DO c1 END) / st ⇓ st''
-(* FILL IN HERE *)
-
-  where "c1 '/' st '⇓' st'" := (ceval c1 st st').
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq"
-  | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
-  | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop"
-  (* FILL IN HERE *)
-  ].
- -
-
- -
-Now we repeat (verbatim) the definition and notation of Hoare triples. -
-
- -
-Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop :=
-  ∀st st',
-       c / st ⇓ st' →
-       P st →
-       Q st'.
- -
-Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q)
-                                  (at level 90, c at next level)
-                                  : hoare_spec_scope.
- -
-
- -
-Finally, we (i.e., you) need to state and prove a theorem, - hoare_if1, that expresses an appropriate Hoare logic proof rule - for one-sided conditionals. Try to come up with a rule that is - both sound and as precise as possible. -
-
- -
-(* FILL IN HERE *)
- -
-
- -
-For full credit, prove formally that your rule is precise enough - to show the following valid Hoare triple: - -
- -
-  {{ X + Y = Z }}
-  IF1 Y ≠ 0 THEN
-    X ::= X + Y
-  FI
-  {{ X = Z }} -
- -
- -
- - Hint: Your proof of this triple may need to use the other proof - rules also. Because we're working in a separate module, you'll - need to copy here the rules you find necessary. -
-
- -
-Lemma hoare_if1_good :
-  {{ fun st ⇒ st X + st Y = st Z }}
-  IF1 BNot (BEq (AId Y) (ANum 0)) THEN
-    X ::= APlus (AId X) (AId Y)
-  FI
-  {{ fun st ⇒ st X = st Z }}.
-Proof. (* FILL IN HERE *) Admitted.
- -
-End If1.
-
- -
-☐ -
-
- -
-
- -
-

Loops

- -
- - Finally, we need a rule for reasoning about while loops. -
- - Suppose we have a loop - -
- -
-      WHILE b DO c END -
- -
- and we want to find a pre-condition P and a post-condition - Q such that - -
- -
-      {{P}} WHILE b DO c END {{Q}}  -
- -
- is a valid triple. -
- -

- -
- - First of all, let's think about the case where b is false at the - beginning — i.e., let's assume that the loop body never executes - at all. In this case, the loop behaves like SKIP, so we might - be tempted to write: -
- - -
- - -
- -
-      {{P}} WHILE b DO c END {{P}}. -
- -
- -
- - -
- - But, as we remarked above for the conditional, we know a - little more at the end — not just P, but also the fact - that b is false in the current state. So we can enrich the - postcondition a little: - -
- - -
- -
-      {{P}} WHILE b DO c END {{P ∧ ¬b}} -
- -
- -
- - -
- - What about the case where the loop body does get executed? - In order to ensure that P holds when the loop finally - exits, we certainly need to make sure that the command c - guarantees that P holds whenever c is finished. - Moreover, since P holds at the beginning of the first - execution of c, and since each execution of c - re-establishes P when it finishes, we can always assume - that P holds at the beginning of c. This leads us to the - following rule: - -
- -
- - - - - - - - - - -
{{P}} c {{P}} -   -
{{P}} WHILE b DO c END {{P ∧ ~b}}
-
- - This is almost the rule we want, but again it can be improved a - little: at the beginning of the loop body, we know not only that - P holds, but also that the guard b is true in the current - state. This gives us a little more information to use in - reasoning about c (showing that it establishes the invariant by - the time it finishes). This gives us the final version of the rule: - -
- -
- - - - - - - - - - -
{{P ∧ b}} c {{P}} - (hoare_while)   -
{{P}} WHILE b DO c END {{P ∧ ~b}}
The proposition P is called an invariant of the loop. - -
-
- -
-Lemma hoare_while : ∀P b c,
-  {{fun st ⇒ P st ∧ bassn b st}} c {{P}} →
-  {{P}} WHILE b DO c END {{fun st ⇒ P st ∧ ¬ (bassn b st)}}.
-
-
-Proof.
-  intros P b c Hhoare st st' He HP.
-  (* Like we've seen before, we need to reason by induction 
-     on He, because, in the "keep looping" case, its hypotheses 
-     talk about the whole loop instead of just c. *)
-  remember (WHILE b DO c END) as wcom eqn:Heqwcom.
-  ceval_cases (induction He) Case;
-    try (inversion Heqwcom); subst; clear Heqwcom.
-  Case "E_WhileEnd".
-    split. assumption. apply bexp_eval_false. assumption.
-  Case "E_WhileLoop".
-    apply IHHe2. reflexivity.
-    apply (Hhoare st st'). assumption.
-      split. assumption. apply bexp_eval_true. assumption.
-Qed.
-
- -
-
- -
- One subtlety in the terminology is that calling some assertion P - a "loop invariant" doesn't just mean that it is preserved by the - body of the loop in question (i.e., {{P}} c {{P}}, where c is - the loop body), but rather that P together with the fact that - the loop's guard is true is a sufficient precondition for c to - ensure P as a postcondition. - -
- - This is a slightly (but significantly) weaker requirement. For - example, if P is the assertion X = 0, then P is an - invariant of the loop - -
- -
-    WHILE X = 2 DO X := 1 END -
- -
- although it is clearly not preserved by the body of the - loop. - -
-
- -
-Example while_example :
-    {{fun st ⇒ st X ≤ 3}}
-  WHILE (BLe (AId X) (ANum 2))
-  DO X ::= APlus (AId X) (ANum 1) END
-    {{fun st ⇒ st X = 3}}.
-
-
-Proof.
-  eapply hoare_consequence_post.
-  apply hoare_while.
-  eapply hoare_consequence_pre.
-  apply hoare_asgn.
-  unfold bassn, assn_sub, assert_implies, update. simpl.
-    intros st [H1 H2]. apply ble_nat_true in H2. omega.
-  unfold bassn, assert_implies. intros st [Hle Hb].
-    simpl in Hb. destruct (ble_nat (st X) 2) eqn : Heqle.
-    apply ex_falso_quodlibet. apply Hb; reflexivity.
-    apply ble_nat_false in Heqle. omega.
-Qed.
-
- -
-
- -
-

- We can use the while rule to prove the following Hoare triple, - which may seem surprising at first... -
-
- -
-Theorem always_loop_hoare : ∀P Q,
-  {{P}} WHILE BTrue DO SKIP END {{Q}}.
-
-
-Proof.
-  (* WORKED IN CLASS *)
-  intros P Q.
-  apply hoare_consequence_pre with (P' := fun st : state ⇒ True).
-  eapply hoare_consequence_post.
-  apply hoare_while.
-  Case "Loop body preserves invariant".
-    apply hoare_post_true. intros st. apply I.
-  Case "Loop invariant and negated guard imply postcondition".
-    simpl. intros st [Hinv Hguard].
-    apply ex_falso_quodlibet. apply Hguard. reflexivity.
-  Case "Precondition implies invariant".
-    intros st H. constructor. Qed.
-
- -
-
- -
-Of course, this result is not surprising if we remember that - the definition of hoare_triple asserts that the postcondition - must hold only when the command terminates. If the command - doesn't terminate, we can prove anything we like about the - post-condition. -
- - Hoare rules that only talk about terminating commands are - often said to describe a logic of "partial" correctness. It is - also possible to give Hoare rules for "total" correctness, which - build in the fact that the commands terminate. However, in this - course we will only talk about partial correctness. -
-
- -
-
- -
-

Exercise: REPEAT

- -
-
- -
-Module RepeatExercise.
- -
-
- -
-

Exercise: 4 stars, advanced (hoare_repeat)

- In this exercise, we'll add a new command to our language of - commands: REPEAT c UNTIL a END. You will write the - evaluation rule for repeat and add a new Hoare rule to - the language for programs involving it. -
-
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAsgn : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com
-  | CRepeat : com → bexp → com.
- -
-
- -
-REPEAT behaves like WHILE, except that the loop guard is - checked after each execution of the body, with the loop - repeating as long as the guard stays false. Because of this, - the body will always execute at least once. -
-
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
-  | Case_aux c "IFB" | Case_aux c "WHILE"
-  | Case_aux c "CRepeat" ].
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "c1 ;; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "X '::=' a" :=
-  (CAsgn X a) (at level 60).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
-  (CIf e1 e2 e3) (at level 80, right associativity).
-Notation "'REPEAT' e1 'UNTIL' b2 'END'" :=
-  (CRepeat e1 b2) (at level 80, right associativity).
- -
-
- -
-Add new rules for REPEAT to ceval below. You can use the rules - for WHILE as a guide, but remember that the body of a REPEAT - should always execute at least once, and that the loop ends when - the guard becomes true. Then update the ceval_cases tactic to - handle these added cases. -
-
- -
-Inductive ceval : state → com → state → Prop :=
-  | E_Skip : ∀st,
-      ceval st SKIP st
-  | E_Ass : ∀st a1 n X,
-      aeval st a1 = n →
-      ceval st (X ::= a1) (update st X n)
-  | E_Seq : ∀c1 c2 st st' st'',
-      ceval st c1 st' →
-      ceval st' c2 st'' →
-      ceval st (c1 ;; c2) st''
-  | E_IfTrue : ∀st st' b1 c1 c2,
-      beval st b1 = true →
-      ceval st c1 st' →
-      ceval st (IFB b1 THEN c1 ELSE c2 FI) st'
-  | E_IfFalse : ∀st st' b1 c1 c2,
-      beval st b1 = false →
-      ceval st c2 st' →
-      ceval st (IFB b1 THEN c1 ELSE c2 FI) st'
-  | E_WhileEnd : ∀b1 st c1,
-      beval st b1 = false →
-      ceval st (WHILE b1 DO c1 END) st
-  | E_WhileLoop : ∀st st' st'' b1 c1,
-      beval st b1 = true →
-      ceval st c1 st' →
-      ceval st' (WHILE b1 DO c1 END) st'' →
-      ceval st (WHILE b1 DO c1 END) st''
-(* FILL IN HERE *)
-.
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip" | Case_aux c "E_Ass"
-  | Case_aux c "E_Seq"
-  | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
-  | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop"
-(* FILL IN HERE *)
-].
- -
-
- -
-A couple of definitions from above, copied here so they use the - new ceval. -
-
- -
-Notation "c1 '/' st '⇓' st'" := (ceval st c1 st')
-                                 (at level 40, st at level 39).
- -
-Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion)
-                        : Prop :=
-  ∀st st', (c / st ⇓ st') → P st → Q st'.
- -
-Notation "{{ P }} c {{ Q }}" :=
-  (hoare_triple P c Q) (at level 90, c at next level).
- -
-
- -
-To make sure you've got the evaluation rules for REPEAT right, - prove that ex1_repeat evaluates correctly. -
-
- -
-Definition ex1_repeat :=
-  REPEAT
-    X ::= ANum 1;;
-    Y ::= APlus (AId Y) (ANum 1)
-  UNTIL (BEq (AId X) (ANum 1)) END.
- -
-Theorem ex1_repeat_works :
-  ex1_repeat / empty_state ⇓
-               update (update empty_state X 1) Y 1.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Now state and prove a theorem, hoare_repeat, that expresses an - appropriate proof rule for repeat commands. Use hoare_while - as a model, and try to make your rule as precise as possible. -
-
- -
-(* FILL IN HERE *)
- -
-
- -
-For full credit, make sure (informally) that your rule can be used - to prove the following valid Hoare triple: - -
- -
-  {{ X > 0 }}
-  REPEAT
-    Y ::= X;;
-    X ::= X - 1
-  UNTIL X = 0 END
-  {{ X = 0 ∧ Y > 0 }} -
- -
- -
-
- -
-End RepeatExercise.
-
- -
-☐ -
-
- -
-
- -
-

Exercise: HAVOC

- -
- -

Exercise: 3 stars (himp_hoare)

- -
- - In this exercise, we will derive proof rules for the HAVOC command - which we studied in the last chapter. First, we enclose this work - in a separate module, and recall the syntax and big-step semantics - of Himp commands. -
-
- -
-Module Himp.
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAsgn : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com
-  | CHavoc : id → com.
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
-  | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "HAVOC" ].
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "X '::=' a" :=
-  (CAsgn X a) (at level 60).
-Notation "c1 ;; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
-  (CIf e1 e2 e3) (at level 80, right associativity).
-Notation "'HAVOC' X" := (CHavoc X) (at level 60).
- -
-Reserved Notation "c1 '/' st '⇓' st'" (at level 40, st at level 39).
- -
-Inductive ceval : com → state → state → Prop :=
-  | E_Skip : ∀st : state, SKIP / st ⇓ st
-  | E_Ass : ∀(st : state) (a1 : aexp) (n : nat) (X : id),
-            aeval st a1 = n → (X ::= a1) / st ⇓ update st X n
-  | E_Seq : ∀(c1 c2 : com) (st st' st'' : state),
-            c1 / st ⇓ st' → c2 / st' ⇓ st'' → (c1 ;; c2) / st ⇓ st''
-  | E_IfTrue : ∀(st st' : state) (b1 : bexp) (c1 c2 : com),
-               beval st b1 = true →
-               c1 / st ⇓ st' → (IFB b1 THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_IfFalse : ∀(st st' : state) (b1 : bexp) (c1 c2 : com),
-                beval st b1 = false →
-                c2 / st ⇓ st' → (IFB b1 THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_WhileEnd : ∀(b1 : bexp) (st : state) (c1 : com),
-                 beval st b1 = false → (WHILE b1 DO c1 END) / st ⇓ st
-  | E_WhileLoop : ∀(st st' st'' : state) (b1 : bexp) (c1 : com),
-                  beval st b1 = true →
-                  c1 / st ⇓ st' →
-                  (WHILE b1 DO c1 END) / st' ⇓ st'' →
-                  (WHILE b1 DO c1 END) / st ⇓ st''
-  | E_Havoc : ∀(st : state) (X : id) (n : nat),
-              (HAVOC X) / st ⇓ update st X n
-
-  where "c1 '/' st '⇓' st'" := (ceval c1 st st').
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq"
-  | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
-  | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop"
-  | Case_aux c "E_Havoc" ].
- -
-
- -
-The definition of Hoare triples is exactly as before. Unlike our - notion of program equivalence, which had subtle consequences with - occassionally nonterminating commands (exercise havoc_diverge), - this definition is still fully satisfactory. Convince yourself of - this before proceeding. -
-
- -
-Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop :=
-  ∀st st', c / st ⇓ st' → P st → Q st'.
- -
-Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q)
-                                  (at level 90, c at next level)
-                                  : hoare_spec_scope.
- -
-
- -
-Complete the Hoare rule for HAVOC commands below by defining - havoc_pre and prove that the resulting rule is correct. -
-
- -
-Definition havoc_pre (X : id) (Q : Assertion) : Assertion :=
-(* FILL IN HERE *) admit.
- -
-Theorem hoare_havoc : ∀(Q : Assertion) (X : id),
-  {{ havoc_pre X Q }} HAVOC X {{ Q }}.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-End Himp.
-
- -
-☐ -
-
- -
-
- -
-

Complete List of Hoare Logic Rules

- -
- - Above, we've introduced Hoare Logic as a tool to reasoning - about Imp programs. In the reminder of this chapter we will - explore a systematic way to use Hoare Logic to prove properties - about programs. The rules of Hoare Logic are the following: -
- - -
- -
- - - - - - - - - - -
   - (hoare_asgn)   -
{{Q [X ↦ a]}} X::=a {{Q}}
- - - - - - - - - - -
   - (hoare_skip)   -
{{ P }} SKIP {{ P }}
- - - - - - - - - - - - - - -
{{ P }} c1 {{ Q }}
{{ Q }} c2 {{ R }} - (hoare_seq)   -
{{ P }} c1;;c2 {{ R }}
- - - - - - - - - - - - - - -
{{P ∧  b}} c1 {{Q}}
{{P ∧ ~b}} c2 {{Q}} - (hoare_if)   -
{{P}} IFB b THEN c1 ELSE c2 FI {{Q}}
- - - - - - - - - - -
{{P ∧ b}} c {{P}} - (hoare_while)   -
{{P}} WHILE b DO c END {{P ∧ ~b}}
- - - - - - - - - - - - - - - - - - -
{{P'}} c {{Q'}}
P ⇾ P'
Q' ⇾ Q - (hoare_consequence)   -
{{P}} c {{Q}}
In the next chapter, we'll see how these rules are used to prove - that programs satisfy specifications of their behavior. - -
-
- -
-(* $Date: 2014-02-27 16:56:35 -0500 (Thu, 27 Feb 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Hoare.v b/Hoare.v deleted file mode 100644 index 853511c..0000000 --- a/Hoare.v +++ /dev/null @@ -1,1573 +0,0 @@ -(** * Hoare: Hoare Logic, Part I *) - -Require Export Imp. - -(** In the past couple of chapters, we've begun applying the - mathematical tools developed in the first part of the course to - studying the theory of a small programming language, Imp. - - - We defined a type of _abstract syntax trees_ for Imp, together - with an _evaluation relation_ (a partial function on states) - that specifies the _operational semantics_ of programs. - - The language we defined, though small, captures some of the key - features of full-blown languages like C, C++, and Java, - including the fundamental notion of mutable state and some - common control structures. - - - We proved a number of _metatheoretic properties_ -- "meta" in - the sense that they are properties of the language as a whole, - rather than properties of particular programs in the language. - These included: - - - determinism of evaluation - - - equivalence of some different ways of writing down the - definitions (e.g. functional and relational definitions of - arithmetic expression evaluation) - - - guaranteed termination of certain classes of programs - - - correctness (in the sense of preserving meaning) of a number - of useful program transformations - - - behavioral equivalence of programs (in the [Equiv] chapter). - - If we stopped here, we would already have something useful: a set - of tools for defining and discussing programming languages and - language features that are mathematically precise, flexible, and - easy to work with, applied to a set of key properties. All of - these properties are things that language designers, compiler - writers, and users might care about knowing. Indeed, many of them - are so fundamental to our understanding of the programming - languages we deal with that we might not consciously recognize - them as "theorems." But properties that seem intuitively obvious - can sometimes be quite subtle (in some cases, even subtly wrong!). - - We'll return to the theme of metatheoretic properties of whole - languages later in the course when we discuss _types_ and _type - soundness_. In this chapter, though, we'll turn to a different - set of issues. - - Our goal is to see how to carry out some simple examples of - _program verification_ -- i.e., using the precise definition of - Imp to prove formally that particular programs satisfy particular - specifications of their behavior. We'll develop a reasoning system - called _Floyd-Hoare Logic_ -- often shortened to just _Hoare - Logic_ -- in which each of the syntactic constructs of Imp is - equipped with a single, generic "proof rule" that can be used to - reason compositionally about the correctness of programs involving - this construct. - - Hoare Logic originates in the 1960s, and it continues to be the - subject of intensive research right up to the present day. It - lies at the core of a multitude of tools that are being used in - academia and industry to specify and verify real software - systems. *) - - - -(* ####################################################### *) -(** * Hoare Logic *) - -(** Hoare Logic combines two beautiful ideas: a natural way of - writing down _specifications_ of programs, and a _compositional - proof technique_ for proving that programs are correct with - respect to such specifications -- where by "compositional" we mean - that the structure of proofs directly mirrors the structure of the - programs that they are about. *) - -(* ####################################################### *) -(** ** Assertions *) - -(** To talk about specifications of programs, the first thing we - need is a way of making _assertions_ about properties that hold at - particular points during a program's execution -- i.e., claims - about the current state of the memory when program execution - reaches that point. Formally, an assertion is just a family of - propositions indexed by a [state]. *) - -Definition Assertion := state -> Prop. - -(** **** Exercise: 1 star, optional (assertions) *) -Module ExAssertions. - -(** Paraphrase the following assertions in English. *) - -Definition as1 : Assertion := fun st => st X = 3. -Definition as2 : Assertion := fun st => st X <= st Y. -Definition as3 : Assertion := - fun st => st X = 3 \/ st X <= st Y. -Definition as4 : Assertion := - fun st => st Z * st Z <= st X /\ - ~ (((S (st Z)) * (S (st Z))) <= st X). -Definition as5 : Assertion := fun st => True. -Definition as6 : Assertion := fun st => False. - -(* FILL IN HERE *) - -End ExAssertions. -(** [] *) - -(** This way of writing assertions can be a little bit heavy, - for two reasons: (1) every single assertion that we ever write is - going to begin with [fun st => ]; and (2) this state [st] is the - only one that we ever use to look up variables (we will never need - to talk about two different memory states at the same time). For - discussing examples informally, we'll adopt some simplifying - conventions: we'll drop the initial [fun st =>], and we'll write - just [X] to mean [st X]. Thus, instead of writing *) -(** - fun st => (st Z) * (st Z) <= m /\ - ~ ((S (st Z)) * (S (st Z)) <= m) - we'll write just - Z * Z <= m /\ ~((S Z) * (S Z) <= m). -*) - -(** Given two assertions [P] and [Q], we say that [P] _implies_ [Q], - written [P ->> Q] (in ASCII, [P -][>][> Q]), if, whenever [P] - holds in some state [st], [Q] also holds. *) - -Definition assert_implies (P Q : Assertion) : Prop := - forall st, P st -> Q st. - -Notation "P ->> Q" := - (assert_implies P Q) (at level 80) : hoare_spec_scope. -Open Scope hoare_spec_scope. - -(** We'll also have occasion to use the "iff" variant of implication - between assertions: *) - -Notation "P <<->> Q" := - (P ->> Q /\ Q ->> P) (at level 80) : hoare_spec_scope. - -(* ####################################################### *) -(** ** Hoare Triples *) - -(** Next, we need a way of making formal claims about the - behavior of commands. *) - -(** Since the behavior of a command is to transform one state to - another, it is natural to express claims about commands in terms - of assertions that are true before and after the command executes: - - - "If command [c] is started in a state satisfying assertion - [P], and if [c] eventually terminates in some final state, - then this final state will satisfy the assertion [Q]." - - Such a claim is called a _Hoare Triple_. The property [P] is - called the _precondition_ of [c], while [Q] is the - _postcondition_. Formally: *) - -Definition hoare_triple - (P:Assertion) (c:com) (Q:Assertion) : Prop := - forall st st', - c / st || st' -> - P st -> - Q st'. - -(** Since we'll be working a lot with Hoare triples, it's useful to - have a compact notation: - {{P}} c {{Q}}. -*) -(** (The traditional notation is [{P} c {Q}], but single braces - are already used for other things in Coq.) *) - -Notation "{{ P }} c {{ Q }}" := - (hoare_triple P c Q) (at level 90, c at next level) - : hoare_spec_scope. - -(** (The [hoare_spec_scope] annotation here tells Coq that this - notation is not global but is intended to be used in particular - contexts. The [Open Scope] tells Coq that this file is one such - context.) *) - -(** **** Exercise: 1 star, optional (triples) *) -(** Paraphrase the following Hoare triples in English. - 1) {{True}} c {{X = 5}} - - 2) {{X = m}} c {{X = m + 5)}} - - 3) {{X <= Y}} c {{Y <= X}} - - 4) {{True}} c {{False}} - - 5) {{X = m}} - c - {{Y = real_fact m}}. - - 6) {{True}} - c - {{(Z * Z) <= m /\ ~ (((S Z) * (S Z)) <= m)}} - - *) - - -(** [] *) - - - - - - - - - -(** **** Exercise: 1 star, optional (valid_triples) *) -(** Which of the following Hoare triples are _valid_ -- i.e., the - claimed relation between [P], [c], and [Q] is true? - 1) {{True}} X ::= 5 {{X = 5}} - - 2) {{X = 2}} X ::= X + 1 {{X = 3}} - - 3) {{True}} X ::= 5; Y ::= 0 {{X = 5}} - - 4) {{X = 2 /\ X = 3}} X ::= 5 {{X = 0}} - - 5) {{True}} SKIP {{False}} - - 6) {{False}} SKIP {{True}} - - 7) {{True}} WHILE True DO SKIP END {{False}} - - 8) {{X = 0}} - WHILE X == 0 DO X ::= X + 1 END - {{X = 1}} - - 9) {{X = 1}} - WHILE X <> 0 DO X ::= X + 1 END - {{X = 100}} - -*) -(* FILL IN HERE *) -(** [] *) - -(** (Note that we're using informal mathematical notations for - expressions inside of commands, for readability, rather than their - formal [aexp] and [bexp] encodings. We'll continue doing so - throughout the chapter.) *) - -(** To get us warmed up for what's coming, here are two simple - facts about Hoare triples. *) - -Theorem hoare_post_true : forall (P Q : Assertion) c, - (forall st, Q st) -> - {{P}} c {{Q}}. -Proof. - intros P Q c H. unfold hoare_triple. - intros st st' Heval HP. - apply H. Qed. - -Theorem hoare_pre_false : forall (P Q : Assertion) c, - (forall st, ~(P st)) -> - {{P}} c {{Q}}. -Proof. - intros P Q c H. unfold hoare_triple. - intros st st' Heval HP. - unfold not in H. apply H in HP. - inversion HP. Qed. - -(* ####################################################### *) -(** ** Proof Rules *) - -(** The goal of Hoare logic is to provide a _compositional_ - method for proving the validity of Hoare triples. That is, the - structure of a program's correctness proof should mirror the - structure of the program itself. To this end, in the sections - below, we'll introduce one rule for reasoning about each of the - different syntactic forms of commands in Imp -- one for - assignment, one for sequencing, one for conditionals, etc. -- plus - a couple of "structural" rules that are useful for gluing things - together. We will prove programs correct using these proof rules, - without ever unfolding the definition of [hoare_triple]. *) - -(* ####################################################### *) -(** *** Assignment *) - -(** The rule for assignment is the most fundamental of the Hoare logic - proof rules. Here's how it works. - - Consider this (valid) Hoare triple: - {{ Y = 1 }} X ::= Y {{ X = 1 }} - In English: if we start out in a state where the value of [Y] - is [1] and we assign [Y] to [X], then we'll finish in a - state where [X] is [1]. That is, the property of being equal - to [1] gets transferred from [Y] to [X]. - - Similarly, in - {{ Y + Z = 1 }} X ::= Y + Z {{ X = 1 }} - the same property (being equal to one) gets transferred to - [X] from the expression [Y + Z] on the right-hand side of - the assignment. - - More generally, if [a] is _any_ arithmetic expression, then - {{ a = 1 }} X ::= a {{ X = 1 }} - is a valid Hoare triple. - - This can be made even more general. To conclude that an - _arbitrary_ property [Q] holds after [X ::= a], we need to assume - that [Q] holds before [X ::= a], but _with all occurrences of_ [X] - replaced by [a] in [Q]. This leads to the Hoare rule for - assignment - {{ Q [X |-> a] }} X ::= a {{ Q }} - where "[Q [X |-> a]]" is pronounced "[Q] where [a] is substituted - for [X]". - - For example, these are valid applications of the assignment - rule: - {{ (X <= 5) [X |-> X + 1] - i.e., X + 1 <= 5 }} - X ::= X + 1 - {{ X <= 5 }} - - {{ (X = 3) [X |-> 3] - i.e., 3 = 3}} - X ::= 3 - {{ X = 3 }} - - {{ (0 <= X /\ X <= 5) [X |-> 3] - i.e., (0 <= 3 /\ 3 <= 5)}} - X ::= 3 - {{ 0 <= X /\ X <= 5 }} -*) - -(** To formalize the rule, we must first formalize the idea of - "substituting an expression for an Imp variable in an assertion." - That is, given a proposition [P], a variable [X], and an - arithmetic expression [a], we want to derive another proposition - [P'] that is just the same as [P] except that, wherever [P] - mentions [X], [P'] should instead mention [a]. - - Since [P] is an arbitrary Coq proposition, we can't directly - "edit" its text. Instead, we can achieve the effect we want by - evaluating [P] in an updated state: *) - -Definition assn_sub X a P : Assertion := - fun (st : state) => - P (update st X (aeval st a)). - -Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10). - -(** That is, [P [X |-> a]] is an assertion [P'] that is just like [P] - except that, wherever [P] looks up the variable [X] in the current - state, [P'] instead uses the value of the expression [a]. - - To see how this works, let's calculate what happens with a couple - of examples. First, suppose [P'] is [(X <= 5) [X |-> 3]] -- that - is, more formally, [P'] is the Coq expression - fun st => - (fun st' => st' X <= 5) - (update st X (aeval st (ANum 3))), - which simplifies to - fun st => - (fun st' => st' X <= 5) - (update st X 3) - and further simplifies to - fun st => - ((update st X 3) X) <= 5) - and by further simplification to - fun st => - (3 <= 5). - That is, [P'] is the assertion that [3] is less than or equal to - [5] (as expected). - - For a more interesting example, suppose [P'] is [(X <= 5) [X |-> - X+1]]. Formally, [P'] is the Coq expression - fun st => - (fun st' => st' X <= 5) - (update st X (aeval st (APlus (AId X) (ANum 1)))), - which simplifies to - fun st => - (((update st X (aeval st (APlus (AId X) (ANum 1))))) X) <= 5 - and further simplifies to - fun st => - (aeval st (APlus (AId X) (ANum 1))) <= 5. - That is, [P'] is the assertion that [X+1] is at most [5]. - -*) - -(** Now we can give the precise proof rule for assignment: - ------------------------------ (hoare_asgn) - {{Q [X |-> a]}} X ::= a {{Q}} -*) - -(** We can prove formally that this rule is indeed valid. *) - -Theorem hoare_asgn : forall Q X a, - {{Q [X |-> a]}} (X ::= a) {{Q}}. -Proof. - unfold hoare_triple. - intros Q X a st st' HE HQ. - inversion HE. subst. - unfold assn_sub in HQ. assumption. Qed. - -(** Here's a first formal proof using this rule. *) - -Example assn_sub_example : - {{(fun st => st X = 3) [X |-> ANum 3]}} - (X ::= (ANum 3)) - {{fun st => st X = 3}}. -Proof. - apply hoare_asgn. Qed. - -(** **** Exercise: 2 stars (hoare_asgn_examples) *) -(** Translate these informal Hoare triples... - 1) {{ (X <= 5) [X |-> X + 1] }} - X ::= X + 1 - {{ X <= 5 }} - - 2) {{ (0 <= X /\ X <= 5) [X |-> 3] }} - X ::= 3 - {{ 0 <= X /\ X <= 5 }} - ...into formal statements and use [hoare_asgn] to prove them. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 2 stars (hoare_asgn_wrong) *) -(** The assignment rule looks backward to almost everyone the first - time they see it. If it still seems backward to you, it may help - to think a little about alternative "forward" rules. Here is a - seemingly natural one: - ------------------------------ (hoare_asgn_wrong) - {{ True }} X ::= a {{ X = a }} - Give a counterexample showing that this rule is incorrect - (informally). Hint: The rule universally quantifies over the - arithmetic expression [a], and your counterexample needs to - exhibit an [a] for which the rule doesn't work. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars, advanced (hoare_asgn_fwd) *) -(** However, using an auxiliary variable [m] to remember the original - value of [X] we can define a Hoare rule for assignment that does, - intuitively, "work forwards" rather than backwards. - ------------------------------------------ (hoare_asgn_fwd) - {{fun st => P st /\ st X = m}} - X ::= a - {{fun st => P st' /\ st X = aeval st' a }} - (where st' = update st X m) - Note that we use the original value of [X] to reconstruct the - state [st'] before the assignment took place. Prove that this rule - is correct (the first hypothesis is the functional extensionality - axiom, which you will need at some point). Also note that this - rule is more complicated than [hoare_asgn]. -*) - -Theorem hoare_asgn_fwd : - (forall {X Y: Type} {f g : X -> Y}, - (forall (x: X), f x = g x) -> f = g) -> - forall m a P, - {{fun st => P st /\ st X = m}} - X ::= a - {{fun st => P (update st X m) /\ st X = aeval (update st X m) a }}. -Proof. - intros functional_extensionality m a P. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, advanced (hoare_asgn_fwd_exists) *) -(** Another way to define a forward rule for assignment is to - existentially quantify over the previous value of the assigned - variable. - ------------------------------------------ (hoare_asgn_fwd_exists) - {{fun st => P st}} - X ::= a - {{fun st => exists m, P (update st X m) /\ - st X = aeval (update st X m) a }} -*) -(* This rule was proposed by Nick Giannarakis and Zoe Paraskevopoulou. *) - -Theorem hoare_asgn_fwd_exists : - (forall {X Y: Type} {f g : X -> Y}, - (forall (x: X), f x = g x) -> f = g) -> - forall a P, - {{fun st => P st}} - X ::= a - {{fun st => exists m, P (update st X m) /\ - st X = aeval (update st X m) a }}. -Proof. - intros functional_extensionality a P. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ####################################################### *) -(** *** Consequence *) - -(** Sometimes the preconditions and postconditions we get from the - Hoare rules won't quite be the ones we want in the particular - situation at hand -- they may be logically equivalent but have a - different syntactic form that fails to unify with the goal we are - trying to prove, or they actually may be logically weaker (for - preconditions) or stronger (for postconditions) than what we need. - - For instance, while - {{(X = 3) [X |-> 3]}} X ::= 3 {{X = 3}}, - follows directly from the assignment rule, - {{True}} X ::= 3 {{X = 3}}. - does not. This triple is valid, but it is not an instance of - [hoare_asgn] because [True] and [(X = 3) [X |-> 3]] are not - syntactically equal assertions. However, they are logically - equivalent, so if one triple is valid, then the other must - certainly be as well. We might capture this observation with the - following rule: - {{P'}} c {{Q}} - P <<->> P' - ----------------------------- (hoare_consequence_pre_equiv) - {{P}} c {{Q}} - Taking this line of thought a bit further, we can see that - strengthening the precondition or weakening the postcondition of a - valid triple always produces another valid triple. This - observation is captured by two _Rules of Consequence_. - {{P'}} c {{Q}} - P ->> P' - ----------------------------- (hoare_consequence_pre) - {{P}} c {{Q}} - - {{P}} c {{Q'}} - Q' ->> Q - ----------------------------- (hoare_consequence_post) - {{P}} c {{Q}} -*) - -(** Here are the formal versions: *) - -Theorem hoare_consequence_pre : forall (P P' Q : Assertion) c, - {{P'}} c {{Q}} -> - P ->> P' -> - {{P}} c {{Q}}. -Proof. - intros P P' Q c Hhoare Himp. - intros st st' Hc HP. apply (Hhoare st st'). - assumption. apply Himp. assumption. Qed. - -Theorem hoare_consequence_post : forall (P Q Q' : Assertion) c, - {{P}} c {{Q'}} -> - Q' ->> Q -> - {{P}} c {{Q}}. -Proof. - intros P Q Q' c Hhoare Himp. - intros st st' Hc HP. - apply Himp. - apply (Hhoare st st'). - assumption. assumption. Qed. - -(** For example, we might use the first consequence rule like this: - {{ True }} ->> - {{ 1 = 1 }} - X ::= 1 - {{ X = 1 }} - Or, formally... -*) - -Example hoare_asgn_example1 : - {{fun st => True}} (X ::= (ANum 1)) {{fun st => st X = 1}}. -Proof. - apply hoare_consequence_pre - with (P' := (fun st => st X = 1) [X |-> ANum 1]). - apply hoare_asgn. - intros st H. unfold assn_sub, update. simpl. reflexivity. -Qed. - -(** Finally, for convenience in some proofs, we can state a "combined" - rule of consequence that allows us to vary both the precondition - and the postcondition. - {{P'}} c {{Q'}} - P ->> P' - Q' ->> Q - ----------------------------- (hoare_consequence) - {{P}} c {{Q}} -*) - -Theorem hoare_consequence : forall (P P' Q Q' : Assertion) c, - {{P'}} c {{Q'}} -> - P ->> P' -> - Q' ->> Q -> - {{P}} c {{Q}}. -Proof. - intros P P' Q Q' c Hht HPP' HQ'Q. - apply hoare_consequence_pre with (P' := P'). - apply hoare_consequence_post with (Q' := Q'). - assumption. assumption. assumption. Qed. - -(* ####################################################### *) -(** *** Digression: The [eapply] Tactic *) - -(** This is a good moment to introduce another convenient feature of - Coq. We had to write "[with (P' := ...)]" explicitly in the proof - of [hoare_asgn_example1] and [hoare_consequence] above, to make - sure that all of the metavariables in the premises to the - [hoare_consequence_pre] rule would be set to specific - values. (Since [P'] doesn't appear in the conclusion of - [hoare_consequence_pre], the process of unifying the conclusion - with the current goal doesn't constrain [P'] to a specific - assertion.) - - This is a little annoying, both because the assertion is a bit - long and also because for [hoare_asgn_example1] the very next - thing we are going to do -- applying the [hoare_asgn] rule -- will - tell us exactly what it should be! We can use [eapply] instead of - [apply] to tell Coq, essentially, "Be patient: The missing part is - going to be filled in soon." *) - -Example hoare_asgn_example1' : - {{fun st => True}} - (X ::= (ANum 1)) - {{fun st => st X = 1}}. -Proof. - eapply hoare_consequence_pre. - apply hoare_asgn. - intros st H. reflexivity. Qed. - -(** In general, [eapply H] tactic works just like [apply H] except - that, instead of failing if unifying the goal with the conclusion - of [H] does not determine how to instantiate all of the variables - appearing in the premises of [H], [eapply H] will replace these - variables with so-called _existential variables_ (written [?nnn]) - as placeholders for expressions that will be determined (by - further unification) later in the proof. *) - -(** In order for [Qed] to succeed, all existential variables need to - be determined by the end of the proof. Otherwise Coq - will (rightly) refuse to accept the proof. Remember that the Coq - tactics build proof objects, and proof objects containing - existential variables are not complete. *) - -Lemma silly1 : forall (P : nat -> nat -> Prop) (Q : nat -> Prop), - (forall x y : nat, P x y) -> - (forall x y : nat, P x y -> Q x) -> - Q 42. -Proof. - intros P Q HP HQ. eapply HQ. apply HP. - -(** Coq gives a warning after [apply HP]: - No more subgoals but non-instantiated existential variables: - Existential 1 = - ?171 : [P : nat -> nat -> Prop - Q : nat -> Prop - HP : forall x y : nat, P x y - HQ : forall x y : nat, P x y -> Q x |- nat] - - (dependent evars: ?171 open,) - - You can use Grab Existential Variables. - Trying to finish the proof with [Qed] gives an error: -<< - Error: Attempt to save a proof with existential variables still - non-instantiated ->> *) - -Abort. - -(** An additional constraint is that existential variables cannot be - instantiated with terms containing (ordinary) variables that did - not exist at the time the existential variable was created. *) - -Lemma silly2 : - forall (P : nat -> nat -> Prop) (Q : nat -> Prop), - (exists y, P 42 y) -> - (forall x y : nat, P x y -> Q x) -> - Q 42. -Proof. - intros P Q HP HQ. eapply HQ. destruct HP as [y HP']. -(** Doing [apply HP'] above fails with the following error: - Error: Impossible to unify "?175" with "y". - In this case there is an easy fix: - doing [destruct HP] _before_ doing [eapply HQ]. -*) - -Abort. - -Lemma silly2_fixed : - forall (P : nat -> nat -> Prop) (Q : nat -> Prop), - (exists y, P 42 y) -> - (forall x y : nat, P x y -> Q x) -> - Q 42. -Proof. - intros P Q HP HQ. destruct HP as [y HP']. - eapply HQ. apply HP'. -Qed. - -(** In the last step we did [apply HP'] which unifies the existential - variable in the goal with the variable [y]. The [assumption] - tactic doesn't work in this case, since it cannot handle - existential variables. However, Coq also provides an [eassumption] - tactic that solves the goal if one of the premises matches the - goal up to instantiations of existential variables. We can use - it instead of [apply HP']. *) - -Lemma silly2_eassumption : forall (P : nat -> nat -> Prop) (Q : nat -> Prop), - (exists y, P 42 y) -> - (forall x y : nat, P x y -> Q x) -> - Q 42. -Proof. - intros P Q HP HQ. destruct HP as [y HP']. eapply HQ. eassumption. -Qed. - - - -(** **** Exercise: 2 stars (hoare_asgn_examples_2) *) -(** Translate these informal Hoare triples... - {{ X + 1 <= 5 }} X ::= X + 1 {{ X <= 5 }} - {{ 0 <= 3 /\ 3 <= 5 }} X ::= 3 {{ 0 <= X /\ X <= 5 }} - ...into formal statements and use [hoare_asgn] and - [hoare_consequence_pre] to prove them. *) - -(* FILL IN HERE *) -(** [] *) - -(* ####################################################### *) -(** *** Skip *) - -(** Since [SKIP] doesn't change the state, it preserves any - property P: - -------------------- (hoare_skip) - {{ P }} SKIP {{ P }} -*) - -Theorem hoare_skip : forall P, - {{P}} SKIP {{P}}. -Proof. - intros P st st' H HP. inversion H. subst. - assumption. Qed. - -(* ####################################################### *) -(** *** Sequencing *) - -(** More interestingly, if the command [c1] takes any state where - [P] holds to a state where [Q] holds, and if [c2] takes any - state where [Q] holds to one where [R] holds, then doing [c1] - followed by [c2] will take any state where [P] holds to one - where [R] holds: - {{ P }} c1 {{ Q }} - {{ Q }} c2 {{ R }} - --------------------- (hoare_seq) - {{ P }} c1;;c2 {{ R }} -*) - -Theorem hoare_seq : forall P Q R c1 c2, - {{Q}} c2 {{R}} -> - {{P}} c1 {{Q}} -> - {{P}} c1;;c2 {{R}}. -Proof. - intros P Q R c1 c2 H1 H2 st st' H12 Pre. - inversion H12; subst. - apply (H1 st'0 st'); try assumption. - apply (H2 st st'0); assumption. Qed. - -(** Note that, in the formal rule [hoare_seq], the premises are - given in "backwards" order ([c2] before [c1]). This matches the - natural flow of information in many of the situations where we'll - use the rule: the natural way to construct a Hoare-logic proof is - to begin at the end of the program (with the final postcondition) - and push postconditions backwards through commands until we reach - the beginning. *) - -(** Informally, a nice way of recording a proof using the sequencing - rule is as a "decorated program" where the intermediate assertion - [Q] is written between [c1] and [c2]: - {{ a = n }} - X ::= a;; - {{ X = n }} <---- decoration for Q - SKIP - {{ X = n }} -*) - -Example hoare_asgn_example3 : forall a n, - {{fun st => aeval st a = n}} - (X ::= a;; SKIP) - {{fun st => st X = n}}. -Proof. - intros a n. eapply hoare_seq. - Case "right part of seq". - apply hoare_skip. - Case "left part of seq". - eapply hoare_consequence_pre. apply hoare_asgn. - intros st H. subst. reflexivity. Qed. - -(** You will most often use [hoare_seq] and - [hoare_consequence_pre] in conjunction with the [eapply] tactic, - as done above. *) - -(** **** Exercise: 2 stars (hoare_asgn_example4) *) -(** Translate this "decorated program" into a formal proof: - {{ True }} ->> - {{ 1 = 1 }} - X ::= 1;; - {{ X = 1 }} ->> - {{ X = 1 /\ 2 = 2 }} - Y ::= 2 - {{ X = 1 /\ Y = 2 }} -*) - -Example hoare_asgn_example4 : - {{fun st => True}} (X ::= (ANum 1);; Y ::= (ANum 2)) - {{fun st => st X = 1 /\ st Y = 2}}. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (swap_exercise) *) -(** Write an Imp program [c] that swaps the values of [X] and [Y] - and show (in Coq) that it satisfies the following - specification: - {{X <= Y}} c {{Y <= X}} -*) - -Definition swap_program : com := - (* FILL IN HERE *) admit. - -Theorem swap_exercise : - {{fun st => st X <= st Y}} - swap_program - {{fun st => st Y <= st X}}. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (hoarestate1) *) -(** Explain why the following proposition can't be proven: - forall (a : aexp) (n : nat), - {{fun st => aeval st a = n}} - (X ::= (ANum 3);; Y ::= a) - {{fun st => st Y = n}}. -*) - -(* FILL IN HERE *) -(** [] *) - -(* ####################################################### *) -(** *** Conditionals *) - -(** What sort of rule do we want for reasoning about conditional - commands? Certainly, if the same assertion [Q] holds after - executing either branch, then it holds after the whole - conditional. So we might be tempted to write: - {{P}} c1 {{Q}} - {{P}} c2 {{Q}} - -------------------------------- - {{P}} IFB b THEN c1 ELSE c2 {{Q}} - However, this is rather weak. For example, using this rule, - we cannot show that: - {{ True }} - IFB X == 0 - THEN Y ::= 2 - ELSE Y ::= X + 1 - FI - {{ X <= Y }} - since the rule tells us nothing about the state in which the - assignments take place in the "then" and "else" branches. *) - -(** But we can actually say something more precise. In the - "then" branch, we know that the boolean expression [b] evaluates to - [true], and in the "else" branch, we know it evaluates to [false]. - Making this information available in the premises of the rule gives - us more information to work with when reasoning about the behavior - of [c1] and [c2] (i.e., the reasons why they establish the - postcondition [Q]). *) -(** - {{P /\ b}} c1 {{Q}} - {{P /\ ~b}} c2 {{Q}} - ------------------------------------ (hoare_if) - {{P}} IFB b THEN c1 ELSE c2 FI {{Q}} -*) - -(** To interpret this rule formally, we need to do a little work. - Strictly speaking, the assertion we've written, [P /\ b], is the - conjunction of an assertion and a boolean expression -- i.e., it - doesn't typecheck. To fix this, we need a way of formally - "lifting" any bexp [b] to an assertion. We'll write [bassn b] for - the assertion "the boolean expression [b] evaluates to [true] (in - the given state)." *) - -Definition bassn b : Assertion := - fun st => (beval st b = true). - -(** A couple of useful facts about [bassn]: *) - -Lemma bexp_eval_true : forall b st, - beval st b = true -> (bassn b) st. -Proof. - intros b st Hbe. - unfold bassn. assumption. Qed. - -Lemma bexp_eval_false : forall b st, - beval st b = false -> ~ ((bassn b) st). -Proof. - intros b st Hbe contra. - unfold bassn in contra. - rewrite -> contra in Hbe. inversion Hbe. Qed. - -(** Now we can formalize the Hoare proof rule for conditionals - and prove it correct. *) - -Theorem hoare_if : forall P Q b c1 c2, - {{fun st => P st /\ bassn b st}} c1 {{Q}} -> - {{fun st => P st /\ ~(bassn b st)}} c2 {{Q}} -> - {{P}} (IFB b THEN c1 ELSE c2 FI) {{Q}}. -Proof. - intros P Q b c1 c2 HTrue HFalse st st' HE HP. - inversion HE; subst. - Case "b is true". - apply (HTrue st st'). - assumption. - split. assumption. - apply bexp_eval_true. assumption. - Case "b is false". - apply (HFalse st st'). - assumption. - split. assumption. - apply bexp_eval_false. assumption. Qed. - - -(* ####################################################### *) - -(** * Hoare Logic: So Far *) - -(** -Idea: create a _domain specific logic_ for reasoning about properties of Imp programs. - -- This hides the low-level details of the semantics of the program -- Leads to a compositional reasoning process - - -The basic structure is given by _Hoare triples_ of the form: - {{P}} c {{Q}} -]] - -- [P] and [Q] are predicates about the state of the Imp program -- "If command [c] is started in a state satisfying assertion - [P], and if [c] eventually terminates in some final state, - then this final state will satisfy the assertion [Q]." - -*) - - -(** ** Hoare Logic Rules (so far) *) - -(** - ------------------------------ (hoare_asgn) - {{Q [X |-> a]}} X::=a {{Q}} - - -------------------- (hoare_skip) - {{ P }} SKIP {{ P }} - - {{ P }} c1 {{ Q }} - {{ Q }} c2 {{ R }} - --------------------- (hoare_seq) - {{ P }} c1;;c2 {{ R }} - - {{P /\ b}} c1 {{Q}} - {{P /\ ~b}} c2 {{Q}} - ------------------------------------ (hoare_if) - {{P}} IFB b THEN c1 ELSE c2 FI {{Q}} - - - {{P'}} c {{Q'}} - P ->> P' - Q' ->> Q - ----------------------------- (hoare_consequence) - {{P}} c {{Q}} -*) - - -(** *** Example *) -(** Here is a formal proof that the program we used to motivate the - rule satisfies the specification we gave. *) - -Example if_example : - {{fun st => True}} - IFB (BEq (AId X) (ANum 0)) - THEN (Y ::= (ANum 2)) - ELSE (Y ::= APlus (AId X) (ANum 1)) - FI - {{fun st => st X <= st Y}}. -Proof. - (* WORKED IN CLASS *) - apply hoare_if. - Case "Then". - eapply hoare_consequence_pre. apply hoare_asgn. - unfold bassn, assn_sub, update, assert_implies. - simpl. intros st [_ H]. - apply beq_nat_true in H. - rewrite H. omega. - Case "Else". - eapply hoare_consequence_pre. apply hoare_asgn. - unfold assn_sub, update, assert_implies. - simpl; intros st _. omega. -Qed. - -(** **** Exercise: 2 stars (if_minus_plus) *) -(** Prove the following hoare triple using [hoare_if]: *) - -Theorem if_minus_plus : - {{fun st => True}} - IFB (BLe (AId X) (AId Y)) - THEN (Z ::= AMinus (AId Y) (AId X)) - ELSE (Y ::= APlus (AId X) (AId Z)) - FI - {{fun st => st Y = st X + st Z}}. -Proof. - (* FILL IN HERE *) Admitted. - -(* ####################################################### *) -(** *** Exercise: One-sided conditionals *) - -(** **** Exercise: 4 stars (if1_hoare) *) - -(** In this exercise we consider extending Imp with "one-sided - conditionals" of the form [IF1 b THEN c FI]. Here [b] is a - boolean expression, and [c] is a command. If [b] evaluates to - [true], then command [c] is evaluated. If [b] evaluates to - [false], then [IF1 b THEN c FI] does nothing. - - We recommend that you do this exercise before the ones that - follow, as it should help solidify your understanding of the - material. *) - - -(** The first step is to extend the syntax of commands and introduce - the usual notations. (We've done this for you. We use a separate - module to prevent polluting the global name space.) *) - -Module If1. - -Inductive com : Type := - | CSkip : com - | CAss : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com - | CIf1 : bexp -> com -> com. - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";" - | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "CIF1" ]. - -Notation "'SKIP'" := - CSkip. -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "X '::=' a" := - (CAss X a) (at level 60). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := - (CIf e1 e2 e3) (at level 80, right associativity). -Notation "'IF1' b 'THEN' c 'FI'" := - (CIf1 b c) (at level 80, right associativity). - -(** Next we need to extend the evaluation relation to accommodate - [IF1] branches. This is for you to do... What rule(s) need to be - added to [ceval] to evaluate one-sided conditionals? *) - -Reserved Notation "c1 '/' st '||' st'" (at level 40, st at level 39). - -Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st : state, SKIP / st || st - | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : id), - aeval st a1 = n -> (X ::= a1) / st || update st X n - | E_Seq : forall (c1 c2 : com) (st st' st'' : state), - c1 / st || st' -> c2 / st' || st'' -> (c1 ;; c2) / st || st'' - | E_IfTrue : forall (st st' : state) (b1 : bexp) (c1 c2 : com), - beval st b1 = true -> - c1 / st || st' -> (IFB b1 THEN c1 ELSE c2 FI) / st || st' - | E_IfFalse : forall (st st' : state) (b1 : bexp) (c1 c2 : com), - beval st b1 = false -> - c2 / st || st' -> (IFB b1 THEN c1 ELSE c2 FI) / st || st' - | E_WhileEnd : forall (b1 : bexp) (st : state) (c1 : com), - beval st b1 = false -> (WHILE b1 DO c1 END) / st || st - | E_WhileLoop : forall (st st' st'' : state) (b1 : bexp) (c1 : com), - beval st b1 = true -> - c1 / st || st' -> - (WHILE b1 DO c1 END) / st' || st'' -> - (WHILE b1 DO c1 END) / st || st'' -(* FILL IN HERE *) - - where "c1 '/' st '||' st'" := (ceval c1 st st'). - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq" - | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" - | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" - (* FILL IN HERE *) - ]. - -(** Now we repeat (verbatim) the definition and notation of Hoare triples. *) - -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop := - forall st st', - c / st || st' -> - P st -> - Q st'. - -Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) - (at level 90, c at next level) - : hoare_spec_scope. - -(** Finally, we (i.e., you) need to state and prove a theorem, - [hoare_if1], that expresses an appropriate Hoare logic proof rule - for one-sided conditionals. Try to come up with a rule that is - both sound and as precise as possible. *) - -(* FILL IN HERE *) - -(** For full credit, prove formally that your rule is precise enough - to show the following valid Hoare triple: - {{ X + Y = Z }} - IF1 Y <> 0 THEN - X ::= X + Y - FI - {{ X = Z }} -*) - -(** Hint: Your proof of this triple may need to use the other proof - rules also. Because we're working in a separate module, you'll - need to copy here the rules you find necessary. *) - - -Lemma hoare_if1_good : - {{ fun st => st X + st Y = st Z }} - IF1 BNot (BEq (AId Y) (ANum 0)) THEN - X ::= APlus (AId X) (AId Y) - FI - {{ fun st => st X = st Z }}. -Proof. (* FILL IN HERE *) Admitted. - -End If1. -(** [] *) - -(* ####################################################### *) -(** *** Loops *) - -(** Finally, we need a rule for reasoning about while loops. *) - -(** Suppose we have a loop - WHILE b DO c END - and we want to find a pre-condition [P] and a post-condition - [Q] such that - {{P}} WHILE b DO c END {{Q}} - is a valid triple. *) - -(** *** *) - -(** First of all, let's think about the case where [b] is false at the - beginning -- i.e., let's assume that the loop body never executes - at all. In this case, the loop behaves like [SKIP], so we might - be tempted to write: *) - -(** - {{P}} WHILE b DO c END {{P}}. -*) - -(** - But, as we remarked above for the conditional, we know a - little more at the end -- not just [P], but also the fact - that [b] is false in the current state. So we can enrich the - postcondition a little: -*) -(** - {{P}} WHILE b DO c END {{P /\ ~b}} -*) - -(** - What about the case where the loop body _does_ get executed? - In order to ensure that [P] holds when the loop finally - exits, we certainly need to make sure that the command [c] - guarantees that [P] holds whenever [c] is finished. - Moreover, since [P] holds at the beginning of the first - execution of [c], and since each execution of [c] - re-establishes [P] when it finishes, we can always assume - that [P] holds at the beginning of [c]. This leads us to the - following rule: -*) -(** - {{P}} c {{P}} - ----------------------------------- - {{P}} WHILE b DO c END {{P /\ ~b}} -*) -(** - This is almost the rule we want, but again it can be improved a - little: at the beginning of the loop body, we know not only that - [P] holds, but also that the guard [b] is true in the current - state. This gives us a little more information to use in - reasoning about [c] (showing that it establishes the invariant by - the time it finishes). This gives us the final version of the rule: -*) -(** - {{P /\ b}} c {{P}} - ----------------------------------- (hoare_while) - {{P}} WHILE b DO c END {{P /\ ~b}} - The proposition [P] is called an _invariant_ of the loop. -*) - -Lemma hoare_while : forall P b c, - {{fun st => P st /\ bassn b st}} c {{P}} -> - {{P}} WHILE b DO c END {{fun st => P st /\ ~ (bassn b st)}}. -Proof. - intros P b c Hhoare st st' He HP. - (* Like we've seen before, we need to reason by induction - on [He], because, in the "keep looping" case, its hypotheses - talk about the whole loop instead of just [c]. *) - remember (WHILE b DO c END) as wcom eqn:Heqwcom. - ceval_cases (induction He) Case; - try (inversion Heqwcom); subst; clear Heqwcom. - Case "E_WhileEnd". - split. assumption. apply bexp_eval_false. assumption. - Case "E_WhileLoop". - apply IHHe2. reflexivity. - apply (Hhoare st st'). assumption. - split. assumption. apply bexp_eval_true. assumption. -Qed. - -(** - One subtlety in the terminology is that calling some assertion [P] - a "loop invariant" doesn't just mean that it is preserved by the - body of the loop in question (i.e., [{{P}} c {{P}}], where [c] is - the loop body), but rather that [P] _together with the fact that - the loop's guard is true_ is a sufficient precondition for [c] to - ensure [P] as a postcondition. - - This is a slightly (but significantly) weaker requirement. For - example, if [P] is the assertion [X = 0], then [P] _is_ an - invariant of the loop - WHILE X = 2 DO X := 1 END - although it is clearly _not_ preserved by the body of the - loop. -*) - - - - - -Example while_example : - {{fun st => st X <= 3}} - WHILE (BLe (AId X) (ANum 2)) - DO X ::= APlus (AId X) (ANum 1) END - {{fun st => st X = 3}}. -Proof. - eapply hoare_consequence_post. - apply hoare_while. - eapply hoare_consequence_pre. - apply hoare_asgn. - unfold bassn, assn_sub, assert_implies, update. simpl. - intros st [H1 H2]. apply ble_nat_true in H2. omega. - unfold bassn, assert_implies. intros st [Hle Hb]. - simpl in Hb. destruct (ble_nat (st X) 2) eqn : Heqle. - apply ex_falso_quodlibet. apply Hb; reflexivity. - apply ble_nat_false in Heqle. omega. -Qed. - - - - - - -(** *** *) -(** We can use the while rule to prove the following Hoare triple, - which may seem surprising at first... *) - -Theorem always_loop_hoare : forall P Q, - {{P}} WHILE BTrue DO SKIP END {{Q}}. -Proof. - (* WORKED IN CLASS *) - intros P Q. - apply hoare_consequence_pre with (P' := fun st : state => True). - eapply hoare_consequence_post. - apply hoare_while. - Case "Loop body preserves invariant". - apply hoare_post_true. intros st. apply I. - Case "Loop invariant and negated guard imply postcondition". - simpl. intros st [Hinv Hguard]. - apply ex_falso_quodlibet. apply Hguard. reflexivity. - Case "Precondition implies invariant". - intros st H. constructor. Qed. - -(** Of course, this result is not surprising if we remember that - the definition of [hoare_triple] asserts that the postcondition - must hold _only_ when the command terminates. If the command - doesn't terminate, we can prove anything we like about the - post-condition. *) - -(** Hoare rules that only talk about terminating commands are - often said to describe a logic of "partial" correctness. It is - also possible to give Hoare rules for "total" correctness, which - build in the fact that the commands terminate. However, in this - course we will only talk about partial correctness. *) - -(* ####################################################### *) -(** *** Exercise: [REPEAT] *) - -Module RepeatExercise. - -(** **** Exercise: 4 stars, advanced (hoare_repeat) *) -(** In this exercise, we'll add a new command to our language of - commands: [REPEAT] c [UNTIL] a [END]. You will write the - evaluation rule for [repeat] and add a new Hoare rule to - the language for programs involving it. *) - -Inductive com : Type := - | CSkip : com - | CAsgn : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com - | CRepeat : com -> bexp -> com. - -(** [REPEAT] behaves like [WHILE], except that the loop guard is - checked _after_ each execution of the body, with the loop - repeating as long as the guard stays _false_. Because of this, - the body will always execute at least once. *) - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";" - | Case_aux c "IFB" | Case_aux c "WHILE" - | Case_aux c "CRepeat" ]. - -Notation "'SKIP'" := - CSkip. -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "X '::=' a" := - (CAsgn X a) (at level 60). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := - (CIf e1 e2 e3) (at level 80, right associativity). -Notation "'REPEAT' e1 'UNTIL' b2 'END'" := - (CRepeat e1 b2) (at level 80, right associativity). - -(** Add new rules for [REPEAT] to [ceval] below. You can use the rules - for [WHILE] as a guide, but remember that the body of a [REPEAT] - should always execute at least once, and that the loop ends when - the guard becomes true. Then update the [ceval_cases] tactic to - handle these added cases. *) - -Inductive ceval : state -> com -> state -> Prop := - | E_Skip : forall st, - ceval st SKIP st - | E_Ass : forall st a1 n X, - aeval st a1 = n -> - ceval st (X ::= a1) (update st X n) - | E_Seq : forall c1 c2 st st' st'', - ceval st c1 st' -> - ceval st' c2 st'' -> - ceval st (c1 ;; c2) st'' - | E_IfTrue : forall st st' b1 c1 c2, - beval st b1 = true -> - ceval st c1 st' -> - ceval st (IFB b1 THEN c1 ELSE c2 FI) st' - | E_IfFalse : forall st st' b1 c1 c2, - beval st b1 = false -> - ceval st c2 st' -> - ceval st (IFB b1 THEN c1 ELSE c2 FI) st' - | E_WhileEnd : forall b1 st c1, - beval st b1 = false -> - ceval st (WHILE b1 DO c1 END) st - | E_WhileLoop : forall st st' st'' b1 c1, - beval st b1 = true -> - ceval st c1 st' -> - ceval st' (WHILE b1 DO c1 END) st'' -> - ceval st (WHILE b1 DO c1 END) st'' -(* FILL IN HERE *) -. - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" | Case_aux c "E_Ass" - | Case_aux c "E_Seq" - | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" - | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" -(* FILL IN HERE *) -]. - -(** A couple of definitions from above, copied here so they use the - new [ceval]. *) - -Notation "c1 '/' st '||' st'" := (ceval st c1 st') - (at level 40, st at level 39). - -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) - : Prop := - forall st st', (c / st || st') -> P st -> Q st'. - -Notation "{{ P }} c {{ Q }}" := - (hoare_triple P c Q) (at level 90, c at next level). - -(** To make sure you've got the evaluation rules for [REPEAT] right, - prove that [ex1_repeat evaluates correctly. *) - -Definition ex1_repeat := - REPEAT - X ::= ANum 1;; - Y ::= APlus (AId Y) (ANum 1) - UNTIL (BEq (AId X) (ANum 1)) END. - -Theorem ex1_repeat_works : - ex1_repeat / empty_state || - update (update empty_state X 1) Y 1. -Proof. - (* FILL IN HERE *) Admitted. - -(** Now state and prove a theorem, [hoare_repeat], that expresses an - appropriate proof rule for [repeat] commands. Use [hoare_while] - as a model, and try to make your rule as precise as possible. *) - -(* FILL IN HERE *) - -(** For full credit, make sure (informally) that your rule can be used - to prove the following valid Hoare triple: - {{ X > 0 }} - REPEAT - Y ::= X;; - X ::= X - 1 - UNTIL X = 0 END - {{ X = 0 /\ Y > 0 }} -*) - - -End RepeatExercise. -(** [] *) - -(* ####################################################### *) -(** ** Exercise: [HAVOC] *) - -(** **** Exercise: 3 stars (himp_hoare) *) - -(** In this exercise, we will derive proof rules for the [HAVOC] command - which we studied in the last chapter. First, we enclose this work - in a separate module, and recall the syntax and big-step semantics - of Himp commands. *) - -Module Himp. - -Inductive com : Type := - | CSkip : com - | CAsgn : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com - | CHavoc : id -> com. - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";" - | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "HAVOC" ]. - -Notation "'SKIP'" := - CSkip. -Notation "X '::=' a" := - (CAsgn X a) (at level 60). -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := - (CIf e1 e2 e3) (at level 80, right associativity). -Notation "'HAVOC' X" := (CHavoc X) (at level 60). - -Reserved Notation "c1 '/' st '||' st'" (at level 40, st at level 39). - -Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st : state, SKIP / st || st - | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : id), - aeval st a1 = n -> (X ::= a1) / st || update st X n - | E_Seq : forall (c1 c2 : com) (st st' st'' : state), - c1 / st || st' -> c2 / st' || st'' -> (c1 ;; c2) / st || st'' - | E_IfTrue : forall (st st' : state) (b1 : bexp) (c1 c2 : com), - beval st b1 = true -> - c1 / st || st' -> (IFB b1 THEN c1 ELSE c2 FI) / st || st' - | E_IfFalse : forall (st st' : state) (b1 : bexp) (c1 c2 : com), - beval st b1 = false -> - c2 / st || st' -> (IFB b1 THEN c1 ELSE c2 FI) / st || st' - | E_WhileEnd : forall (b1 : bexp) (st : state) (c1 : com), - beval st b1 = false -> (WHILE b1 DO c1 END) / st || st - | E_WhileLoop : forall (st st' st'' : state) (b1 : bexp) (c1 : com), - beval st b1 = true -> - c1 / st || st' -> - (WHILE b1 DO c1 END) / st' || st'' -> - (WHILE b1 DO c1 END) / st || st'' - | E_Havoc : forall (st : state) (X : id) (n : nat), - (HAVOC X) / st || update st X n - - where "c1 '/' st '||' st'" := (ceval c1 st st'). - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq" - | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" - | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" - | Case_aux c "E_Havoc" ]. - -(** The definition of Hoare triples is exactly as before. Unlike our - notion of program equivalence, which had subtle consequences with - occassionally nonterminating commands (exercise [havoc_diverge]), - this definition is still fully satisfactory. Convince yourself of - this before proceeding. *) - -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop := - forall st st', c / st || st' -> P st -> Q st'. - -Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) - (at level 90, c at next level) - : hoare_spec_scope. - -(** Complete the Hoare rule for [HAVOC] commands below by defining - [havoc_pre] and prove that the resulting rule is correct. *) - -Definition havoc_pre (X : id) (Q : Assertion) : Assertion := -(* FILL IN HERE *) admit. - -Theorem hoare_havoc : forall (Q : Assertion) (X : id), - {{ havoc_pre X Q }} HAVOC X {{ Q }}. -Proof. - (* FILL IN HERE *) Admitted. - -End Himp. -(** [] *) - - -(* ####################################################### *) -(** ** Complete List of Hoare Logic Rules *) - -(** Above, we've introduced Hoare Logic as a tool to reasoning - about Imp programs. In the reminder of this chapter we will - explore a systematic way to use Hoare Logic to prove properties - about programs. The rules of Hoare Logic are the following: *) - -(** - ------------------------------ (hoare_asgn) - {{Q [X |-> a]}} X::=a {{Q}} - - -------------------- (hoare_skip) - {{ P }} SKIP {{ P }} - - {{ P }} c1 {{ Q }} - {{ Q }} c2 {{ R }} - --------------------- (hoare_seq) - {{ P }} c1;;c2 {{ R }} - - {{P /\ b}} c1 {{Q}} - {{P /\ ~b}} c2 {{Q}} - ------------------------------------ (hoare_if) - {{P}} IFB b THEN c1 ELSE c2 FI {{Q}} - - {{P /\ b}} c {{P}} - ----------------------------------- (hoare_while) - {{P}} WHILE b DO c END {{P /\ ~b}} - - {{P'}} c {{Q'}} - P ->> P' - Q' ->> Q - ----------------------------- (hoare_consequence) - {{P}} c {{Q}} - In the next chapter, we'll see how these rules are used to prove - that programs satisfy specifications of their behavior. -*) - -(* $Date: 2014-02-27 16:56:35 -0500 (Thu, 27 Feb 2014) $ *) - diff --git a/Hoare2.html b/Hoare2.html deleted file mode 100644 index 8d632fa..0000000 --- a/Hoare2.html +++ /dev/null @@ -1,2228 +0,0 @@ - - - - - -Hoare2: Hoare Logic, Part II - - - - - - -
- - - -
- -

Hoare2Hoare Logic, Part II

- -
-
- -
- -
-
- -
-Require Export Hoare.
- -
-
- -
-

Decorated Programs

- -
- - The beauty of Hoare Logic is that it is compositional — - the structure of proofs exactly follows the structure of programs. - This suggests that we can record the essential ideas of a proof - informally (leaving out some low-level calculational details) by - decorating programs with appropriate assertions around each - statement. Such a decorated program carries with it - an (informal) proof of its own correctness. -
- - For example, here is a complete decorated program: -
- - -
- -
-      {{ True }} ⇾
-      {{ m = m }}
-    X ::= m;
-      {{ X = m }} ⇾
-      {{ X = m ∧ p = p }}
-    Z ::= p;
-      {{ X = m ∧ Z = p }} ⇾
-      {{ Z - X = p - m }}
-    WHILE X ≠ 0 DO
-        {{ Z - X = p - m ∧ X ≠ 0 }} ⇾
-        {{ (Z - 1) - (X - 1) = p - m }}
-      Z ::= Z - 1;
-        {{ Z - (X - 1) = p - m }}
-      X ::= X - 1
-        {{ Z - X = p - m }}
-    END;
-      {{ Z - X = p - m ∧ ¬ (X ≠ 0) }} ⇾
-      {{ Z = p - m }}  -
- -
- -
- - Concretely, a decorated program consists of the program text - interleaved with assertions. To check that a decorated program - represents a valid proof, we check that each individual command is - locally consistent with its accompanying assertions in the - following sense: -
- - -
- -
    -
  • SKIP is locally consistent if its precondition and - postcondition are the same: - -
    - -
    -    {{ P }}
    -    SKIP
    -    {{ P }} -
    - -
    - -
    • -
- -
- - -
- -
    -
  • The sequential composition of c1 and c2 is locally - consistent (with respect to assertions P and R) if c1 is - locally consistent (with respect to P and Q) and c2 is - locally consistent (with respect to Q and R): - -
    - -
    -    {{ P }}
    -    c1;
    -    {{ Q }}
    -    c2
    -    {{ R }} -
    - -
    - -
    • -
- -
- - -
- -
    -
  • An assignment is locally consistent if its precondition is - the appropriate substitution of its postcondition: - -
    - -
    -    {{ P [X ↦ a] }}
    -    X ::= a
    -    {{ P }} -
    - -
    - -
    • -
- -
- - -
- -
    -
  • A conditional is locally consistent (with respect to assertions - P and Q) if the assertions at the top of its "then" and - "else" branches are exactly P ∧ b and P ∧ ¬b and if its "then" - branch is locally consistent (with respect to P ∧ b and Q) - and its "else" branch is locally consistent (with respect to - P ∧ ¬b and Q): - -
    - -
    -    {{ P }}
    -    IFB b THEN
    -      {{ P ∧ b }}
    -      c1
    -      {{ Q }}
    -    ELSE
    -      {{ P ∧ ¬b }}
    -      c2
    -      {{ Q }}
    -    FI
    -    {{ Q }} -
    - -
    - -
    • -
- -
- - -
- -
    -
  • A while loop with precondition P is locally consistent if its - postcondition is P ∧ ¬b and if the pre- and postconditions of - its body are exactly P ∧ b and P: - -
    - -
    -    {{ P }}
    -    WHILE b DO
    -      {{ P ∧ b }}
    -      c1
    -      {{ P }}
    -    END
    -    {{ P ∧ ¬b }} -
    - -
    - -
    • -
- -
- - -
- -
    -
  • A pair of assertions separated by ⇾ is locally consistent if - the first implies the second (in all states): - -
    - -
    -    {{ P }} ⇾
    -    {{ P' }} -
    - -
    - -
    - - This corresponds to the application of hoare_consequence and - is the only place in a decorated program where checking if - decorations are correct is not fully mechanical and syntactic, - but involves logical and/or arithmetic reasoning. - -
    • -
- -
- - We have seen above how verifying the correctness of a - given proof involves checking that every single command is locally - consistent with the accompanying assertions. If we are instead - interested in finding a proof for a given specification we need - to discover the right assertions. This can be done in an almost - automatic way, with the exception of finding loop invariants, - which is the subject of in the next section. In the reminder of - this section we explain in detail how to construct decorations for - several simple programs that don't involve non-trivial loop - invariants. -
-
- -
-
- -
-

Example: Swapping Using Addition and Subtraction

- -
- - Here is a program that swaps the values of two variables using - addition and subtraction (instead of by assigning to a temporary - variable). - -
- -
-  X ::= X + Y;
-  Y ::= X - Y;
-  X ::= X - Y -
- -
- We can prove using decorations that this program is correct — - i.e., it always swaps the values of variables X and Y. -
- - -
- - -
- -
- (1)     {{ X = m ∧ Y = n }} ⇾
- (2)     {{ (X + Y) - ((X + Y) - Y) = n ∧ (X + Y) - Y = m }}
-        X ::= X + Y;
- (3)     {{ X - (X - Y) = n ∧ X - Y = m }}
-        Y ::= X - Y;
- (4)     {{ X - Y = n ∧ Y = m }}
-        X ::= X - Y
- (5)     {{ X = n ∧ Y = m }} -
- -
- The decorations were constructed as follows: - -
- -
    -
  • We begin with the undecorated program (the unnumbered lines). - -
    • -
  • We then add the specification — i.e., the outer - precondition (1) and postcondition (5). In the precondition we - use auxiliary variables (parameters) m and n to remember - the initial values of variables X and respectively Y, so - that we can refer to them in the postcondition (5). - -
    • -
  • We work backwards mechanically starting from (5) all the way - to (2). At each step, we obtain the precondition of the - assignment from its postcondition by substituting the assigned - variable with the right-hand-side of the assignment. For - instance, we obtain (4) by substituting X with X - Y - in (5), and (3) by substituting Y with X - Y in (4). - -
    • -
  • Finally, we verify that (1) logically implies (2) — i.e., - that the step from (1) to (2) is a valid use of the law of - consequence. For this we substitute X by m and Y by n - and calculate as follows: - -
    - -
    -    (m + n) - ((m + n) - n) = n ∧ (m + n) - n = m
    -    (m + n) - m = n ∧ m = m
    -    n = n ∧ m = m -
    - -
    - -
    • -
- -
- - (Note that, since we are working with natural numbers, not - fixed-size machine integers, we don't need to worry about the - possibility of arithmetic overflow anywhere in this argument.) - -
-
- -
-
- -
-

Example: Simple Conditionals

- -
- - Here is a simple decorated program using conditionals: - -
- -
- (1)     {{True}}
-       IFB X ≤ Y THEN
- (2)       {{True ∧ X ≤ Y}} ⇾
- (3)       {{(Y - X) + X = Y ∨ (Y - X) + Y = X}}
-         Z ::= Y - X
- (4)       {{Z + X = Y ∨ Z + Y = X}}
-       ELSE
- (5)       {{True ∧ ~(X ≤ Y) }} ⇾
- (6)       {{(X - Y) + X = Y ∨ (X - Y) + Y = X}}
-         Z ::= X - Y
- (7)       {{Z + X = Y ∨ Z + Y = X}}
-       FI
- (8)     {{Z + X = Y ∨ Z + Y = X}} -
- -
- -
- -These decorations were constructed as follows: - -
- -
    -
  • We start with the outer precondition (1) and postcondition (8). - -
    • -
  • We follow the format dictated by the hoare_if rule and copy the - postcondition (8) to (4) and (7). We conjoin the precondition (1) - with the guard of the conditional to obtain (2). We conjoin (1) - with the negated guard of the conditional to obtain (5). - -
    • -
  • In order to use the assignment rule and obtain (3), we substitute - Z by Y - X in (4). To obtain (6) we substitute Z by X - Y - in (7). - -
    • -
  • Finally, we verify that (2) implies (3) and (5) implies (6). Both - of these implications crucially depend on the ordering of X and - Y obtained from the guard. For instance, knowing that X ≤ Y - ensures that subtracting X from Y and then adding back X - produces Y, as required by the first disjunct of (3). Similarly, - knowing that ~(X ≤ Y) ensures that subtracting Y from X and - then adding back Y produces X, as needed by the second - disjunct of (6). Note that n - m + m = n does not hold for - arbitrary natural numbers n and m (for example, 3 - 5 + 5 = - 5). -
    • -
- -
- -

Exercise: 2 stars (if_minus_plus_reloaded)

- Fill in valid decorations for the following program: - -
- -
-   {{ True }}
-  IFB X ≤ Y THEN
-      {{                         }} ⇾
-      {{                         }}
-    Z ::= Y - X
-      {{                         }}
-  ELSE
-      {{                         }} ⇾
-      {{                         }}
-    Y ::= X + Z
-      {{                         }}
-  FI
-    {{ Y = X + Z }} -
- -
- -
-
- -
-
- -
-

Example: Reduce to Zero (Trivial Loop)

- -
- - Here is a WHILE loop that is so simple it needs no - invariant (i.e., the invariant True will do the job). - -
- -
- (1)      {{ True }}
-        WHILE X ≠ 0 DO
- (2)        {{ True ∧ X ≠ 0 }} ⇾
- (3)        {{ True }}
-          X ::= X - 1
- (4)        {{ True }}
-        END
- (5)      {{ True ∧ X = 0 }} ⇾
- (6)      {{ X = 0 }} -
- -
-The decorations can be constructed as follows: - -
- -
    -
  • Start with the outer precondition (1) and postcondition (6). - -
    • -
  • Following the format dictated by the hoare_while rule, we copy - (1) to (4). We conjoin (1) with the guard to obtain (2) and with - the negation of the guard to obtain (5). Note that, because the - outer postcondition (6) does not syntactically match (5), we need a - trivial use of the consequence rule from (5) to (6). - -
    • -
  • Assertion (3) is the same as (4), because X does not appear in - 4, so the substitution in the assignment rule is trivial. - -
    • -
  • Finally, the implication between (2) and (3) is also trivial. - -
    • -
- -
- - From this informal proof, it is easy to read off a formal proof - using the Coq versions of the Hoare rules. Note that we do not - unfold the definition of hoare_triple anywhere in this proof — - the idea is to use the Hoare rules as a "self-contained" logic for - reasoning about programs. -
-
- -
-Definition reduce_to_zero' : com :=
-  WHILE BNot (BEq (AId X) (ANum 0)) DO
-    X ::= AMinus (AId X) (ANum 1)
-  END.
- -
-Theorem reduce_to_zero_correct' :
-  {{fun st ⇒ True}}
-  reduce_to_zero'
-  {{fun st ⇒ st X = 0}}.
-Proof.
-  unfold reduce_to_zero'.
-  (* First we need to transform the postcondition so
-     that hoare_while will apply. *)
-  eapply hoare_consequence_post.
-  apply hoare_while.
-  Case "Loop body preserves invariant".
-    (* Need to massage precondition before hoare_asgn applies *)
-    eapply hoare_consequence_pre. apply hoare_asgn.
-    (* Proving trivial implication (2) ->> (3) *)
-    intros st [HT Hbp]. unfold assn_sub. apply I.
-  Case "Invariant and negated guard imply postcondition".
-    intros st [Inv GuardFalse].
-    unfold bassn in GuardFalse. simpl in GuardFalse.
-    (* SearchAbout helps to find the right lemmas *)
-    SearchAbout [not true].
-    rewrite not_true_iff_false in GuardFalse.
-    SearchAbout [negb false].
-    rewrite negb_false_iff in GuardFalse.
-    SearchAbout [beq_nat true].
-    apply beq_nat_true in GuardFalse.
-    apply GuardFalse. Qed.
- -
-
- -
-

Example: Division

- -
- - The following Imp program calculates the integer division and - remainder of two numbers m and n that are arbitrary constants - in the program. - -
- -
-  X ::= m;
-  Y ::= 0;
-  WHILE n ≤ X DO
-    X ::= X - n;
-    Y ::= Y + 1
-  END; -
- -
- In other words, if we replace m and n by concrete numbers and - execute the program, it will terminate with the variable X set - to the remainder when m is divided by n and Y set to the - quotient. -
- - In order to give a specification to this program we need to - remember that dividing m by n produces a reminder X and a - quotient Y so that n × Y + X = m ∧ X < n. - -
- - It turns out that we get lucky with this program and don't have to - think very hard about the loop invariant: the invariant is the - just first conjunct n × Y + X = m, so we use that to decorate - the program. - -
- - -
- -
- (1)    {{ True }} ⇾
- (2)    {{ n × 0 + m = m }}
-      X ::= m;
- (3)    {{ n × 0 + X = m }}
-      Y ::= 0;
- (4)    {{ n × Y + X = m }}
-      WHILE n ≤ X DO
- (5)      {{ n × Y + X = m ∧ n ≤ X }} ⇾
- (6)      {{ n × (Y + 1) + (X - n) = m }}
-        X ::= X - n;
- (7)      {{ n × (Y + 1) + X = m }}
-        Y ::= Y + 1
- (8)      {{ n × Y + X = m }}
-      END
- (9)    {{ n × Y + X = m ∧ X < n }} -
- -
- -
- - Assertions (4), (5), (8), and (9) are derived mechanically from - the invariant and the loop's guard. Assertions (8), (7), and (6) - are derived using the assignment rule going backwards from (8) to - (6). Assertions (4), (3), and (2) are again backwards applications - of the assignment rule. - -
- - Now that we've decorated the program it only remains to check that - the two uses of the consequence rule are correct — i.e., that (1) - implies (2) and that (5) implies (6). This is indeed the case, so - we have a valid decorated program. - -
-
- -
-
- -
-

Finding Loop Invariants

- -
- - Once the outermost precondition and postcondition are chosen, the - only creative part in verifying programs with Hoare Logic is - finding the right loop invariants. The reason this is difficult - is the same as the reason that doing inductive mathematical proofs - requires creativity: strengthening the loop invariant (or the - induction hypothesis) means that you have a stronger assumption to - work with when trying to establish the postcondition of the loop - body (complete the induction step of the proof), but it also means - that the loop body postcondition itself is harder to prove! - -
- - This section is dedicated to teaching you how to approach the - challenge of finding loop invariants using a series of examples - and exercises. -
- -

Example: Slow Subtraction

- -
- - The following program subtracts the value of X from the value of - Y by repeatedly decrementing both X and Y. We want to verify its - correctness with respect to the following specification: - -
- -
-             {{ X = m ∧ Y = n }}
-           WHILE X ≠ 0 DO
-             Y ::= Y - 1;
-             X ::= X - 1
-           END
-             {{ Y = n - m }} -
- -
- -
- - To verify this program we need to find an invariant I for the - loop. As a first step we can leave I as an unknown and build a - skeleton for the proof by applying backward the rules for local - consistency. This process leads to the following skeleton: - -
- -
-    (1)      {{ X = m ∧ Y = n }}  ⇾     (a)
-    (2)      {{ I }}
-           WHILE X ≠ 0 DO
-    (3)        {{ I ∧ X ≠ 0 }}  ⇾      (c)
-    (4)        {{ I[X ↦ X-1][Y ↦ Y-1] }}
-             Y ::= Y - 1;
-    (5)        {{ I[X ↦ X-1] }}
-             X ::= X - 1
-    (6)        {{ I }}
-           END
-    (7)      {{ I ∧ ~(X ≠ 0) }}  ⇾         (b)
-    (8)      {{ Y = n - m }} -
- -
- -
- - By examining this skeleton, we can see that any valid I will - have to respect three conditions: - -
- -
    -
  • (a) it must be weak enough to be implied by the loop's - precondition, i.e. (1) must imply (2); - -
    • -
  • (b) it must be strong enough to imply the loop's postcondition, - i.e. (7) must imply (8); - -
    • -
  • (c) it must be preserved by one iteration of the loop, i.e. (3) - must imply (4). -
    • -
- -
- - These conditions are actually independent of the particular - program and specification we are considering. Indeed, every loop - invariant has to satisfy them. One way to find an invariant that - simultaneously satisfies these three conditions is by using an - iterative process: start with a "candidate" invariant (e.g. a - guess or a heuristic choice) and check the three conditions above; - if any of the checks fails, try to use the information that we get - from the failure to produce another (hopefully better) candidate - invariant, and repeat the process. - -
- - For instance, in the reduce-to-zero example above, we saw that, - for a very simple loop, choosing True as an invariant did the - job. So let's try it again here! I.e., let's instantiate I with - True in the skeleton above see what we get... - -
- -
-    (1)      {{ X = m ∧ Y = n }} ⇾       (a - OK)
-    (2)      {{ True }}
-           WHILE X ≠ 0 DO
-    (3)        {{ True ∧ X ≠ 0 }}  ⇾    (c - OK)
-    (4)        {{ True }}
-             Y ::= Y - 1;
-    (5)        {{ True }}
-             X ::= X - 1
-    (6)        {{ True }}
-           END
-    (7)      {{ True ∧ X = 0 }}  ⇾       (b - WRONG!)
-    (8)      {{ Y = n - m }} -
- -
- -
- - While conditions (a) and (c) are trivially satisfied, - condition (b) is wrong, i.e. it is not the case that (7) True ∧ - X = 0 implies (8) Y = n - m. In fact, the two assertions are - completely unrelated and it is easy to find a counterexample (say, - Y = X = m = 0 and n = 1). - -
- - If we want (b) to hold, we need to strengthen the invariant so - that it implies the postcondition (8). One very simple way to do - this is to let the invariant be the postcondition. So let's - return to our skeleton, instantiate I with Y = n - m, and - check conditions (a) to (c) again. - -
- -
-    (1)      {{ X = m ∧ Y = n }}  ⇾          (a - WRONG!)
-    (2)      {{ Y = n - m }}
-           WHILE X ≠ 0 DO
-    (3)        {{ Y = n - m ∧ X ≠ 0 }}  ⇾   (c - WRONG!)
-    (4)        {{ Y - 1 = n - m }}
-             Y ::= Y - 1;
-    (5)        {{ Y = n - m }}
-             X ::= X - 1
-    (6)        {{ Y = n - m }}
-           END
-    (7)      {{ Y = n - m ∧ X = 0 }}  ⇾      (b - OK)
-    (8)      {{ Y = n - m }} -
- -
- -
- - This time, condition (b) holds trivially, but (a) and (c) are - broken. Condition (a) requires that (1) X = m ∧ Y = n - implies (2) Y = n - m. If we substitute Y by n we have to - show that n = n - m for arbitrary m and n, which does not - hold (for instance, when m = n = 1). Condition (c) requires that - n - m - 1 = n - m, which fails, for instance, for n = 1 and m = - 0. So, although Y = n - m holds at the end of the loop, it does - not hold from the start, and it doesn't hold on each iteration; - it is not a correct invariant. - -
- - This failure is not very surprising: the variable Y changes - during the loop, while m and n are constant, so the assertion - we chose didn't have much chance of being an invariant! - -
- - To do better, we need to generalize (8) to some statement that is - equivalent to (8) when X is 0, since this will be the case - when the loop terminates, and that "fills the gap" in some - appropriate way when X is nonzero. Looking at how the loop - works, we can observe that X and Y are decremented together - until X reaches 0. So, if X = 2 and Y = 5 initially, - after one iteration of the loop we obtain X = 1 and Y = 4; - after two iterations X = 0 and Y = 3; and then the loop stops. - Notice that the difference between Y and X stays constant - between iterations; initially, Y = n and X = m, so this - difference is always n - m. So let's try instantiating I in - the skeleton above with Y - X = n - m. - -
- -
-    (1)      {{ X = m ∧ Y = n }}  ⇾               (a - OK)
-    (2)      {{ Y - X = n - m }}
-           WHILE X ≠ 0 DO
-    (3)        {{ Y - X = n - m ∧ X ≠ 0 }}  ⇾    (c - OK)
-    (4)        {{ (Y - 1) - (X - 1) = n - m }}
-             Y ::= Y - 1;
-    (5)        {{ Y - (X - 1) = n - m }}
-             X ::= X - 1
-    (6)        {{ Y - X = n - m }}
-           END
-    (7)      {{ Y - X = n - m ∧ X = 0 }}  ⇾       (b - OK)
-    (8)      {{ Y = n - m }} -
- -
- -
- - Success! Conditions (a), (b) and (c) all hold now. (To - verify (c), we need to check that, under the assumption that X ≠ - 0, we have Y - X = (Y - 1) - (X - 1); this holds for all - natural numbers X and Y.) -
-
- -
-
- -
-

Exercise: Slow Assignment

- -
- -

Exercise: 2 stars (slow_assignment)

- A roundabout way of assigning a number currently stored in X to - the variable Y is to start Y at 0, then decrement X until - it hits 0, incrementing Y at each step. Here is a program that - implements this idea: - -
- -
-      {{ X = m }}
-    Y ::= 0;
-    WHILE X ≠ 0 DO
-      X ::= X - 1;
-      Y ::= Y + 1;
-    END
-      {{ Y = m }} -
- -
- Write an informal decorated program showing that this is correct. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Exercise: Slow Addition

- -
- -

Exercise: 3 stars, optional (add_slowly_decoration)

- The following program adds the variable X into the variable Z - by repeatedly decrementing X and incrementing Z. - -
- -
-  WHILE X ≠ 0 DO
-     Z ::= Z + 1;
-     X ::= X - 1
-  END -
- -
- -
- - Following the pattern of the subtract_slowly example above, pick - a precondition and postcondition that give an appropriate - specification of add_slowly; then (informally) decorate the - program accordingly. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Example: Parity

- -
- - Here is a cute little program for computing the parity of the - value initially stored in X (due to Daniel Cristofani). - -
- -
-    {{ X = m }}
-  WHILE 2 ≤ X DO
-    X ::= X - 2
-  END
-    {{ X = parity m }} -
- -
- The mathematical parity function used in the specification is - defined in Coq as follows: -
-
- -
-Fixpoint parity x :=
-  match x with
-  | 0 ⇒ 0
-  | 1 ⇒ 1
-  | S (S x') ⇒ parity x'
-  end.
- -
-
- -
-The postcondition does not hold at the beginning of the loop, - since m = parity m does not hold for an arbitrary m, so we - cannot use that as an invariant. To find an invariant that works, - let's think a bit about what this loop does. On each iteration it - decrements X by 2, which preserves the parity of X. So the - parity of X does not change, i.e. it is invariant. The initial - value of X is m, so the parity of X is always equal to the - parity of m. Using parity X = parity m as an invariant we - obtain the following decorated program: - -
- -
-    {{ X = m }} ⇾                              (a - OK)
-    {{ parity X = parity m }}
-  WHILE 2 ≤ X DO
-      {{ parity X = parity m ∧ 2 ≤ X }}  ⇾    (c - OK)
-      {{ parity (X-2) = parity m }}
-    X ::= X - 2
-      {{ parity X = parity m }}
-  END
-    {{ parity X = parity m ∧ X < 2 }}  ⇾       (b - OK)
-    {{ X = parity m }} -
- -
- -
- - With this invariant, conditions (a), (b), and (c) are all - satisfied. For verifying (b), we observe that, when X < 2, we - have parity X = X (we can easily see this in the definition of - parity). For verifying (c), we observe that, when 2 ≤ X, we - have parity X = parity (X-2). -
- -

Exercise: 3 stars, optional (parity_formal)

- Translate this proof to Coq. Refer to the reduce-to-zero example - for ideas. You may find the following two lemmas useful: -
-
- -
-Lemma parity_ge_2 : ∀x,
-  2 ≤ x →
-  parity (x - 2) = parity x.
-
-
-Proof.
-  induction x; intro. reflexivity.
-  destruct x. inversion H. inversion H1.
-  simpl. rewrite ← minus_n_O. reflexivity.
-Qed.
-
- -
-Lemma parity_lt_2 : ∀x,
-  ¬ 2 ≤ x →
-  parity (x) = x.
-
-
-Proof.
-  intros. induction x. reflexivity. destruct x. reflexivity.
-    apply ex_falso_quodlibet. apply H. omega.
-Qed.
-
- -
-Theorem parity_correct : ∀m,
-    {{ fun st ⇒ st X = m }}
-  WHILE BLe (ANum 2) (AId X) DO
-    X ::= AMinus (AId X) (ANum 2)
-  END
-    {{ fun st ⇒ st X = parity m }}.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Example: Finding Square Roots

- -
- - The following program computes the square root of X - by naive iteration: - -
- -
-      {{ X=m }}
-    Z ::= 0;
-    WHILE (Z+1)*(Z+1) ≤ X DO
-      Z ::= Z+1
-    END
-      {{ Z×Z≤m ∧ m<(Z+1)*(Z+1) }} -
- -
- -
- - As above, we can try to use the postcondition as a candidate - invariant, obtaining the following decorated program: - -
- -
- (1)  {{ X=m }}  ⇾           (a - second conjunct of (2) WRONG!)
- (2)  {{ 0×0 ≤ m ∧ m<1×1 }}
-    Z ::= 0;
- (3)  {{ Z×Z ≤ m ∧ m<(Z+1)*(Z+1) }}
-    WHILE (Z+1)*(Z+1) ≤ X DO
- (4)    {{ Z×Z≤m ∧ (Z+1)*(Z+1)≤X }}  ⇾           (c - WRONG!)
- (5)    {{ (Z+1)*(Z+1)≤m ∧ m<(Z+2)*(Z+2) }}
-      Z ::= Z+1
- (6)    {{ Z×Z≤m ∧ m<(Z+1)*(Z+1) }}
-    END
- (7)  {{ Z×Z≤m ∧ m<(Z+1)*(Z+1) ∧ X<(Z+1)*(Z+1) }}  ⇾ (b - OK)
- (8)  {{ Z×Z≤m ∧ m<(Z+1)*(Z+1) }} -
- -
- -
- - This didn't work very well: both conditions (a) and (c) failed. - Looking at condition (c), we see that the second conjunct of (4) - is almost the same as the first conjunct of (5), except that (4) - mentions X while (5) mentions m. But note that X is never - assigned in this program, so we should have X=m, but we didn't - propagate this information from (1) into the loop invariant. - -
- - Also, looking at the second conjunct of (8), it seems quite - hopeless as an invariant — and we don't even need it, since we - can obtain it from the negation of the guard (third conjunct - in (7)), again under the assumption that X=m. - -
- - So we now try X=m ∧ Z×Z ≤ m as the loop invariant: - -
- -
-      {{ X=m }}  ⇾                                      (a - OK)
-      {{ X=m ∧ 0×0 ≤ m }}
-    Z ::= 0;
-      {{ X=m ∧ Z×Z ≤ m }}
-    WHILE (Z+1)*(Z+1) ≤ X DO
-        {{ X=m ∧ Z×Z≤m ∧ (Z+1)*(Z+1)≤X }}  ⇾        (c - OK)
-        {{ X=m ∧ (Z+1)*(Z+1)≤m }}
-      Z ::= Z+1
-        {{ X=m ∧ Z×Z≤m }}
-    END
-      {{ X=m ∧ Z×Z≤m ∧ X<(Z+1)*(Z+1) }}  ⇾           (b - OK)
-      {{ Z×Z≤m ∧ m<(Z+1)*(Z+1) }} -
- -
- -
- - This works, since conditions (a), (b), and (c) are now all - trivially satisfied. - -
- - Very often, if a variable is used in a loop in a read-only - fashion (i.e., it is referred to by the program or by the - specification and it is not changed by the loop) it is necessary - to add the fact that it doesn't change to the loop invariant. -
-
- -
-
- -
-

Example: Squaring

- -
- - Here is a program that squares X by repeated addition: - -
- - -
- -
-    {{ X = m }}
-  Y ::= 0;
-  Z ::= 0;
-  WHILE  Y  ≠  X  DO
-    Z ::= Z + X;
-    Y ::= Y + 1
-  END
-    {{ Z = m×m }} -
- -
- -
- - The first thing to note is that the loop reads X but doesn't - change its value. As we saw in the previous example, in such cases - it is a good idea to add X = m to the invariant. The other thing - we often use in the invariant is the postcondition, so let's add - that too, leading to the invariant candidate Z = m × m ∧ X = m. - -
- -
-      {{ X = m }} ⇾                            (a - WRONG)
-      {{ 0 = m×m ∧ X = m }}
-    Y ::= 0;
-      {{ 0 = m×m ∧ X = m }}
-    Z ::= 0;
-      {{ Z = m×m ∧ X = m }}
-    WHILE Y ≠ X DO
-        {{ Z = Y×m ∧ X = m ∧ Y ≠ X }} ⇾     (c - WRONG)
-        {{ Z+X = m×m ∧ X = m }}
-      Z ::= Z + X;
-        {{ Z = m×m ∧ X = m }}
-      Y ::= Y + 1
-        {{ Z = m×m ∧ X = m }}
-    END
-      {{ Z = m×m ∧ X = m ∧ Y = X }} ⇾         (b - OK)
-      {{ Z = m×m }} -
- -
- -
- - Conditions (a) and (c) fail because of the Z = m×m part. While - Z starts at 0 and works itself up to m×m, we can't expect - Z to be m×m from the start. If we look at how Z progesses - in the loop, after the 1st iteration Z = m, after the 2nd - iteration Z = 2×m, and at the end Z = m×m. Since the variable - Y tracks how many times we go through the loop, we derive the - new invariant candidate Z = Y×m ∧ X = m. - -
- -
-      {{ X = m }} ⇾                               (a - OK)
-      {{ 0 = 0×m ∧ X = m }}
-    Y ::= 0;
-      {{ 0 = Y×m ∧ X = m }}
-    Z ::= 0;
-      {{ Z = Y×m ∧ X = m }}
-    WHILE Y ≠ X DO
-        {{ Z = Y×m ∧ X = m ∧ Y ≠ X }} ⇾        (c - OK)
-        {{ Z+X = (Y+1)×m ∧ X = m }}
-      Z ::= Z + X;
-        {{ Z = (Y+1)×m ∧ X = m }}
-      Y ::= Y + 1
-        {{ Z = Y×m ∧ X = m }}
-    END
-      {{ Z = Y×m ∧ X = m ∧ Y = X }} ⇾           (b - OK)
-      {{ Z = m×m }} -
- -
- -
- - This new invariant makes the proof go through: all three - conditions are easy to check. - -
- - It is worth comparing the postcondition Z = m×m and the Z = - Y×m conjunct of the invariant. It is often the case that one has - to replace auxiliary variabes (parameters) with variables — or - with expressions involving both variables and parameters (like - m - Y) — when going from postconditions to invariants. -
-
- -
-
- -
-

Exercise: Factorial

- -
- -

Exercise: 3 stars (factorial)

- Recall that n! denotes the factorial of n (i.e. n! = - 1×2×...×n). Here is an Imp program that calculates the factorial - of the number initially stored in the variable X and puts it in - the variable Y: - -
- -
-    {{ X = m }} ;
-  Y ::= 1
-  WHILE X ≠ 0
-  DO
-     Y ::= Y × X
-     X ::= X - 1
-  END
-    {{ Y = m! }} -
- -
- -
- - Fill in the blanks in following decorated program: - -
- -
-    {{ X = m }} ⇾
-    {{                                      }}
-  Y ::= 1;
-    {{                                      }}
-  WHILE X ≠ 0
-  DO   {{                                      }} ⇾
-       {{                                      }}
-     Y ::= Y × X;
-       {{                                      }}
-     X ::= X - 1
-       {{                                      }}
-  END
-    {{                                      }} ⇾
-    {{ Y = m! }} -
- -
- -
- - ☐ -
-
- -
-
- -
-

Exercise: Min

- -
- -

Exercise: 3 stars (Min_Hoare)

- Fill in valid decorations for the following program. - For the => steps in your annotations, you may rely (silently) on the - following facts about min - -
- - Lemma lemma1 : forall x y, - (x=0 λ/ y=0) -> min x y = 0. - Lemma lemma2 : forall x y, - min (x-1) (y-1) = (min x y) - 1. - -
- - plus, as usual, standard high-school algebra. - -
- - -
- -
-  {{ True }} ⇾
-  {{                    }}
-  X ::= a;
-  {{                       }}
-  Y ::= b;
-  {{                       }}
-  Z ::= 0;
-  {{                       }}
-  WHILE (X ≠ 0 ∧ Y ≠ 0) DO
-  {{                                     }} ⇾
-  {{                                }}
-  X := X - 1;
-  {{                            }}
-  Y := Y - 1;
-  {{                        }}
-  Z := Z + 1;
-  {{                       }}
-  END
-  {{                            }} ⇾
-  {{ Z = min a b }} -
- -
- -
- -

Exercise: 3 stars (two_loops)

- Here is a very inefficient way of adding 3 numbers: - -
- -
-  X ::= 0;
-  Y ::= 0;
-  Z ::= c;
-  WHILE X ≠ a DO
-    X ::= X + 1;
-    Z ::= Z + 1
-  END;
-  WHILE Y ≠ b DO
-    Y ::= Y + 1;
-    Z ::= Z + 1
-  END -
- -
- -
- - Show that it does what it should by filling in the blanks in the - following decorated program. - -
- - -
- -
-    {{ True }} ⇾
-    {{                                        }}
-  X ::= 0;
-    {{                                        }}
-  Y ::= 0;
-    {{                                        }}
-  Z ::= c;
-    {{                                        }}
-  WHILE X ≠ a DO
-      {{                                        }} ⇾
-      {{                                        }}
-    X ::= X + 1;
-      {{                                        }}
-    Z ::= Z + 1
-      {{                                        }}
-  END;
-    {{                                        }} ⇾
-    {{                                        }}
-  WHILE Y ≠ b DO
-      {{                                        }} ⇾
-      {{                                        }}
-    Y ::= Y + 1;
-      {{                                        }}
-    Z ::= Z + 1
-      {{                                        }}
-  END
-    {{                                        }} ⇾
-    {{ Z = a + b + c }} -
- -
- -
-
- -
-
- -
-

Exercise: Power Series

- -
- -

Exercise: 4 stars, optional (dpow2_down)

- Here is a program that computes the series: - 1 + 2 + 2^2 + ... + 2^m = 2^(m+1) - 1 - -
- -
-  X ::= 0;
-  Y ::= 1;
-  Z ::= 1;
-  WHILE X ≠ m DO
-    Z ::= 2 × Z;
-    Y ::= Y + Z;
-    X ::= X + 1;
-  END -
- -
- Write a decorated program for this. -
-
- -
-(* FILL IN HERE *)
- -
-
- -
-

Weakest Preconditions (Advanced)

- -
- - Some Hoare triples are more interesting than others. - For example, - -
- -
-      {{ False }}  X ::= Y + 1  {{ X ≤ 5 }} -
- -
- is not very interesting: although it is perfectly valid, it - tells us nothing useful. Since the precondition isn't satisfied - by any state, it doesn't describe any situations where we can use - the command X ::= Y + 1 to achieve the postcondition X ≤ 5. - -
- - By contrast, - -
- -
-      {{ Y ≤ 4 ∧ Z = 0 }}  X ::= Y + 1 {{ X ≤ 5 }} -
- -
- is useful: it tells us that, if we can somehow create a situation - in which we know that Y ≤ 4 ∧ Z = 0, then running this command - will produce a state satisfying the postcondition. However, this - triple is still not as useful as it could be, because the Z = 0 - clause in the precondition actually has nothing to do with the - postcondition X ≤ 5. The most useful triple (for a given - command and postcondition) is this one: - -
- -
-      {{ Y ≤ 4 }}  X ::= Y + 1  {{ X ≤ 5 }} -
- -
- In other words, Y ≤ 4 is the weakest valid precondition of - the command X ::= Y + 1 for the postcondition X ≤ 5. -
- - In general, we say that "P is the weakest precondition of - command c for postcondition Q" if {{P}} c {{Q}} and if, - whenever P' is an assertion such that {{P'}} c {{Q}}, we have - P' st implies P st for all states st. -
-
- -
-Definition is_wp P c Q :=
-  {{P}} c {{Q}} ∧
-  ∀P', {{P'}} c {{Q}} → (P' ⇾ P).
- -
-
- -
-That is, P is the weakest precondition of c for Q - if (a) P is a precondition for Q and c, and (b) P is the - weakest (easiest to satisfy) assertion that guarantees Q after - executing c. -
- -

Exercise: 1 star, optional (wp)

- What are the weakest preconditions of the following commands - for the following postconditions? - -
- -
-  1) {{ ? }}  SKIP  {{ X = 5 }}
-
-  2) {{ ? }}  X ::= Y + Z {{ X = 5 }}
-
-  3) {{ ? }}  X ::= Y  {{ X = Y }}
-
-  4) {{ ? }}
-     IFB X == 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI
-     {{ Y = 5 }}
-
-  5) {{ ? }}
-     X ::= 5
-     {{ X = 0 }}
-
-  6) {{ ? }}
-     WHILE True DO X ::= 0 END
-     {{ X = 0 }} -
- -
- -
-
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars, advanced, optional (is_wp_formal)

- Prove formally using the definition of hoare_triple that Y ≤ 4 - is indeed the weakest precondition of X ::= Y + 1 with respect to - postcondition X ≤ 5. -
-
- -
-Theorem is_wp_example :
-  is_wp (fun st ⇒ st Y ≤ 4)
-    (X ::= APlus (AId Y) (ANum 1)) (fun st ⇒ st X ≤ 5).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, advanced (hoare_asgn_weakest)

- Show that the precondition in the rule hoare_asgn is in fact the - weakest precondition. -
-
- -
-Theorem hoare_asgn_weakest : ∀Q X a,
-  is_wp (Q [X ↦ a]) (X ::= a) Q.
-Proof.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, advanced, optional (hoare_havoc_weakest)

- Show that your havoc_pre rule from the himp_hoare exercise - in the Hoare chapter returns the weakest precondition. -
-
- -
-Lemma hoare_havoc_weakest : ∀(P Q : Assertion) (X : id),
-  {{ P }} HAVOC X {{ Q }} →
-  P ⇾ havoc_pre X Q.
-Proof.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Formal Decorated Programs (Advanced)

- -
- - The informal conventions for decorated programs amount to a way of - displaying Hoare triples in which commands are annotated with - enough embedded assertions that checking the validity of the - triple is reduced to simple logical and algebraic calculations - showing that some assertions imply others. In this section, we - show that this informal presentation style can actually be made - completely formal and indeed that checking the validity of - decorated programs can mostly be automated. -
- -

Syntax

- -
- - The first thing we need to do is to formalize a variant of the - syntax of commands with embedded assertions. We call the new - commands decorated commands, or dcoms. -
-
- -
-Inductive dcom : Type :=
-  | DCSkip : Assertion → dcom
-  | DCSeq : dcom → dcom → dcom
-  | DCAsgn : id → aexp → Assertion → dcom
-  | DCIf : bexp → Assertion → dcom → Assertion → dcom
-           → Assertion→ dcom
-  | DCWhile : bexp → Assertion → dcom → Assertion → dcom
-  | DCPre : Assertion → dcom → dcom
-  | DCPost : dcom → Assertion → dcom.
- -
-Tactic Notation "dcom_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "Skip" | Case_aux c "Seq" | Case_aux c "Asgn"
-  | Case_aux c "If" | Case_aux c "While"
-  | Case_aux c "Pre" | Case_aux c "Post" ].
- -
-Notation "'SKIP' {{ P }}"
-      := (DCSkip P)
-      (at level 10) : dcom_scope.
-Notation "l '::=' a {{ P }}"
-      := (DCAsgn l a P)
-      (at level 60, a at next level) : dcom_scope.
-Notation "'WHILE' b 'DO' {{ Pbody }} d 'END' {{ Ppost }}"
-      := (DCWhile b Pbody d Ppost)
-      (at level 80, right associativity) : dcom_scope.
-Notation "'IFB' b 'THEN' {{ P }} d 'ELSE' {{ P' }} d' 'FI' {{ Q }}"
-      := (DCIf b P d P' d' Q)
-      (at level 80, right associativity) : dcom_scope.
-Notation "'⇾' {{ P }} d"
-      := (DCPre P d)
-      (at level 90, right associativity) : dcom_scope.
-Notation "{{ P }} d"
-      := (DCPre P d)
-      (at level 90) : dcom_scope.
-Notation "d '⇾' {{ P }}"
-      := (DCPost d P)
-      (at level 80, right associativity) : dcom_scope.
-Notation " d ;; d' "
-      := (DCSeq d d')
-      (at level 80, right associativity) : dcom_scope.
- -
-Delimit Scope dcom_scope with dcom.
- -
-
- -
-To avoid clashing with the existing Notation definitions - for ordinary commands, we introduce these notations in a special - scope called dcom_scope, and we wrap examples with the - declaration % dcom to signal that we want the notations to be - interpreted in this scope. - -
- - Careful readers will note that we've defined two notations for the - DCPre constructor, one with and one without a ⇾. The - "without" version is intended to be used to supply the initial - precondition at the very top of the program. -
-
- -
-Example dec_while : dcom := (
-  {{ fun st ⇒ True }}
-  WHILE (BNot (BEq (AId X) (ANum 0)))
-  DO
-    {{ fun st ⇒ True ∧ st X ≠ 0}}
-    X ::= (AMinus (AId X) (ANum 1))
-    {{ fun _ ⇒ True }}
-  END
-  {{ fun st ⇒ True ∧ st X = 0}} ⇾
-  {{ fun st ⇒ st X = 0 }}
-) % dcom.
- -
-
- -
-It is easy to go from a dcom to a com by erasing all - annotations. -
-
- -
-Fixpoint extract (d:dcom) : com :=
-  match d with
-  | DCSkip _ ⇒ SKIP
-  | DCSeq d1 d2 ⇒ (extract d1 ;; extract d2)
-  | DCAsgn X a _ ⇒ X ::= a
-  | DCIf b _ d1 _ d2 _ ⇒ IFB b THEN extract d1 ELSE extract d2 FI
-  | DCWhile b _ d _ ⇒ WHILE b DO extract d END
-  | DCPre _ d ⇒ extract d
-  | DCPost d _ ⇒ extract d
-  end.
- -
-
- -
-The choice of exactly where to put assertions in the definition of - dcom is a bit subtle. The simplest thing to do would be to - annotate every dcom with a precondition and postcondition. But - this would result in very verbose programs with a lot of repeated - annotations: for example, a program like SKIP;SKIP would have to - be annotated as - -
- -
-        {{P}} ({{P}} SKIP {{P}}) ;; ({{P}} SKIP {{P}}) {{P}}, -
- -
- with pre- and post-conditions on each SKIP, plus identical pre- - and post-conditions on the semicolon! - -
- - Instead, the rule we've followed is this: - -
- -
    -
  • The post-condition expected by each dcom d is embedded in d - -
    - - -
    • -
  • The pre-condition is supplied by the context. -
    • -
- -
- - In other words, the invariant of the representation is that a - dcom d together with a precondition P determines a Hoare - triple {{P}} (extract d) {{post d}}, where post is defined as - follows: -
-
- -
-Fixpoint post (d:dcom) : Assertion :=
-  match d with
-  | DCSkip P ⇒ P
-  | DCSeq d1 d2 ⇒ post d2
-  | DCAsgn X a Q ⇒ Q
-  | DCIf _ _ d1 _ d2 Q ⇒ Q
-  | DCWhile b Pbody c Ppost ⇒ Ppost
-  | DCPre _ d ⇒ post d
-  | DCPost c Q ⇒ Q
-  end.
- -
-
- -
-Similarly, we can extract the "initial precondition" from a - decorated program. -
-
- -
-Fixpoint pre (d:dcom) : Assertion :=
-  match d with
-  | DCSkip P ⇒ fun st ⇒ True
-  | DCSeq c1 c2 ⇒ pre c1
-  | DCAsgn X a Q ⇒ fun st ⇒ True
-  | DCIf _ _ t _ e _ ⇒ fun st ⇒ True
-  | DCWhile b Pbody c Ppost ⇒ fun st ⇒ True
-  | DCPre P c ⇒ P
-  | DCPost c Q ⇒ pre c
-  end.
- -
-
- -
-This function is not doing anything sophisticated like calculating - a weakest precondition; it just recursively searches for an - explicit annotation at the very beginning of the program, - returning default answers for programs that lack an explicit - precondition (like a bare assignment or SKIP). -
- - Using pre and post, and assuming that we adopt the convention - of always supplying an explicit precondition annotation at the - very beginning of our decorated programs, we can express what it - means for a decorated program to be correct as follows: -
-
- -
-Definition dec_correct (d:dcom) :=
-  {{pre d}} (extract d) {{post d}}.
- -
-
- -
-To check whether this Hoare triple is valid, we need a way to - extract the "proof obligations" from a decorated program. These - obligations are often called verification conditions, because - they are the facts that must be verified to see that the - decorations are logically consistent and thus add up to a complete - proof of correctness. -
- -

Extracting Verification Conditions

- -
- - The function verification_conditions takes a dcom d together - with a precondition P and returns a proposition that, if it - can be proved, implies that the triple {{P}} (extract d) {{post d}} - is valid. -
- - It does this by walking over d and generating a big - conjunction including all the "local checks" that we listed when - we described the informal rules for decorated programs. (Strictly - speaking, we need to massage the informal rules a little bit to - add some uses of the rule of consequence, but the correspondence - should be clear.) -
-
- -
-Fixpoint verification_conditions (P : Assertion) (d:dcom) : Prop :=
-  match d with
-  | DCSkip Q ⇒
-      (P ⇾ Q)
-  | DCSeq d1 d2 ⇒
-      verification_conditions P d1
-      ∧ verification_conditions (post d1) d2
-  | DCAsgn X a Q ⇒
-      (P ⇾ Q [X ↦ a])
-  | DCIf b P1 d1 P2 d2 Q ⇒
-      ((fun st ⇒ P st ∧ bassn b st) ⇾ P1)
-      ∧ ((fun st ⇒ P st ∧ ¬ (bassn b st)) ⇾ P2)
-      ∧ (Q ⇿ post d1) ∧ (Q ⇿ post d2)
-      ∧ verification_conditions P1 d1
-      ∧ verification_conditions P2 d2
-  | DCWhile b Pbody d Ppost ⇒
-      (* post d is the loop invariant and the initial precondition *)
-      (P ⇾ post d)
-      ∧ (Pbody ⇿ (fun st ⇒ post d st ∧ bassn b st))
-      ∧ (Ppost ⇿ (fun st ⇒ post d st ∧ ~(bassn b st)))
-      ∧ verification_conditions Pbody d
-  | DCPre P' d ⇒
-      (P ⇾ P') ∧ verification_conditions P' d
-  | DCPost d Q ⇒
-      verification_conditions P d ∧ (post d ⇾ Q)
-  end.
- -
-
- -
-And now, the key theorem, which states that - verification_conditions does its job correctly. Not - surprisingly, we need to use each of the Hoare Logic rules at some - point in the proof. We have used in variants of several tactics before to - apply them to values in the context rather than the goal. An - extension of this idea is the syntax tactic in ×, which applies - tactic in the goal and every hypothesis in the context. We most - commonly use this facility in conjunction with the simpl tactic, - as below. -
-
- -
-Theorem verification_correct : ∀d P,
-  verification_conditions P d → {{P}} (extract d) {{post d}}.
-
-
-Proof.
-  dcom_cases (induction d) Case; intros P H; simpl in ×.
-  Case "Skip".
-    eapply hoare_consequence_pre.
-      apply hoare_skip.
-      assumption.
-  Case "Seq".
-    inversion H as [H1 H2]. clear H.
-    eapply hoare_seq.
-      apply IHd2. apply H2.
-      apply IHd1. apply H1.
-  Case "Asgn".
-    eapply hoare_consequence_pre.
-      apply hoare_asgn.
-      assumption.
-  Case "If".
-    inversion H as [HPre1 [HPre2 [[Hd11 Hd12]
-                                  [[Hd21 Hd22] [HThen HElse]]]]].
-    clear H.
-    apply IHd1 in HThen. clear IHd1.
-    apply IHd2 in HElse. clear IHd2.
-    apply hoare_if.
-      eapply hoare_consequence_pre; eauto.
-      eapply hoare_consequence_post; eauto.
-      eapply hoare_consequence_pre; eauto.
-      eapply hoare_consequence_post; eauto.
-  Case "While".
-    inversion H as [Hpre [[Hbody1 Hbody2] [[Hpost1 Hpost2] Hd]]];
-    subst; clear H.
-    eapply hoare_consequence_pre; eauto.
-    eapply hoare_consequence_post; eauto.
-    apply hoare_while.
-    eapply hoare_consequence_pre; eauto.
-  Case "Pre".
-    inversion H as [HP Hd]; clear H.
-    eapply hoare_consequence_pre. apply IHd. apply Hd. assumption.
-  Case "Post".
-    inversion H as [Hd HQ]; clear H.
-    eapply hoare_consequence_post. apply IHd. apply Hd. assumption.
-Qed.
-
- -
-
- -
-

Examples

- -
- - The propositions generated by verification_conditions are fairly - big, and they contain many conjuncts that are essentially trivial. -
-
- -
-Eval simpl in (verification_conditions (fun st ⇒ True) dec_while).
-
- -
- -
- -
-⇒
-(((fun _ : state ⇒ True) ⇾ (fun _ : state ⇒ True)) ∧
- ((fun _ : state ⇒ True) ⇾ (fun _ : state ⇒ True)) ∧
- (fun st : state ⇒ True ∧ bassn (BNot (BEq (AId X) (ANum 0))) st) =
- (fun st : state ⇒ True ∧ bassn (BNot (BEq (AId X) (ANum 0))) st) ∧
- (fun st : state ⇒ True ∧ ¬ bassn (BNot (BEq (AId X) (ANum 0))) st) =
- (fun st : state ⇒ True ∧ ¬ bassn (BNot (BEq (AId X) (ANum 0))) st) ∧
- (fun st : state ⇒ True ∧ bassn (BNot (BEq (AId X) (ANum 0))) st) ⇾
- (fun _ : state ⇒ True) [X ↦ AMinus (AId X) (ANum 1)]) ∧
-(fun st : state ⇒ True ∧ ¬ bassn (BNot (BEq (AId X) (ANum 0))) st) ⇾
-(fun st : state ⇒ st X = 0) -
- -
- -
- - In principle, we could certainly work with them using just the - tactics we have so far, but we can make things much smoother with - a bit of automation. We first define a custom verify tactic - that applies splitting repeatedly to turn all the conjunctions - into separate subgoals and then uses omega and eauto (a handy - general-purpose automation tactic that we'll discuss in detail - later) to deal with as many of them as possible. -
-
- -
-Lemma ble_nat_true_iff : ∀n m : nat,
-  ble_nat n m = true ↔ n ≤ m.
-
-
-Proof.
-  intros n m. split. apply ble_nat_true.
-  generalize dependent m. induction n; intros m H. reflexivity.
-    simpl. destruct m. inversion H.
-    apply le_S_n in H. apply IHn. assumption.
-Qed.
-
- -
-Lemma ble_nat_false_iff : ∀n m : nat,
-  ble_nat n m = false ↔ ~(n ≤ m).
-
-
-Proof.
-  intros n m. split. apply ble_nat_false.
-  generalize dependent m. induction n; intros m H.
-    apply ex_falso_quodlibet. apply H. apply le_0_n.
-    simpl. destruct m. reflexivity.
-    apply IHn. intro Hc. apply H. apply le_n_S. assumption.
-Qed.
-
- -
-Tactic Notation "verify" :=
-  apply verification_correct;
-  repeat split;
-  simpl; unfold assert_implies;
-  unfold bassn in ×; unfold beval in ×; unfold aeval in ×;
-  unfold assn_sub; intros;
-  repeat rewrite update_eq;
-  repeat (rewrite update_neq; [| (intro X; inversion X)]);
-  simpl in ×;
-  repeat match goal with [H : _ ∧ _ ⊢ _] ⇒ destruct H end;
-  repeat rewrite not_true_iff_false in ×;
-  repeat rewrite not_false_iff_true in ×;
-  repeat rewrite negb_true_iff in ×;
-  repeat rewrite negb_false_iff in ×;
-  repeat rewrite beq_nat_true_iff in ×;
-  repeat rewrite beq_nat_false_iff in ×;
-  repeat rewrite ble_nat_true_iff in ×;
-  repeat rewrite ble_nat_false_iff in ×;
-  try subst;
-  repeat
-    match goal with
-      [st : state ⊢ _] ⇒
-        match goal with
-          [H : st _ = _ ⊢ _] ⇒ rewrite → H in ×; clear H
-        | [H : _ = st _ ⊢ _] ⇒ rewrite ← H in ×; clear H
-        end
-    end;
-  try eauto; try omega.
- -
-
- -
-What's left after verify does its thing is "just the interesting - parts" of checking that the decorations are correct. For very - simple examples verify immediately solves the goal (provided - that the annotations are correct). -
-
- -
-Theorem dec_while_correct :
-  dec_correct dec_while.
-Proof. verify. Qed.
- -
-
- -
-Another example (formalizing a decorated program we've seen - before): -
-
- -
-Example subtract_slowly_dec (m:nat) (p:nat) : dcom := (
-    {{ fun st ⇒ st X = m ∧ st Z = p }} ⇾
-    {{ fun st ⇒ st Z - st X = p - m }}
-  WHILE BNot (BEq (AId X) (ANum 0))
-  DO {{ fun st ⇒ st Z - st X = p - m ∧ st X ≠ 0 }} ⇾
-       {{ fun st ⇒ (st Z - 1) - (st X - 1) = p - m }}
-     Z ::= AMinus (AId Z) (ANum 1)
-       {{ fun st ⇒ st Z - (st X - 1) = p - m }} ;;
-     X ::= AMinus (AId X) (ANum 1)
-       {{ fun st ⇒ st Z - st X = p - m }}
-  END
-    {{ fun st ⇒ st Z - st X = p - m ∧ st X = 0 }} ⇾
-    {{ fun st ⇒ st Z = p - m }}
-) % dcom.
- -
-Theorem subtract_slowly_dec_correct : ∀m p,
-  dec_correct (subtract_slowly_dec m p).
-Proof. intros m p. verify. (* this grinds for a bit! *) Qed.
- -
-
- -
-

Exercise: 3 stars, advanced (slow_assignment_dec)

- -
- - In the slow_assignment exercise above, we saw a roundabout way - of assigning a number currently stored in X to the variable Y: - start Y at 0, then decrement X until it hits 0, - incrementing Y at each step. - -
- - Write a formal version of this decorated program and prove it - correct. -
-
- -
-Example slow_assignment_dec (m:nat) : dcom :=
-(* FILL IN HERE *) admit.
- -
-Theorem slow_assignment_dec_correct : ∀m,
-  dec_correct (slow_assignment_dec m).
-Proof. (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (factorial_dec)

- Remember the factorial function we worked with before: -
-
- -
-Fixpoint real_fact (n:nat) : nat :=
-  match n with
-  | O ⇒ 1
-  | S n' ⇒ n × (real_fact n')
-  end.
- -
-
- -
-Following the pattern of subtract_slowly_dec, write a decorated - program that implements the factorial function and prove it - correct. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-(* $Date: 2014-04-03 23:55:40 -0400 (Thu, 03 Apr 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Hoare2.v b/Hoare2.v deleted file mode 100644 index 3e6c9df..0000000 --- a/Hoare2.v +++ /dev/null @@ -1,1406 +0,0 @@ -(** * Hoare2: Hoare Logic, Part II *) - -Require Export Hoare. - - - -(* ####################################################### *) -(** * Decorated Programs *) - -(** The beauty of Hoare Logic is that it is _compositional_ -- - the structure of proofs exactly follows the structure of programs. - This suggests that we can record the essential ideas of a proof - informally (leaving out some low-level calculational details) by - decorating programs with appropriate assertions around each - statement. Such a _decorated program_ carries with it - an (informal) proof of its own correctness. *) - -(** For example, here is a complete decorated program: *) -(** - {{ True }} ->> - {{ m = m }} - X ::= m; - {{ X = m }} ->> - {{ X = m /\ p = p }} - Z ::= p; - {{ X = m /\ Z = p }} ->> - {{ Z - X = p - m }} - WHILE X <> 0 DO - {{ Z - X = p - m /\ X <> 0 }} ->> - {{ (Z - 1) - (X - 1) = p - m }} - Z ::= Z - 1; - {{ Z - (X - 1) = p - m }} - X ::= X - 1 - {{ Z - X = p - m }} - END; - {{ Z - X = p - m /\ ~ (X <> 0) }} ->> - {{ Z = p - m }} -*) - -(** Concretely, a decorated program consists of the program text - interleaved with assertions. To check that a decorated program - represents a valid proof, we check that each individual command is - _locally consistent_ with its accompanying assertions in the - following sense: *) - -(** - - [SKIP] is locally consistent if its precondition and - postcondition are the same: - {{ P }} - SKIP - {{ P }} -*) - -(** - - The sequential composition of [c1] and [c2] is locally - consistent (with respect to assertions [P] and [R]) if [c1] is - locally consistent (with respect to [P] and [Q]) and [c2] is - locally consistent (with respect to [Q] and [R]): - {{ P }} - c1; - {{ Q }} - c2 - {{ R }} -*) - -(** - - - An assignment is locally consistent if its precondition is - the appropriate substitution of its postcondition: - {{ P [X |-> a] }} - X ::= a - {{ P }} -*) - -(** - - A conditional is locally consistent (with respect to assertions - [P] and [Q]) if the assertions at the top of its "then" and - "else" branches are exactly [P /\ b] and [P /\ ~b] and if its "then" - branch is locally consistent (with respect to [P /\ b] and [Q]) - and its "else" branch is locally consistent (with respect to - [P /\ ~b] and [Q]): - {{ P }} - IFB b THEN - {{ P /\ b }} - c1 - {{ Q }} - ELSE - {{ P /\ ~b }} - c2 - {{ Q }} - FI - {{ Q }} -*) - -(** - - - A while loop with precondition [P] is locally consistent if its - postcondition is [P /\ ~b] and if the pre- and postconditions of - its body are exactly [P /\ b] and [P]: - {{ P }} - WHILE b DO - {{ P /\ b }} - c1 - {{ P }} - END - {{ P /\ ~b }} -*) - -(** - - - A pair of assertions separated by [->>] is locally consistent if - the first implies the second (in all states): - {{ P }} ->> - {{ P' }} - - This corresponds to the application of [hoare_consequence] and - is the only place in a decorated program where checking if - decorations are correct is not fully mechanical and syntactic, - but involves logical and/or arithmetic reasoning. -*) - -(** We have seen above how _verifying_ the correctness of a - given proof involves checking that every single command is locally - consistent with the accompanying assertions. If we are instead - interested in _finding_ a proof for a given specification we need - to discover the right assertions. This can be done in an almost - automatic way, with the exception of finding loop invariants, - which is the subject of in the next section. In the reminder of - this section we explain in detail how to construct decorations for - several simple programs that don't involve non-trivial loop - invariants. *) - -(* ####################################################### *) -(** ** Example: Swapping Using Addition and Subtraction *) - -(** Here is a program that swaps the values of two variables using - addition and subtraction (instead of by assigning to a temporary - variable). - X ::= X + Y; - Y ::= X - Y; - X ::= X - Y - We can prove using decorations that this program is correct -- - i.e., it always swaps the values of variables [X] and [Y]. *) - -(** - (1) {{ X = m /\ Y = n }} ->> - (2) {{ (X + Y) - ((X + Y) - Y) = n /\ (X + Y) - Y = m }} - X ::= X + Y; - (3) {{ X - (X - Y) = n /\ X - Y = m }} - Y ::= X - Y; - (4) {{ X - Y = n /\ Y = m }} - X ::= X - Y - (5) {{ X = n /\ Y = m }} - The decorations were constructed as follows: - - We begin with the undecorated program (the unnumbered lines). - - We then add the specification -- i.e., the outer - precondition (1) and postcondition (5). In the precondition we - use auxiliary variables (parameters) [m] and [n] to remember - the initial values of variables [X] and respectively [Y], so - that we can refer to them in the postcondition (5). - - We work backwards mechanically starting from (5) all the way - to (2). At each step, we obtain the precondition of the - assignment from its postcondition by substituting the assigned - variable with the right-hand-side of the assignment. For - instance, we obtain (4) by substituting [X] with [X - Y] - in (5), and (3) by substituting [Y] with [X - Y] in (4). - - Finally, we verify that (1) logically implies (2) -- i.e., - that the step from (1) to (2) is a valid use of the law of - consequence. For this we substitute [X] by [m] and [Y] by [n] - and calculate as follows: - (m + n) - ((m + n) - n) = n /\ (m + n) - n = m - (m + n) - m = n /\ m = m - n = n /\ m = m - - (Note that, since we are working with natural numbers, not - fixed-size machine integers, we don't need to worry about the - possibility of arithmetic overflow anywhere in this argument.) -*) - -(* ####################################################### *) -(** ** Example: Simple Conditionals *) - -(** Here is a simple decorated program using conditionals: - (1) {{True}} - IFB X <= Y THEN - (2) {{True /\ X <= Y}} ->> - (3) {{(Y - X) + X = Y \/ (Y - X) + Y = X}} - Z ::= Y - X - (4) {{Z + X = Y \/ Z + Y = X}} - ELSE - (5) {{True /\ ~(X <= Y) }} ->> - (6) {{(X - Y) + X = Y \/ (X - Y) + Y = X}} - Z ::= X - Y - (7) {{Z + X = Y \/ Z + Y = X}} - FI - (8) {{Z + X = Y \/ Z + Y = X}} - -These decorations were constructed as follows: - - We start with the outer precondition (1) and postcondition (8). - - We follow the format dictated by the [hoare_if] rule and copy the - postcondition (8) to (4) and (7). We conjoin the precondition (1) - with the guard of the conditional to obtain (2). We conjoin (1) - with the negated guard of the conditional to obtain (5). - - In order to use the assignment rule and obtain (3), we substitute - [Z] by [Y - X] in (4). To obtain (6) we substitute [Z] by [X - Y] - in (7). - - Finally, we verify that (2) implies (3) and (5) implies (6). Both - of these implications crucially depend on the ordering of [X] and - [Y] obtained from the guard. For instance, knowing that [X <= Y] - ensures that subtracting [X] from [Y] and then adding back [X] - produces [Y], as required by the first disjunct of (3). Similarly, - knowing that [~(X <= Y)] ensures that subtracting [Y] from [X] and - then adding back [Y] produces [X], as needed by the second - disjunct of (6). Note that [n - m + m = n] does _not_ hold for - arbitrary natural numbers [n] and [m] (for example, [3 - 5 + 5 = - 5]). *) - -(** **** Exercise: 2 stars (if_minus_plus_reloaded) *) -(** Fill in valid decorations for the following program: - {{ True }} - IFB X <= Y THEN - {{ }} ->> - {{ }} - Z ::= Y - X - {{ }} - ELSE - {{ }} ->> - {{ }} - Y ::= X + Z - {{ }} - FI - {{ Y = X + Z }} -*) - - -(* ####################################################### *) -(** ** Example: Reduce to Zero (Trivial Loop) *) - -(** Here is a [WHILE] loop that is so simple it needs no - invariant (i.e., the invariant [True] will do the job). - (1) {{ True }} - WHILE X <> 0 DO - (2) {{ True /\ X <> 0 }} ->> - (3) {{ True }} - X ::= X - 1 - (4) {{ True }} - END - (5) {{ True /\ X = 0 }} ->> - (6) {{ X = 0 }} -The decorations can be constructed as follows: - - Start with the outer precondition (1) and postcondition (6). - - Following the format dictated by the [hoare_while] rule, we copy - (1) to (4). We conjoin (1) with the guard to obtain (2) and with - the negation of the guard to obtain (5). Note that, because the - outer postcondition (6) does not syntactically match (5), we need a - trivial use of the consequence rule from (5) to (6). - - Assertion (3) is the same as (4), because [X] does not appear in - [4], so the substitution in the assignment rule is trivial. - - Finally, the implication between (2) and (3) is also trivial. -*) - -(** From this informal proof, it is easy to read off a formal proof - using the Coq versions of the Hoare rules. Note that we do _not_ - unfold the definition of [hoare_triple] anywhere in this proof -- - the idea is to use the Hoare rules as a "self-contained" logic for - reasoning about programs. *) - -Definition reduce_to_zero' : com := - WHILE BNot (BEq (AId X) (ANum 0)) DO - X ::= AMinus (AId X) (ANum 1) - END. - -Theorem reduce_to_zero_correct' : - {{fun st => True}} - reduce_to_zero' - {{fun st => st X = 0}}. -Proof. - unfold reduce_to_zero'. - (* First we need to transform the postcondition so - that hoare_while will apply. *) - eapply hoare_consequence_post. - apply hoare_while. - Case "Loop body preserves invariant". - (* Need to massage precondition before [hoare_asgn] applies *) - eapply hoare_consequence_pre. apply hoare_asgn. - (* Proving trivial implication (2) ->> (3) *) - intros st [HT Hbp]. unfold assn_sub. apply I. - Case "Invariant and negated guard imply postcondition". - intros st [Inv GuardFalse]. - unfold bassn in GuardFalse. simpl in GuardFalse. - (* SearchAbout helps to find the right lemmas *) - SearchAbout [not true]. - rewrite not_true_iff_false in GuardFalse. - SearchAbout [negb false]. - rewrite negb_false_iff in GuardFalse. - SearchAbout [beq_nat true]. - apply beq_nat_true in GuardFalse. - apply GuardFalse. Qed. - -(* ####################################################### *) -(** ** Example: Division *) - - -(** The following Imp program calculates the integer division and - remainder of two numbers [m] and [n] that are arbitrary constants - in the program. - X ::= m; - Y ::= 0; - WHILE n <= X DO - X ::= X - n; - Y ::= Y + 1 - END; - In other words, if we replace [m] and [n] by concrete numbers and - execute the program, it will terminate with the variable [X] set - to the remainder when [m] is divided by [n] and [Y] set to the - quotient. *) - -(** In order to give a specification to this program we need to - remember that dividing [m] by [n] produces a reminder [X] and a - quotient [Y] so that [n * Y + X = m /\ X < n]. - - It turns out that we get lucky with this program and don't have to - think very hard about the loop invariant: the invariant is the - just first conjunct [n * Y + X = m], so we use that to decorate - the program. - - (1) {{ True }} ->> - (2) {{ n * 0 + m = m }} - X ::= m; - (3) {{ n * 0 + X = m }} - Y ::= 0; - (4) {{ n * Y + X = m }} - WHILE n <= X DO - (5) {{ n * Y + X = m /\ n <= X }} ->> - (6) {{ n * (Y + 1) + (X - n) = m }} - X ::= X - n; - (7) {{ n * (Y + 1) + X = m }} - Y ::= Y + 1 - (8) {{ n * Y + X = m }} - END - (9) {{ n * Y + X = m /\ X < n }} - - Assertions (4), (5), (8), and (9) are derived mechanically from - the invariant and the loop's guard. Assertions (8), (7), and (6) - are derived using the assignment rule going backwards from (8) to - (6). Assertions (4), (3), and (2) are again backwards applications - of the assignment rule. - - Now that we've decorated the program it only remains to check that - the two uses of the consequence rule are correct -- i.e., that (1) - implies (2) and that (5) implies (6). This is indeed the case, so - we have a valid decorated program. -*) - -(* ####################################################### *) -(** * Finding Loop Invariants *) - -(** Once the outermost precondition and postcondition are chosen, the - only creative part in verifying programs with Hoare Logic is - finding the right loop invariants. The reason this is difficult - is the same as the reason that doing inductive mathematical proofs - requires creativity: strengthening the loop invariant (or the - induction hypothesis) means that you have a stronger assumption to - work with when trying to establish the postcondition of the loop - body (complete the induction step of the proof), but it also means - that the loop body postcondition itself is harder to prove! - - This section is dedicated to teaching you how to approach the - challenge of finding loop invariants using a series of examples - and exercises. *) - -(** ** Example: Slow Subtraction *) - -(** The following program subtracts the value of [X] from the value of - [Y] by repeatedly decrementing both [X] and [Y]. We want to verify its - correctness with respect to the following specification: - {{ X = m /\ Y = n }} - WHILE X <> 0 DO - Y ::= Y - 1; - X ::= X - 1 - END - {{ Y = n - m }} - - To verify this program we need to find an invariant [I] for the - loop. As a first step we can leave [I] as an unknown and build a - _skeleton_ for the proof by applying backward the rules for local - consistency. This process leads to the following skeleton: - (1) {{ X = m /\ Y = n }} ->> (a) - (2) {{ I }} - WHILE X <> 0 DO - (3) {{ I /\ X <> 0 }} ->> (c) - (4) {{ I[X |-> X-1][Y |-> Y-1] }} - Y ::= Y - 1; - (5) {{ I[X |-> X-1] }} - X ::= X - 1 - (6) {{ I }} - END - (7) {{ I /\ ~(X <> 0) }} ->> (b) - (8) {{ Y = n - m }} - - By examining this skeleton, we can see that any valid [I] will - have to respect three conditions: - - (a) it must be weak enough to be implied by the loop's - precondition, i.e. (1) must imply (2); - - (b) it must be strong enough to imply the loop's postcondition, - i.e. (7) must imply (8); - - (c) it must be preserved by one iteration of the loop, i.e. (3) - must imply (4). *) - -(** These conditions are actually independent of the particular - program and specification we are considering. Indeed, every loop - invariant has to satisfy them. One way to find an invariant that - simultaneously satisfies these three conditions is by using an - iterative process: start with a "candidate" invariant (e.g. a - guess or a heuristic choice) and check the three conditions above; - if any of the checks fails, try to use the information that we get - from the failure to produce another (hopefully better) candidate - invariant, and repeat the process. - - For instance, in the reduce-to-zero example above, we saw that, - for a very simple loop, choosing [True] as an invariant did the - job. So let's try it again here! I.e., let's instantiate [I] with - [True] in the skeleton above see what we get... - (1) {{ X = m /\ Y = n }} ->> (a - OK) - (2) {{ True }} - WHILE X <> 0 DO - (3) {{ True /\ X <> 0 }} ->> (c - OK) - (4) {{ True }} - Y ::= Y - 1; - (5) {{ True }} - X ::= X - 1 - (6) {{ True }} - END - (7) {{ True /\ X = 0 }} ->> (b - WRONG!) - (8) {{ Y = n - m }} - - While conditions (a) and (c) are trivially satisfied, - condition (b) is wrong, i.e. it is not the case that (7) [True /\ - X = 0] implies (8) [Y = n - m]. In fact, the two assertions are - completely unrelated and it is easy to find a counterexample (say, - [Y = X = m = 0] and [n = 1]). - - If we want (b) to hold, we need to strengthen the invariant so - that it implies the postcondition (8). One very simple way to do - this is to let the invariant _be_ the postcondition. So let's - return to our skeleton, instantiate [I] with [Y = n - m], and - check conditions (a) to (c) again. - (1) {{ X = m /\ Y = n }} ->> (a - WRONG!) - (2) {{ Y = n - m }} - WHILE X <> 0 DO - (3) {{ Y = n - m /\ X <> 0 }} ->> (c - WRONG!) - (4) {{ Y - 1 = n - m }} - Y ::= Y - 1; - (5) {{ Y = n - m }} - X ::= X - 1 - (6) {{ Y = n - m }} - END - (7) {{ Y = n - m /\ X = 0 }} ->> (b - OK) - (8) {{ Y = n - m }} - - This time, condition (b) holds trivially, but (a) and (c) are - broken. Condition (a) requires that (1) [X = m /\ Y = n] - implies (2) [Y = n - m]. If we substitute [Y] by [n] we have to - show that [n = n - m] for arbitrary [m] and [n], which does not - hold (for instance, when [m = n = 1]). Condition (c) requires that - [n - m - 1 = n - m], which fails, for instance, for [n = 1] and [m = - 0]. So, although [Y = n - m] holds at the end of the loop, it does - not hold from the start, and it doesn't hold on each iteration; - it is not a correct invariant. - - This failure is not very surprising: the variable [Y] changes - during the loop, while [m] and [n] are constant, so the assertion - we chose didn't have much chance of being an invariant! - - To do better, we need to generalize (8) to some statement that is - equivalent to (8) when [X] is [0], since this will be the case - when the loop terminates, and that "fills the gap" in some - appropriate way when [X] is nonzero. Looking at how the loop - works, we can observe that [X] and [Y] are decremented together - until [X] reaches [0]. So, if [X = 2] and [Y = 5] initially, - after one iteration of the loop we obtain [X = 1] and [Y = 4]; - after two iterations [X = 0] and [Y = 3]; and then the loop stops. - Notice that the difference between [Y] and [X] stays constant - between iterations; initially, [Y = n] and [X = m], so this - difference is always [n - m]. So let's try instantiating [I] in - the skeleton above with [Y - X = n - m]. - (1) {{ X = m /\ Y = n }} ->> (a - OK) - (2) {{ Y - X = n - m }} - WHILE X <> 0 DO - (3) {{ Y - X = n - m /\ X <> 0 }} ->> (c - OK) - (4) {{ (Y - 1) - (X - 1) = n - m }} - Y ::= Y - 1; - (5) {{ Y - (X - 1) = n - m }} - X ::= X - 1 - (6) {{ Y - X = n - m }} - END - (7) {{ Y - X = n - m /\ X = 0 }} ->> (b - OK) - (8) {{ Y = n - m }} - - Success! Conditions (a), (b) and (c) all hold now. (To - verify (c), we need to check that, under the assumption that [X <> - 0], we have [Y - X = (Y - 1) - (X - 1)]; this holds for all - natural numbers [X] and [Y].) *) - -(* ####################################################### *) -(** ** Exercise: Slow Assignment *) - - -(** **** Exercise: 2 stars (slow_assignment) *) -(** A roundabout way of assigning a number currently stored in [X] to - the variable [Y] is to start [Y] at [0], then decrement [X] until - it hits [0], incrementing [Y] at each step. Here is a program that - implements this idea: - {{ X = m }} - Y ::= 0; - WHILE X <> 0 DO - X ::= X - 1; - Y ::= Y + 1; - END - {{ Y = m }} - Write an informal decorated program showing that this is correct. *) - -(* FILL IN HERE *) -(** [] *) - -(* ####################################################### *) -(** ** Exercise: Slow Addition *) - - -(** **** Exercise: 3 stars, optional (add_slowly_decoration) *) -(** The following program adds the variable X into the variable Z - by repeatedly decrementing X and incrementing Z. - WHILE X <> 0 DO - Z ::= Z + 1; - X ::= X - 1 - END - - Following the pattern of the [subtract_slowly] example above, pick - a precondition and postcondition that give an appropriate - specification of [add_slowly]; then (informally) decorate the - program accordingly. *) - -(* FILL IN HERE *) -(** [] *) - -(* ####################################################### *) -(** ** Example: Parity *) - - -(** Here is a cute little program for computing the parity of the - value initially stored in [X] (due to Daniel Cristofani). - {{ X = m }} - WHILE 2 <= X DO - X ::= X - 2 - END - {{ X = parity m }} - The mathematical [parity] function used in the specification is - defined in Coq as follows: *) - -Fixpoint parity x := - match x with - | 0 => 0 - | 1 => 1 - | S (S x') => parity x' - end. - -(** The postcondition does not hold at the beginning of the loop, - since [m = parity m] does not hold for an arbitrary [m], so we - cannot use that as an invariant. To find an invariant that works, - let's think a bit about what this loop does. On each iteration it - decrements [X] by [2], which preserves the parity of [X]. So the - parity of [X] does not change, i.e. it is invariant. The initial - value of [X] is [m], so the parity of [X] is always equal to the - parity of [m]. Using [parity X = parity m] as an invariant we - obtain the following decorated program: - {{ X = m }} ->> (a - OK) - {{ parity X = parity m }} - WHILE 2 <= X DO - {{ parity X = parity m /\ 2 <= X }} ->> (c - OK) - {{ parity (X-2) = parity m }} - X ::= X - 2 - {{ parity X = parity m }} - END - {{ parity X = parity m /\ X < 2 }} ->> (b - OK) - {{ X = parity m }} - - With this invariant, conditions (a), (b), and (c) are all - satisfied. For verifying (b), we observe that, when [X < 2], we - have [parity X = X] (we can easily see this in the definition of - [parity]). For verifying (c), we observe that, when [2 <= X], we - have [parity X = parity (X-2)]. *) - - -(** **** Exercise: 3 stars, optional (parity_formal) *) -(** Translate this proof to Coq. Refer to the reduce-to-zero example - for ideas. You may find the following two lemmas useful: *) - -Lemma parity_ge_2 : forall x, - 2 <= x -> - parity (x - 2) = parity x. -Proof. - induction x; intro. reflexivity. - destruct x. inversion H. inversion H1. - simpl. rewrite <- minus_n_O. reflexivity. -Qed. - -Lemma parity_lt_2 : forall x, - ~ 2 <= x -> - parity (x) = x. -Proof. - intros. induction x. reflexivity. destruct x. reflexivity. - apply ex_falso_quodlibet. apply H. omega. -Qed. - -Theorem parity_correct : forall m, - {{ fun st => st X = m }} - WHILE BLe (ANum 2) (AId X) DO - X ::= AMinus (AId X) (ANum 2) - END - {{ fun st => st X = parity m }}. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ####################################################### *) -(** ** Example: Finding Square Roots *) - - -(** The following program computes the square root of [X] - by naive iteration: - {{ X=m }} - Z ::= 0; - WHILE (Z+1)*(Z+1) <= X DO - Z ::= Z+1 - END - {{ Z*Z<=m /\ m<(Z+1)*(Z+1) }} -*) - -(** As above, we can try to use the postcondition as a candidate - invariant, obtaining the following decorated program: - (1) {{ X=m }} ->> (a - second conjunct of (2) WRONG!) - (2) {{ 0*0 <= m /\ m<1*1 }} - Z ::= 0; - (3) {{ Z*Z <= m /\ m<(Z+1)*(Z+1) }} - WHILE (Z+1)*(Z+1) <= X DO - (4) {{ Z*Z<=m /\ (Z+1)*(Z+1)<=X }} ->> (c - WRONG!) - (5) {{ (Z+1)*(Z+1)<=m /\ m<(Z+2)*(Z+2) }} - Z ::= Z+1 - (6) {{ Z*Z<=m /\ m<(Z+1)*(Z+1) }} - END - (7) {{ Z*Z<=m /\ m<(Z+1)*(Z+1) /\ X<(Z+1)*(Z+1) }} ->> (b - OK) - (8) {{ Z*Z<=m /\ m<(Z+1)*(Z+1) }} - - This didn't work very well: both conditions (a) and (c) failed. - Looking at condition (c), we see that the second conjunct of (4) - is almost the same as the first conjunct of (5), except that (4) - mentions [X] while (5) mentions [m]. But note that [X] is never - assigned in this program, so we should have [X=m], but we didn't - propagate this information from (1) into the loop invariant. - - Also, looking at the second conjunct of (8), it seems quite - hopeless as an invariant -- and we don't even need it, since we - can obtain it from the negation of the guard (third conjunct - in (7)), again under the assumption that [X=m]. - - So we now try [X=m /\ Z*Z <= m] as the loop invariant: - {{ X=m }} ->> (a - OK) - {{ X=m /\ 0*0 <= m }} - Z ::= 0; - {{ X=m /\ Z*Z <= m }} - WHILE (Z+1)*(Z+1) <= X DO - {{ X=m /\ Z*Z<=m /\ (Z+1)*(Z+1)<=X }} ->> (c - OK) - {{ X=m /\ (Z+1)*(Z+1)<=m }} - Z ::= Z+1 - {{ X=m /\ Z*Z<=m }} - END - {{ X=m /\ Z*Z<=m /\ X<(Z+1)*(Z+1) }} ->> (b - OK) - {{ Z*Z<=m /\ m<(Z+1)*(Z+1) }} - - This works, since conditions (a), (b), and (c) are now all - trivially satisfied. - - Very often, if a variable is used in a loop in a read-only - fashion (i.e., it is referred to by the program or by the - specification and it is not changed by the loop) it is necessary - to add the fact that it doesn't change to the loop invariant. *) - -(* ####################################################### *) -(** ** Example: Squaring *) - - -(** Here is a program that squares [X] by repeated addition: - - {{ X = m }} - Y ::= 0; - Z ::= 0; - WHILE Y <> X DO - Z ::= Z + X; - Y ::= Y + 1 - END - {{ Z = m*m }} -*) - -(** The first thing to note is that the loop reads [X] but doesn't - change its value. As we saw in the previous example, in such cases - it is a good idea to add [X = m] to the invariant. The other thing - we often use in the invariant is the postcondition, so let's add - that too, leading to the invariant candidate [Z = m * m /\ X = m]. - {{ X = m }} ->> (a - WRONG) - {{ 0 = m*m /\ X = m }} - Y ::= 0; - {{ 0 = m*m /\ X = m }} - Z ::= 0; - {{ Z = m*m /\ X = m }} - WHILE Y <> X DO - {{ Z = Y*m /\ X = m /\ Y <> X }} ->> (c - WRONG) - {{ Z+X = m*m /\ X = m }} - Z ::= Z + X; - {{ Z = m*m /\ X = m }} - Y ::= Y + 1 - {{ Z = m*m /\ X = m }} - END - {{ Z = m*m /\ X = m /\ Y = X }} ->> (b - OK) - {{ Z = m*m }} - - Conditions (a) and (c) fail because of the [Z = m*m] part. While - [Z] starts at [0] and works itself up to [m*m], we can't expect - [Z] to be [m*m] from the start. If we look at how [Z] progesses - in the loop, after the 1st iteration [Z = m], after the 2nd - iteration [Z = 2*m], and at the end [Z = m*m]. Since the variable - [Y] tracks how many times we go through the loop, we derive the - new invariant candidate [Z = Y*m /\ X = m]. - {{ X = m }} ->> (a - OK) - {{ 0 = 0*m /\ X = m }} - Y ::= 0; - {{ 0 = Y*m /\ X = m }} - Z ::= 0; - {{ Z = Y*m /\ X = m }} - WHILE Y <> X DO - {{ Z = Y*m /\ X = m /\ Y <> X }} ->> (c - OK) - {{ Z+X = (Y+1)*m /\ X = m }} - Z ::= Z + X; - {{ Z = (Y+1)*m /\ X = m }} - Y ::= Y + 1 - {{ Z = Y*m /\ X = m }} - END - {{ Z = Y*m /\ X = m /\ Y = X }} ->> (b - OK) - {{ Z = m*m }} - - This new invariant makes the proof go through: all three - conditions are easy to check. - - It is worth comparing the postcondition [Z = m*m] and the [Z = - Y*m] conjunct of the invariant. It is often the case that one has - to replace auxiliary variabes (parameters) with variables -- or - with expressions involving both variables and parameters (like - [m - Y]) -- when going from postconditions to invariants. *) - -(* ####################################################### *) -(** ** Exercise: Factorial *) - -(** **** Exercise: 3 stars (factorial) *) -(** Recall that [n!] denotes the factorial of [n] (i.e. [n! = - 1*2*...*n]). Here is an Imp program that calculates the factorial - of the number initially stored in the variable [X] and puts it in - the variable [Y]: - {{ X = m }} ; - Y ::= 1 - WHILE X <> 0 - DO - Y ::= Y * X - X ::= X - 1 - END - {{ Y = m! }} - - Fill in the blanks in following decorated program: - {{ X = m }} ->> - {{ }} - Y ::= 1; - {{ }} - WHILE X <> 0 - DO {{ }} ->> - {{ }} - Y ::= Y * X; - {{ }} - X ::= X - 1 - {{ }} - END - {{ }} ->> - {{ Y = m! }} -*) - - -(** [] *) - - -(* ####################################################### *) -(** ** Exercise: Min *) - -(** **** Exercise: 3 stars (Min_Hoare) *) -(** Fill in valid decorations for the following program. - For the => steps in your annotations, you may rely (silently) on the - following facts about min - - Lemma lemma1 : forall x y, - (x=0 \/ y=0) -> min x y = 0. - Lemma lemma2 : forall x y, - min (x-1) (y-1) = (min x y) - 1. - - plus, as usual, standard high-school algebra. - - {{ True }} ->> - {{ }} - X ::= a; - {{ }} - Y ::= b; - {{ }} - Z ::= 0; - {{ }} - WHILE (X <> 0 /\ Y <> 0) DO - {{ }} ->> - {{ }} - X := X - 1; - {{ }} - Y := Y - 1; - {{ }} - Z := Z + 1; - {{ }} - END - {{ }} ->> - {{ Z = min a b }} -*) - - - - -(** **** Exercise: 3 stars (two_loops) *) -(** Here is a very inefficient way of adding 3 numbers: - X ::= 0; - Y ::= 0; - Z ::= c; - WHILE X <> a DO - X ::= X + 1; - Z ::= Z + 1 - END; - WHILE Y <> b DO - Y ::= Y + 1; - Z ::= Z + 1 - END - - Show that it does what it should by filling in the blanks in the - following decorated program. - - {{ True }} ->> - {{ }} - X ::= 0; - {{ }} - Y ::= 0; - {{ }} - Z ::= c; - {{ }} - WHILE X <> a DO - {{ }} ->> - {{ }} - X ::= X + 1; - {{ }} - Z ::= Z + 1 - {{ }} - END; - {{ }} ->> - {{ }} - WHILE Y <> b DO - {{ }} ->> - {{ }} - Y ::= Y + 1; - {{ }} - Z ::= Z + 1 - {{ }} - END - {{ }} ->> - {{ Z = a + b + c }} -*) - - -(* ####################################################### *) -(** ** Exercise: Power Series *) - - -(** **** Exercise: 4 stars, optional (dpow2_down) *) -(** Here is a program that computes the series: - [1 + 2 + 2^2 + ... + 2^m = 2^(m+1) - 1] - X ::= 0; - Y ::= 1; - Z ::= 1; - WHILE X <> m DO - Z ::= 2 * Z; - Y ::= Y + Z; - X ::= X + 1; - END - Write a decorated program for this. *) - -(* FILL IN HERE *) - -(* ####################################################### *) -(** * Weakest Preconditions (Advanced) *) - -(** Some Hoare triples are more interesting than others. - For example, - {{ False }} X ::= Y + 1 {{ X <= 5 }} - is _not_ very interesting: although it is perfectly valid, it - tells us nothing useful. Since the precondition isn't satisfied - by any state, it doesn't describe any situations where we can use - the command [X ::= Y + 1] to achieve the postcondition [X <= 5]. - - By contrast, - {{ Y <= 4 /\ Z = 0 }} X ::= Y + 1 {{ X <= 5 }} - is useful: it tells us that, if we can somehow create a situation - in which we know that [Y <= 4 /\ Z = 0], then running this command - will produce a state satisfying the postcondition. However, this - triple is still not as useful as it could be, because the [Z = 0] - clause in the precondition actually has nothing to do with the - postcondition [X <= 5]. The _most_ useful triple (for a given - command and postcondition) is this one: - {{ Y <= 4 }} X ::= Y + 1 {{ X <= 5 }} - In other words, [Y <= 4] is the _weakest_ valid precondition of - the command [X ::= Y + 1] for the postcondition [X <= 5]. *) - -(** In general, we say that "[P] is the weakest precondition of - command [c] for postcondition [Q]" if [{{P}} c {{Q}}] and if, - whenever [P'] is an assertion such that [{{P'}} c {{Q}}], we have - [P' st] implies [P st] for all states [st]. *) - -Definition is_wp P c Q := - {{P}} c {{Q}} /\ - forall P', {{P'}} c {{Q}} -> (P' ->> P). - -(** That is, [P] is the weakest precondition of [c] for [Q] - if (a) [P] _is_ a precondition for [Q] and [c], and (b) [P] is the - _weakest_ (easiest to satisfy) assertion that guarantees [Q] after - executing [c]. *) - -(** **** Exercise: 1 star, optional (wp) *) -(** What are the weakest preconditions of the following commands - for the following postconditions? - 1) {{ ? }} SKIP {{ X = 5 }} - - 2) {{ ? }} X ::= Y + Z {{ X = 5 }} - - 3) {{ ? }} X ::= Y {{ X = Y }} - - 4) {{ ? }} - IFB X == 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI - {{ Y = 5 }} - - 5) {{ ? }} - X ::= 5 - {{ X = 0 }} - - 6) {{ ? }} - WHILE True DO X ::= 0 END - {{ X = 0 }} -*) -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars, advanced, optional (is_wp_formal) *) -(** Prove formally using the definition of [hoare_triple] that [Y <= 4] - is indeed the weakest precondition of [X ::= Y + 1] with respect to - postcondition [X <= 5]. *) - -Theorem is_wp_example : - is_wp (fun st => st Y <= 4) - (X ::= APlus (AId Y) (ANum 1)) (fun st => st X <= 5). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, advanced (hoare_asgn_weakest) *) -(** Show that the precondition in the rule [hoare_asgn] is in fact the - weakest precondition. *) - -Theorem hoare_asgn_weakest : forall Q X a, - is_wp (Q [X |-> a]) (X ::= a) Q. -Proof. -(* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, advanced, optional (hoare_havoc_weakest) *) -(** Show that your [havoc_pre] rule from the [himp_hoare] exercise - in the [Hoare] chapter returns the weakest precondition. *) -Module Himp2. -Import Himp. - -Lemma hoare_havoc_weakest : forall (P Q : Assertion) (X : id), - {{ P }} HAVOC X {{ Q }} -> - P ->> havoc_pre X Q. -Proof. -(* FILL IN HERE *) Admitted. -End Himp2. -(** [] *) - -(* ####################################################### *) -(** * Formal Decorated Programs (Advanced) *) - -(** The informal conventions for decorated programs amount to a way of - displaying Hoare triples in which commands are annotated with - enough embedded assertions that checking the validity of the - triple is reduced to simple logical and algebraic calculations - showing that some assertions imply others. In this section, we - show that this informal presentation style can actually be made - completely formal and indeed that checking the validity of - decorated programs can mostly be automated. *) - -(** ** Syntax *) - -(** The first thing we need to do is to formalize a variant of the - syntax of commands with embedded assertions. We call the new - commands _decorated commands_, or [dcom]s. *) - -Inductive dcom : Type := - | DCSkip : Assertion -> dcom - | DCSeq : dcom -> dcom -> dcom - | DCAsgn : id -> aexp -> Assertion -> dcom - | DCIf : bexp -> Assertion -> dcom -> Assertion -> dcom - -> Assertion-> dcom - | DCWhile : bexp -> Assertion -> dcom -> Assertion -> dcom - | DCPre : Assertion -> dcom -> dcom - | DCPost : dcom -> Assertion -> dcom. - -Tactic Notation "dcom_cases" tactic(first) ident(c) := - first; - [ Case_aux c "Skip" | Case_aux c "Seq" | Case_aux c "Asgn" - | Case_aux c "If" | Case_aux c "While" - | Case_aux c "Pre" | Case_aux c "Post" ]. - -Notation "'SKIP' {{ P }}" - := (DCSkip P) - (at level 10) : dcom_scope. -Notation "l '::=' a {{ P }}" - := (DCAsgn l a P) - (at level 60, a at next level) : dcom_scope. -Notation "'WHILE' b 'DO' {{ Pbody }} d 'END' {{ Ppost }}" - := (DCWhile b Pbody d Ppost) - (at level 80, right associativity) : dcom_scope. -Notation "'IFB' b 'THEN' {{ P }} d 'ELSE' {{ P' }} d' 'FI' {{ Q }}" - := (DCIf b P d P' d' Q) - (at level 80, right associativity) : dcom_scope. -Notation "'->>' {{ P }} d" - := (DCPre P d) - (at level 90, right associativity) : dcom_scope. -Notation "{{ P }} d" - := (DCPre P d) - (at level 90) : dcom_scope. -Notation "d '->>' {{ P }}" - := (DCPost d P) - (at level 80, right associativity) : dcom_scope. -Notation " d ;; d' " - := (DCSeq d d') - (at level 80, right associativity) : dcom_scope. - -Delimit Scope dcom_scope with dcom. - -(** To avoid clashing with the existing [Notation] definitions - for ordinary [com]mands, we introduce these notations in a special - scope called [dcom_scope], and we wrap examples with the - declaration [% dcom] to signal that we want the notations to be - interpreted in this scope. - - Careful readers will note that we've defined two notations for the - [DCPre] constructor, one with and one without a [->>]. The - "without" version is intended to be used to supply the initial - precondition at the very top of the program. *) - -Example dec_while : dcom := ( - {{ fun st => True }} - WHILE (BNot (BEq (AId X) (ANum 0))) - DO - {{ fun st => True /\ st X <> 0}} - X ::= (AMinus (AId X) (ANum 1)) - {{ fun _ => True }} - END - {{ fun st => True /\ st X = 0}} ->> - {{ fun st => st X = 0 }} -) % dcom. - -(** It is easy to go from a [dcom] to a [com] by erasing all - annotations. *) - -Fixpoint extract (d:dcom) : com := - match d with - | DCSkip _ => SKIP - | DCSeq d1 d2 => (extract d1 ;; extract d2) - | DCAsgn X a _ => X ::= a - | DCIf b _ d1 _ d2 _ => IFB b THEN extract d1 ELSE extract d2 FI - | DCWhile b _ d _ => WHILE b DO extract d END - | DCPre _ d => extract d - | DCPost d _ => extract d - end. - -(** The choice of exactly where to put assertions in the definition of - [dcom] is a bit subtle. The simplest thing to do would be to - annotate every [dcom] with a precondition and postcondition. But - this would result in very verbose programs with a lot of repeated - annotations: for example, a program like [SKIP;SKIP] would have to - be annotated as - {{P}} ({{P}} SKIP {{P}}) ;; ({{P}} SKIP {{P}}) {{P}}, - with pre- and post-conditions on each [SKIP], plus identical pre- - and post-conditions on the semicolon! - - Instead, the rule we've followed is this: - - - The _post_-condition expected by each [dcom] [d] is embedded in [d] - - - The _pre_-condition is supplied by the context. *) - -(** In other words, the invariant of the representation is that a - [dcom] [d] together with a precondition [P] determines a Hoare - triple [{{P}} (extract d) {{post d}}], where [post] is defined as - follows: *) - -Fixpoint post (d:dcom) : Assertion := - match d with - | DCSkip P => P - | DCSeq d1 d2 => post d2 - | DCAsgn X a Q => Q - | DCIf _ _ d1 _ d2 Q => Q - | DCWhile b Pbody c Ppost => Ppost - | DCPre _ d => post d - | DCPost c Q => Q - end. - -(** Similarly, we can extract the "initial precondition" from a - decorated program. *) - -Fixpoint pre (d:dcom) : Assertion := - match d with - | DCSkip P => fun st => True - | DCSeq c1 c2 => pre c1 - | DCAsgn X a Q => fun st => True - | DCIf _ _ t _ e _ => fun st => True - | DCWhile b Pbody c Ppost => fun st => True - | DCPre P c => P - | DCPost c Q => pre c - end. - -(** This function is not doing anything sophisticated like calculating - a weakest precondition; it just recursively searches for an - explicit annotation at the very beginning of the program, - returning default answers for programs that lack an explicit - precondition (like a bare assignment or [SKIP]). *) - -(** Using [pre] and [post], and assuming that we adopt the convention - of always supplying an explicit precondition annotation at the - very beginning of our decorated programs, we can express what it - means for a decorated program to be correct as follows: *) - -Definition dec_correct (d:dcom) := - {{pre d}} (extract d) {{post d}}. - -(** To check whether this Hoare triple is _valid_, we need a way to - extract the "proof obligations" from a decorated program. These - obligations are often called _verification conditions_, because - they are the facts that must be verified to see that the - decorations are logically consistent and thus add up to a complete - proof of correctness. *) - -(** ** Extracting Verification Conditions *) - -(** The function [verification_conditions] takes a [dcom] [d] together - with a precondition [P] and returns a _proposition_ that, if it - can be proved, implies that the triple [{{P}} (extract d) {{post d}}] - is valid. *) - -(** It does this by walking over [d] and generating a big - conjunction including all the "local checks" that we listed when - we described the informal rules for decorated programs. (Strictly - speaking, we need to massage the informal rules a little bit to - add some uses of the rule of consequence, but the correspondence - should be clear.) *) - -Fixpoint verification_conditions (P : Assertion) (d:dcom) : Prop := - match d with - | DCSkip Q => - (P ->> Q) - | DCSeq d1 d2 => - verification_conditions P d1 - /\ verification_conditions (post d1) d2 - | DCAsgn X a Q => - (P ->> Q [X |-> a]) - | DCIf b P1 d1 P2 d2 Q => - ((fun st => P st /\ bassn b st) ->> P1) - /\ ((fun st => P st /\ ~ (bassn b st)) ->> P2) - /\ (Q <<->> post d1) /\ (Q <<->> post d2) - /\ verification_conditions P1 d1 - /\ verification_conditions P2 d2 - | DCWhile b Pbody d Ppost => - (* post d is the loop invariant and the initial precondition *) - (P ->> post d) - /\ (Pbody <<->> (fun st => post d st /\ bassn b st)) - /\ (Ppost <<->> (fun st => post d st /\ ~(bassn b st))) - /\ verification_conditions Pbody d - | DCPre P' d => - (P ->> P') /\ verification_conditions P' d - | DCPost d Q => - verification_conditions P d /\ (post d ->> Q) - end. - -(** And now, the key theorem, which states that - [verification_conditions] does its job correctly. Not - surprisingly, we need to use each of the Hoare Logic rules at some - point in the proof. *) -(** We have used _in_ variants of several tactics before to - apply them to values in the context rather than the goal. An - extension of this idea is the syntax [tactic in *], which applies - [tactic] in the goal and every hypothesis in the context. We most - commonly use this facility in conjunction with the [simpl] tactic, - as below. *) - -Theorem verification_correct : forall d P, - verification_conditions P d -> {{P}} (extract d) {{post d}}. -Proof. - dcom_cases (induction d) Case; intros P H; simpl in *. - Case "Skip". - eapply hoare_consequence_pre. - apply hoare_skip. - assumption. - Case "Seq". - inversion H as [H1 H2]. clear H. - eapply hoare_seq. - apply IHd2. apply H2. - apply IHd1. apply H1. - Case "Asgn". - eapply hoare_consequence_pre. - apply hoare_asgn. - assumption. - Case "If". - inversion H as [HPre1 [HPre2 [[Hd11 Hd12] - [[Hd21 Hd22] [HThen HElse]]]]]. - clear H. - apply IHd1 in HThen. clear IHd1. - apply IHd2 in HElse. clear IHd2. - apply hoare_if. - eapply hoare_consequence_pre; eauto. - eapply hoare_consequence_post; eauto. - eapply hoare_consequence_pre; eauto. - eapply hoare_consequence_post; eauto. - Case "While". - inversion H as [Hpre [[Hbody1 Hbody2] [[Hpost1 Hpost2] Hd]]]; - subst; clear H. - eapply hoare_consequence_pre; eauto. - eapply hoare_consequence_post; eauto. - apply hoare_while. - eapply hoare_consequence_pre; eauto. - Case "Pre". - inversion H as [HP Hd]; clear H. - eapply hoare_consequence_pre. apply IHd. apply Hd. assumption. - Case "Post". - inversion H as [Hd HQ]; clear H. - eapply hoare_consequence_post. apply IHd. apply Hd. assumption. -Qed. - -(** ** Examples *) - -(** The propositions generated by [verification_conditions] are fairly - big, and they contain many conjuncts that are essentially trivial. *) - -Eval simpl in (verification_conditions (fun st => True) dec_while). -(** -==> -(((fun _ : state => True) ->> (fun _ : state => True)) /\ - ((fun _ : state => True) ->> (fun _ : state => True)) /\ - (fun st : state => True /\ bassn (BNot (BEq (AId X) (ANum 0))) st) = - (fun st : state => True /\ bassn (BNot (BEq (AId X) (ANum 0))) st) /\ - (fun st : state => True /\ ~ bassn (BNot (BEq (AId X) (ANum 0))) st) = - (fun st : state => True /\ ~ bassn (BNot (BEq (AId X) (ANum 0))) st) /\ - (fun st : state => True /\ bassn (BNot (BEq (AId X) (ANum 0))) st) ->> - (fun _ : state => True) [X |-> AMinus (AId X) (ANum 1)]) /\ -(fun st : state => True /\ ~ bassn (BNot (BEq (AId X) (ANum 0))) st) ->> -(fun st : state => st X = 0) -*) - -(** In principle, we could certainly work with them using just the - tactics we have so far, but we can make things much smoother with - a bit of automation. We first define a custom [verify] tactic - that applies splitting repeatedly to turn all the conjunctions - into separate subgoals and then uses [omega] and [eauto] (a handy - general-purpose automation tactic that we'll discuss in detail - later) to deal with as many of them as possible. *) - -Lemma ble_nat_true_iff : forall n m : nat, - ble_nat n m = true <-> n <= m. -Proof. - intros n m. split. apply ble_nat_true. - generalize dependent m. induction n; intros m H. reflexivity. - simpl. destruct m. inversion H. - apply le_S_n in H. apply IHn. assumption. -Qed. - -Lemma ble_nat_false_iff : forall n m : nat, - ble_nat n m = false <-> ~(n <= m). -Proof. - intros n m. split. apply ble_nat_false. - generalize dependent m. induction n; intros m H. - apply ex_falso_quodlibet. apply H. apply le_0_n. - simpl. destruct m. reflexivity. - apply IHn. intro Hc. apply H. apply le_n_S. assumption. -Qed. - -Tactic Notation "verify" := - apply verification_correct; - repeat split; - simpl; unfold assert_implies; - unfold bassn in *; unfold beval in *; unfold aeval in *; - unfold assn_sub; intros; - repeat rewrite update_eq; - repeat (rewrite update_neq; [| (intro X; inversion X)]); - simpl in *; - repeat match goal with [H : _ /\ _ |- _] => destruct H end; - repeat rewrite not_true_iff_false in *; - repeat rewrite not_false_iff_true in *; - repeat rewrite negb_true_iff in *; - repeat rewrite negb_false_iff in *; - repeat rewrite beq_nat_true_iff in *; - repeat rewrite beq_nat_false_iff in *; - repeat rewrite ble_nat_true_iff in *; - repeat rewrite ble_nat_false_iff in *; - try subst; - repeat - match goal with - [st : state |- _] => - match goal with - [H : st _ = _ |- _] => rewrite -> H in *; clear H - | [H : _ = st _ |- _] => rewrite <- H in *; clear H - end - end; - try eauto; try omega. - -(** What's left after [verify] does its thing is "just the interesting - parts" of checking that the decorations are correct. For very - simple examples [verify] immediately solves the goal (provided - that the annotations are correct). *) - -Theorem dec_while_correct : - dec_correct dec_while. -Proof. verify. Qed. - -(** Another example (formalizing a decorated program we've seen - before): *) - -Example subtract_slowly_dec (m:nat) (p:nat) : dcom := ( - {{ fun st => st X = m /\ st Z = p }} ->> - {{ fun st => st Z - st X = p - m }} - WHILE BNot (BEq (AId X) (ANum 0)) - DO {{ fun st => st Z - st X = p - m /\ st X <> 0 }} ->> - {{ fun st => (st Z - 1) - (st X - 1) = p - m }} - Z ::= AMinus (AId Z) (ANum 1) - {{ fun st => st Z - (st X - 1) = p - m }} ;; - X ::= AMinus (AId X) (ANum 1) - {{ fun st => st Z - st X = p - m }} - END - {{ fun st => st Z - st X = p - m /\ st X = 0 }} ->> - {{ fun st => st Z = p - m }} -) % dcom. - -Theorem subtract_slowly_dec_correct : forall m p, - dec_correct (subtract_slowly_dec m p). -Proof. intros m p. verify. (* this grinds for a bit! *) Qed. - -(** **** Exercise: 3 stars, advanced (slow_assignment_dec) *) - -(** In the [slow_assignment] exercise above, we saw a roundabout way - of assigning a number currently stored in [X] to the variable [Y]: - start [Y] at [0], then decrement [X] until it hits [0], - incrementing [Y] at each step. - - Write a _formal_ version of this decorated program and prove it - correct. *) - -Example slow_assignment_dec (m:nat) : dcom := -(* FILL IN HERE *) admit. - -Theorem slow_assignment_dec_correct : forall m, - dec_correct (slow_assignment_dec m). -Proof. (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 4 stars, advanced (factorial_dec) *) -(** Remember the factorial function we worked with before: *) - -Fixpoint real_fact (n:nat) : nat := - match n with - | O => 1 - | S n' => n * (real_fact n') - end. - -(** Following the pattern of [subtract_slowly_dec], write a decorated - program that implements the factorial function and prove it - correct. *) - -(* FILL IN HERE *) -(** [] *) - - - -(* $Date: 2014-04-03 23:55:40 -0400 (Thu, 03 Apr 2014) $ *) - diff --git a/Imp.html b/Imp.html deleted file mode 100644 index 3219f9a..0000000 --- a/Imp.html +++ /dev/null @@ -1,3091 +0,0 @@ - - - - - -Imp: Simple Imperative Programs - - - - - - -
- - - -
- -

ImpSimple Imperative Programs

- -
-
- -
- -
- - In this chapter, we begin a new direction that will continue for - the rest of the course. Up to now most of our attention has been - focused on various aspects of Coq itself, while from now on we'll - mostly be using Coq to formalize other things. (We'll continue to - pause from time to time to introduce a few additional aspects of - Coq.) - -
- - Our first case study is a simple imperative programming language - called Imp, embodying a tiny core fragment of conventional - mainstream languages such as C and Java. Here is a familiar - mathematical function written in Imp. - -
- -
-     Z ::= X;;
-     Y ::= 1;;
-     WHILE not (Z = 0) DO
-       Y ::= Y × Z;;
-       Z ::= Z - 1
-     END -
- -
- -
- - This chapter looks at how to define the syntax and semantics - of Imp; the chapters that follow develop a theory of program - equivalence and introduce Hoare Logic, a widely used logic for - reasoning about imperative programs. -
-
- -
-
- -
-

Sflib

- -
- - A minor technical point: Instead of asking Coq to import our - earlier definitions from chapter Logic, we import a small library - called Sflib.v, containing just a few definitions and theorems - from earlier chapters that we'll actually use in the rest of the - course. This change should be nearly invisible, since most of what's - missing from Sflib has identical definitions in the Coq standard - library. The main reason for doing it is to tidy the global Coq - environment so that, for example, it is easier to search for - relevant theorems. -
-
- -
-Require Export SfLib.
- -
-
- -
-

Arithmetic and Boolean Expressions

- -
- - We'll present Imp in three parts: first a core language of - arithmetic and boolean expressions, then an extension of these - expressions with variables, and finally a language of commands - including assignment, conditions, sequencing, and loops. -
-
- -
-
- -
-

Syntax

- -
-
- -
-Module AExp.
- -
-
- -
-These two definitions specify the abstract syntax of - arithmetic and boolean expressions. -
-
- -
-Inductive aexp : Type :=
-  | ANum : nat → aexp
-  | APlus : aexp → aexp → aexp
-  | AMinus : aexp → aexp → aexp
-  | AMult : aexp → aexp → aexp.
- -
-Inductive bexp : Type :=
-  | BTrue : bexp
-  | BFalse : bexp
-  | BEq : aexp → aexp → bexp
-  | BLe : aexp → aexp → bexp
-  | BNot : bexp → bexp
-  | BAnd : bexp → bexp → bexp.
- -
-
- -
-In this chapter, we'll elide the translation from the - concrete syntax that a programmer would actually write to these - abstract syntax trees — the process that, for example, would - translate the string "1+2×3" to the AST APlus (ANum - 1) (AMult (ANum 2) (ANum 3)). The optional chapter ImpParser - develops a simple implementation of a lexical analyzer and parser - that can perform this translation. You do not need to - understand that file to understand this one, but if you haven't - taken a course where these techniques are covered (e.g., a - compilers course) you may want to skim it. -
- -

- For comparison, here's a conventional BNF (Backus-Naur Form) - grammar defining the same abstract syntax: - -
- -
-    a ::= nat
-        | a + a
-        | a - a
-        | a × a
-
-    b ::= true
-        | false
-        | a = a
-        | a ≤ a
-        | not b
-        | b and b -
- -
- -
- - Compared to the Coq version above... - -
- -
    -
  • The BNF is more informal — for example, it gives some - suggestions about the surface syntax of expressions (like the - fact that the addition operation is written + and is an - infix symbol) while leaving other aspects of lexical analysis - and parsing (like the relative precedence of +, -, and - ×) unspecified. Some additional information — and human - intelligence — would be required to turn this description - into a formal definition (when implementing a compiler, for - example). - -
    - - The Coq version consistently omits all this information and - concentrates on the abstract syntax only. - -
    - - -
    • -
  • On the other hand, the BNF version is lighter and - easier to read. Its informality makes it flexible, which is - a huge advantage in situations like discussions at the - blackboard, where conveying general ideas is more important - than getting every detail nailed down precisely. - -
    - - Indeed, there are dozens of BNF-like notations and people - switch freely among them, usually without bothering to say which - form of BNF they're using because there is no need to: a - rough-and-ready informal understanding is all that's - needed. -
    • -
- -
- - It's good to be comfortable with both sorts of notations: - informal ones for communicating between humans and formal ones for - carrying out implementations and proofs. -
-
- -
-
- -
-

Evaluation

- -
- - Evaluating an arithmetic expression produces a number. -
-
- -
-Fixpoint aeval (a : aexp) : nat :=
-  match a with
-  | ANum n ⇒ n
-  | APlus a1 a2 ⇒ (aeval a1) + (aeval a2)
-  | AMinus a1 a2 ⇒ (aeval a1) - (aeval a2)
-  | AMult a1 a2 ⇒ (aeval a1) × (aeval a2)
-  end.
- -
-Example test_aeval1:
-  aeval (APlus (ANum 2) (ANum 2)) = 4.
-Proof. reflexivity. Qed.
- -
-
- -
-

- Similarly, evaluating a boolean expression yields a boolean. -
-
- -
-Fixpoint beval (b : bexp) : bool :=
-  match b with
-  | BTrue ⇒ true
-  | BFalse ⇒ false
-  | BEq a1 a2 ⇒ beq_nat (aeval a1) (aeval a2)
-  | BLe a1 a2 ⇒ ble_nat (aeval a1) (aeval a2)
-  | BNot b1 ⇒ negb (beval b1)
-  | BAnd b1 b2 ⇒ andb (beval b1) (beval b2)
-  end.
- -
-
- -
-

Optimization

- -
- - We haven't defined very much yet, but we can already get - some mileage out of the definitions. Suppose we define a function - that takes an arithmetic expression and slightly simplifies it, - changing every occurrence of 0+e (i.e., (APlus (ANum 0) e) - into just e. -
-
- -
-Fixpoint optimize_0plus (a:aexp) : aexp :=
-  match a with
-  | ANum n ⇒
-      ANum n
-  | APlus (ANum 0) e2 ⇒
-      optimize_0plus e2
-  | APlus e1 e2 ⇒
-      APlus (optimize_0plus e1) (optimize_0plus e2)
-  | AMinus e1 e2 ⇒
-      AMinus (optimize_0plus e1) (optimize_0plus e2)
-  | AMult e1 e2 ⇒
-      AMult (optimize_0plus e1) (optimize_0plus e2)
-  end.
- -
-
- -
-To make sure our optimization is doing the right thing we - can test it on some examples and see if the output looks OK. -
-
- -
-Example test_optimize_0plus:
-  optimize_0plus (APlus (ANum 2)
-                        (APlus (ANum 0)
-                               (APlus (ANum 0) (ANum 1))))
-  = APlus (ANum 2) (ANum 1).
-Proof. reflexivity. Qed.
- -
-
- -
-But if we want to be sure the optimization is correct — - i.e., that evaluating an optimized expression gives the same - result as the original — we should prove it. -
-
- -
-Theorem optimize_0plus_sound: ∀a,
-  aeval (optimize_0plus a) = aeval a.
-Proof.
-  intros a. induction a.
-  Case "ANum". reflexivity.
-  Case "APlus". destruct a1.
-    SCase "a1 = ANum n". destruct n.
-      SSCase "n = 0". simpl. apply IHa2.
-      SSCase "n ≠ 0". simpl. rewrite IHa2. reflexivity.
-    SCase "a1 = APlus a1_1 a1_2".
-      simpl. simpl in IHa1. rewrite IHa1.
-      rewrite IHa2. reflexivity.
-    SCase "a1 = AMinus a1_1 a1_2".
-      simpl. simpl in IHa1. rewrite IHa1.
-      rewrite IHa2. reflexivity.
-    SCase "a1 = AMult a1_1 a1_2".
-      simpl. simpl in IHa1. rewrite IHa1.
-      rewrite IHa2. reflexivity.
-  Case "AMinus".
-    simpl. rewrite IHa1. rewrite IHa2. reflexivity.
-  Case "AMult".
-    simpl. rewrite IHa1. rewrite IHa2. reflexivity. Qed.
- -
-
- -
-

Coq Automation

- -
- - The repetition in this last proof is starting to be a little - annoying. If either the language of arithmetic expressions or the - optimization being proved sound were significantly more complex, - it would begin to be a real problem. - -
- - So far, we've been doing all our proofs using just a small handful - of Coq's tactics and completely ignoring its powerful facilities - for constructing parts of proofs automatically. This section - introduces some of these facilities, and we will see more over the - next several chapters. Getting used to them will take some - energy — Coq's automation is a power tool — but it will allow us - to scale up our efforts to more complex definitions and more - interesting properties without becoming overwhelmed by boring, - repetitive, low-level details. -
-
- -
-
- -
-

Tacticals

- -
- - Tacticals is Coq's term for tactics that take other tactics as - arguments — "higher-order tactics," if you will. -
-
- -
-
- -
-

The repeat Tactical

- -
- - The repeat tactical takes another tactic and keeps applying - this tactic until the tactic fails. Here is an example showing - that 100 is even using repeat. -
-
- -
-Theorem ev100 : ev 100.
-Proof.
-  repeat (apply ev_SS). (* applies ev_SS 50 times,
-                           until apply ev_SS fails *)
-  apply ev_0.
-Qed.
-(* Print ev100. *)
- -
-
- -
-The repeat T tactic never fails; if the tactic T doesn't apply - to the original goal, then repeat still succeeds without changing - the original goal (it repeats zero times). -
-
- -
-Theorem ev100' : ev 100.
-Proof.
-  repeat (apply ev_0). (* doesn't fail, applies ev_0 zero times *)
-  repeat (apply ev_SS). apply ev_0. (* we can continue the proof *)
-Qed.
- -
-
- -
-The repeat T tactic does not have any bound on the number of - times it applies T. If T is a tactic that always succeeds then - repeat T will loop forever (e.g. repeat simpl loops forever - since simpl always succeeds). While Coq's term language is - guaranteed to terminate, Coq's tactic language is not! -
-
- -
-
- -
-

The try Tactical

- -
- - If T is a tactic, then try T is a tactic that is just like T - except that, if T fails, try T successfully does nothing at - all (instead of failing). -
-
- -
-Theorem silly1 : ∀ae, aeval ae = aeval ae.
-Proof. try reflexivity. (* this just does reflexivity *) Qed.
- -
-Theorem silly2 : ∀(P : Prop), P → P.
-Proof.
-  intros P HP.
-  try reflexivity. (* just reflexivity would have failed *)
-  apply HP. (* we can still finish the proof in some other way *)
-Qed.
- -
-
- -
-Using try in a completely manual proof is a bit silly, but - we'll see below that try is very useful for doing automated - proofs in conjunction with the ; tactical. -
-
- -
-
- -
-

The ; Tactical (Simple Form)

- -
- - In its most commonly used form, the ; tactical takes two tactics - as argument: T;T' first performs the tactic T and then - performs the tactic T' on each subgoal generated by T. -
- - For example, consider the following trivial lemma: -
-
- -
-Lemma foo : ∀n, ble_nat 0 n = true.
-Proof.
-  intros.
-  destruct n.
-    (* Leaves two subgoals, which are discharged identically...  *)
-    Case "n=0". simpl. reflexivity.
-    Case "n=Sn'". simpl. reflexivity.
-Qed.
- -
-
- -
-We can simplify this proof using the ; tactical: -
-
- -
-Lemma foo' : ∀n, ble_nat 0 n = true.
-Proof.
-  intros.
-  destruct n; (* destruct the current goal *)
-  simpl; (* then simpl each resulting subgoal *)
-  reflexivity. (* and do reflexivity on each resulting subgoal *)
-Qed.
- -
-
- -
-Using try and ; together, we can get rid of the repetition in - the proof that was bothering us a little while ago. -
-
- -
-Theorem optimize_0plus_sound': ∀a,
-  aeval (optimize_0plus a) = aeval a.
-Proof.
-  intros a.
-  induction a;
-    (* Most cases follow directly by the IH *)
-    try (simpl; rewrite IHa1; rewrite IHa2; reflexivity).
-  (* The remaining cases -- ANum and APlus -- are different *)
-  Case "ANum". reflexivity.
-  Case "APlus".
-    destruct a1;
-      (* Again, most cases follow directly by the IH *)
-      try (simpl; simpl in IHa1; rewrite IHa1;
-           rewrite IHa2; reflexivity).
-    (* The interesting case, on which the try... does nothing,
-       is when e1 = ANum n. In this case, we have to destruct
-       n (to see whether the optimization applies) and rewrite
-       with the induction hypothesis. *)
-    SCase "a1 = ANum n". destruct n;
-      simpl; rewrite IHa2; reflexivity. Qed.
- -
-
- -
-Coq experts often use this "...; try... " idiom after a tactic - like induction to take care of many similar cases all at once. - Naturally, this practice has an analog in informal proofs. - -
- - Here is an informal proof of this theorem that matches the - structure of the formal one: - -
- - Theorem: For all arithmetic expressions a, - -
- -
-       aeval (optimize_0plus a) = aeval a. -
- -
- Proof: By induction on a. The AMinus and AMult cases - follow directly from the IH. The remaining cases are as follows: - -
- -
    -
  • Suppose a = ANum n for some n. We must show - -
    - -
    -  aeval (optimize_0plus (ANum n)) = aeval (ANum n). -
    - -
    - This is immediate from the definition of optimize_0plus. - -
    - - -
    • -
  • Suppose a = APlus a1 a2 for some a1 and a2. We - must show - -
    - -
    -  aeval (optimize_0plus (APlus a1 a2))
    -= aeval (APlus a1 a2). -
    - -
    - Consider the possible forms of a1. For most of them, - optimize_0plus simply calls itself recursively for the - subexpressions and rebuilds a new expression of the same form - as a1; in these cases, the result follows directly from the - IH. - -
    - - The interesting case is when a1 = ANum n for some n. - If n = ANum 0, then - -
    - -
    -  optimize_0plus (APlus a1 a2) = optimize_0plus a2 -
    - -
    - and the IH for a2 is exactly what we need. On the other - hand, if n = S n' for some n', then again optimize_0plus - simply calls itself recursively, and the result follows from - the IH. ☐ -
    • -
- -
- - This proof can still be improved: the first case (for a = ANum - n) is very trivial — even more trivial than the cases that we - said simply followed from the IH — yet we have chosen to write it - out in full. It would be better and clearer to drop it and just - say, at the top, "Most cases are either immediate or direct from - the IH. The only interesting case is the one for APlus..." We - can make the same improvement in our formal proof too. Here's how - it looks: -
-
- -
-Theorem optimize_0plus_sound'': ∀a,
-  aeval (optimize_0plus a) = aeval a.
-Proof.
-  intros a.
-  induction a;
-    (* Most cases follow directly by the IH *)
-    try (simpl; rewrite IHa1; rewrite IHa2; reflexivity);
-    (* ... or are immediate by definition *)
-    try reflexivity.
-  (* The interesting case is when a = APlus a1 a2. *)
-  Case "APlus".
-    destruct a1; try (simpl; simpl in IHa1; rewrite IHa1;
-                      rewrite IHa2; reflexivity).
-    SCase "a1 = ANum n". destruct n;
-      simpl; rewrite IHa2; reflexivity. Qed.
- -
-
- -
-

The ; Tactical (General Form)

- -
- - The ; tactical has a more general than the simple T;T' we've - seen above, which is sometimes also useful. If T, T1, ..., - Tn are tactics, then - -
- -
-      T; [T1 | T2 | ... | Tn] -
- -
- is a tactic that first performs T and then performs T1 on the - first subgoal generated by T, performs T2 on the second - subgoal, etc. - -
- - So T;T' is just special notation for the case when all of the - Ti's are the same tactic; i.e. T;T' is just a shorthand for: - -
- -
-      T; [T' | T' | ... | T'] -
- -
- -
-
- -
-
- -
-

Defining New Tactic Notations

- -
- - Coq also provides several ways of "programming" tactic scripts. - -
- -
    -
  • The Tactic Notation idiom illustrated below gives a handy - way to define "shorthand tactics" that bundle several tactics - into a single command. - -
    - - -
    • -
  • For more sophisticated programming, Coq offers a small - built-in programming language called Ltac with primitives - that can examine and modify the proof state. The details are - a bit too complicated to get into here (and it is generally - agreed that Ltac is not the most beautiful part of Coq's - design!), but they can be found in the reference manual, and - there are many examples of Ltac definitions in the Coq - standard library that you can use as examples. - -
    - - -
    • -
  • There is also an OCaml API, which can be used to build tactics - that access Coq's internal structures at a lower level, but - this is seldom worth the trouble for ordinary Coq users. - -
    • -
- -
- -The Tactic Notation mechanism is the easiest to come to grips with, -and it offers plenty of power for many purposes. Here's an example. - -
-
- -
-Tactic Notation "simpl_and_try" tactic(c) :=
-  simpl;
-  try c.
- -
-
- -
-This defines a new tactical called simpl_and_try which - takes one tactic c as an argument, and is defined to be - equivalent to the tactic simpl; try c. For example, writing - "simpl_and_try reflexivity." in a proof would be the same as - writing "simpl; try reflexivity." -
- - The next subsection gives a more sophisticated use of this - feature... -
-
- -
-
- -
-

Bulletproofing Case Analyses

- -
- - Being able to deal with most of the cases of an induction - or destruct all at the same time is very convenient, but it can - also be a little confusing. One problem that often comes up is - that maintaining proofs written in this style can be difficult. - For example, suppose that, later, we extended the definition of - aexp with another constructor that also required a special - argument. The above proof might break because Coq generated the - subgoals for this constructor before the one for APlus, so that, - at the point when we start working on the APlus case, Coq is - actually expecting the argument for a completely different - constructor. What we'd like is to get a sensible error message - saying "I was expecting the AFoo case at this point, but the - proof script is talking about APlus." Here's a nice trick (due - to Aaron Bohannon) that smoothly achieves this. -
-
- -
-Tactic Notation "aexp_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ANum" | Case_aux c "APlus"
-  | Case_aux c "AMinus" | Case_aux c "AMult" ].
- -
-
- -
-(Case_aux implements the common functionality of Case, - SCase, SSCase, etc. For example, Case "foo" is defined as - Case_aux Case "foo".) -
- - For example, if a is a variable of type aexp, then doing - -
- -
-      aexp_cases (induction a) Case -
- -
- will perform an induction on a (the same as if we had just typed - induction a) and also add a Case tag to each subgoal - generated by the induction, labeling which constructor it comes - from. For example, here is yet another proof of - optimize_0plus_sound, using aexp_cases: -
-
- -
-Theorem optimize_0plus_sound''': ∀a,
-  aeval (optimize_0plus a) = aeval a.
-Proof.
-  intros a.
-  aexp_cases (induction a) Case;
-    try (simpl; rewrite IHa1; rewrite IHa2; reflexivity);
-    try reflexivity.
-  (* At this point, there is already an "APlus" case name
-     in the context.  The Case "APlus" here in the proof
-     text has the effect of a sanity check: if the "Case"
-     string in the context is anything _other_ than "APlus"
-     (for example, because we added a clause to the definition
-     of aexp and forgot to change the proof) we'll get a
-     helpful error at this point telling us that this is now
-     the wrong case. *)
-  Case "APlus".
-    aexp_cases (destruct a1) SCase;
-      try (simpl; simpl in IHa1;
-           rewrite IHa1; rewrite IHa2; reflexivity).
-    SCase "ANum". destruct n;
-      simpl; rewrite IHa2; reflexivity. Qed.
- -
-
- -
-

Exercise: 3 stars (optimize_0plus_b)

- Since the optimize_0plus tranformation doesn't change the value - of aexps, we should be able to apply it to all the aexps that - appear in a bexp without changing the bexp's value. Write a - function which performs that transformation on bexps, and prove - it is sound. Use the tacticals we've just seen to make the proof - as elegant as possible. -
-
- -
-Fixpoint optimize_0plus_b (b : bexp) : bexp :=
-  (* FILL IN HERE *) admit.
- -
-Theorem optimize_0plus_b_sound : ∀b,
-  beval (optimize_0plus_b b) = beval b.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 4 stars, optional (optimizer)

- Design exercise: The optimization implemented by our - optimize_0plus function is only one of many imaginable - optimizations on arithmetic and boolean expressions. Write a more - sophisticated optimizer and prove it correct. - -
- -(* FILL IN HERE *)
- ☐ -
-
- -
-
- -
-

The omega Tactic

- -
- - The omega tactic implements a decision procedure for a subset of - first-order logic called Presburger arithmetic. It is based on - the Omega algorithm invented in 1992 by William Pugh. - -
- - If the goal is a universally quantified formula made out of - -
- -
    -
  • numeric constants, addition (+ and S), subtraction (- - and pred), and multiplication by constants (this is what - makes it Presburger arithmetic), - -
    - - -
    • -
  • equality (= and ≠) and inequality (≤), and - -
    - - -
    • -
  • the logical connectives ∧, ∨, ¬, and →, - -
    • -
- -
- - then invoking omega will either solve the goal or tell you that - it is actually false. -
-
- -
-Example silly_presburger_example : ∀m n o p,
-  m + n ≤ n + o ∧ o + 3 = p + 3 →
-  m ≤ p.
-Proof.
-  intros. omega.
-Qed.
- -
-
- -
-Liebniz wrote, "It is unworthy of excellent men to lose - hours like slaves in the labor of calculation which could be - relegated to anyone else if machines were used." We recommend - using the omega tactic whenever possible. -
-
- -
-
- -
-

A Few More Handy Tactics

- -
- - Finally, here are some miscellaneous tactics that you may find - convenient. - -
- -
    -
  • clear H: Delete hypothesis H from the context. - -
    - - -
    • -
  • subst x: Find an assumption x = e or e = x in the - context, replace x with e throughout the context and - current goal, and clear the assumption. - -
    - - -
    • -
  • subst: Substitute away all assumptions of the form x = e - or e = x. - -
    - - -
    • -
  • rename... into...: Change the name of a hypothesis in the - proof context. For example, if the context includes a variable - named x, then rename x into y will change all occurrences - of x to y. - -
    - - -
    • -
  • assumption: Try to find a hypothesis H in the context that - exactly matches the goal; if one is found, behave just like - apply H. - -
    - - -
    • -
  • contradiction: Try to find a hypothesis H in the current - context that is logically equivalent to False. If one is - found, solve the goal. - -
    - - -
    • -
  • constructor: Try to find a constructor c (from some - Inductive definition in the current environment) that can be - applied to solve the current goal. If one is found, behave - like apply c. -
    • -
- -
- - We'll see many examples of these in the proofs below. -
-
- -
-
- -
-

Evaluation as a Relation

- -
- - We have presented aeval and beval as functions defined by - Fixpoints. Another way to think about evaluation — one that we - will see is often more flexible — is as a relation between - expressions and their values. This leads naturally to Inductive - definitions like the following one for arithmetic - expressions... -
-
- -
-Module aevalR_first_try.
- -
-Inductive aevalR : aexp → nat → Prop :=
-  | E_ANum : ∀(n: nat),
-      aevalR (ANum n) n
-  | E_APlus : ∀(e1 e2: aexp) (n1 n2: nat),
-      aevalR e1 n1 →
-      aevalR e2 n2 →
-      aevalR (APlus e1 e2) (n1 + n2)
-  | E_AMinus: ∀(e1 e2: aexp) (n1 n2: nat),
-      aevalR e1 n1 →
-      aevalR e2 n2 →
-      aevalR (AMinus e1 e2) (n1 - n2)
-  | E_AMult : ∀(e1 e2: aexp) (n1 n2: nat),
-      aevalR e1 n1 →
-      aevalR e2 n2 →
-      aevalR (AMult e1 e2) (n1 × n2).
- -
-
- -
-As is often the case with relations, we'll find it - convenient to define infix notation for aevalR. We'll write e - ⇓ n to mean that arithmetic expression e evaluates to value - n. (This notation is one place where the limitation to ASCII - symbols becomes a little bothersome. The standard notation for - the evaluation relation is a double down-arrow. We'll typeset it - like this in the HTML version of the notes and use a double - vertical bar as the closest approximation in .v files.) -
-
- -
-Notation "e '⇓' n" := (aevalR e n) : type_scope.
- -
-
- -
-In fact, Coq provides a way to use this notation in the definition - of aevalR itself. This avoids situations where we're working on - a proof involving statements in the form e ⇓ n but we have to - refer back to a definition written using the form aevalR e n. - -
- - We do this by first "reserving" the notation, then giving the - definition together with a declaration of what the notation - means. -
-
- -
-Reserved Notation "e '⇓' n" (at level 50, left associativity).
- -
-Inductive aevalR : aexp → nat → Prop :=
-  | E_ANum : ∀(n:nat),
-      (ANum n) ⇓ n
-  | E_APlus : ∀(e1 e2: aexp) (n1 n2 : nat),
-      (e1 ⇓ n1) → (e2 ⇓ n2) → (APlus e1 e2) ⇓ (n1 + n2)
-  | E_AMinus : ∀(e1 e2: aexp) (n1 n2 : nat),
-      (e1 ⇓ n1) → (e2 ⇓ n2) → (AMinus e1 e2) ⇓ (n1 - n2)
-  | E_AMult : ∀(e1 e2: aexp) (n1 n2 : nat),
-      (e1 ⇓ n1) → (e2 ⇓ n2) → (AMult e1 e2) ⇓ (n1 × n2)
-
-  where "e '⇓' n" := (aevalR e n) : type_scope.
- -
-Tactic Notation "aevalR_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_ANum" | Case_aux c "E_APlus"
-  | Case_aux c "E_AMinus" | Case_aux c "E_AMult" ].
- -
-
- -
-

Inference Rule Notation

- -
- - In informal discussions, it is convenient write the rules for - aevalR and similar relations in the more readable graphical form - of inference rules, where the premises above the line justify - the conclusion below the line (we have already seen them in the - Prop chapter). -
- - For example, the constructor E_APlus... - -
- -
-      | E_APlus : ∀(e1 e2: aexp) (n1 n2: nat),
-          aevalR e1 n1 →
-          aevalR e2 n2 →
-          aevalR (APlus e1 e2) (n1 + n2) -
- -
- ...would be written like this as an inference rule: -
- - - - - - - - - - - - - - -
e1 ⇓ n1
e2 ⇓ n2 - (E_APlus)   -
APlus e1 e2 ⇓ n1+n2
-
- - Formally, there is nothing very deep about inference rules: - they are just implications. You can read the rule name on the - right as the name of the constructor and read each of the - linebreaks between the premises above the line and the line itself - as →. All the variables mentioned in the rule (e1, n1, - etc.) are implicitly bound by universal quantifiers at the - beginning. (Such variables are often called metavariables to - distinguish them from the variables of the language we are - defining. At the moment, our arithmetic expressions don't include - variables, but we'll soon be adding them.) The whole collection - of rules is understood as being wrapped in an Inductive - declaration (informally, this is either elided or else indicated - by saying something like "Let aevalR be the smallest relation - closed under the following rules..."). -
- - For example, ⇓ is the smallest relation closed under these - rules: -
- - - - - - - - - - -
   - (E_ANum)   -
ANum n ⇓ n
- - - - - - - - - - - - - - -
e1 ⇓ n1
e2 ⇓ n2 - (E_APlus)   -
APlus e1 e2 ⇓ n1+n2
- - - - - - - - - - - - - - -
e1 ⇓ n1
e2 ⇓ n2 - (E_AMinus)   -
AMinus e1 e2 ⇓ n1-n2
- - - - - - - - - - - - - - -
e1 ⇓ n1
e2 ⇓ n2 - (E_AMult)   -
AMult e1 e2 ⇓ n1*n2
-
-
- -
-
- -
-

Equivalence of the Definitions

- -
- - It is straightforward to prove that the relational and functional - definitions of evaluation agree on all possible arithmetic - expressions... -
-
- -
-Theorem aeval_iff_aevalR : ∀a n,
-  (a ⇓ n) ↔ aeval a = n.
-
-
-Proof.
- split.
- Case "→".
-   intros H.
-   aevalR_cases (induction H) SCase; simpl.
-   SCase "E_ANum".
-     reflexivity.
-   SCase "E_APlus".
-     rewrite IHaevalR1. rewrite IHaevalR2. reflexivity.
-   SCase "E_AMinus".
-     rewrite IHaevalR1. rewrite IHaevalR2. reflexivity.
-   SCase "E_AMult".
-     rewrite IHaevalR1. rewrite IHaevalR2. reflexivity.
- Case "←".
-   generalize dependent n.
-   aexp_cases (induction a) SCase;
-      simpl; intros; subst.
-   SCase "ANum".
-     apply E_ANum.
-   SCase "APlus".
-     apply E_APlus.
-      apply IHa1. reflexivity.
-      apply IHa2. reflexivity.
-   SCase "AMinus".
-     apply E_AMinus.
-      apply IHa1. reflexivity.
-      apply IHa2. reflexivity.
-   SCase "AMult".
-     apply E_AMult.
-      apply IHa1. reflexivity.
-      apply IHa2. reflexivity.
-Qed.
-
- -
-
- -
-Note: if you're reading the HTML file, you'll see an empty square box instead -of a proof for this theorem. -You can click on this box to "unfold" the text to see the proof. -Click on the unfolded to text to "fold" it back up to a box. We'll be using -this style frequently from now on to help keep the HTML easier to read. -The full proofs always appear in the .v files. -
- - We can make the proof quite a bit shorter by making more - use of tacticals... -
-
- -
-Theorem aeval_iff_aevalR' : ∀a n,
-  (a ⇓ n) ↔ aeval a = n.
-Proof.
-  (* WORKED IN CLASS *)
-  split.
-  Case "→".
-    intros H; induction H; subst; reflexivity.
-  Case "←".
-    generalize dependent n.
-    induction a; simpl; intros; subst; constructor;
-       try apply IHa1; try apply IHa2; reflexivity.
-Qed.
- -
-
- -
-

Exercise: 3 stars (bevalR)

- Write a relation bevalR in the same style as - aevalR, and prove that it is equivalent to beval. -
-
- -
-(* 
-Inductive bevalR:
-(* FILL IN HERE *)
-*)
-
- -
-☐ -
-
- -
-
- -
-

Computational vs. Relational Definitions

- -
- - For the definitions of evaluation for arithmetic and boolean - expressions, the choice of whether to use functional or relational - definitions is mainly a matter of taste. In general, Coq has - somewhat better support for working with relations. On the other - hand, in some sense function definitions carry more information, - because functions are necessarily deterministic and defined on all - arguments; for a relation we have to show these properties - explicitly if we need them. Functions also take advantage of Coq's - computations mechanism. - -
- - However, there are circumstances where relational definitions of - evaluation are preferable to functional ones. -
-
- -
-Module aevalR_division.
- -
-
- -
-For example, suppose that we wanted to extend the arithmetic - operations by considering also a division operation: -
-
- -
-Inductive aexp : Type :=
-  | ANum : nat → aexp
-  | APlus : aexp → aexp → aexp
-  | AMinus : aexp → aexp → aexp
-  | AMult : aexp → aexp → aexp
-  | ADiv : aexp → aexp → aexp. (* <--- new *)
- -
-
- -
-Extending the definition of aeval to handle this new operation - would not be straightforward (what should we return as the result - of ADiv (ANum 5) (ANum 0)?). But extending aevalR is - straightforward. -
-
- -
-Inductive aevalR : aexp → nat → Prop :=
-  | E_ANum : ∀(n:nat),
-      (ANum n) ⇓ n
-  | E_APlus : ∀(a1 a2: aexp) (n1 n2 : nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (APlus a1 a2) ⇓ (n1 + n2)
-  | E_AMinus : ∀(a1 a2: aexp) (n1 n2 : nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (AMinus a1 a2) ⇓ (n1 - n2)
-  | E_AMult : ∀(a1 a2: aexp) (n1 n2 : nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (AMult a1 a2) ⇓ (n1 × n2)
-  | E_ADiv : ∀(a1 a2: aexp) (n1 n2 n3: nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (mult n2 n3 = n1) → (ADiv a1 a2) ⇓ n3
-
-where "a '⇓' n" := (aevalR a n) : type_scope.
- -
-End aevalR_division.
-Module aevalR_extended.
- -
-
- -
-

Adding nondeterminism

- -
-
-(* /TERSE *)
-
- -
-Suppose, instead, that we want to extend the arithmetic operations - by a nondeterministic number generator any: -
-
- -
-Inductive aexp : Type :=
-  | AAny : aexp (* <--- NEW *)
-  | ANum : nat → aexp
-  | APlus : aexp → aexp → aexp
-  | AMinus : aexp → aexp → aexp
-  | AMult : aexp → aexp → aexp.
- -
-
- -
-Again, extending aeval would be tricky (because evaluation is - not a deterministic function from expressions to numbers), but - extending aevalR is no problem: -
-
- -
-Inductive aevalR : aexp → nat → Prop :=
-  | E_Any : ∀(n:nat),
-      AAny ⇓ n (* <--- new *)
-  | E_ANum : ∀(n:nat),
-      (ANum n) ⇓ n
-  | E_APlus : ∀(a1 a2: aexp) (n1 n2 : nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (APlus a1 a2) ⇓ (n1 + n2)
-  | E_AMinus : ∀(a1 a2: aexp) (n1 n2 : nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (AMinus a1 a2) ⇓ (n1 - n2)
-  | E_AMult : ∀(a1 a2: aexp) (n1 n2 : nat),
-      (a1 ⇓ n1) → (a2 ⇓ n2) → (AMult a1 a2) ⇓ (n1 × n2)
-
-where "a '⇓' n" := (aevalR a n) : type_scope.
- -
-End aevalR_extended.
- -
-
- -
-

Expressions With Variables

- -
- - Let's turn our attention back to defining Imp. The next thing we - need to do is to enrich our arithmetic and boolean expressions - with variables. To keep things simple, we'll assume that all - variables are global and that they only hold numbers. -
-
- -
-
- -
-

Identifiers

- -
- - To begin, we'll need to formalize identifiers such as program - variables. We could use strings for this — or, in a real - compiler, fancier structures like pointers into a symbol table. - But for simplicity let's just use natural numbers as identifiers. -
- - (We hide this section in a module because these definitions are - actually in SfLib, but we want to repeat them here so that we - can explain them.) -
-
- -
-Module Id.
- -
-
- -
-We define a new inductive datatype Id so that we won't confuse - identifiers and numbers. We use sumbool to define a computable - equality operator on Id. -
-
- -
-Inductive id : Type :=
-  Id : nat → id.
- -
-Theorem eq_id_dec : ∀id1 id2 : id, {id1 = id2} + {id1 ≠ id2}.
-Proof.
-   intros id1 id2.
-   destruct id1 as [n1]. destruct id2 as [n2].
-   destruct (eq_nat_dec n1 n2) as [Heq | Hneq].
-   Case "n1 = n2".
-     left. rewrite Heq. reflexivity.
-   Case "n1 ≠ n2".
-     right. intros contra. inversion contra. apply Hneq. apply H0.
-Defined.
- -
-
- -
-The following lemmas will be useful for rewriting terms involving eq_id_dec. -
-
- -
-Lemma eq_id : ∀(T:Type) x (p q:T),
-              (if eq_id_dec x x then p else q) = p.
-Proof.
-  intros.
-  destruct (eq_id_dec x x).
-  Case "x = x".
-    reflexivity.
-  Case "x ≠ x (impossible)".
-    apply ex_falso_quodlibet; apply n; reflexivity. Qed.
- -
-
- -
-

Exercise: 1 star, optional (neq_id)

- -
-
-Lemma neq_id : ∀(T:Type) x y (p q:T), x ≠ y →
-               (if eq_id_dec x y then p else q) = q.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-End Id.
- -
-
- -
-

States

- -
- - A state represents the current values of all the variables at - some point in the execution of a program. For simplicity (to avoid dealing with partial functions), we - let the state be defined for all variables, even though any - given program is only going to mention a finite number of them. - The state captures all of the information stored in memory. For Imp - programs, because each variable stores only a natural number, we - can represent the state as a mapping from identifiers to nat. - For more complex programming languages, the state might have more - structure. - -
-
- -
-Definition state := id → nat.
- -
-Definition empty_state : state :=
-  fun _ ⇒ 0.
- -
-Definition update (st : state) (x : id) (n : nat) : state :=
-  fun x' ⇒ if eq_id_dec x x' then n else st x'.
- -
-
- -
-For proofs involving states, we'll need several simple properties - of update. -
- -

Exercise: 1 star (update_eq)

- -
-
-Theorem update_eq : ∀n x st,
-  (update st x n) x = n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (update_neq)

- -
-
-Theorem update_neq : ∀x2 x1 n st,
-  x2 ≠ x1 →
-  (update st x2 n) x1 = (st x1).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (update_example)

- Before starting to play with tactics, make sure you understand - exactly what the theorem is saying! -
-
- -
-Theorem update_example : ∀(n:nat),
-  (update empty_state (Id 2) n) (Id 3) = 0.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (update_shadow)

- -
-
-Theorem update_shadow : ∀n1 n2 x1 x2 (st : state),
-   (update (update st x2 n1) x2 n2) x1 = (update st x2 n2) x1.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (update_same)

- -
-
-Theorem update_same : ∀n1 x1 x2 (st : state),
-  st x1 = n1 →
-  (update st x1 n1) x2 = st x2.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (update_permute)

- -
-
-Theorem update_permute : ∀n1 n2 x1 x2 x3 st,
-  x2 ≠ x1 →
-  (update (update st x2 n1) x1 n2) x3 = (update (update st x1 n2) x2 n1) x3.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Syntax

- -
- - We can add variables to the arithmetic expressions we had before by - simply adding one more constructor: -
-
- -
-Inductive aexp : Type :=
-  | ANum : nat → aexp
-  | AId : id → aexp (* <----- NEW *)
-  | APlus : aexp → aexp → aexp
-  | AMinus : aexp → aexp → aexp
-  | AMult : aexp → aexp → aexp.
- -
-Tactic Notation "aexp_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ANum" | Case_aux c "AId" | Case_aux c "APlus"
-  | Case_aux c "AMinus" | Case_aux c "AMult" ].
- -
-
- -
-Defining a few variable names as notational shorthands will make - examples easier to read: -
-
- -
-Definition X : id := Id 0.
-Definition Y : id := Id 1.
-Definition Z : id := Id 2.
- -
-
- -
-(This convention for naming program variables (X, Y, - Z) clashes a bit with our earlier use of uppercase letters for - types. Since we're not using polymorphism heavily in this part of - the course, this overloading should not cause confusion.) -
- - The definition of bexps is the same as before (using the new - aexps): -
-
- -
-Inductive bexp : Type :=
-  | BTrue : bexp
-  | BFalse : bexp
-  | BEq : aexp → aexp → bexp
-  | BLe : aexp → aexp → bexp
-  | BNot : bexp → bexp
-  | BAnd : bexp → bexp → bexp.
- -
-Tactic Notation "bexp_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "BTrue" | Case_aux c "BFalse" | Case_aux c "BEq"
-  | Case_aux c "BLe" | Case_aux c "BNot" | Case_aux c "BAnd" ].
- -
-
- -
-

Evaluation

- -
- - The arith and boolean evaluators can be extended to handle - variables in the obvious way: -
-
- -
-Fixpoint aeval (st : state) (a : aexp) : nat :=
-  match a with
-  | ANum n ⇒ n
-  | AId x ⇒ st x (* <----- NEW *)
-  | APlus a1 a2 ⇒ (aeval st a1) + (aeval st a2)
-  | AMinus a1 a2 ⇒ (aeval st a1) - (aeval st a2)
-  | AMult a1 a2 ⇒ (aeval st a1) × (aeval st a2)
-  end.
- -
-Fixpoint beval (st : state) (b : bexp) : bool :=
-  match b with
-  | BTrue ⇒ true
-  | BFalse ⇒ false
-  | BEq a1 a2 ⇒ beq_nat (aeval st a1) (aeval st a2)
-  | BLe a1 a2 ⇒ ble_nat (aeval st a1) (aeval st a2)
-  | BNot b1 ⇒ negb (beval st b1)
-  | BAnd b1 b2 ⇒ andb (beval st b1) (beval st b2)
-  end.
- -
-Example aexp1 :
-  aeval (update empty_state X 5)
-        (APlus (ANum 3) (AMult (AId X) (ANum 2)))
-  = 13.
-Proof. reflexivity. Qed.
- -
-Example bexp1 :
-  beval (update empty_state X 5)
-        (BAnd BTrue (BNot (BLe (AId X) (ANum 4))))
-  = true.
-Proof. reflexivity. Qed.
- -
-
- -
-

Commands

- -
- - Now we are ready define the syntax and behavior of Imp - commands (often called statements). -
-
- -
-
- -
-

Syntax

- -
- - Informally, commands c are described by the following BNF - grammar: - -
- -
-     c ::= SKIP
-         | x ::= a
-         | c ;; c
-         | WHILE b DO c END
-         | IFB b THEN c ELSE c FI -
- -
- -
- - For example, here's the factorial function in Imp. - -
- -
-     Z ::= X;;
-     Y ::= 1;;
-     WHILE not (Z = 0) DO
-       Y ::= Y × Z;;
-       Z ::= Z - 1
-     END -
- -
- When this command terminates, the variable Y will contain the - factorial of the initial value of X. - -
- - Here is the formal definition of the syntax of commands: -
-
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAss : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com.
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";;"
-  | Case_aux c "IFB" | Case_aux c "WHILE" ].
- -
-
- -
-As usual, we can use a few Notation declarations to make things - more readable. We need to be a bit careful to avoid conflicts - with Coq's built-in notations, so we'll keep this light — in - particular, we won't introduce any notations for aexps and - bexps to avoid confusion with the numerical and boolean - operators we've already defined. We use the keyword IFB for - conditionals instead of IF, for similar reasons. -
-
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "x '::=' a" :=
-  (CAss x a) (at level 60).
-Notation "c1 ;; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" :=
-  (CIf c1 c2 c3) (at level 80, right associativity).
- -
-
- -
-For example, here is the factorial function again, written as a - formal definition to Coq: -
-
- -
-Definition fact_in_coq : com :=
-  Z ::= AId X;;
-  Y ::= ANum 1;;
-  WHILE BNot (BEq (AId Z) (ANum 0)) DO
-    Y ::= AMult (AId Y) (AId Z);;
-    Z ::= AMinus (AId Z) (ANum 1)
-  END.
- -
-
- -
-

Examples

- -
- - Assignment: -
-
- -
-Definition plus2 : com :=
-  X ::= (APlus (AId X) (ANum 2)).
- -
-Definition XtimesYinZ : com :=
-  Z ::= (AMult (AId X) (AId Y)).
- -
-Definition subtract_slowly_body : com :=
-  Z ::= AMinus (AId Z) (ANum 1) ;;
-  X ::= AMinus (AId X) (ANum 1).
- -
-
- -
-

Loops

- -
-
- -
-Definition subtract_slowly : com :=
-  WHILE BNot (BEq (AId X) (ANum 0)) DO
-    subtract_slowly_body
-  END.
- -
-Definition subtract_3_from_5_slowly : com :=
-  X ::= ANum 3 ;;
-  Z ::= ANum 5 ;;
-  subtract_slowly.
- -
-
- -
-

An infinite loop:

- -
-
- -
-Definition loop : com :=
-  WHILE BTrue DO
-    SKIP
-  END.
- -
-
- -
-

Evaluation

- -
- - Next we need to define what it means to evaluate an Imp command. - The fact that WHILE loops don't necessarily terminate makes defining - an evaluation function tricky... -
-
- -
-
- -
-

Evaluation as a Function (Failed Attempt)

- -
- - Here's an attempt at defining an evaluation function for commands, - omitting the WHILE case. -
-
- -
-Fixpoint ceval_fun_no_while (st : state) (c : com) : state :=
-  match c with
-    | SKIP ⇒
-        st
-    | x ::= a1 ⇒
-        update st x (aeval st a1)
-    | c1 ;; c2 ⇒
-        let st' := ceval_fun_no_while st c1 in
-        ceval_fun_no_while st' c2
-    | IFB b THEN c1 ELSE c2 FI ⇒
-        if (beval st b)
-          then ceval_fun_no_while st c1
-          else ceval_fun_no_while st c2
-    | WHILE b DO c END ⇒
-        st (* bogus *)
-  end.
-
- -
-In a traditional functional programming language like ML or - Haskell we could write the WHILE case as follows: -
-  Fixpoint ceval_fun (st : state) (c : com) : state :=
-    match c with
-      ...
-      | WHILE b DO c END =>
-          if (beval st b1)
-            then ceval_fun st (c1; WHILE b DO c END)
-            else st
-    end.
-
- Coq doesn't accept such a definition ("Error: Cannot guess - decreasing argument of fix") because the function we want to - define is not guaranteed to terminate. Indeed, it doesn't always - terminate: for example, the full version of the ceval_fun - function applied to the loop program above would never - terminate. Since Coq is not just a functional programming - language, but also a consistent logic, any potentially - non-terminating function needs to be rejected. Here is - an (invalid!) Coq program showing what would go wrong if Coq - allowed non-terminating recursive functions: -
-     Fixpoint loop_false (n : nat) : False := loop_false n.
-
- That is, propositions like False would become provable - (e.g. loop_false 0 would be a proof of False), which - would be a disaster for Coq's logical consistency. - -
- - Thus, because it doesn't terminate on all inputs, the full version - of ceval_fun cannot be written in Coq — at least not without - additional tricks (see chapter ImpCEvalFun if curious). -
-
- -
-
- -
-

Evaluation as a Relation

- -
- - Here's a better way: we define ceval as a relation rather than - a function — i.e., we define it in Prop instead of Type, as - we did for aevalR above. -
- - This is an important change. Besides freeing us from the awkward - workarounds that would be needed to define evaluation as a - function, it gives us a lot more flexibility in the definition. - For example, if we added concurrency features to the language, - we'd want the definition of evaluation to be non-deterministic — - i.e., not only would it not be total, it would not even be a - partial function! We'll use the notation c / st ⇓ st' for our ceval relation: - c / st ⇓ st' means that executing program c in a starting - state st results in an ending state st'. This can be - pronounced "c takes state st to st'". - -
- -

Operational Semantics

- -
- - - - - - - - - - -
   - (E_Skip)   -
SKIP / st ⇓ st
- - - - - - - - - - -
aeval st a1 = n - (E_Ass)   -
x := a1 / st ⇓ (update st x n)
- - - - - - - - - - - - - - -
c1 / st ⇓ st'
c2 / st' ⇓ st'' - (E_Seq)   -
c1;;c2 / st ⇓ st''
- - - - - - - - - - - - - - -
beval st b1 = true
c1 / st ⇓ st' - (E_IfTrue)   -
IF b1 THEN c1 ELSE c2 FI / st ⇓ st'
- - - - - - - - - - - - - - -
beval st b1 = false
c2 / st ⇓ st' - (E_IfFalse)   -
IF b1 THEN c1 ELSE c2 FI / st ⇓ st'
- - - - - - - - - - -
beval st b1 = false - (E_WhileEnd)   -
WHILE b DO c END / st ⇓ st
- - - - - - - - - - - - - - - - - - -
beval st b1 = true
c / st ⇓ st'
WHILE b DO c END / st' ⇓ st'' - (E_WhileLoop)   -
WHILE b DO c END / st ⇓ st''
-
- - Here is the formal definition. (Make sure you understand - how it corresponds to the inference rules.) -
-
- -
-Reserved Notation "c1 '/' st '⇓' st'" (at level 40, st at level 39).
- -
-Inductive ceval : com → state → state → Prop :=
-  | E_Skip : ∀st,
-      SKIP / st ⇓ st
-  | E_Ass : ∀st a1 n x,
-      aeval st a1 = n →
-      (x ::= a1) / st ⇓ (update st x n)
-  | E_Seq : ∀c1 c2 st st' st'',
-      c1 / st ⇓ st' →
-      c2 / st' ⇓ st'' →
-      (c1 ;; c2) / st ⇓ st''
-  | E_IfTrue : ∀st st' b c1 c2,
-      beval st b = true →
-      c1 / st ⇓ st' →
-      (IFB b THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_IfFalse : ∀st st' b c1 c2,
-      beval st b = false →
-      c2 / st ⇓ st' →
-      (IFB b THEN c1 ELSE c2 FI) / st ⇓ st'
-  | E_WhileEnd : ∀b st c,
-      beval st b = false →
-      (WHILE b DO c END) / st ⇓ st
-  | E_WhileLoop : ∀st st' st'' b c,
-      beval st b = true →
-      c / st ⇓ st' →
-      (WHILE b DO c END) / st' ⇓ st'' →
-      (WHILE b DO c END) / st ⇓ st''
-
-  where "c1 '/' st '⇓' st'" := (ceval c1 st st').
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq"
-  | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
-  | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" ].
- -
-
- -
-

- The cost of defining evaluation as a relation instead of a - function is that we now need to construct proofs that some - program evaluates to some result state, rather than just letting - Coq's computation mechanism do it for us. -
-
- -
-Example ceval_example1:
-    (X ::= ANum 2;;
-     IFB BLe (AId X) (ANum 1)
-       THEN Y ::= ANum 3
-       ELSE Z ::= ANum 4
-     FI)
-   / empty_state
-   ⇓ (update (update empty_state X 2) Z 4).
-Proof.
-  (* We must supply the intermediate state *)
-  apply E_Seq with (update empty_state X 2).
-  Case "assignment command".
-    apply E_Ass. reflexivity.
-  Case "if command".
-    apply E_IfFalse.
-      reflexivity.
-      apply E_Ass. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (ceval_example2)

- -
-
-Example ceval_example2:
-    (X ::= ANum 0;; Y ::= ANum 1;; Z ::= ANum 2) / empty_state ⇓
-    (update (update (update empty_state X 0) Y 1) Z 2).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (pup_to_n)

- Write an Imp program that sums the numbers from 1 to - X (inclusive: 1 + 2 + ... + X) in the variable Y. - Prove that this program executes as intended for X = 2 - (this latter part is trickier than you might expect). -
-
- -
-Definition pup_to_n : com :=
-  (* FILL IN HERE *) admit.
- -
-Theorem pup_to_2_ceval :
-  pup_to_n / (update empty_state X 2) ⇓
-    update (update (update (update (update (update empty_state
-      X 2) Y 0) Y 2) X 1) Y 3) X 0.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Determinism of Evaluation

- -
- - Changing from a computational to a relational definition of - evaluation is a good move because it allows us to escape from the - artificial requirement (imposed by Coq's restrictions on - Fixpoint definitions) that evaluation should be a total - function. But it also raises a question: Is the second definition - of evaluation actually a partial function? That is, is it - possible that, beginning from the same state st, we could - evaluate some command c in different ways to reach two different - output states st' and st''? - -
- - In fact, this cannot happen: ceval is a partial function. - Here's the proof: -
-
- -
-Theorem ceval_deterministic: ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-
-
-Proof.
-  intros c st st1 st2 E1 E2.
-  generalize dependent st2.
-  ceval_cases (induction E1) Case;
-           intros st2 E2; inversion E2; subst.
-  Case "E_Skip". reflexivity.
-  Case "E_Ass". reflexivity.
-  Case "E_Seq".
-    assert (st' = st'0) as EQ1.
-      SCase "Proof of assertion". apply IHE1_1; assumption.
-    subst st'0.
-    apply IHE1_2. assumption.
-  Case "E_IfTrue".
-    SCase "b1 evaluates to true".
-      apply IHE1. assumption.
-    SCase "b1 evaluates to false (contradiction)".
-      rewrite H in H5. inversion H5.
-  Case "E_IfFalse".
-    SCase "b1 evaluates to true (contradiction)".
-      rewrite H in H5. inversion H5.
-    SCase "b1 evaluates to false".
-      apply IHE1. assumption.
-  Case "E_WhileEnd".
-    SCase "b1 evaluates to false".
-      reflexivity.
-    SCase "b1 evaluates to true (contradiction)".
-      rewrite H in H2. inversion H2.
-  Case "E_WhileLoop".
-    SCase "b1 evaluates to false (contradiction)".
-      rewrite H in H4. inversion H4.
-    SCase "b1 evaluates to true".
-      assert (st' = st'0) as EQ1.
-        SSCase "Proof of assertion". apply IHE1_1; assumption.
-      subst st'0.
-      apply IHE1_2. assumption. Qed.
-
- -
-
- -
-

Reasoning About Imp Programs

- -
- - We'll get much deeper into systematic techniques for reasoning - about Imp programs in the following chapters, but we can do quite - a bit just working with the bare definitions. -
-
- -
-(* This section explores some examples. *)
- -
-Theorem plus2_spec : ∀st n st',
-  st X = n →
-  plus2 / st ⇓ st' →
-  st' X = n + 2.
-Proof.
-  intros st n st' HX Heval.
-  (* Inverting Heval essentially forces Coq to expand one
-     step of the ceval computation - in this case revealing
-     that st' must be st extended with the new value of X,
-     since plus2 is an assignment *)
-  inversion Heval. subst. clear Heval. simpl.
-  apply update_eq. Qed.
- -
-
- -
-

Exercise: 3 stars (XtimesYinZ_spec)

- State and prove a specification of XtimesYinZ. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars (loop_never_stops)

- -
-
-Theorem loop_never_stops : ∀st st',
-  ~(loop / st ⇓ st').
-Proof.
-  intros st st' contra. unfold loop in contra.
-  remember (WHILE BTrue DO SKIP END) as loopdef eqn:Heqloopdef.
-    (* Proceed by induction on the assumed derivation showing that
-     loopdef terminates.  Most of the cases are immediately
-     contradictory (and so can be solved in one step with
-     inversion). *)
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (no_whilesR)

- Consider the definition of the no_whiles property below: -
-
- -
-Fixpoint no_whiles (c : com) : bool :=
-  match c with
-  | SKIP ⇒ true
-  | _ ::= _ ⇒ true
-  | c1 ;; c2 ⇒ andb (no_whiles c1) (no_whiles c2)
-  | IFB _ THEN ct ELSE cf FI ⇒ andb (no_whiles ct) (no_whiles cf)
-  | WHILE _ DO _ END ⇒ false
-  end.
- -
-
- -
-This property yields true just on programs that - have no while loops. Using Inductive, write a property - no_whilesR such that no_whilesR c is provable exactly when c - is a program with no while loops. Then prove its equivalence - with no_whiles. -
-
- -
-Inductive no_whilesR: com → Prop :=
- (* FILL IN HERE *)
-  .
- -
-Theorem no_whiles_eqv:
-   ∀c, no_whiles c = true ↔ no_whilesR c.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 4 stars (no_whiles_terminating)

- Imp programs that don't involve while loops always terminate. - State and prove a theorem that says this. (Use either no_whiles or no_whilesR, as you prefer.) -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 3 stars (stack_compiler)

- HP Calculators, programming languages like Forth and Postscript, - and abstract machines like the Java Virtual Machine all evaluate - arithmetic expressions using a stack. For instance, the expression -
-   (2*3)+(3*(4-2))
-
- would be entered as -
-   2 3 * 3 4 2 - * +
-
- and evaluated like this: -
-  []            |    2 3 * 3 4 2 - * +
-  [2]           |    3 * 3 4 2 - * +
-  [3, 2]        |    * 3 4 2 - * +
-  [6]           |    3 4 2 - * +
-  [3, 6]        |    4 2 - * +
-  [4, 3, 6]     |    2 - * +
-  [2, 4, 3, 6]  |    - * +
-  [2, 3, 6]     |    * +
-  [6, 6]        |    +
-  [12]          |
-
- -
- - The task of this exercise is to write a small compiler that - translates aexps into stack machine instructions. - -
- - The instruction set for our stack language will consist of the - following instructions: - -
- -
    -
  • SPush n: Push the number n on the stack. - -
    • -
  • SLoad x: Load the identifier x from the store and push it - on the stack - -
    • -
  • SPlus: Pop the two top numbers from the stack, add them, and - push the result onto the stack. - -
    • -
  • SMinus: Similar, but subtract. - -
    • -
  • SMult: Similar, but multiply. -
    • -
- -
-
- -
-Inductive sinstr : Type :=
-| SPush : nat → sinstr
-| SLoad : id → sinstr
-| SPlus : sinstr
-| SMinus : sinstr
-| SMult : sinstr.
- -
-
- -
-Write a function to evaluate programs in the stack language. It - takes as input a state, a stack represented as a list of - numbers (top stack item is the head of the list), and a program - represented as a list of instructions, and returns the stack after - executing the program. Test your function on the examples below. - -
- - Note that the specification leaves unspecified what to do when - encountering an SPlus, SMinus, or SMult instruction if the - stack contains less than two elements. In a sense, it is - immaterial what we do, since our compiler will never emit such a - malformed program. -
-
- -
-Fixpoint s_execute (st : state) (stack : list nat)
-                   (prog : list sinstr)
-                 : list nat :=
-(* FILL IN HERE *) admit.
- -
-Example s_execute1 :
-     s_execute empty_state []
-       [SPush 5; SPush 3; SPush 1; SMinus]
-   = [2; 5].
-(* FILL IN HERE *) Admitted.
- -
-Example s_execute2 :
-     s_execute (update empty_state X 3) [3;4]
-       [SPush 4; SLoad X; SMult; SPlus]
-   = [15; 4].
-(* FILL IN HERE *) Admitted.
- -
-
- -
-Next, write a function which compiles an aexp into a stack - machine program. The effect of running the program should be the - same as pushing the value of the expression on the stack. -
-
- -
-Fixpoint s_compile (e : aexp) : list sinstr :=
-(* FILL IN HERE *) admit.
- -
-
- -
-After you've defined s_compile, uncomment the following to test - that it works. -
-
- -
-(* 
-Example s_compile1 :
-    s_compile (AMinus (AId X) (AMult (ANum 2) (AId Y)))
-  = SLoad X; SPush 2; SLoad Y; SMult; SMinus.
-Proof. reflexivity. Qed.
-*)
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (stack_compiler_correct)

- The task of this exercise is to prove the correctness of the - calculator implemented in the previous exercise. Remember that - the specification left unspecified what to do when encountering an - SPlus, SMinus, or SMult instruction if the stack contains - less than two elements. (In order to make your correctness proof - easier you may find it useful to go back and change your - implementation!) - -
- - Prove the following theorem, stating that the compile function - behaves correctly. You will need to start by stating a more - general lemma to get a usable induction hypothesis; the main - theorem will then be a simple corollary of this lemma. -
-
- -
-Theorem s_compile_correct : ∀(st : state) (e : aexp),
-  s_execute st [] (s_compile e) = [ aeval st e ].
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 5 stars, advanced (break_imp)

- -
-
-Module BreakImp.
- -
-
- -
-Imperative languages such as C or Java often have a break or - similar statement for interrupting the execution of loops. In this - exercise we will consider how to add break to Imp. - -
- - First, we need to enrich the language of commands with an - additional case. -
-
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CBreak : com
-  | CAss : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com.
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "BREAK" | Case_aux c "::=" | Case_aux c ";"
-  | Case_aux c "IFB" | Case_aux c "WHILE" ].
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "'BREAK'" :=
-  CBreak.
-Notation "x '::=' a" :=
-  (CAss x a) (at level 60).
-Notation "c1 ; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" :=
-  (CIf c1 c2 c3) (at level 80, right associativity).
- -
-
- -
-Next, we need to define the behavior of BREAK. Informally, - whenever BREAK is executed in a sequence of commands, it stops - the execution of that sequence and signals that the innermost - enclosing loop (if any) should terminate. If there aren't any - enclosing loops, then the whole program simply terminates. The - final state should be the same as the one in which the BREAK - statement was executed. - -
- - One important point is what to do when there are multiple loops - enclosing a given BREAK. In those cases, BREAK should only - terminate the innermost loop where it occurs. Thus, after - executing the following piece of code... - -
- -
-   X ::= 0;
-   Y ::= 1;
-   WHILE 0 ≠ Y DO
-     WHILE TRUE DO
-       BREAK
-     END;
-     X ::= 1;
-     Y ::= Y - 1
-   END -
- -
- ... the value of X should be 1, and not 0. - -
- - One way of expressing this behavior is to add another parameter to - the evaluation relation that specifies whether evaluation of a - command executes a BREAK statement: -
-
- -
-Inductive status : Type :=
-  | SContinue : status
-  | SBreak : status.
- -
-Reserved Notation "c1 '/' st '⇓' s '/' st'"
-                  (at level 40, st, s at level 39).
- -
-
- -
-Intuitively, c / st ⇓ s / st' means that, if c is started in - state st, then it terminates in state st' and either signals - that any surrounding loop (or the whole program) should exit - immediately (s = SBreak) or that execution should continue - normally (s = SContinue). - -
- - The definition of the "c / st ⇓ s / st'" relation is very - similar to the one we gave above for the regular evaluation - relation (c / st ⇓ s / st') — we just need to handle the - termination signals appropriately: - -
- -
    -
  • If the command is SKIP, then the state doesn't change, and - execution of any enclosing loop can continue normally. - -
    - - -
    • -
  • If the command is BREAK, the state stays unchanged, but we - signal a SBreak. - -
    - - -
    • -
  • If the command is an assignment, then we update the binding for - that variable in the state accordingly and signal that execution - can continue normally. - -
    - - -
    • -
  • If the command is of the form IF b THEN c1 ELSE c2 FI, then - the state is updated as in the original semantics of Imp, except - that we also propagate the signal from the execution of - whichever branch was taken. - -
    - - -
    • -
  • If the command is a sequence c1 ; c2, we first execute - c1. If this yields a SBreak, we skip the execution of c2 - and propagate the SBreak signal to the surrounding context; - the resulting state should be the same as the one obtained by - executing c1 alone. Otherwise, we execute c2 on the state - obtained after executing c1, and propagate the signal that was - generated there. - -
    - - -
    • -
  • Finally, for a loop of the form WHILE b DO c END, the - semantics is almost the same as before. The only difference is - that, when b evaluates to true, we execute c and check the - signal that it raises. If that signal is SContinue, then the - execution proceeds as in the original semantics. Otherwise, we - stop the execution of the loop, and the resulting state is the - same as the one resulting from the execution of the current - iteration. In either case, since BREAK only terminates the - innermost loop, WHILE signals SContinue. -
    • -
- -
- - Based on the above description, complete the definition of the - ceval relation. -
-
- -
-Inductive ceval : com → state → status → state → Prop :=
-  | E_Skip : ∀st,
-      CSkip / st ⇓ SContinue / st
-  (* FILL IN HERE *)
-
-  where "c1 '/' st '⇓' s '/' st'" := (ceval c1 st s st').
- -
-Tactic Notation "ceval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Skip"
-  (* FILL IN HERE *)
-  ].
- -
-
- -
-Now the following properties of your definition of ceval: -
-
- -
-Theorem break_ignore : ∀c st st' s,
-     (BREAK; c) / st ⇓ s / st' →
-     st = st'.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem while_continue : ∀b c st st' s,
-  (WHILE b DO c END) / st ⇓ s / st' →
-  s = SContinue.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem while_stops_on_break : ∀b c st st',
-  beval st b = true →
-  c / st ⇓ SBreak / st' →
-  (WHILE b DO c END) / st ⇓ SContinue / st'.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 3 stars, advanced, optional (while_break_true)

- -
-
-Theorem while_break_true : ∀b c st st',
-  (WHILE b DO c END) / st ⇓ SContinue / st' →
-  beval st' b = true →
-  ∃st'', c / st'' ⇓ SBreak / st'.
-Proof.
-(* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 4 stars, advanced, optional (ceval_deterministic)

- -
-
-Theorem ceval_deterministic: ∀(c:com) st st1 st2 s1 s2,
-     c / st ⇓ s1 / st1 →
-     c / st ⇓ s2 / st2 →
-     st1 = st2 ∧ s1 = s2.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-End BreakImp.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (short_circuit)

- Most modern programming languages use a "short-circuit" evaluation - rule for boolean and: to evaluate BAnd b1 b2, first evaluate - b1. If it evaluates to false, then the entire BAnd - expression evaluates to false immediately, without evaluating - b2. Otherwise, b2 is evaluated to determine the result of the - BAnd expression. - -
- - Write an alternate version of beval that performs short-circuit - evaluation of BAnd in this manner, and prove that it is - equivalent to beval. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 4 stars, optional (add_for_loop)

- Add C-style for loops to the language of commands, update the - ceval definition to define the semantics of for loops, and add - cases for for loops as needed so that all the proofs in this file - are accepted by Coq. - -
- - A for loop should be parameterized by (a) a statement executed - initially, (b) a test that is run on each iteration of the loop to - determine whether the loop should continue, (c) a statement - executed at the end of each loop iteration, and (d) a statement - that makes up the body of the loop. (You don't need to worry - about making up a concrete Notation for for loops, but feel free - to play with this too if you like.) -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-(* <$Date: 2014-02-22 09:43:41 -0500 (Sat, 22 Feb 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Imp.v b/Imp.v deleted file mode 100644 index 43fff38..0000000 --- a/Imp.v +++ /dev/null @@ -1,1890 +0,0 @@ -(** * Imp: Simple Imperative Programs *) - -(** In this chapter, we begin a new direction that will continue for - the rest of the course. Up to now most of our attention has been - focused on various aspects of Coq itself, while from now on we'll - mostly be using Coq to formalize other things. (We'll continue to - pause from time to time to introduce a few additional aspects of - Coq.) - - Our first case study is a _simple imperative programming language_ - called Imp, embodying a tiny core fragment of conventional - mainstream languages such as C and Java. Here is a familiar - mathematical function written in Imp. - Z ::= X;; - Y ::= 1;; - WHILE not (Z = 0) DO - Y ::= Y * Z;; - Z ::= Z - 1 - END -*) - -(** This chapter looks at how to define the _syntax_ and _semantics_ - of Imp; the chapters that follow develop a theory of _program - equivalence_ and introduce _Hoare Logic_, a widely used logic for - reasoning about imperative programs. *) - -(* ####################################################### *) -(** *** Sflib *) - -(** A minor technical point: Instead of asking Coq to import our - earlier definitions from chapter [Logic], we import a small library - called [Sflib.v], containing just a few definitions and theorems - from earlier chapters that we'll actually use in the rest of the - course. This change should be nearly invisible, since most of what's - missing from Sflib has identical definitions in the Coq standard - library. The main reason for doing it is to tidy the global Coq - environment so that, for example, it is easier to search for - relevant theorems. *) - -Require Export SfLib. - -(* ####################################################### *) -(** * Arithmetic and Boolean Expressions *) - -(** We'll present Imp in three parts: first a core language of - _arithmetic and boolean expressions_, then an extension of these - expressions with _variables_, and finally a language of _commands_ - including assignment, conditions, sequencing, and loops. *) - -(* ####################################################### *) -(** ** Syntax *) - -Module AExp. - -(** These two definitions specify the _abstract syntax_ of - arithmetic and boolean expressions. *) - -Inductive aexp : Type := - | ANum : nat -> aexp - | APlus : aexp -> aexp -> aexp - | AMinus : aexp -> aexp -> aexp - | AMult : aexp -> aexp -> aexp. - -Inductive bexp : Type := - | BTrue : bexp - | BFalse : bexp - | BEq : aexp -> aexp -> bexp - | BLe : aexp -> aexp -> bexp - | BNot : bexp -> bexp - | BAnd : bexp -> bexp -> bexp. - -(** In this chapter, we'll elide the translation from the - concrete syntax that a programmer would actually write to these - abstract syntax trees -- the process that, for example, would - translate the string ["1+2*3"] to the AST [APlus (ANum - 1) (AMult (ANum 2) (ANum 3))]. The optional chapter [ImpParser] - develops a simple implementation of a lexical analyzer and parser - that can perform this translation. You do _not_ need to - understand that file to understand this one, but if you haven't - taken a course where these techniques are covered (e.g., a - compilers course) you may want to skim it. *) - -(** *** *) -(** For comparison, here's a conventional BNF (Backus-Naur Form) - grammar defining the same abstract syntax: - a ::= nat - | a + a - | a - a - | a * a - - b ::= true - | false - | a = a - | a <= a - | not b - | b and b -*) - -(** Compared to the Coq version above... - - - The BNF is more informal -- for example, it gives some - suggestions about the surface syntax of expressions (like the - fact that the addition operation is written [+] and is an - infix symbol) while leaving other aspects of lexical analysis - and parsing (like the relative precedence of [+], [-], and - [*]) unspecified. Some additional information -- and human - intelligence -- would be required to turn this description - into a formal definition (when implementing a compiler, for - example). - - The Coq version consistently omits all this information and - concentrates on the abstract syntax only. - - - On the other hand, the BNF version is lighter and - easier to read. Its informality makes it flexible, which is - a huge advantage in situations like discussions at the - blackboard, where conveying general ideas is more important - than getting every detail nailed down precisely. - - Indeed, there are dozens of BNF-like notations and people - switch freely among them, usually without bothering to say which - form of BNF they're using because there is no need to: a - rough-and-ready informal understanding is all that's - needed. *) - -(** It's good to be comfortable with both sorts of notations: - informal ones for communicating between humans and formal ones for - carrying out implementations and proofs. *) - -(* ####################################################### *) -(** ** Evaluation *) - -(** _Evaluating_ an arithmetic expression produces a number. *) - -Fixpoint aeval (a : aexp) : nat := - match a with - | ANum n => n - | APlus a1 a2 => (aeval a1) + (aeval a2) - | AMinus a1 a2 => (aeval a1) - (aeval a2) - | AMult a1 a2 => (aeval a1) * (aeval a2) - end. - -Example test_aeval1: - aeval (APlus (ANum 2) (ANum 2)) = 4. -Proof. reflexivity. Qed. - -(** *** *) -(** Similarly, evaluating a boolean expression yields a boolean. *) - -Fixpoint beval (b : bexp) : bool := - match b with - | BTrue => true - | BFalse => false - | BEq a1 a2 => beq_nat (aeval a1) (aeval a2) - | BLe a1 a2 => ble_nat (aeval a1) (aeval a2) - | BNot b1 => negb (beval b1) - | BAnd b1 b2 => andb (beval b1) (beval b2) - end. - -(* ####################################################### *) -(** ** Optimization *) - -(** We haven't defined very much yet, but we can already get - some mileage out of the definitions. Suppose we define a function - that takes an arithmetic expression and slightly simplifies it, - changing every occurrence of [0+e] (i.e., [(APlus (ANum 0) e]) - into just [e]. *) - -Fixpoint optimize_0plus (a:aexp) : aexp := - match a with - | ANum n => - ANum n - | APlus (ANum 0) e2 => - optimize_0plus e2 - | APlus e1 e2 => - APlus (optimize_0plus e1) (optimize_0plus e2) - | AMinus e1 e2 => - AMinus (optimize_0plus e1) (optimize_0plus e2) - | AMult e1 e2 => - AMult (optimize_0plus e1) (optimize_0plus e2) - end. - -(** To make sure our optimization is doing the right thing we - can test it on some examples and see if the output looks OK. *) - -Example test_optimize_0plus: - optimize_0plus (APlus (ANum 2) - (APlus (ANum 0) - (APlus (ANum 0) (ANum 1)))) - = APlus (ANum 2) (ANum 1). -Proof. reflexivity. Qed. - -(** But if we want to be sure the optimization is correct -- - i.e., that evaluating an optimized expression gives the same - result as the original -- we should prove it. *) - -Theorem optimize_0plus_sound: forall a, - aeval (optimize_0plus a) = aeval a. -Proof. - intros a. induction a. - Case "ANum". reflexivity. - Case "APlus". destruct a1. - SCase "a1 = ANum n". destruct n. - SSCase "n = 0". simpl. apply IHa2. - SSCase "n <> 0". simpl. rewrite IHa2. reflexivity. - SCase "a1 = APlus a1_1 a1_2". - simpl. simpl in IHa1. rewrite IHa1. - rewrite IHa2. reflexivity. - SCase "a1 = AMinus a1_1 a1_2". - simpl. simpl in IHa1. rewrite IHa1. - rewrite IHa2. reflexivity. - SCase "a1 = AMult a1_1 a1_2". - simpl. simpl in IHa1. rewrite IHa1. - rewrite IHa2. reflexivity. - Case "AMinus". - simpl. rewrite IHa1. rewrite IHa2. reflexivity. - Case "AMult". - simpl. rewrite IHa1. rewrite IHa2. reflexivity. Qed. - -(* ####################################################### *) -(** * Coq Automation *) - -(** The repetition in this last proof is starting to be a little - annoying. If either the language of arithmetic expressions or the - optimization being proved sound were significantly more complex, - it would begin to be a real problem. - - So far, we've been doing all our proofs using just a small handful - of Coq's tactics and completely ignoring its powerful facilities - for constructing parts of proofs automatically. This section - introduces some of these facilities, and we will see more over the - next several chapters. Getting used to them will take some - energy -- Coq's automation is a power tool -- but it will allow us - to scale up our efforts to more complex definitions and more - interesting properties without becoming overwhelmed by boring, - repetitive, low-level details. *) - -(* ####################################################### *) -(** ** Tacticals *) - -(** _Tacticals_ is Coq's term for tactics that take other tactics as - arguments -- "higher-order tactics," if you will. *) - -(* ####################################################### *) -(** *** The [repeat] Tactical *) - -(** The [repeat] tactical takes another tactic and keeps applying - this tactic until the tactic fails. Here is an example showing - that [100] is even using repeat. *) - -Theorem ev100 : ev 100. -Proof. - repeat (apply ev_SS). (* applies ev_SS 50 times, - until [apply ev_SS] fails *) - apply ev_0. -Qed. -(* Print ev100. *) - -(** The [repeat T] tactic never fails; if the tactic [T] doesn't apply - to the original goal, then repeat still succeeds without changing - the original goal (it repeats zero times). *) - -Theorem ev100' : ev 100. -Proof. - repeat (apply ev_0). (* doesn't fail, applies ev_0 zero times *) - repeat (apply ev_SS). apply ev_0. (* we can continue the proof *) -Qed. - -(** The [repeat T] tactic does not have any bound on the number of - times it applies [T]. If [T] is a tactic that always succeeds then - repeat [T] will loop forever (e.g. [repeat simpl] loops forever - since [simpl] always succeeds). While Coq's term language is - guaranteed to terminate, Coq's tactic language is not! *) - -(* ####################################################### *) -(** *** The [try] Tactical *) - -(** If [T] is a tactic, then [try T] is a tactic that is just like [T] - except that, if [T] fails, [try T] _successfully_ does nothing at - all (instead of failing). *) - -Theorem silly1 : forall ae, aeval ae = aeval ae. -Proof. try reflexivity. (* this just does [reflexivity] *) Qed. - -Theorem silly2 : forall (P : Prop), P -> P. -Proof. - intros P HP. - try reflexivity. (* just [reflexivity] would have failed *) - apply HP. (* we can still finish the proof in some other way *) -Qed. - -(** Using [try] in a completely manual proof is a bit silly, but - we'll see below that [try] is very useful for doing automated - proofs in conjunction with the [;] tactical. *) - -(* ####################################################### *) -(** *** The [;] Tactical (Simple Form) *) - -(** In its most commonly used form, the [;] tactical takes two tactics - as argument: [T;T'] first performs the tactic [T] and then - performs the tactic [T'] on _each subgoal_ generated by [T]. *) - -(** For example, consider the following trivial lemma: *) - -Lemma foo : forall n, ble_nat 0 n = true. -Proof. - intros. - destruct n. - (* Leaves two subgoals, which are discharged identically... *) - Case "n=0". simpl. reflexivity. - Case "n=Sn'". simpl. reflexivity. -Qed. - -(** We can simplify this proof using the [;] tactical: *) - -Lemma foo' : forall n, ble_nat 0 n = true. -Proof. - intros. - destruct n; (* [destruct] the current goal *) - simpl; (* then [simpl] each resulting subgoal *) - reflexivity. (* and do [reflexivity] on each resulting subgoal *) -Qed. - -(** Using [try] and [;] together, we can get rid of the repetition in - the proof that was bothering us a little while ago. *) - -Theorem optimize_0plus_sound': forall a, - aeval (optimize_0plus a) = aeval a. -Proof. - intros a. - induction a; - (* Most cases follow directly by the IH *) - try (simpl; rewrite IHa1; rewrite IHa2; reflexivity). - (* The remaining cases -- ANum and APlus -- are different *) - Case "ANum". reflexivity. - Case "APlus". - destruct a1; - (* Again, most cases follow directly by the IH *) - try (simpl; simpl in IHa1; rewrite IHa1; - rewrite IHa2; reflexivity). - (* The interesting case, on which the [try...] does nothing, - is when [e1 = ANum n]. In this case, we have to destruct - [n] (to see whether the optimization applies) and rewrite - with the induction hypothesis. *) - SCase "a1 = ANum n". destruct n; - simpl; rewrite IHa2; reflexivity. Qed. - -(** Coq experts often use this "[...; try... ]" idiom after a tactic - like [induction] to take care of many similar cases all at once. - Naturally, this practice has an analog in informal proofs. - - Here is an informal proof of this theorem that matches the - structure of the formal one: - - _Theorem_: For all arithmetic expressions [a], - aeval (optimize_0plus a) = aeval a. - _Proof_: By induction on [a]. The [AMinus] and [AMult] cases - follow directly from the IH. The remaining cases are as follows: - - - Suppose [a = ANum n] for some [n]. We must show - aeval (optimize_0plus (ANum n)) = aeval (ANum n). - This is immediate from the definition of [optimize_0plus]. - - - Suppose [a = APlus a1 a2] for some [a1] and [a2]. We - must show - aeval (optimize_0plus (APlus a1 a2)) - = aeval (APlus a1 a2). - Consider the possible forms of [a1]. For most of them, - [optimize_0plus] simply calls itself recursively for the - subexpressions and rebuilds a new expression of the same form - as [a1]; in these cases, the result follows directly from the - IH. - - The interesting case is when [a1 = ANum n] for some [n]. - If [n = ANum 0], then - optimize_0plus (APlus a1 a2) = optimize_0plus a2 - and the IH for [a2] is exactly what we need. On the other - hand, if [n = S n'] for some [n'], then again [optimize_0plus] - simply calls itself recursively, and the result follows from - the IH. [] *) - -(** This proof can still be improved: the first case (for [a = ANum - n]) is very trivial -- even more trivial than the cases that we - said simply followed from the IH -- yet we have chosen to write it - out in full. It would be better and clearer to drop it and just - say, at the top, "Most cases are either immediate or direct from - the IH. The only interesting case is the one for [APlus]..." We - can make the same improvement in our formal proof too. Here's how - it looks: *) - -Theorem optimize_0plus_sound'': forall a, - aeval (optimize_0plus a) = aeval a. -Proof. - intros a. - induction a; - (* Most cases follow directly by the IH *) - try (simpl; rewrite IHa1; rewrite IHa2; reflexivity); - (* ... or are immediate by definition *) - try reflexivity. - (* The interesting case is when a = APlus a1 a2. *) - Case "APlus". - destruct a1; try (simpl; simpl in IHa1; rewrite IHa1; - rewrite IHa2; reflexivity). - SCase "a1 = ANum n". destruct n; - simpl; rewrite IHa2; reflexivity. Qed. - -(* ####################################################### *) -(** *** The [;] Tactical (General Form) *) - -(** The [;] tactical has a more general than the simple [T;T'] we've - seen above, which is sometimes also useful. If [T], [T1], ..., - [Tn] are tactics, then - T; [T1 | T2 | ... | Tn] - is a tactic that first performs [T] and then performs [T1] on the - first subgoal generated by [T], performs [T2] on the second - subgoal, etc. - - So [T;T'] is just special notation for the case when all of the - [Ti]'s are the same tactic; i.e. [T;T'] is just a shorthand for: - T; [T' | T' | ... | T'] -*) - -(* ####################################################### *) -(** ** Defining New Tactic Notations *) - -(** Coq also provides several ways of "programming" tactic scripts. - - - The [Tactic Notation] idiom illustrated below gives a handy - way to define "shorthand tactics" that bundle several tactics - into a single command. - - - For more sophisticated programming, Coq offers a small - built-in programming language called [Ltac] with primitives - that can examine and modify the proof state. The details are - a bit too complicated to get into here (and it is generally - agreed that [Ltac] is not the most beautiful part of Coq's - design!), but they can be found in the reference manual, and - there are many examples of [Ltac] definitions in the Coq - standard library that you can use as examples. - - - There is also an OCaml API, which can be used to build tactics - that access Coq's internal structures at a lower level, but - this is seldom worth the trouble for ordinary Coq users. - -The [Tactic Notation] mechanism is the easiest to come to grips with, -and it offers plenty of power for many purposes. Here's an example. -*) - -Tactic Notation "simpl_and_try" tactic(c) := - simpl; - try c. - -(** This defines a new tactical called [simpl_and_try] which - takes one tactic [c] as an argument, and is defined to be - equivalent to the tactic [simpl; try c]. For example, writing - "[simpl_and_try reflexivity.]" in a proof would be the same as - writing "[simpl; try reflexivity.]" *) - -(** The next subsection gives a more sophisticated use of this - feature... *) - -(* ####################################################### *) -(** *** Bulletproofing Case Analyses *) - -(** Being able to deal with most of the cases of an [induction] - or [destruct] all at the same time is very convenient, but it can - also be a little confusing. One problem that often comes up is - that _maintaining_ proofs written in this style can be difficult. - For example, suppose that, later, we extended the definition of - [aexp] with another constructor that also required a special - argument. The above proof might break because Coq generated the - subgoals for this constructor before the one for [APlus], so that, - at the point when we start working on the [APlus] case, Coq is - actually expecting the argument for a completely different - constructor. What we'd like is to get a sensible error message - saying "I was expecting the [AFoo] case at this point, but the - proof script is talking about [APlus]." Here's a nice trick (due - to Aaron Bohannon) that smoothly achieves this. *) - -Tactic Notation "aexp_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ANum" | Case_aux c "APlus" - | Case_aux c "AMinus" | Case_aux c "AMult" ]. - -(** ([Case_aux] implements the common functionality of [Case], - [SCase], [SSCase], etc. For example, [Case "foo"] is defined as - [Case_aux Case "foo".) *) - -(** For example, if [a] is a variable of type [aexp], then doing - aexp_cases (induction a) Case - will perform an induction on [a] (the same as if we had just typed - [induction a]) and _also_ add a [Case] tag to each subgoal - generated by the [induction], labeling which constructor it comes - from. For example, here is yet another proof of - [optimize_0plus_sound], using [aexp_cases]: *) - -Theorem optimize_0plus_sound''': forall a, - aeval (optimize_0plus a) = aeval a. -Proof. - intros a. - aexp_cases (induction a) Case; - try (simpl; rewrite IHa1; rewrite IHa2; reflexivity); - try reflexivity. - (* At this point, there is already an ["APlus"] case name - in the context. The [Case "APlus"] here in the proof - text has the effect of a sanity check: if the "Case" - string in the context is anything _other_ than ["APlus"] - (for example, because we added a clause to the definition - of [aexp] and forgot to change the proof) we'll get a - helpful error at this point telling us that this is now - the wrong case. *) - Case "APlus". - aexp_cases (destruct a1) SCase; - try (simpl; simpl in IHa1; - rewrite IHa1; rewrite IHa2; reflexivity). - SCase "ANum". destruct n; - simpl; rewrite IHa2; reflexivity. Qed. - -(** **** Exercise: 3 stars (optimize_0plus_b) *) -(** Since the [optimize_0plus] tranformation doesn't change the value - of [aexp]s, we should be able to apply it to all the [aexp]s that - appear in a [bexp] without changing the [bexp]'s value. Write a - function which performs that transformation on [bexp]s, and prove - it is sound. Use the tacticals we've just seen to make the proof - as elegant as possible. *) - -Fixpoint optimize_0plus_b (b : bexp) : bexp := - (* FILL IN HERE *) admit. - - -Theorem optimize_0plus_b_sound : forall b, - beval (optimize_0plus_b b) = beval b. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 4 stars, optional (optimizer) *) -(** _Design exercise_: The optimization implemented by our - [optimize_0plus] function is only one of many imaginable - optimizations on arithmetic and boolean expressions. Write a more - sophisticated optimizer and prove it correct. - -(* FILL IN HERE *) -*) -(** [] *) - -(* ####################################################### *) -(** ** The [omega] Tactic *) - -(** The [omega] tactic implements a decision procedure for a subset of - first-order logic called _Presburger arithmetic_. It is based on - the Omega algorithm invented in 1992 by William Pugh. - - If the goal is a universally quantified formula made out of - - - numeric constants, addition ([+] and [S]), subtraction ([-] - and [pred]), and multiplication by constants (this is what - makes it Presburger arithmetic), - - - equality ([=] and [<>]) and inequality ([<=]), and - - - the logical connectives [/\], [\/], [~], and [->], - - then invoking [omega] will either solve the goal or tell you that - it is actually false. *) - -Example silly_presburger_example : forall m n o p, - m + n <= n + o /\ o + 3 = p + 3 -> - m <= p. -Proof. - intros. omega. -Qed. - -(** Liebniz wrote, "It is unworthy of excellent men to lose - hours like slaves in the labor of calculation which could be - relegated to anyone else if machines were used." We recommend - using the omega tactic whenever possible. *) - -(* ####################################################### *) -(** ** A Few More Handy Tactics *) - -(** Finally, here are some miscellaneous tactics that you may find - convenient. - - - [clear H]: Delete hypothesis [H] from the context. - - - [subst x]: Find an assumption [x = e] or [e = x] in the - context, replace [x] with [e] throughout the context and - current goal, and clear the assumption. - - - [subst]: Substitute away _all_ assumptions of the form [x = e] - or [e = x]. - - - [rename... into...]: Change the name of a hypothesis in the - proof context. For example, if the context includes a variable - named [x], then [rename x into y] will change all occurrences - of [x] to [y]. - - - [assumption]: Try to find a hypothesis [H] in the context that - exactly matches the goal; if one is found, behave just like - [apply H]. - - - [contradiction]: Try to find a hypothesis [H] in the current - context that is logically equivalent to [False]. If one is - found, solve the goal. - - - [constructor]: Try to find a constructor [c] (from some - [Inductive] definition in the current environment) that can be - applied to solve the current goal. If one is found, behave - like [apply c]. *) - -(** We'll see many examples of these in the proofs below. *) - -(* ####################################################### *) -(** * Evaluation as a Relation *) - -(** We have presented [aeval] and [beval] as functions defined by - [Fixpoints]. Another way to think about evaluation -- one that we - will see is often more flexible -- is as a _relation_ between - expressions and their values. This leads naturally to [Inductive] - definitions like the following one for arithmetic - expressions... *) - -Module aevalR_first_try. - -Inductive aevalR : aexp -> nat -> Prop := - | E_ANum : forall (n: nat), - aevalR (ANum n) n - | E_APlus : forall (e1 e2: aexp) (n1 n2: nat), - aevalR e1 n1 -> - aevalR e2 n2 -> - aevalR (APlus e1 e2) (n1 + n2) - | E_AMinus: forall (e1 e2: aexp) (n1 n2: nat), - aevalR e1 n1 -> - aevalR e2 n2 -> - aevalR (AMinus e1 e2) (n1 - n2) - | E_AMult : forall (e1 e2: aexp) (n1 n2: nat), - aevalR e1 n1 -> - aevalR e2 n2 -> - aevalR (AMult e1 e2) (n1 * n2). - -(** As is often the case with relations, we'll find it - convenient to define infix notation for [aevalR]. We'll write [e - || n] to mean that arithmetic expression [e] evaluates to value - [n]. (This notation is one place where the limitation to ASCII - symbols becomes a little bothersome. The standard notation for - the evaluation relation is a double down-arrow. We'll typeset it - like this in the HTML version of the notes and use a double - vertical bar as the closest approximation in [.v] files.) *) - -Notation "e '||' n" := (aevalR e n) : type_scope. - -End aevalR_first_try. - -(** In fact, Coq provides a way to use this notation in the definition - of [aevalR] itself. This avoids situations where we're working on - a proof involving statements in the form [e || n] but we have to - refer back to a definition written using the form [aevalR e n]. - - We do this by first "reserving" the notation, then giving the - definition together with a declaration of what the notation - means. *) - -Reserved Notation "e '||' n" (at level 50, left associativity). - -Inductive aevalR : aexp -> nat -> Prop := - | E_ANum : forall (n:nat), - (ANum n) || n - | E_APlus : forall (e1 e2: aexp) (n1 n2 : nat), - (e1 || n1) -> (e2 || n2) -> (APlus e1 e2) || (n1 + n2) - | E_AMinus : forall (e1 e2: aexp) (n1 n2 : nat), - (e1 || n1) -> (e2 || n2) -> (AMinus e1 e2) || (n1 - n2) - | E_AMult : forall (e1 e2: aexp) (n1 n2 : nat), - (e1 || n1) -> (e2 || n2) -> (AMult e1 e2) || (n1 * n2) - - where "e '||' n" := (aevalR e n) : type_scope. - -Tactic Notation "aevalR_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_ANum" | Case_aux c "E_APlus" - | Case_aux c "E_AMinus" | Case_aux c "E_AMult" ]. - -(* ####################################################### *) -(** ** Inference Rule Notation *) - -(** In informal discussions, it is convenient write the rules for - [aevalR] and similar relations in the more readable graphical form - of _inference rules_, where the premises above the line justify - the conclusion below the line (we have already seen them in the - Prop chapter). *) - -(** For example, the constructor [E_APlus]... - | E_APlus : forall (e1 e2: aexp) (n1 n2: nat), - aevalR e1 n1 -> - aevalR e2 n2 -> - aevalR (APlus e1 e2) (n1 + n2) - ...would be written like this as an inference rule: - e1 || n1 - e2 || n2 - -------------------- (E_APlus) - APlus e1 e2 || n1+n2 -*) - -(** Formally, there is nothing very deep about inference rules: - they are just implications. You can read the rule name on the - right as the name of the constructor and read each of the - linebreaks between the premises above the line and the line itself - as [->]. All the variables mentioned in the rule ([e1], [n1], - etc.) are implicitly bound by universal quantifiers at the - beginning. (Such variables are often called _metavariables_ to - distinguish them from the variables of the language we are - defining. At the moment, our arithmetic expressions don't include - variables, but we'll soon be adding them.) The whole collection - of rules is understood as being wrapped in an [Inductive] - declaration (informally, this is either elided or else indicated - by saying something like "Let [aevalR] be the smallest relation - closed under the following rules..."). *) - -(** For example, [||] is the smallest relation closed under these - rules: - ----------- (E_ANum) - ANum n || n - - e1 || n1 - e2 || n2 - -------------------- (E_APlus) - APlus e1 e2 || n1+n2 - - e1 || n1 - e2 || n2 - --------------------- (E_AMinus) - AMinus e1 e2 || n1-n2 - - e1 || n1 - e2 || n2 - -------------------- (E_AMult) - AMult e1 e2 || n1*n2 -*) - - - -(* ####################################################### *) -(** ** Equivalence of the Definitions *) - -(** It is straightforward to prove that the relational and functional - definitions of evaluation agree on all possible arithmetic - expressions... *) - -Theorem aeval_iff_aevalR : forall a n, - (a || n) <-> aeval a = n. -Proof. - split. - Case "->". - intros H. - aevalR_cases (induction H) SCase; simpl. - SCase "E_ANum". - reflexivity. - SCase "E_APlus". - rewrite IHaevalR1. rewrite IHaevalR2. reflexivity. - SCase "E_AMinus". - rewrite IHaevalR1. rewrite IHaevalR2. reflexivity. - SCase "E_AMult". - rewrite IHaevalR1. rewrite IHaevalR2. reflexivity. - Case "<-". - generalize dependent n. - aexp_cases (induction a) SCase; - simpl; intros; subst. - SCase "ANum". - apply E_ANum. - SCase "APlus". - apply E_APlus. - apply IHa1. reflexivity. - apply IHa2. reflexivity. - SCase "AMinus". - apply E_AMinus. - apply IHa1. reflexivity. - apply IHa2. reflexivity. - SCase "AMult". - apply E_AMult. - apply IHa1. reflexivity. - apply IHa2. reflexivity. -Qed. - -(** Note: if you're reading the HTML file, you'll see an empty square box instead -of a proof for this theorem. -You can click on this box to "unfold" the text to see the proof. -Click on the unfolded to text to "fold" it back up to a box. We'll be using -this style frequently from now on to help keep the HTML easier to read. -The full proofs always appear in the .v files. *) - -(** We can make the proof quite a bit shorter by making more - use of tacticals... *) - -Theorem aeval_iff_aevalR' : forall a n, - (a || n) <-> aeval a = n. -Proof. - (* WORKED IN CLASS *) - split. - Case "->". - intros H; induction H; subst; reflexivity. - Case "<-". - generalize dependent n. - induction a; simpl; intros; subst; constructor; - try apply IHa1; try apply IHa2; reflexivity. -Qed. - -(** **** Exercise: 3 stars (bevalR) *) -(** Write a relation [bevalR] in the same style as - [aevalR], and prove that it is equivalent to [beval].*) - -(* -Inductive bevalR: -(* FILL IN HERE *) -*) -(** [] *) -End AExp. - -(* ####################################################### *) -(** ** Computational vs. Relational Definitions *) - -(** For the definitions of evaluation for arithmetic and boolean - expressions, the choice of whether to use functional or relational - definitions is mainly a matter of taste. In general, Coq has - somewhat better support for working with relations. On the other - hand, in some sense function definitions carry more information, - because functions are necessarily deterministic and defined on all - arguments; for a relation we have to show these properties - explicitly if we need them. Functions also take advantage of Coq's - computations mechanism. - - However, there are circumstances where relational definitions of - evaluation are preferable to functional ones. *) - -Module aevalR_division. - -(** For example, suppose that we wanted to extend the arithmetic - operations by considering also a division operation:*) - -Inductive aexp : Type := - | ANum : nat -> aexp - | APlus : aexp -> aexp -> aexp - | AMinus : aexp -> aexp -> aexp - | AMult : aexp -> aexp -> aexp - | ADiv : aexp -> aexp -> aexp. (* <--- new *) - -(** Extending the definition of [aeval] to handle this new operation - would not be straightforward (what should we return as the result - of [ADiv (ANum 5) (ANum 0)]?). But extending [aevalR] is - straightforward. *) - -Inductive aevalR : aexp -> nat -> Prop := - | E_ANum : forall (n:nat), - (ANum n) || n - | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), - (a1 || n1) -> (a2 || n2) -> (APlus a1 a2) || (n1 + n2) - | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), - (a1 || n1) -> (a2 || n2) -> (AMinus a1 a2) || (n1 - n2) - | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), - (a1 || n1) -> (a2 || n2) -> (AMult a1 a2) || (n1 * n2) - | E_ADiv : forall (a1 a2: aexp) (n1 n2 n3: nat), - (a1 || n1) -> (a2 || n2) -> (mult n2 n3 = n1) -> (ADiv a1 a2) || n3 - -where "a '||' n" := (aevalR a n) : type_scope. - -End aevalR_division. -Module aevalR_extended. - - -(** *** Adding nondeterminism *) -(* /TERSE *) -(** Suppose, instead, that we want to extend the arithmetic operations - by a nondeterministic number generator [any]:*) - -Inductive aexp : Type := - | AAny : aexp (* <--- NEW *) - | ANum : nat -> aexp - | APlus : aexp -> aexp -> aexp - | AMinus : aexp -> aexp -> aexp - | AMult : aexp -> aexp -> aexp. - -(** Again, extending [aeval] would be tricky (because evaluation is - _not_ a deterministic function from expressions to numbers), but - extending [aevalR] is no problem: *) - -Inductive aevalR : aexp -> nat -> Prop := - | E_Any : forall (n:nat), - AAny || n (* <--- new *) - | E_ANum : forall (n:nat), - (ANum n) || n - | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), - (a1 || n1) -> (a2 || n2) -> (APlus a1 a2) || (n1 + n2) - | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), - (a1 || n1) -> (a2 || n2) -> (AMinus a1 a2) || (n1 - n2) - | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), - (a1 || n1) -> (a2 || n2) -> (AMult a1 a2) || (n1 * n2) - -where "a '||' n" := (aevalR a n) : type_scope. - -End aevalR_extended. - -(** * Expressions With Variables *) - -(** Let's turn our attention back to defining Imp. The next thing we - need to do is to enrich our arithmetic and boolean expressions - with variables. To keep things simple, we'll assume that all - variables are global and that they only hold numbers. *) - -(* ##################################################### *) -(** ** Identifiers *) - -(** To begin, we'll need to formalize _identifiers_ such as program - variables. We could use strings for this -- or, in a real - compiler, fancier structures like pointers into a symbol table. - But for simplicity let's just use natural numbers as identifiers. *) - -(** (We hide this section in a module because these definitions are - actually in [SfLib], but we want to repeat them here so that we - can explain them.) *) - -Module Id. - -(** We define a new inductive datatype [Id] so that we won't confuse - identifiers and numbers. We use [sumbool] to define a computable - equality operator on [Id]. *) - -Inductive id : Type := - Id : nat -> id. - -Theorem eq_id_dec : forall id1 id2 : id, {id1 = id2} + {id1 <> id2}. -Proof. - intros id1 id2. - destruct id1 as [n1]. destruct id2 as [n2]. - destruct (eq_nat_dec n1 n2) as [Heq | Hneq]. - Case "n1 = n2". - left. rewrite Heq. reflexivity. - Case "n1 <> n2". - right. intros contra. inversion contra. apply Hneq. apply H0. -Defined. - - -(** The following lemmas will be useful for rewriting terms involving [eq_id_dec]. *) - -Lemma eq_id : forall (T:Type) x (p q:T), - (if eq_id_dec x x then p else q) = p. -Proof. - intros. - destruct (eq_id_dec x x). - Case "x = x". - reflexivity. - Case "x <> x (impossible)". - apply ex_falso_quodlibet; apply n; reflexivity. Qed. - -(** **** Exercise: 1 star, optional (neq_id) *) -Lemma neq_id : forall (T:Type) x y (p q:T), x <> y -> - (if eq_id_dec x y then p else q) = q. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -End Id. - -(* ####################################################### *) -(** ** States *) - -(** A _state_ represents the current values of _all_ the variables at - some point in the execution of a program. *) -(** For simplicity (to avoid dealing with partial functions), we - let the state be defined for _all_ variables, even though any - given program is only going to mention a finite number of them. - The state captures all of the information stored in memory. For Imp - programs, because each variable stores only a natural number, we - can represent the state as a mapping from identifiers to [nat]. - For more complex programming languages, the state might have more - structure. -*) - -Definition state := id -> nat. - -Definition empty_state : state := - fun _ => 0. - -Definition update (st : state) (x : id) (n : nat) : state := - fun x' => if eq_id_dec x x' then n else st x'. - -(** For proofs involving states, we'll need several simple properties - of [update]. *) - -(** **** Exercise: 1 star (update_eq) *) -Theorem update_eq : forall n x st, - (update st x n) x = n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star (update_neq) *) -Theorem update_neq : forall x2 x1 n st, - x2 <> x1 -> - (update st x2 n) x1 = (st x1). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star (update_example) *) -(** Before starting to play with tactics, make sure you understand - exactly what the theorem is saying! *) - -Theorem update_example : forall (n:nat), - (update empty_state (Id 2) n) (Id 3) = 0. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star (update_shadow) *) -Theorem update_shadow : forall n1 n2 x1 x2 (st : state), - (update (update st x2 n1) x2 n2) x1 = (update st x2 n2) x1. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (update_same) *) -Theorem update_same : forall n1 x1 x2 (st : state), - st x1 = n1 -> - (update st x1 n1) x2 = st x2. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (update_permute) *) -Theorem update_permute : forall n1 n2 x1 x2 x3 st, - x2 <> x1 -> - (update (update st x2 n1) x1 n2) x3 = (update (update st x1 n2) x2 n1) x3. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ################################################### *) -(** ** Syntax *) - -(** We can add variables to the arithmetic expressions we had before by - simply adding one more constructor: *) - -Inductive aexp : Type := - | ANum : nat -> aexp - | AId : id -> aexp (* <----- NEW *) - | APlus : aexp -> aexp -> aexp - | AMinus : aexp -> aexp -> aexp - | AMult : aexp -> aexp -> aexp. - -Tactic Notation "aexp_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ANum" | Case_aux c "AId" | Case_aux c "APlus" - | Case_aux c "AMinus" | Case_aux c "AMult" ]. - -(** Defining a few variable names as notational shorthands will make - examples easier to read: *) - -Definition X : id := Id 0. -Definition Y : id := Id 1. -Definition Z : id := Id 2. - -(** (This convention for naming program variables ([X], [Y], - [Z]) clashes a bit with our earlier use of uppercase letters for - types. Since we're not using polymorphism heavily in this part of - the course, this overloading should not cause confusion.) *) - -(** The definition of [bexp]s is the same as before (using the new - [aexp]s): *) - -Inductive bexp : Type := - | BTrue : bexp - | BFalse : bexp - | BEq : aexp -> aexp -> bexp - | BLe : aexp -> aexp -> bexp - | BNot : bexp -> bexp - | BAnd : bexp -> bexp -> bexp. - -Tactic Notation "bexp_cases" tactic(first) ident(c) := - first; - [ Case_aux c "BTrue" | Case_aux c "BFalse" | Case_aux c "BEq" - | Case_aux c "BLe" | Case_aux c "BNot" | Case_aux c "BAnd" ]. - -(* ################################################### *) -(** ** Evaluation *) - -(** The arith and boolean evaluators can be extended to handle - variables in the obvious way: *) - -Fixpoint aeval (st : state) (a : aexp) : nat := - match a with - | ANum n => n - | AId x => st x (* <----- NEW *) - | APlus a1 a2 => (aeval st a1) + (aeval st a2) - | AMinus a1 a2 => (aeval st a1) - (aeval st a2) - | AMult a1 a2 => (aeval st a1) * (aeval st a2) - end. - -Fixpoint beval (st : state) (b : bexp) : bool := - match b with - | BTrue => true - | BFalse => false - | BEq a1 a2 => beq_nat (aeval st a1) (aeval st a2) - | BLe a1 a2 => ble_nat (aeval st a1) (aeval st a2) - | BNot b1 => negb (beval st b1) - | BAnd b1 b2 => andb (beval st b1) (beval st b2) - end. - -Example aexp1 : - aeval (update empty_state X 5) - (APlus (ANum 3) (AMult (AId X) (ANum 2))) - = 13. -Proof. reflexivity. Qed. - -Example bexp1 : - beval (update empty_state X 5) - (BAnd BTrue (BNot (BLe (AId X) (ANum 4)))) - = true. -Proof. reflexivity. Qed. - -(* ####################################################### *) -(** * Commands *) - -(** Now we are ready define the syntax and behavior of Imp - _commands_ (often called _statements_). *) - -(* ################################################### *) -(** ** Syntax *) - -(** Informally, commands [c] are described by the following BNF - grammar: - c ::= SKIP - | x ::= a - | c ;; c - | WHILE b DO c END - | IFB b THEN c ELSE c FI -]] -*) -(** - For example, here's the factorial function in Imp. - Z ::= X;; - Y ::= 1;; - WHILE not (Z = 0) DO - Y ::= Y * Z;; - Z ::= Z - 1 - END - When this command terminates, the variable [Y] will contain the - factorial of the initial value of [X]. -*) - -(** Here is the formal definition of the syntax of commands: *) - -Inductive com : Type := - | CSkip : com - | CAss : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com. - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";;" - | Case_aux c "IFB" | Case_aux c "WHILE" ]. - -(** As usual, we can use a few [Notation] declarations to make things - more readable. We need to be a bit careful to avoid conflicts - with Coq's built-in notations, so we'll keep this light -- in - particular, we won't introduce any notations for [aexps] and - [bexps] to avoid confusion with the numerical and boolean - operators we've already defined. We use the keyword [IFB] for - conditionals instead of [IF], for similar reasons. *) - -Notation "'SKIP'" := - CSkip. -Notation "x '::=' a" := - (CAss x a) (at level 60). -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := - (CIf c1 c2 c3) (at level 80, right associativity). - -(** For example, here is the factorial function again, written as a - formal definition to Coq: *) - -Definition fact_in_coq : com := - Z ::= AId X;; - Y ::= ANum 1;; - WHILE BNot (BEq (AId Z) (ANum 0)) DO - Y ::= AMult (AId Y) (AId Z);; - Z ::= AMinus (AId Z) (ANum 1) - END. - -(* ####################################################### *) -(** ** Examples *) - -(** Assignment: *) - -Definition plus2 : com := - X ::= (APlus (AId X) (ANum 2)). - -Definition XtimesYinZ : com := - Z ::= (AMult (AId X) (AId Y)). - -Definition subtract_slowly_body : com := - Z ::= AMinus (AId Z) (ANum 1) ;; - X ::= AMinus (AId X) (ANum 1). - - -(** *** Loops *) - -Definition subtract_slowly : com := - WHILE BNot (BEq (AId X) (ANum 0)) DO - subtract_slowly_body - END. - -Definition subtract_3_from_5_slowly : com := - X ::= ANum 3 ;; - Z ::= ANum 5 ;; - subtract_slowly. - - -(** *** An infinite loop: *) - -Definition loop : com := - WHILE BTrue DO - SKIP - END. - -(* ################################################################ *) -(** * Evaluation *) - -(** Next we need to define what it means to evaluate an Imp command. - The fact that [WHILE] loops don't necessarily terminate makes defining - an evaluation function tricky... *) - -(* #################################### *) -(** ** Evaluation as a Function (Failed Attempt) *) - -(** Here's an attempt at defining an evaluation function for commands, - omitting the [WHILE] case. *) - -Fixpoint ceval_fun_no_while (st : state) (c : com) : state := - match c with - | SKIP => - st - | x ::= a1 => - update st x (aeval st a1) - | c1 ;; c2 => - let st' := ceval_fun_no_while st c1 in - ceval_fun_no_while st' c2 - | IFB b THEN c1 ELSE c2 FI => - if (beval st b) - then ceval_fun_no_while st c1 - else ceval_fun_no_while st c2 - | WHILE b DO c END => - st (* bogus *) - end. -(** In a traditional functional programming language like ML or - Haskell we could write the [WHILE] case as follows: -<< - Fixpoint ceval_fun (st : state) (c : com) : state := - match c with - ... - | WHILE b DO c END => - if (beval st b1) - then ceval_fun st (c1; WHILE b DO c END) - else st - end. ->> - Coq doesn't accept such a definition ("Error: Cannot guess - decreasing argument of fix") because the function we want to - define is not guaranteed to terminate. Indeed, it doesn't always - terminate: for example, the full version of the [ceval_fun] - function applied to the [loop] program above would never - terminate. Since Coq is not just a functional programming - language, but also a consistent logic, any potentially - non-terminating function needs to be rejected. Here is - an (invalid!) Coq program showing what would go wrong if Coq - allowed non-terminating recursive functions: -<< - Fixpoint loop_false (n : nat) : False := loop_false n. ->> - That is, propositions like [False] would become provable - (e.g. [loop_false 0] would be a proof of [False]), which - would be a disaster for Coq's logical consistency. - - Thus, because it doesn't terminate on all inputs, the full version - of [ceval_fun] cannot be written in Coq -- at least not without - additional tricks (see chapter [ImpCEvalFun] if curious). *) - -(* #################################### *) -(** ** Evaluation as a Relation *) - -(** Here's a better way: we define [ceval] as a _relation_ rather than - a _function_ -- i.e., we define it in [Prop] instead of [Type], as - we did for [aevalR] above. *) - -(** This is an important change. Besides freeing us from the awkward - workarounds that would be needed to define evaluation as a - function, it gives us a lot more flexibility in the definition. - For example, if we added concurrency features to the language, - we'd want the definition of evaluation to be non-deterministic -- - i.e., not only would it not be total, it would not even be a - partial function! *) -(** We'll use the notation [c / st || st'] for our [ceval] relation: - [c / st || st'] means that executing program [c] in a starting - state [st] results in an ending state [st']. This can be - pronounced "[c] takes state [st] to [st']". - -*) -(** *** Operational Semantics - ---------------- (E_Skip) - SKIP / st || st - - aeval st a1 = n - -------------------------------- (E_Ass) - x := a1 / st || (update st x n) - - c1 / st || st' - c2 / st' || st'' - ------------------- (E_Seq) - c1;;c2 / st || st'' - - beval st b1 = true - c1 / st || st' - ------------------------------------- (E_IfTrue) - IF b1 THEN c1 ELSE c2 FI / st || st' - - beval st b1 = false - c2 / st || st' - ------------------------------------- (E_IfFalse) - IF b1 THEN c1 ELSE c2 FI / st || st' - - beval st b1 = false - ------------------------------ (E_WhileEnd) - WHILE b DO c END / st || st - - beval st b1 = true - c / st || st' - WHILE b DO c END / st' || st'' - --------------------------------- (E_WhileLoop) - WHILE b DO c END / st || st'' -*) - -(** Here is the formal definition. (Make sure you understand - how it corresponds to the inference rules.) *) - -Reserved Notation "c1 '/' st '||' st'" (at level 40, st at level 39). - -Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st, - SKIP / st || st - | E_Ass : forall st a1 n x, - aeval st a1 = n -> - (x ::= a1) / st || (update st x n) - | E_Seq : forall c1 c2 st st' st'', - c1 / st || st' -> - c2 / st' || st'' -> - (c1 ;; c2) / st || st'' - | E_IfTrue : forall st st' b c1 c2, - beval st b = true -> - c1 / st || st' -> - (IFB b THEN c1 ELSE c2 FI) / st || st' - | E_IfFalse : forall st st' b c1 c2, - beval st b = false -> - c2 / st || st' -> - (IFB b THEN c1 ELSE c2 FI) / st || st' - | E_WhileEnd : forall b st c, - beval st b = false -> - (WHILE b DO c END) / st || st - | E_WhileLoop : forall st st' st'' b c, - beval st b = true -> - c / st || st' -> - (WHILE b DO c END) / st' || st'' -> - (WHILE b DO c END) / st || st'' - - where "c1 '/' st '||' st'" := (ceval c1 st st'). - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq" - | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" - | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" ]. - -(** *** *) -(** The cost of defining evaluation as a relation instead of a - function is that we now need to construct _proofs_ that some - program evaluates to some result state, rather than just letting - Coq's computation mechanism do it for us. *) - -Example ceval_example1: - (X ::= ANum 2;; - IFB BLe (AId X) (ANum 1) - THEN Y ::= ANum 3 - ELSE Z ::= ANum 4 - FI) - / empty_state - || (update (update empty_state X 2) Z 4). -Proof. - (* We must supply the intermediate state *) - apply E_Seq with (update empty_state X 2). - Case "assignment command". - apply E_Ass. reflexivity. - Case "if command". - apply E_IfFalse. - reflexivity. - apply E_Ass. reflexivity. Qed. - -(** **** Exercise: 2 stars (ceval_example2) *) -Example ceval_example2: - (X ::= ANum 0;; Y ::= ANum 1;; Z ::= ANum 2) / empty_state || - (update (update (update empty_state X 0) Y 1) Z 2). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (pup_to_n) *) -(** Write an Imp program that sums the numbers from [1] to - [X] (inclusive: [1 + 2 + ... + X]) in the variable [Y]. - Prove that this program executes as intended for X = 2 - (this latter part is trickier than you might expect). *) - -Definition pup_to_n : com := - (* FILL IN HERE *) admit. - -Theorem pup_to_2_ceval : - pup_to_n / (update empty_state X 2) || - update (update (update (update (update (update empty_state - X 2) Y 0) Y 2) X 1) Y 3) X 0. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ####################################################### *) -(** ** Determinism of Evaluation *) - -(** Changing from a computational to a relational definition of - evaluation is a good move because it allows us to escape from the - artificial requirement (imposed by Coq's restrictions on - [Fixpoint] definitions) that evaluation should be a total - function. But it also raises a question: Is the second definition - of evaluation actually a partial function? That is, is it - possible that, beginning from the same state [st], we could - evaluate some command [c] in different ways to reach two different - output states [st'] and [st'']? - - In fact, this cannot happen: [ceval] is a partial function. - Here's the proof: *) - -Theorem ceval_deterministic: forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 E1 E2. - generalize dependent st2. - ceval_cases (induction E1) Case; - intros st2 E2; inversion E2; subst. - Case "E_Skip". reflexivity. - Case "E_Ass". reflexivity. - Case "E_Seq". - assert (st' = st'0) as EQ1. - SCase "Proof of assertion". apply IHE1_1; assumption. - subst st'0. - apply IHE1_2. assumption. - Case "E_IfTrue". - SCase "b1 evaluates to true". - apply IHE1. assumption. - SCase "b1 evaluates to false (contradiction)". - rewrite H in H5. inversion H5. - Case "E_IfFalse". - SCase "b1 evaluates to true (contradiction)". - rewrite H in H5. inversion H5. - SCase "b1 evaluates to false". - apply IHE1. assumption. - Case "E_WhileEnd". - SCase "b1 evaluates to false". - reflexivity. - SCase "b1 evaluates to true (contradiction)". - rewrite H in H2. inversion H2. - Case "E_WhileLoop". - SCase "b1 evaluates to false (contradiction)". - rewrite H in H4. inversion H4. - SCase "b1 evaluates to true". - assert (st' = st'0) as EQ1. - SSCase "Proof of assertion". apply IHE1_1; assumption. - subst st'0. - apply IHE1_2. assumption. Qed. - -(* ####################################################### *) -(** * Reasoning About Imp Programs *) - -(** We'll get much deeper into systematic techniques for reasoning - about Imp programs in the following chapters, but we can do quite - a bit just working with the bare definitions. *) - -(* This section explores some examples. *) - -Theorem plus2_spec : forall st n st', - st X = n -> - plus2 / st || st' -> - st' X = n + 2. -Proof. - intros st n st' HX Heval. - (* Inverting Heval essentially forces Coq to expand one - step of the ceval computation - in this case revealing - that st' must be st extended with the new value of X, - since plus2 is an assignment *) - inversion Heval. subst. clear Heval. simpl. - apply update_eq. Qed. - -(** **** Exercise: 3 stars (XtimesYinZ_spec) *) -(** State and prove a specification of [XtimesYinZ]. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars (loop_never_stops) *) -Theorem loop_never_stops : forall st st', - ~(loop / st || st'). -Proof. - intros st st' contra. unfold loop in contra. - remember (WHILE BTrue DO SKIP END) as loopdef eqn:Heqloopdef. - (* Proceed by induction on the assumed derivation showing that - [loopdef] terminates. Most of the cases are immediately - contradictory (and so can be solved in one step with - [inversion]). *) - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (no_whilesR) *) -(** Consider the definition of the [no_whiles] property below: *) - -Fixpoint no_whiles (c : com) : bool := - match c with - | SKIP => true - | _ ::= _ => true - | c1 ;; c2 => andb (no_whiles c1) (no_whiles c2) - | IFB _ THEN ct ELSE cf FI => andb (no_whiles ct) (no_whiles cf) - | WHILE _ DO _ END => false - end. - -(** This property yields [true] just on programs that - have no while loops. Using [Inductive], write a property - [no_whilesR] such that [no_whilesR c] is provable exactly when [c] - is a program with no while loops. Then prove its equivalence - with [no_whiles]. *) - -Inductive no_whilesR: com -> Prop := - (* FILL IN HERE *) - . - -Theorem no_whiles_eqv: - forall c, no_whiles c = true <-> no_whilesR c. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 4 stars (no_whiles_terminating) *) -(** Imp programs that don't involve while loops always terminate. - State and prove a theorem that says this. *) -(** (Use either [no_whiles] or [no_whilesR], as you prefer.) *) - -(* FILL IN HERE *) -(** [] *) - -(* ####################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 3 stars (stack_compiler) *) -(** HP Calculators, programming languages like Forth and Postscript, - and abstract machines like the Java Virtual Machine all evaluate - arithmetic expressions using a stack. For instance, the expression -<< - (2*3)+(3*(4-2)) ->> - would be entered as -<< - 2 3 * 3 4 2 - * + ->> - and evaluated like this: -<< - [] | 2 3 * 3 4 2 - * + - [2] | 3 * 3 4 2 - * + - [3, 2] | * 3 4 2 - * + - [6] | 3 4 2 - * + - [3, 6] | 4 2 - * + - [4, 3, 6] | 2 - * + - [2, 4, 3, 6] | - * + - [2, 3, 6] | * + - [6, 6] | + - [12] | ->> - - The task of this exercise is to write a small compiler that - translates [aexp]s into stack machine instructions. - - The instruction set for our stack language will consist of the - following instructions: - - [SPush n]: Push the number [n] on the stack. - - [SLoad x]: Load the identifier [x] from the store and push it - on the stack - - [SPlus]: Pop the two top numbers from the stack, add them, and - push the result onto the stack. - - [SMinus]: Similar, but subtract. - - [SMult]: Similar, but multiply. *) - -Inductive sinstr : Type := -| SPush : nat -> sinstr -| SLoad : id -> sinstr -| SPlus : sinstr -| SMinus : sinstr -| SMult : sinstr. - -(** Write a function to evaluate programs in the stack language. It - takes as input a state, a stack represented as a list of - numbers (top stack item is the head of the list), and a program - represented as a list of instructions, and returns the stack after - executing the program. Test your function on the examples below. - - Note that the specification leaves unspecified what to do when - encountering an [SPlus], [SMinus], or [SMult] instruction if the - stack contains less than two elements. In a sense, it is - immaterial what we do, since our compiler will never emit such a - malformed program. *) - -Fixpoint s_execute (st : state) (stack : list nat) - (prog : list sinstr) - : list nat := -(* FILL IN HERE *) admit. - - -Example s_execute1 : - s_execute empty_state [] - [SPush 5; SPush 3; SPush 1; SMinus] - = [2; 5]. -(* FILL IN HERE *) Admitted. - -Example s_execute2 : - s_execute (update empty_state X 3) [3;4] - [SPush 4; SLoad X; SMult; SPlus] - = [15; 4]. -(* FILL IN HERE *) Admitted. - -(** Next, write a function which compiles an [aexp] into a stack - machine program. The effect of running the program should be the - same as pushing the value of the expression on the stack. *) - -Fixpoint s_compile (e : aexp) : list sinstr := -(* FILL IN HERE *) admit. - -(** After you've defined [s_compile], uncomment the following to test - that it works. *) - -(* -Example s_compile1 : - s_compile (AMinus (AId X) (AMult (ANum 2) (AId Y))) - = [SLoad X; SPush 2; SLoad Y; SMult; SMinus]. -Proof. reflexivity. Qed. -*) -(** [] *) - -(** **** Exercise: 3 stars, advanced (stack_compiler_correct) *) -(** The task of this exercise is to prove the correctness of the - calculator implemented in the previous exercise. Remember that - the specification left unspecified what to do when encountering an - [SPlus], [SMinus], or [SMult] instruction if the stack contains - less than two elements. (In order to make your correctness proof - easier you may find it useful to go back and change your - implementation!) - - Prove the following theorem, stating that the [compile] function - behaves correctly. You will need to start by stating a more - general lemma to get a usable induction hypothesis; the main - theorem will then be a simple corollary of this lemma. *) - - -Theorem s_compile_correct : forall (st : state) (e : aexp), - s_execute st [] (s_compile e) = [ aeval st e ]. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 5 stars, advanced (break_imp) *) -Module BreakImp. - -(** Imperative languages such as C or Java often have a [break] or - similar statement for interrupting the execution of loops. In this - exercise we will consider how to add [break] to Imp. - - First, we need to enrich the language of commands with an - additional case. *) - -Inductive com : Type := - | CSkip : com - | CBreak : com - | CAss : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com. - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "BREAK" | Case_aux c "::=" | Case_aux c ";" - | Case_aux c "IFB" | Case_aux c "WHILE" ]. - -Notation "'SKIP'" := - CSkip. -Notation "'BREAK'" := - CBreak. -Notation "x '::=' a" := - (CAss x a) (at level 60). -Notation "c1 ; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := - (CIf c1 c2 c3) (at level 80, right associativity). - -(** Next, we need to define the behavior of [BREAK]. Informally, - whenever [BREAK] is executed in a sequence of commands, it stops - the execution of that sequence and signals that the innermost - enclosing loop (if any) should terminate. If there aren't any - enclosing loops, then the whole program simply terminates. The - final state should be the same as the one in which the [BREAK] - statement was executed. - - One important point is what to do when there are multiple loops - enclosing a given [BREAK]. In those cases, [BREAK] should only - terminate the _innermost_ loop where it occurs. Thus, after - executing the following piece of code... - X ::= 0; - Y ::= 1; - WHILE 0 <> Y DO - WHILE TRUE DO - BREAK - END; - X ::= 1; - Y ::= Y - 1 - END - ... the value of [X] should be [1], and not [0]. - - One way of expressing this behavior is to add another parameter to - the evaluation relation that specifies whether evaluation of a - command executes a [BREAK] statement: *) - -Inductive status : Type := - | SContinue : status - | SBreak : status. - -Reserved Notation "c1 '/' st '||' s '/' st'" - (at level 40, st, s at level 39). - -(** Intuitively, [c / st || s / st'] means that, if [c] is started in - state [st], then it terminates in state [st'] and either signals - that any surrounding loop (or the whole program) should exit - immediately ([s = SBreak]) or that execution should continue - normally ([s = SContinue]). - - The definition of the "[c / st || s / st']" relation is very - similar to the one we gave above for the regular evaluation - relation ([c / st || s / st']) -- we just need to handle the - termination signals appropriately: - - - If the command is [SKIP], then the state doesn't change, and - execution of any enclosing loop can continue normally. - - - If the command is [BREAK], the state stays unchanged, but we - signal a [SBreak]. - - - If the command is an assignment, then we update the binding for - that variable in the state accordingly and signal that execution - can continue normally. - - - If the command is of the form [IF b THEN c1 ELSE c2 FI], then - the state is updated as in the original semantics of Imp, except - that we also propagate the signal from the execution of - whichever branch was taken. - - - If the command is a sequence [c1 ; c2], we first execute - [c1]. If this yields a [SBreak], we skip the execution of [c2] - and propagate the [SBreak] signal to the surrounding context; - the resulting state should be the same as the one obtained by - executing [c1] alone. Otherwise, we execute [c2] on the state - obtained after executing [c1], and propagate the signal that was - generated there. - - - Finally, for a loop of the form [WHILE b DO c END], the - semantics is almost the same as before. The only difference is - that, when [b] evaluates to true, we execute [c] and check the - signal that it raises. If that signal is [SContinue], then the - execution proceeds as in the original semantics. Otherwise, we - stop the execution of the loop, and the resulting state is the - same as the one resulting from the execution of the current - iteration. In either case, since [BREAK] only terminates the - innermost loop, [WHILE] signals [SContinue]. *) - -(** Based on the above description, complete the definition of the - [ceval] relation. *) - -Inductive ceval : com -> state -> status -> state -> Prop := - | E_Skip : forall st, - CSkip / st || SContinue / st - (* FILL IN HERE *) - - where "c1 '/' st '||' s '/' st'" := (ceval c1 st s st'). - -Tactic Notation "ceval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Skip" - (* FILL IN HERE *) - ]. - -(** Now the following properties of your definition of [ceval]: *) - -Theorem break_ignore : forall c st st' s, - (BREAK; c) / st || s / st' -> - st = st'. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem while_continue : forall b c st st' s, - (WHILE b DO c END) / st || s / st' -> - s = SContinue. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem while_stops_on_break : forall b c st st', - beval st b = true -> - c / st || SBreak / st' -> - (WHILE b DO c END) / st || SContinue / st'. -Proof. - (* FILL IN HERE *) Admitted. - -(** **** Exercise: 3 stars, advanced, optional (while_break_true) *) -Theorem while_break_true : forall b c st st', - (WHILE b DO c END) / st || SContinue / st' -> - beval st' b = true -> - exists st'', c / st'' || SBreak / st'. -Proof. -(* FILL IN HERE *) Admitted. - -(** **** Exercise: 4 stars, advanced, optional (ceval_deterministic) *) -Theorem ceval_deterministic: forall (c:com) st st1 st2 s1 s2, - c / st || s1 / st1 -> - c / st || s2 / st2 -> - st1 = st2 /\ s1 = s2. -Proof. - (* FILL IN HERE *) Admitted. - -End BreakImp. -(** [] *) - -(** **** Exercise: 3 stars, optional (short_circuit) *) -(** Most modern programming languages use a "short-circuit" evaluation - rule for boolean [and]: to evaluate [BAnd b1 b2], first evaluate - [b1]. If it evaluates to [false], then the entire [BAnd] - expression evaluates to [false] immediately, without evaluating - [b2]. Otherwise, [b2] is evaluated to determine the result of the - [BAnd] expression. - - Write an alternate version of [beval] that performs short-circuit - evaluation of [BAnd] in this manner, and prove that it is - equivalent to [beval]. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 4 stars, optional (add_for_loop) *) -(** Add C-style [for] loops to the language of commands, update the - [ceval] definition to define the semantics of [for] loops, and add - cases for [for] loops as needed so that all the proofs in this file - are accepted by Coq. - - A [for] loop should be parameterized by (a) a statement executed - initially, (b) a test that is run on each iteration of the loop to - determine whether the loop should continue, (c) a statement - executed at the end of each loop iteration, and (d) a statement - that makes up the body of the loop. (You don't need to worry - about making up a concrete Notation for [for] loops, but feel free - to play with this too if you like.) *) - -(* FILL IN HERE *) -(** [] *) - - -(* <$Date: 2014-02-22 09:43:41 -0500 (Sat, 22 Feb 2014) $ *) - diff --git a/ImpCEvalFun.html b/ImpCEvalFun.html deleted file mode 100644 index c2c97b3..0000000 --- a/ImpCEvalFun.html +++ /dev/null @@ -1,508 +0,0 @@ - - - - - -ImpCEvalFun: Evaluation Function for Imp - - - - - - -
- - - -
- -

ImpCEvalFunEvaluation Function for Imp

- -
-
- -
- -
-
- -
-(* $Date: 2013-07-01 18:48:47 -0400 (Mon, 01 Jul 2013) $ *)
- -
-
- -
-

Evaluation Function

- -
-
- -
-Require Import Imp.
- -
-
- -
-Here's a first try at an evaluation function for commands, - omitting WHILE. -
-
- -
-Fixpoint ceval_step1 (st : state) (c : com) : state :=
-  match c with
-    | SKIP ⇒
-        st
-    | l ::= a1 ⇒
-        update st l (aeval st a1)
-    | c1 ;; c2 ⇒
-        let st' := ceval_step1 st c1 in
-        ceval_step1 st' c2
-    | IFB b THEN c1 ELSE c2 FI ⇒
-        if (beval st b)
-          then ceval_step1 st c1
-          else ceval_step1 st c2
-    | WHILE b1 DO c1 END ⇒
-        st (* bogus *)
-  end.
- -
-
- -
-In a traditional functional programming language like ML or - Haskell we could write the WHILE case as follows: -
-    | WHILE b1 DO c1 END => 
-        if (beval st b1) 
-          then ceval_step1 st (c1;; WHILE b1 DO c1 END)
-          else st 
-
- Coq doesn't accept such a definition (Error: Cannot guess - decreasing argument of fix) because the function we want to - define is not guaranteed to terminate. Indeed, the changed - ceval_step1 function applied to the loop program from Imp.v would - never terminate. Since Coq is not just a functional programming - language, but also a consistent logic, any potentially - non-terminating function needs to be rejected. Here is an - invalid(!) Coq program showing what would go wrong if Coq allowed - non-terminating recursive functions: -
-     Fixpoint loop_false (n : nat) : False := loop_false n.
-
- That is, propositions like False would become - provable (e.g. loop_false 0 would be a proof of False), which - would be a disaster for Coq's logical consistency. - -
- - Thus, because it doesn't terminate on all inputs, the full version - of ceval_step1 cannot be written in Coq — at least not - without one additional trick... -
- - Second try, using an extra numeric argument as a "step index" to - ensure that evaluation always terminates. -
-
- -
-Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state :=
-  match i with
-  | O ⇒ empty_state
-  | S i' ⇒
-    match c with
-      | SKIP ⇒
-          st
-      | l ::= a1 ⇒
-          update st l (aeval st a1)
-      | c1 ;; c2 ⇒
-          let st' := ceval_step2 st c1 i' in
-          ceval_step2 st' c2 i'
-      | IFB b THEN c1 ELSE c2 FI ⇒
-          if (beval st b)
-            then ceval_step2 st c1 i'
-            else ceval_step2 st c2 i'
-      | WHILE b1 DO c1 END ⇒
-          if (beval st b1)
-          then let st' := ceval_step2 st c1 i' in
-               ceval_step2 st' c i'
-          else st
-    end
-  end.
- -
-
- -
-Note: It is tempting to think that the index i here is - counting the "number of steps of evaluation." But if you look - closely you'll see that this is not the case: for example, in the - rule for sequencing, the same i is passed to both recursive - calls. Understanding the exact way that i is treated will be - important in the proof of ceval__ceval_step, which is given as - an exercise below. -
- - Third try, returning an option state instead of just a state - so that we can distinguish between normal and abnormal - termination. -
-
- -
-Fixpoint ceval_step3 (st : state) (c : com) (i : nat)
-                    : option state :=
-  match i with
-  | O ⇒ None
-  | S i' ⇒
-    match c with
-      | SKIP ⇒
-          Some st
-      | l ::= a1 ⇒
-          Some (update st l (aeval st a1))
-      | c1 ;; c2 ⇒
-          match (ceval_step3 st c1 i') with
-          | Some st' ⇒ ceval_step3 st' c2 i'
-          | None ⇒ None
-          end
-      | IFB b THEN c1 ELSE c2 FI ⇒
-          if (beval st b)
-            then ceval_step3 st c1 i'
-            else ceval_step3 st c2 i'
-      | WHILE b1 DO c1 END ⇒
-          if (beval st b1)
-          then match (ceval_step3 st c1 i') with
-               | Some st' ⇒ ceval_step3 st' c i'
-               | None ⇒ None
-               end
-          else Some st
-    end
-  end.
- -
-
- -
-We can improve the readability of this definition by introducing a - bit of auxiliary notation to hide the "plumbing" involved in - repeatedly matching against optional states. -
-
- -
-Notation "'LETOPT' x <== e1 'IN' e2"
-   := (match e1 with
-         | Some x ⇒ e2
-         | None ⇒ None
-       end)
-   (right associativity, at level 60).
- -
-Fixpoint ceval_step (st : state) (c : com) (i : nat)
-                    : option state :=
-  match i with
-  | O ⇒ None
-  | S i' ⇒
-    match c with
-      | SKIP ⇒
-          Some st
-      | l ::= a1 ⇒
-          Some (update st l (aeval st a1))
-      | c1 ;; c2 ⇒
-          LETOPT st' <== ceval_step st c1 i' IN
-          ceval_step st' c2 i'
-      | IFB b THEN c1 ELSE c2 FI ⇒
-          if (beval st b)
-            then ceval_step st c1 i'
-            else ceval_step st c2 i'
-      | WHILE b1 DO c1 END ⇒
-          if (beval st b1)
-          then LETOPT st' <== ceval_step st c1 i' IN
-               ceval_step st' c i'
-          else Some st
-    end
-  end.
- -
-Definition test_ceval (st:state) (c:com) :=
-  match ceval_step st c 500 with
-  | None ⇒ None
-  | Some st ⇒ Some (st X, st Y, st Z)
-  end.
- -
-(* Eval compute in 
-     (test_ceval empty_state 
-         (X ::= ANum 2;;
-          IFB BLe (AId X) (ANum 1)
-            THEN Y ::= ANum 3 
-            ELSE Z ::= ANum 4
-          FI)).
-   ====>
-      Some (2, 0, 4)   *)
- -
-
- -
-

Exercise: 2 stars (pup_to_n)

- Write an Imp program that sums the numbers from 1 to - X (inclusive: 1 + 2 + ... + X) in the variable Y. Make sure - your solution satisfies the test that follows. -
-
- -
-Definition pup_to_n : com :=
-  (* FILL IN HERE *) admit.
- -
-(* 
-Example pup_to_n_1 : 
-  test_ceval (update empty_state X 5) pup_to_n
-  = Some (0, 15, 0).
-Proof. reflexivity. Qed.
-*)
-
- -
-☐ -
- -

Exercise: 2 stars, optional (peven)

- Write a While program that sets Z to 0 if X is even and - sets Z to 1 otherwise. Use ceval_test to test your - program. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Equivalence of Relational and Step-Indexed Evaluation

- -
- - As with arithmetic and boolean expressions, we'd hope that - the two alternative definitions of evaluation actually boil down - to the same thing. This section shows that this is the case. - Make sure you understand the statements of the theorems and can - follow the structure of the proofs. -
-
- -
-Theorem ceval_step__ceval: ∀c st st',
-      (∃i, ceval_step st c i = Some st') →
-      c / st ⇓ st'.
-Proof.
-  intros c st st' H.
-  inversion H as [i E].
-  clear H.
-  generalize dependent st'.
-  generalize dependent st.
-  generalize dependent c.
-  induction i as [| i' ].
- -
-  Case "i = 0 -- contradictory".
-    intros c st st' H. inversion H.
- -
-  Case "i = S i'".
-    intros c st st' H.
-    com_cases (destruct c) SCase;
-           simpl in H; inversion H; subst; clear H.
-      SCase "SKIP". apply E_Skip.
-      SCase "::=". apply E_Ass. reflexivity.
- -
-      SCase ";;".
-        destruct (ceval_step st c1 i') eqn:Heqr1.
-        SSCase "Evaluation of r1 terminates normally".
-          apply E_Seq with s.
-            apply IHi'. rewrite Heqr1. reflexivity.
-            apply IHi'. simpl in H1. assumption.
-        SSCase "Otherwise -- contradiction".
-          inversion H1.
- -
-      SCase "IFB".
-        destruct (beval st b) eqn:Heqr.
-        SSCase "r = true".
-          apply E_IfTrue. rewrite Heqr. reflexivity.
-          apply IHi'. assumption.
-        SSCase "r = false".
-          apply E_IfFalse. rewrite Heqr. reflexivity.
-          apply IHi'. assumption.
- -
-      SCase "WHILE". destruct (beval st b) eqn :Heqr.
-        SSCase "r = true".
-         destruct (ceval_step st c i') eqn:Heqr1.
-          SSSCase "r1 = Some s".
-            apply E_WhileLoop with s. rewrite Heqr. reflexivity.
-            apply IHi'. rewrite Heqr1. reflexivity.
-            apply IHi'. simpl in H1. assumption.
-          SSSCase "r1 = None".
-            inversion H1.
-        SSCase "r = false".
-          inversion H1.
-          apply E_WhileEnd.
-          rewrite ← Heqr. subst. reflexivity. Qed.
- -
-
- -
-

Exercise: 4 stars (ceval_step__ceval_inf)

- Write an informal proof of ceval_step__ceval, following the - usual template. (The template for case analysis on an inductively - defined value should look the same as for induction, except that - there is no induction hypothesis.) Make your proof communicate - the main ideas to a human reader; do not simply transcribe the - steps of the formal proof. - -
- -(* FILL IN HERE *)
-☐ - -
-
- -
-Theorem ceval_step_more: ∀i1 i2 st st' c,
-  i1 ≤ i2 →
-  ceval_step st c i1 = Some st' →
-  ceval_step st c i2 = Some st'.
-Proof.
-induction i1 as [|i1']; intros i2 st st' c Hle Hceval.
-  Case "i1 = 0".
-    simpl in Hceval. inversion Hceval.
-  Case "i1 = S i1'".
-    destruct i2 as [|i2']. inversion Hle.
-    assert (Hle': i1' ≤ i2') by omega.
-    com_cases (destruct c) SCase.
-    SCase "SKIP".
-      simpl in Hceval. inversion Hceval.
-      reflexivity.
-    SCase "::=".
-      simpl in Hceval. inversion Hceval.
-      reflexivity.
-    SCase ";;".
-      simpl in Hceval. simpl.
-      destruct (ceval_step st c1 i1') eqn:Heqst1'o.
-      SSCase "st1'o = Some".
-        apply (IHi1' i2') in Heqst1'o; try assumption.
-        rewrite Heqst1'o. simpl. simpl in Hceval.
-        apply (IHi1' i2') in Hceval; try assumption.
-      SSCase "st1'o = None".
-        inversion Hceval.
- -
-    SCase "IFB".
-      simpl in Hceval. simpl.
-      destruct (beval st b); apply (IHi1' i2') in Hceval; assumption.
- -
-    SCase "WHILE".
-      simpl in Hceval. simpl.
-      destruct (beval st b); try assumption.
-      destruct (ceval_step st c i1') eqn: Heqst1'o.
-      SSCase "st1'o = Some".
-        apply (IHi1' i2') in Heqst1'o; try assumption.
-        rewrite → Heqst1'o. simpl. simpl in Hceval.
-        apply (IHi1' i2') in Hceval; try assumption.
-      SSCase "i1'o = None".
-        simpl in Hceval. inversion Hceval. Qed.
- -
-
- -
-

Exercise: 3 stars (ceval__ceval_step)

- Finish the following proof. You'll need ceval_step_more in a - few places, as well as some basic facts about ≤ and plus. -
-
- -
-Theorem ceval__ceval_step: ∀c st st',
-      c / st ⇓ st' →
-      ∃i, ceval_step st c i = Some st'.
-Proof.
-  intros c st st' Hce.
-  ceval_cases (induction Hce) Case.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-Theorem ceval_and_ceval_step_coincide: ∀c st st',
-      c / st ⇓ st'
-  ↔ ∃i, ceval_step st c i = Some st'.
-Proof.
-  intros c st st'.
-  split. apply ceval__ceval_step. apply ceval_step__ceval.
-Qed.
- -
-
- -
-

Determinism of Evaluation (Simpler Proof)

- -
- - Here's a slicker proof showing that the evaluation relation is - deterministic, using the fact that the relational and step-indexed - definition of evaluation are the same. -
-
- -
-Theorem ceval_deterministic' : ∀c st st1 st2,
-     c / st ⇓ st1 →
-     c / st ⇓ st2 →
-     st1 = st2.
-Proof.
-  intros c st st1 st2 He1 He2.
-  apply ceval__ceval_step in He1.
-  apply ceval__ceval_step in He2.
-  inversion He1 as [i1 E1].
-  inversion He2 as [i2 E2].
-  apply ceval_step_more with (i2 := i1 + i2) in E1.
-  apply ceval_step_more with (i2 := i1 + i2) in E2.
-  rewrite E1 in E2. inversion E2. reflexivity.
-  omega. omega. Qed.
-
-
- - - -
- - - \ No newline at end of file diff --git a/ImpCEvalFun.v b/ImpCEvalFun.v deleted file mode 100644 index 1ddc4d2..0000000 --- a/ImpCEvalFun.v +++ /dev/null @@ -1,362 +0,0 @@ -(** * ImpCEvalFun: Evaluation Function for Imp *) - -(* $Date: 2013-07-01 18:48:47 -0400 (Mon, 01 Jul 2013) $ *) - -(* #################################### *) -(** ** Evaluation Function *) - -Require Import Imp. - -(** Here's a first try at an evaluation function for commands, - omitting [WHILE]. *) - -Fixpoint ceval_step1 (st : state) (c : com) : state := - match c with - | SKIP => - st - | l ::= a1 => - update st l (aeval st a1) - | c1 ;; c2 => - let st' := ceval_step1 st c1 in - ceval_step1 st' c2 - | IFB b THEN c1 ELSE c2 FI => - if (beval st b) - then ceval_step1 st c1 - else ceval_step1 st c2 - | WHILE b1 DO c1 END => - st (* bogus *) - end. - -(** In a traditional functional programming language like ML or - Haskell we could write the WHILE case as follows: -<< - | WHILE b1 DO c1 END => - if (beval st b1) - then ceval_step1 st (c1;; WHILE b1 DO c1 END) - else st ->> - Coq doesn't accept such a definition ([Error: Cannot guess - decreasing argument of fix]) because the function we want to - define is not guaranteed to terminate. Indeed, the changed - [ceval_step1] function applied to the [loop] program from [Imp.v] would - never terminate. Since Coq is not just a functional programming - language, but also a consistent logic, any potentially - non-terminating function needs to be rejected. Here is an - invalid(!) Coq program showing what would go wrong if Coq allowed - non-terminating recursive functions: -<< - Fixpoint loop_false (n : nat) : False := loop_false n. ->> - That is, propositions like [False] would become - provable (e.g. [loop_false 0] would be a proof of [False]), which - would be a disaster for Coq's logical consistency. - - Thus, because it doesn't terminate on all inputs, the full version - of [ceval_step1] cannot be written in Coq -- at least not - without one additional trick... *) - - -(** Second try, using an extra numeric argument as a "step index" to - ensure that evaluation always terminates. *) - -Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := - match i with - | O => empty_state - | S i' => - match c with - | SKIP => - st - | l ::= a1 => - update st l (aeval st a1) - | c1 ;; c2 => - let st' := ceval_step2 st c1 i' in - ceval_step2 st' c2 i' - | IFB b THEN c1 ELSE c2 FI => - if (beval st b) - then ceval_step2 st c1 i' - else ceval_step2 st c2 i' - | WHILE b1 DO c1 END => - if (beval st b1) - then let st' := ceval_step2 st c1 i' in - ceval_step2 st' c i' - else st - end - end. - -(** _Note_: It is tempting to think that the index [i] here is - counting the "number of steps of evaluation." But if you look - closely you'll see that this is not the case: for example, in the - rule for sequencing, the same [i] is passed to both recursive - calls. Understanding the exact way that [i] is treated will be - important in the proof of [ceval__ceval_step], which is given as - an exercise below. *) - -(** Third try, returning an [option state] instead of just a [state] - so that we can distinguish between normal and abnormal - termination. *) - -Fixpoint ceval_step3 (st : state) (c : com) (i : nat) - : option state := - match i with - | O => None - | S i' => - match c with - | SKIP => - Some st - | l ::= a1 => - Some (update st l (aeval st a1)) - | c1 ;; c2 => - match (ceval_step3 st c1 i') with - | Some st' => ceval_step3 st' c2 i' - | None => None - end - | IFB b THEN c1 ELSE c2 FI => - if (beval st b) - then ceval_step3 st c1 i' - else ceval_step3 st c2 i' - | WHILE b1 DO c1 END => - if (beval st b1) - then match (ceval_step3 st c1 i') with - | Some st' => ceval_step3 st' c i' - | None => None - end - else Some st - end - end. - -(** We can improve the readability of this definition by introducing a - bit of auxiliary notation to hide the "plumbing" involved in - repeatedly matching against optional states. *) - -Notation "'LETOPT' x <== e1 'IN' e2" - := (match e1 with - | Some x => e2 - | None => None - end) - (right associativity, at level 60). - -Fixpoint ceval_step (st : state) (c : com) (i : nat) - : option state := - match i with - | O => None - | S i' => - match c with - | SKIP => - Some st - | l ::= a1 => - Some (update st l (aeval st a1)) - | c1 ;; c2 => - LETOPT st' <== ceval_step st c1 i' IN - ceval_step st' c2 i' - | IFB b THEN c1 ELSE c2 FI => - if (beval st b) - then ceval_step st c1 i' - else ceval_step st c2 i' - | WHILE b1 DO c1 END => - if (beval st b1) - then LETOPT st' <== ceval_step st c1 i' IN - ceval_step st' c i' - else Some st - end - end. - -Definition test_ceval (st:state) (c:com) := - match ceval_step st c 500 with - | None => None - | Some st => Some (st X, st Y, st Z) - end. - -(* Eval compute in - (test_ceval empty_state - (X ::= ANum 2;; - IFB BLe (AId X) (ANum 1) - THEN Y ::= ANum 3 - ELSE Z ::= ANum 4 - FI)). - ====> - Some (2, 0, 4) *) - -(** **** Exercise: 2 stars (pup_to_n) *) -(** Write an Imp program that sums the numbers from [1] to - [X] (inclusive: [1 + 2 + ... + X]) in the variable [Y]. Make sure - your solution satisfies the test that follows. *) - -Definition pup_to_n : com := - (* FILL IN HERE *) admit. - -(* -Example pup_to_n_1 : - test_ceval (update empty_state X 5) pup_to_n - = Some (0, 15, 0). -Proof. reflexivity. Qed. -*) -(** [] *) - -(** **** Exercise: 2 stars, optional (peven) *) -(** Write a [While] program that sets [Z] to [0] if [X] is even and - sets [Z] to [1] otherwise. Use [ceval_test] to test your - program. *) - -(* FILL IN HERE *) -(** [] *) - -(* ################################################################ *) -(** ** Equivalence of Relational and Step-Indexed Evaluation *) - -(** As with arithmetic and boolean expressions, we'd hope that - the two alternative definitions of evaluation actually boil down - to the same thing. This section shows that this is the case. - Make sure you understand the statements of the theorems and can - follow the structure of the proofs. *) - -Theorem ceval_step__ceval: forall c st st', - (exists i, ceval_step st c i = Some st') -> - c / st || st'. -Proof. - intros c st st' H. - inversion H as [i E]. - clear H. - generalize dependent st'. - generalize dependent st. - generalize dependent c. - induction i as [| i' ]. - - Case "i = 0 -- contradictory". - intros c st st' H. inversion H. - - Case "i = S i'". - intros c st st' H. - com_cases (destruct c) SCase; - simpl in H; inversion H; subst; clear H. - SCase "SKIP". apply E_Skip. - SCase "::=". apply E_Ass. reflexivity. - - SCase ";;". - destruct (ceval_step st c1 i') eqn:Heqr1. - SSCase "Evaluation of r1 terminates normally". - apply E_Seq with s. - apply IHi'. rewrite Heqr1. reflexivity. - apply IHi'. simpl in H1. assumption. - SSCase "Otherwise -- contradiction". - inversion H1. - - SCase "IFB". - destruct (beval st b) eqn:Heqr. - SSCase "r = true". - apply E_IfTrue. rewrite Heqr. reflexivity. - apply IHi'. assumption. - SSCase "r = false". - apply E_IfFalse. rewrite Heqr. reflexivity. - apply IHi'. assumption. - - SCase "WHILE". destruct (beval st b) eqn :Heqr. - SSCase "r = true". - destruct (ceval_step st c i') eqn:Heqr1. - SSSCase "r1 = Some s". - apply E_WhileLoop with s. rewrite Heqr. reflexivity. - apply IHi'. rewrite Heqr1. reflexivity. - apply IHi'. simpl in H1. assumption. - SSSCase "r1 = None". - inversion H1. - SSCase "r = false". - inversion H1. - apply E_WhileEnd. - rewrite <- Heqr. subst. reflexivity. Qed. - -(** **** Exercise: 4 stars (ceval_step__ceval_inf) *) -(** Write an informal proof of [ceval_step__ceval], following the - usual template. (The template for case analysis on an inductively - defined value should look the same as for induction, except that - there is no induction hypothesis.) Make your proof communicate - the main ideas to a human reader; do not simply transcribe the - steps of the formal proof. - -(* FILL IN HERE *) -[] -*) - -Theorem ceval_step_more: forall i1 i2 st st' c, - i1 <= i2 -> - ceval_step st c i1 = Some st' -> - ceval_step st c i2 = Some st'. -Proof. -induction i1 as [|i1']; intros i2 st st' c Hle Hceval. - Case "i1 = 0". - simpl in Hceval. inversion Hceval. - Case "i1 = S i1'". - destruct i2 as [|i2']. inversion Hle. - assert (Hle': i1' <= i2') by omega. - com_cases (destruct c) SCase. - SCase "SKIP". - simpl in Hceval. inversion Hceval. - reflexivity. - SCase "::=". - simpl in Hceval. inversion Hceval. - reflexivity. - SCase ";;". - simpl in Hceval. simpl. - destruct (ceval_step st c1 i1') eqn:Heqst1'o. - SSCase "st1'o = Some". - apply (IHi1' i2') in Heqst1'o; try assumption. - rewrite Heqst1'o. simpl. simpl in Hceval. - apply (IHi1' i2') in Hceval; try assumption. - SSCase "st1'o = None". - inversion Hceval. - - SCase "IFB". - simpl in Hceval. simpl. - destruct (beval st b); apply (IHi1' i2') in Hceval; assumption. - - SCase "WHILE". - simpl in Hceval. simpl. - destruct (beval st b); try assumption. - destruct (ceval_step st c i1') eqn: Heqst1'o. - SSCase "st1'o = Some". - apply (IHi1' i2') in Heqst1'o; try assumption. - rewrite -> Heqst1'o. simpl. simpl in Hceval. - apply (IHi1' i2') in Hceval; try assumption. - SSCase "i1'o = None". - simpl in Hceval. inversion Hceval. Qed. - -(** **** Exercise: 3 stars (ceval__ceval_step) *) -(** Finish the following proof. You'll need [ceval_step_more] in a - few places, as well as some basic facts about [<=] and [plus]. *) - -Theorem ceval__ceval_step: forall c st st', - c / st || st' -> - exists i, ceval_step st c i = Some st'. -Proof. - intros c st st' Hce. - ceval_cases (induction Hce) Case. - (* FILL IN HERE *) Admitted. -(** [] *) - -Theorem ceval_and_ceval_step_coincide: forall c st st', - c / st || st' - <-> exists i, ceval_step st c i = Some st'. -Proof. - intros c st st'. - split. apply ceval__ceval_step. apply ceval_step__ceval. -Qed. - -(* ####################################################### *) -(** ** Determinism of Evaluation (Simpler Proof) *) - -(** Here's a slicker proof showing that the evaluation relation is - deterministic, using the fact that the relational and step-indexed - definition of evaluation are the same. *) - -Theorem ceval_deterministic' : forall c st st1 st2, - c / st || st1 -> - c / st || st2 -> - st1 = st2. -Proof. - intros c st st1 st2 He1 He2. - apply ceval__ceval_step in He1. - apply ceval__ceval_step in He2. - inversion He1 as [i1 E1]. - inversion He2 as [i2 E2]. - apply ceval_step_more with (i2 := i1 + i2) in E1. - apply ceval_step_more with (i2 := i1 + i2) in E2. - rewrite E1 in E2. inversion E2. reflexivity. - omega. omega. Qed. diff --git a/ImpParser.html b/ImpParser.html deleted file mode 100644 index e5cb327..0000000 --- a/ImpParser.html +++ /dev/null @@ -1,580 +0,0 @@ - - - - - -ImpParser: Lexing and Parsing in Coq - - - - - - -
- - - -
- -

ImpParserLexing and Parsing in Coq

- -
-
- -
- -
-
- -
-(* $Date: 2013-07-01 18:48:47 -0400 (Mon, 01 Jul 2013) $ *)
- -
-
- -
-The development of the Imp language in Imp.v completely ignores - issues of concrete syntax — how an ascii string that a programmer - might write gets translated into the abstract syntax trees defined - by the datatypes aexp, bexp, and com. In this file we - illustrate how the rest of the story can be filled in by building - a simple lexical analyzer and parser using Coq's functional - programming facilities. - -
- - This development is not intended to be understood in detail: the - explanations are fairly terse and there are no exercises. The - main point is simply to demonstrate that it can be done. You are - invited to look through the code — most of it is not very - complicated, though the parser relies on some "monadic" - programming idioms that may require a little work to make out — - but most readers will probably want to just skip down to the - Examples section at the very end to get the punchline. -
-
- -
-
- -
-

Internals

- -
-
- -
-Require Import SfLib.
-Require Import Imp.
- -
-Require Import String.
-Require Import Ascii.
- -
-Open Scope list_scope.
- -
-
- -
-

Lexical Analysis

- -
-
- -
-Definition isWhite (c : ascii) : bool :=
-  let n := nat_of_ascii c in
-  orb (orb (beq_nat n 32) (* space *)
-           (beq_nat n 9)) (* tab *)
-      (orb (beq_nat n 10) (* linefeed *)
-           (beq_nat n 13)). (* Carriage return. *)
- -
-Notation "x '<=?' y" := (ble_nat x y)
-  (at level 70, no associativity) : nat_scope.
- -
-Definition isLowerAlpha (c : ascii) : bool :=
-  let n := nat_of_ascii c in
-    andb (97 <=? n) (n <=? 122).
- -
-Definition isAlpha (c : ascii) : bool :=
-  let n := nat_of_ascii c in
-    orb (andb (65 <=? n) (n <=? 90))
-        (andb (97 <=? n) (n <=? 122)).
- -
-Definition isDigit (c : ascii) : bool :=
-  let n := nat_of_ascii c in
-     andb (48 <=? n) (n <=? 57).
- -
-Inductive chartype := white | alpha | digit | other.
- -
-Definition classifyChar (c : ascii) : chartype :=
-  if isWhite c then
-    white
-  else if isAlpha c then
-    alpha
-  else if isDigit c then
-    digit
-  else
-    other.
- -
-Fixpoint list_of_string (s : string) : list ascii :=
-  match s with
-  | EmptyString ⇒ []
-  | String c s ⇒ c :: (list_of_string s)
-  end.
- -
-Fixpoint string_of_list (xs : list ascii) : string :=
-  fold_right String EmptyString xs.
- -
-Definition token := string.
- -
-Fixpoint tokenize_helper (cls : chartype) (acc xs : list ascii)
-                       : list (list ascii) :=
-  let tk := match acc with [] ⇒ [] | _::_ ⇒ [rev acc] end in
-  match xs with
-  | [] ⇒ tk
-  | (x::xs') ⇒
-    match cls, classifyChar x, x with
-    | _, _, "(" ⇒ tk ++ ["("]::(tokenize_helper other [] xs')
-    | _, _, ")" ⇒ tk ++ [")"]::(tokenize_helper other [] xs')
-    | _, white, _ ⇒ tk ++ (tokenize_helper white [] xs')
-    | alpha,alpha,x ⇒ tokenize_helper alpha (x::acc) xs'
-    | digit,digit,x ⇒ tokenize_helper digit (x::acc) xs'
-    | other,other,x ⇒ tokenize_helper other (x::acc) xs'
-    | _,tp,x ⇒ tk ++ (tokenize_helper tp [x] xs')
-    end
-  end %char.
- -
-Definition tokenize (s : string) : list string :=
-  map string_of_list (tokenize_helper white [] (list_of_string s)).
- -
-Example tokenize_ex1 :
-    tokenize "abc12==3 223*(3+(a+c))" %string
-  = ["abc"; "12"; "=="; "3"; "223";
-       "×"; "("; "3"; "+"; "(";
-       "a"; "+"; "c"; ")"; ")"]%string.
-Proof. reflexivity. Qed.
- -
-
- -
-

Parsing

- -
-
- -
-
- -
-

Options with Errors

- -
-
- -
-(* An option with error messages. *)
-Inductive optionE (X:Type) : Type :=
-  | SomeE : X → optionE X
-  | NoneE : string → optionE X.
- -
-Implicit Arguments SomeE [[X]].
-Implicit Arguments NoneE [[X]].
- -
-(* Some syntactic sugar to make writing nested match-expressions on
-   optionE more convenient. *)
- -
-Notation "'DO' ( x , y ) <== e1 ; e2"
-   := (match e1 with
-         | SomeE (x,y) ⇒ e2
-         | NoneE err ⇒ NoneE err
-       end)
-   (right associativity, at level 60).
- -
-Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3"
-   := (match e1 with
-         | SomeE (x,y) ⇒ e2
-         | NoneE err ⇒ e3
-       end)
-   (right associativity, at level 60, e2 at next level).
- -
-
- -
-

Symbol Table

- -
-
- -
-(* Build a mapping from tokens to nats.  A real parser would do
-   this incrementally as it encountered new symbols, but passing
-   around the symbol table inside the parsing functions is a bit
-   inconvenient, so instead we do it as a first pass. *)
-Fixpoint build_symtable (xs : list token) (n : nat) : (token → nat) :=
-  match xs with
-  | [] ⇒ (fun s ⇒ n)
-  | x::xs ⇒
-    if (forallb isLowerAlpha (list_of_string x))
-     then (fun s ⇒ if string_dec s x then n else (build_symtable xs (S n) s))
-     else build_symtable xs n
-  end.
- -
-
- -
-

Generic Combinators for Building Parsers

- -
-
- -
-Open Scope string_scope.
- -
-Definition parser (T : Type) :=
-  list token → optionE (T × list token).
- -
-Fixpoint many_helper {T} (p : parser T) acc steps xs :=
-match steps, p xs with
-| 0, _ ⇒ NoneE "Too many recursive calls"
-| _, NoneE _ ⇒ SomeE ((rev acc), xs)
-| S steps', SomeE (t, xs') ⇒ many_helper p (t::acc) steps' xs'
-end.
- -
-(* A (step-indexed) parser which expects zero or more ps *)
-Fixpoint many {T} (p : parser T) (steps : nat) : parser (list T) :=
-  many_helper p [] steps.
- -
-(* A parser which expects a given token, followed by p *)
-Definition firstExpect {T} (t : token) (p : parser T) : parser T :=
-  fun xs ⇒ match xs with
-              | x::xs' ⇒ if string_dec x t
-                           then p xs'
-                          else NoneE ("expected '" ++ t ++ "'.")
-              | [] ⇒ NoneE ("expected '" ++ t ++ "'.")
-            end.
- -
-(* A parser which expects a particular token *)
-Definition expect (t : token) : parser unit :=
-  firstExpect t (fun xs ⇒ SomeE(tt, xs)).
- -
-
- -
-

A Recursive-Descent Parser for Imp

- -
-
- -
-(* Identifiers *)
-Definition parseIdentifier (symtable :string→nat) (xs : list token)
-                         : optionE (id × list token) :=
-match xs with
-| [] ⇒ NoneE "Expected identifier"
-| x::xs' ⇒
-    if forallb isLowerAlpha (list_of_string x) then
-      SomeE (Id (symtable x), xs')
-    else
-      NoneE ("Illegal identifier:'" ++ x ++ "'")
-end.
- -
-(* Numbers *)
-Definition parseNumber (xs : list token) : optionE (nat × list token) :=
-match xs with
-| [] ⇒ NoneE "Expected number"
-| x::xs' ⇒
-    if forallb isDigit (list_of_string x) then
-      SomeE (fold_left (fun n d ⇒
-                        10 × n + (nat_of_ascii d - nat_of_ascii "0"%char))
-                (list_of_string x)
-                0,
-              xs')
-    else
-      NoneE "Expected number"
-end.
- -
-(* Parse arithmetic expressions *)
-Fixpoint parsePrimaryExp (steps:nat) symtable (xs : list token)
-   : optionE (aexp × list token) :=
-  match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-      DO (i, rest) <-- parseIdentifier symtable xs ;
-          SomeE (AId i, rest)
-      OR DO (n, rest) <-- parseNumber xs ;
-          SomeE (ANum n, rest)
-      OR (DO (e, rest) <== firstExpect "(" (parseSumExp steps' symtable) xs;
-          DO (u, rest') <== expect ")" rest ;
-          SomeE(e,rest'))
-  end
-with parseProductExp (steps:nat) symtable (xs : list token) :=
-  match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-    DO (e, rest) <==
-      parsePrimaryExp steps' symtable xs ;
-    DO (es, rest') <==
-      many (firstExpect "×" (parsePrimaryExp steps' symtable)) steps' rest;
-    SomeE (fold_left AMult es e, rest')
-  end
-with parseSumExp (steps:nat) symtable (xs : list token) :=
-  match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-    DO (e, rest) <==
-      parseProductExp steps' symtable xs ;
-    DO (es, rest') <==
-      many (fun xs ⇒
-             DO (e,rest') <--
-               firstExpect "+" (parseProductExp steps' symtable) xs;
-                                 SomeE ( (true, e), rest')
-             OR DO (e,rest') <==
-               firstExpect "-" (parseProductExp steps' symtable) xs;
-                                 SomeE ( (false, e), rest'))
-                            steps' rest;
-      SomeE (fold_left (fun e0 term ⇒
-                          match term with
-                            (true, e) ⇒ APlus e0 e
-                          | (false, e) ⇒ AMinus e0 e
-                          end)
-                       es e,
-             rest')
-  end.
- -
-Definition parseAExp := parseSumExp.
- -
-(* Parsing boolean expressions. *)
-Fixpoint parseAtomicExp (steps:nat) (symtable : string→nat) (xs : list token) :=
-match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-     DO (u,rest) <-- expect "true" xs;
-         SomeE (BTrue,rest)
-     OR DO (u,rest) <-- expect "false" xs;
-         SomeE (BFalse,rest)
-     OR DO (e,rest) <-- firstExpect "not" (parseAtomicExp steps' symtable) xs;
-         SomeE (BNot e, rest)
-     OR DO (e,rest) <-- firstExpect "(" (parseConjunctionExp steps' symtable) xs;
-          (DO (u,rest') <== expect ")" rest; SomeE (e, rest'))
-     OR DO (e, rest) <== parseProductExp steps' symtable xs ;
-            (DO (e', rest') <--
-              firstExpect "==" (parseAExp steps' symtable) rest ;
-              SomeE (BEq e e', rest')
-             OR DO (e', rest') <--
-               firstExpect "≤" (parseAExp steps' symtable) rest ;
-               SomeE (BLe e e', rest')
-             OR
-               NoneE "Expected '==' or '≤' after arithmetic expression")
-end
-with parseConjunctionExp (steps:nat) (symtable : string→nat) (xs : list token) :=
-  match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-    DO (e, rest) <==
-      parseAtomicExp steps' symtable xs ;
-    DO (es, rest') <==
-      many (firstExpect "&&" (parseAtomicExp steps' symtable)) steps' rest;
-    SomeE (fold_left BAnd es e, rest')
-  end.
- -
-Definition parseBExp := parseConjunctionExp.
- -
-(* 
-Eval compute in 
-  (parseProductExp 100 (tokenize "x*y*(x*x)*x")).
-
-Eval compute in 
-  (parseDisjunctionExp 100 (tokenize "not((x==x||x*x<=(x*x)*x)&&x==x)")). 
-*)
- -
-(* Parsing commands *)
-Fixpoint parseSimpleCommand (steps:nat) (symtable:string→nat) (xs : list token) :=
-  match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-    DO (u, rest) <-- expect "SKIP" xs;
-      SomeE (SKIP, rest)
-    OR DO (e,rest) <--
-         firstExpect "IF" (parseBExp steps' symtable) xs;
-       DO (c,rest') <==
-         firstExpect "THEN" (parseSequencedCommand steps' symtable) rest;
-       DO (c',rest'') <==
-         firstExpect "ELSE" (parseSequencedCommand steps' symtable) rest';
-       DO (u,rest''') <==
-         expect "END" rest'';
-       SomeE(IFB e THEN c ELSE c' FI, rest''')
-    OR DO (e,rest) <--
-         firstExpect "WHILE" (parseBExp steps' symtable) xs;
-       DO (c,rest') <==
-         firstExpect "DO" (parseSequencedCommand steps' symtable) rest;
-       DO (u,rest'') <==
-         expect "END" rest';
-       SomeE(WHILE e DO c END, rest'')
-    OR DO (i, rest) <==
-         parseIdentifier symtable xs;
-       DO (e, rest') <==
-         firstExpect ":=" (parseAExp steps' symtable) rest;
-       SomeE(i ::= e, rest')
-  end
-
-with parseSequencedCommand (steps:nat) (symtable:string→nat) (xs : list token) :=
-  match steps with
-  | 0 ⇒ NoneE "Too many recursive calls"
-  | S steps' ⇒
-      DO (c, rest) <==
-        parseSimpleCommand steps' symtable xs;
-      DO (c', rest') <--
-        firstExpect ";;" (parseSequencedCommand steps' symtable) rest;
-        SomeE(c ;; c', rest')
-      OR
-        SomeE(c, rest)
-  end.
- -
-Definition bignumber := 1000.
- -
-Definition parse (str : string) : optionE (com × list token) :=
-  let tokens := tokenize str in
-  parseSequencedCommand bignumber (build_symtable tokens 0) tokens.
- -
-
- -
-

Examples

- -
-
- -
-(*
-Eval compute in parse "
-    IF x == y + 1 + 2 - y * 6 + 3 THEN
-      x := x * 1;;
-      y := 0
-    ELSE
-      SKIP
-    END  ".
-====>
-    SomeE
-       (IFB BEq (AId (Id 0))
-                (APlus
-                   (AMinus (APlus (APlus (AId (Id 1)) (ANum 1)) (ANum 2))
-                      (AMult (AId (Id 1)) (ANum 6))) 
-                   (ANum 3))
-        THEN Id 0 ::= AMult (AId (Id 0)) (ANum 1);; Id 1 ::= ANum 0
-        ELSE SKIP FI, )
-*)
- -
-(*
-Eval compute in parse "
-    SKIP;;
-    z:=x*y*(x*x);;
-    WHILE x==x DO
-      IF z <= z*z && not x == 2 THEN
-        x := z;;
-        y := z
-      ELSE
-        SKIP
-      END;;
-      SKIP
-    END;;
-    x:=z  ".
-====> 
-     SomeE
-        (SKIP;;
-         Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2)))
-                        (AMult (AId (Id 1)) (AId (Id 1)));;
-         WHILE BEq (AId (Id 1)) (AId (Id 1)) DO 
-           IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0))))
-                     (BNot (BEq (AId (Id 1)) (ANum 2)))
-              THEN Id 1 ::= AId (Id 0);; Id 2 ::= AId (Id 0) 
-              ELSE SKIP FI;; 
-           SKIP 
-         END;; 
-         Id 1 ::= AId (Id 0), 
-        ) 
-*)
- -
-(*
-Eval compute in parse "
-   SKIP;;
-   z:=x*y*(x*x);;
-   WHILE x==x DO
-     IF z <= z*z && not x == 2 THEN
-       x := z;;
-       y := z
-     ELSE
-       SKIP
-     END;;
-     SKIP
-   END;;
-   x:=z  ".
-=====> 
-      SomeE
-         (SKIP;;
-          Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2)))
-                (AMult (AId (Id 1)) (AId (Id 1)));;
-          WHILE BEq (AId (Id 1)) (AId (Id 1)) DO 
-            IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0))))
-                     (BNot (BEq (AId (Id 1)) (ANum 2)))
-              THEN Id 1 ::= AId (Id 0);; 
-                   Id 2 ::= AId (Id 0) 
-              ELSE SKIP 
-            FI;; 
-            SKIP 
-          END;;
-          Id 1 ::= AId (Id 0), 
-         ).
-*)
-
-
- - - -
- - - \ No newline at end of file diff --git a/ImpParser.v b/ImpParser.v deleted file mode 100644 index 4a2829b..0000000 --- a/ImpParser.v +++ /dev/null @@ -1,444 +0,0 @@ -(** * ImpParser: Lexing and Parsing in Coq *) - -(* $Date: 2013-07-01 18:48:47 -0400 (Mon, 01 Jul 2013) $ *) - -(** The development of the [Imp] language in Imp.v completely ignores - issues of concrete syntax -- how an ascii string that a programmer - might write gets translated into the abstract syntax trees defined - by the datatypes [aexp], [bexp], and [com]. In this file we - illustrate how the rest of the story can be filled in by building - a simple lexical analyzer and parser using Coq's functional - programming facilities. - - This development is not intended to be understood in detail: the - explanations are fairly terse and there are no exercises. The - main point is simply to demonstrate that it can be done. You are - invited to look through the code -- most of it is not very - complicated, though the parser relies on some "monadic" - programming idioms that may require a little work to make out -- - but most readers will probably want to just skip down to the - Examples section at the very end to get the punchline. *) - -(* ####################################################### *) -(** * Internals *) - -Require Import SfLib. -Require Import Imp. - -Require Import String. -Require Import Ascii. - -Open Scope list_scope. - -(* ####################################################### *) -(** ** Lexical Analysis *) - -Definition isWhite (c : ascii) : bool := - let n := nat_of_ascii c in - orb (orb (beq_nat n 32) (* space *) - (beq_nat n 9)) (* tab *) - (orb (beq_nat n 10) (* linefeed *) - (beq_nat n 13)). (* Carriage return. *) - -Notation "x '<=?' y" := (ble_nat x y) - (at level 70, no associativity) : nat_scope. - -Definition isLowerAlpha (c : ascii) : bool := - let n := nat_of_ascii c in - andb (97 <=? n) (n <=? 122). - -Definition isAlpha (c : ascii) : bool := - let n := nat_of_ascii c in - orb (andb (65 <=? n) (n <=? 90)) - (andb (97 <=? n) (n <=? 122)). - -Definition isDigit (c : ascii) : bool := - let n := nat_of_ascii c in - andb (48 <=? n) (n <=? 57). - -Inductive chartype := white | alpha | digit | other. - -Definition classifyChar (c : ascii) : chartype := - if isWhite c then - white - else if isAlpha c then - alpha - else if isDigit c then - digit - else - other. - -Fixpoint list_of_string (s : string) : list ascii := - match s with - | EmptyString => [] - | String c s => c :: (list_of_string s) - end. - -Fixpoint string_of_list (xs : list ascii) : string := - fold_right String EmptyString xs. - -Definition token := string. - -Fixpoint tokenize_helper (cls : chartype) (acc xs : list ascii) - : list (list ascii) := - let tk := match acc with [] => [] | _::_ => [rev acc] end in - match xs with - | [] => tk - | (x::xs') => - match cls, classifyChar x, x with - | _, _, "(" => tk ++ ["("]::(tokenize_helper other [] xs') - | _, _, ")" => tk ++ [")"]::(tokenize_helper other [] xs') - | _, white, _ => tk ++ (tokenize_helper white [] xs') - | alpha,alpha,x => tokenize_helper alpha (x::acc) xs' - | digit,digit,x => tokenize_helper digit (x::acc) xs' - | other,other,x => tokenize_helper other (x::acc) xs' - | _,tp,x => tk ++ (tokenize_helper tp [x] xs') - end - end %char. - -Definition tokenize (s : string) : list string := - map string_of_list (tokenize_helper white [] (list_of_string s)). - -Example tokenize_ex1 : - tokenize "abc12==3 223*(3+(a+c))" %string - = ["abc"; "12"; "=="; "3"; "223"; - "*"; "("; "3"; "+"; "("; - "a"; "+"; "c"; ")"; ")"]%string. -Proof. reflexivity. Qed. - -(* ####################################################### *) -(** ** Parsing *) - -(* ####################################################### *) -(** *** Options with Errors *) - -(* An option with error messages. *) -Inductive optionE (X:Type) : Type := - | SomeE : X -> optionE X - | NoneE : string -> optionE X. - -Implicit Arguments SomeE [[X]]. -Implicit Arguments NoneE [[X]]. - -(* Some syntactic sugar to make writing nested match-expressions on - optionE more convenient. *) - -Notation "'DO' ( x , y ) <== e1 ; e2" - := (match e1 with - | SomeE (x,y) => e2 - | NoneE err => NoneE err - end) - (right associativity, at level 60). - -Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3" - := (match e1 with - | SomeE (x,y) => e2 - | NoneE err => e3 - end) - (right associativity, at level 60, e2 at next level). - -(* ####################################################### *) -(** *** Symbol Table *) - -(* Build a mapping from [tokens] to [nats]. A real parser would do - this incrementally as it encountered new symbols, but passing - around the symbol table inside the parsing functions is a bit - inconvenient, so instead we do it as a first pass. *) -Fixpoint build_symtable (xs : list token) (n : nat) : (token -> nat) := - match xs with - | [] => (fun s => n) - | x::xs => - if (forallb isLowerAlpha (list_of_string x)) - then (fun s => if string_dec s x then n else (build_symtable xs (S n) s)) - else build_symtable xs n - end. - -(* ####################################################### *) -(** *** Generic Combinators for Building Parsers *) - -Open Scope string_scope. - -Definition parser (T : Type) := - list token -> optionE (T * list token). - -Fixpoint many_helper {T} (p : parser T) acc steps xs := -match steps, p xs with -| 0, _ => NoneE "Too many recursive calls" -| _, NoneE _ => SomeE ((rev acc), xs) -| S steps', SomeE (t, xs') => many_helper p (t::acc) steps' xs' -end. - -(* A (step-indexed) parser which expects zero or more [p]s *) -Fixpoint many {T} (p : parser T) (steps : nat) : parser (list T) := - many_helper p [] steps. - -(* A parser which expects a given token, followed by p *) -Definition firstExpect {T} (t : token) (p : parser T) : parser T := - fun xs => match xs with - | x::xs' => if string_dec x t - then p xs' - else NoneE ("expected '" ++ t ++ "'.") - | [] => NoneE ("expected '" ++ t ++ "'.") - end. - -(* A parser which expects a particular token *) -Definition expect (t : token) : parser unit := - firstExpect t (fun xs => SomeE(tt, xs)). - -(* ####################################################### *) -(** *** A Recursive-Descent Parser for Imp *) - -(* Identifiers *) -Definition parseIdentifier (symtable :string->nat) (xs : list token) - : optionE (id * list token) := -match xs with -| [] => NoneE "Expected identifier" -| x::xs' => - if forallb isLowerAlpha (list_of_string x) then - SomeE (Id (symtable x), xs') - else - NoneE ("Illegal identifier:'" ++ x ++ "'") -end. - -(* Numbers *) -Definition parseNumber (xs : list token) : optionE (nat * list token) := -match xs with -| [] => NoneE "Expected number" -| x::xs' => - if forallb isDigit (list_of_string x) then - SomeE (fold_left (fun n d => - 10 * n + (nat_of_ascii d - nat_of_ascii "0"%char)) - (list_of_string x) - 0, - xs') - else - NoneE "Expected number" -end. - -(* Parse arithmetic expressions *) -Fixpoint parsePrimaryExp (steps:nat) symtable (xs : list token) - : optionE (aexp * list token) := - match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (i, rest) <-- parseIdentifier symtable xs ; - SomeE (AId i, rest) - OR DO (n, rest) <-- parseNumber xs ; - SomeE (ANum n, rest) - OR (DO (e, rest) <== firstExpect "(" (parseSumExp steps' symtable) xs; - DO (u, rest') <== expect ")" rest ; - SomeE(e,rest')) - end -with parseProductExp (steps:nat) symtable (xs : list token) := - match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (e, rest) <== - parsePrimaryExp steps' symtable xs ; - DO (es, rest') <== - many (firstExpect "*" (parsePrimaryExp steps' symtable)) steps' rest; - SomeE (fold_left AMult es e, rest') - end -with parseSumExp (steps:nat) symtable (xs : list token) := - match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (e, rest) <== - parseProductExp steps' symtable xs ; - DO (es, rest') <== - many (fun xs => - DO (e,rest') <-- - firstExpect "+" (parseProductExp steps' symtable) xs; - SomeE ( (true, e), rest') - OR DO (e,rest') <== - firstExpect "-" (parseProductExp steps' symtable) xs; - SomeE ( (false, e), rest')) - steps' rest; - SomeE (fold_left (fun e0 term => - match term with - (true, e) => APlus e0 e - | (false, e) => AMinus e0 e - end) - es e, - rest') - end. - -Definition parseAExp := parseSumExp. - -(* Parsing boolean expressions. *) -Fixpoint parseAtomicExp (steps:nat) (symtable : string->nat) (xs : list token) := -match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (u,rest) <-- expect "true" xs; - SomeE (BTrue,rest) - OR DO (u,rest) <-- expect "false" xs; - SomeE (BFalse,rest) - OR DO (e,rest) <-- firstExpect "not" (parseAtomicExp steps' symtable) xs; - SomeE (BNot e, rest) - OR DO (e,rest) <-- firstExpect "(" (parseConjunctionExp steps' symtable) xs; - (DO (u,rest') <== expect ")" rest; SomeE (e, rest')) - OR DO (e, rest) <== parseProductExp steps' symtable xs ; - (DO (e', rest') <-- - firstExpect "==" (parseAExp steps' symtable) rest ; - SomeE (BEq e e', rest') - OR DO (e', rest') <-- - firstExpect "<=" (parseAExp steps' symtable) rest ; - SomeE (BLe e e', rest') - OR - NoneE "Expected '==' or '<=' after arithmetic expression") -end -with parseConjunctionExp (steps:nat) (symtable : string->nat) (xs : list token) := - match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (e, rest) <== - parseAtomicExp steps' symtable xs ; - DO (es, rest') <== - many (firstExpect "&&" (parseAtomicExp steps' symtable)) steps' rest; - SomeE (fold_left BAnd es e, rest') - end. - -Definition parseBExp := parseConjunctionExp. - -(* -Eval compute in - (parseProductExp 100 (tokenize "x*y*(x*x)*x")). - -Eval compute in - (parseDisjunctionExp 100 (tokenize "not((x==x||x*x<=(x*x)*x)&&x==x)")). -*) - -(* Parsing commands *) -Fixpoint parseSimpleCommand (steps:nat) (symtable:string->nat) (xs : list token) := - match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (u, rest) <-- expect "SKIP" xs; - SomeE (SKIP, rest) - OR DO (e,rest) <-- - firstExpect "IF" (parseBExp steps' symtable) xs; - DO (c,rest') <== - firstExpect "THEN" (parseSequencedCommand steps' symtable) rest; - DO (c',rest'') <== - firstExpect "ELSE" (parseSequencedCommand steps' symtable) rest'; - DO (u,rest''') <== - expect "END" rest''; - SomeE(IFB e THEN c ELSE c' FI, rest''') - OR DO (e,rest) <-- - firstExpect "WHILE" (parseBExp steps' symtable) xs; - DO (c,rest') <== - firstExpect "DO" (parseSequencedCommand steps' symtable) rest; - DO (u,rest'') <== - expect "END" rest'; - SomeE(WHILE e DO c END, rest'') - OR DO (i, rest) <== - parseIdentifier symtable xs; - DO (e, rest') <== - firstExpect ":=" (parseAExp steps' symtable) rest; - SomeE(i ::= e, rest') - end - -with parseSequencedCommand (steps:nat) (symtable:string->nat) (xs : list token) := - match steps with - | 0 => NoneE "Too many recursive calls" - | S steps' => - DO (c, rest) <== - parseSimpleCommand steps' symtable xs; - DO (c', rest') <-- - firstExpect ";;" (parseSequencedCommand steps' symtable) rest; - SomeE(c ;; c', rest') - OR - SomeE(c, rest) - end. - -Definition bignumber := 1000. - -Definition parse (str : string) : optionE (com * list token) := - let tokens := tokenize str in - parseSequencedCommand bignumber (build_symtable tokens 0) tokens. - -(* ####################################################### *) -(** * Examples *) - - -(* -Eval compute in parse " - IF x == y + 1 + 2 - y * 6 + 3 THEN - x := x * 1;; - y := 0 - ELSE - SKIP - END ". -====> - SomeE - (IFB BEq (AId (Id 0)) - (APlus - (AMinus (APlus (APlus (AId (Id 1)) (ANum 1)) (ANum 2)) - (AMult (AId (Id 1)) (ANum 6))) - (ANum 3)) - THEN Id 0 ::= AMult (AId (Id 0)) (ANum 1);; Id 1 ::= ANum 0 - ELSE SKIP FI, []) -*) - -(* -Eval compute in parse " - SKIP;; - z:=x*y*(x*x);; - WHILE x==x DO - IF z <= z*z && not x == 2 THEN - x := z;; - y := z - ELSE - SKIP - END;; - SKIP - END;; - x:=z ". -====> - SomeE - (SKIP;; - Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2))) - (AMult (AId (Id 1)) (AId (Id 1)));; - WHILE BEq (AId (Id 1)) (AId (Id 1)) DO - IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0)))) - (BNot (BEq (AId (Id 1)) (ANum 2))) - THEN Id 1 ::= AId (Id 0);; Id 2 ::= AId (Id 0) - ELSE SKIP FI;; - SKIP - END;; - Id 1 ::= AId (Id 0), - []) -*) - -(* -Eval compute in parse " - SKIP;; - z:=x*y*(x*x);; - WHILE x==x DO - IF z <= z*z && not x == 2 THEN - x := z;; - y := z - ELSE - SKIP - END;; - SKIP - END;; - x:=z ". -=====> - SomeE - (SKIP;; - Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2))) - (AMult (AId (Id 1)) (AId (Id 1)));; - WHILE BEq (AId (Id 1)) (AId (Id 1)) DO - IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0)))) - (BNot (BEq (AId (Id 1)) (ANum 2))) - THEN Id 1 ::= AId (Id 0);; - Id 2 ::= AId (Id 0) - ELSE SKIP - FI;; - SKIP - END;; - Id 1 ::= AId (Id 0), - []). -*) diff --git a/Induction.html b/Induction.html deleted file mode 100644 index 884d877..0000000 --- a/Induction.html +++ /dev/null @@ -1,1035 +0,0 @@ - - - - - -Induction: Proof by Induction - - - - - - -
- - - -
- -

InductionProof by Induction

- -
-
- -
- -
- - The next line imports all of our definitions from the - previous chapter. -
-
- -
-Require Export Basics.
- -
-
- -
-For it to work, you need to use coqc to compile Basics.v - into Basics.vo. (This is like making a .class file from a .java - file, or a .o file from a .c file.) - -
- - Here are two ways to compile your code: - -
- -
    -
  • CoqIDE: - -
    - - Open Basics.v. - In the "Compile" menu, click on "Compile Buffer". - -
    - - -
    • -
  • Command line: - -
    - - Run coqc Basics.v - -
    • -
- -
- - -
-
- -
-
- -
-

Naming Cases

- -
- - The fact that there is no explicit command for moving from - one branch of a case analysis to the next can make proof scripts - rather hard to read. In larger proofs, with nested case analyses, - it can even become hard to stay oriented when you're sitting with - Coq and stepping through the proof. (Imagine trying to remember - that the first five subgoals belong to the inner case analysis and - the remaining seven cases are what remains of the outer one...) - Disciplined use of indentation and comments can help, but a better - way is to use the Case tactic. -
- - Case is not built into Coq: we need to define it ourselves. - There is no need to understand how it works — you can just skip - over the definition to the example that follows. It uses some - facilities of Coq that we have not discussed — the string - library (just for the concrete syntax of quoted strings) and the - Ltac command, which allows us to declare custom tactics. Kudos - to Aaron Bohannon for this nice hack! -
-
- -
-Require String. Open Scope string_scope.
- -
-Ltac move_to_top x :=
-  match reverse goal with
-  | H : _ ⊢ _ ⇒ try move x after H
-  end.
- -
-Tactic Notation "assert_eq" ident(x) constr(v) :=
-  let H := fresh in
-  assert (x = v) as H by reflexivity;
-  clear H.
- -
-Tactic Notation "Case_aux" ident(x) constr(name) :=
-  first [
-    set (x := name); move_to_top x
-  | assert_eq x name; move_to_top x
-  | fail 1 "because we are working on a different case" ].
- -
-Tactic Notation "Case" constr(name) := Case_aux Case name.
-Tactic Notation "SCase" constr(name) := Case_aux SCase name.
-Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
-Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
-Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
-Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
-Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
-Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.
-
- -
-Here's an example of how Case is used. Step through the - following proof and observe how the context changes. -
-
- -
-Theorem andb_true_elim1 : ∀b c : bool,
-  andb b c = true → b = true.
-Proof.
-  intros b c H.
-  destruct b.
-  Case "b = true". (* <----- here *)
-    reflexivity.
-  Case "b = false". (* <---- and here *)
-    rewrite ← H.
-    reflexivity.
-Qed.
- -
-
- -
-Case does something very straightforward: It simply adds a - string that we choose (tagged with the identifier "Case") to the - context for the current goal. When subgoals are generated, this - string is carried over into their contexts. When the last of - these subgoals is finally proved and the next top-level goal - becomes active, this string will no longer appear in the context - and we will be able to see that the case where we introduced it is - complete. Also, as a sanity check, if we try to execute a new - Case tactic while the string left by the previous one is still - in the context, we get a nice clear error message. - -
- - For nested case analyses (e.g., when we want to use a destruct - to solve a goal that has itself been generated by a destruct), - there is an SCase ("subcase") tactic. -
- -

Exercise: 2 stars (andb_true_elim2)

- Prove andb_true_elim2, marking cases (and subcases) when - you use destruct. -
-
- -
-Theorem andb_true_elim2 : ∀b c : bool,
-  andb b c = true → c = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - There are no hard and fast rules for how proofs should be - formatted in Coq — in particular, where lines should be broken - and how sections of the proof should be indented to indicate their - nested structure. However, if the places where multiple subgoals - are generated are marked with explicit Case tactics placed at - the beginning of lines, then the proof will be readable almost no - matter what choices are made about other aspects of layout. - -
- - This is a good place to mention one other piece of (possibly - obvious) advice about line lengths. Beginning Coq users sometimes - tend to the extremes, either writing each tactic on its own line - or entire proofs on one line. Good style lies somewhere in the - middle. In particular, one reasonable convention is to limit - yourself to 80-character lines. Lines longer than this are hard - to read and can be inconvenient to display and print. Many - editors have features that help enforce this. -
-
- -
-
- -
-

Proof by Induction

- -
- - We proved in the last chapter that 0 is a neutral element - for + on the left using a simple argument. The fact that it is - also a neutral element on the right... -
-
- -
-Theorem plus_0_r_firsttry : ∀n:nat,
-  n + 0 = n.
- -
-
- -
-... cannot be proved in the same simple way. Just applying - reflexivity doesn't work: the n in n + 0 is an arbitrary - unknown number, so the match in the definition of + can't be - simplified. -
-
- -
-Proof.
-  intros n.
-  simpl. (* Does nothing! *)
-Abort.
- -
-
- -
-

- -
- - And reasoning by cases using destruct n doesn't get us much - further: the branch of the case analysis where we assume n = 0 - goes through, but in the branch where n = S n' for some n' we - get stuck in exactly the same way. We could use destruct n' to - get one step further, but since n can be arbitrarily large, if we - try to keep on like this we'll never be done. -
-
- -
-Theorem plus_0_r_secondtry : ∀n:nat,
-  n + 0 = n.
-Proof.
-  intros n. destruct n as [| n'].
-  Case "n = 0".
-    reflexivity. (* so far so good... *)
-  Case "n = S n'".
-    simpl. (* ...but here we are stuck again *)
-Abort.
- -
-
- -
-

- -
- - To prove such facts — indeed, to prove most interesting - facts about numbers, lists, and other inductively defined sets — - we need a more powerful reasoning principle: induction. - -
- - Recall (from high school) the principle of induction over natural - numbers: If P(n) is some proposition involving a natural number - n and we want to show that P holds for all numbers n, we can - reason like this: - -
- -
    -
  • show that P(O) holds; - -
    • -
  • show that, for any n', if P(n') holds, then so does - P(S n'); - -
    • -
  • conclude that P(n) holds for all n. - -
    • -
- -
- - In Coq, the steps are the same but the order is backwards: we - begin with the goal of proving P(n) for all n and break it - down (by applying the induction tactic) into two separate - subgoals: first showing P(O) and then showing P(n') → P(S - n'). Here's how this works for the theorem we are trying to - prove at the moment: -
- -

- -
-
- -
-Theorem plus_0_r : ∀n:nat, n + 0 = n.
-Proof.
-  intros n. induction n as [| n'].
-  Case "n = 0". reflexivity.
-  Case "n = S n'". simpl. rewrite → IHn'. reflexivity. Qed.
- -
-
- -
-Like destruct, the induction tactic takes an as... - clause that specifies the names of the variables to be introduced - in the subgoals. In the first branch, n is replaced by 0 and - the goal becomes 0 + 0 = 0, which follows by simplification. In - the second, n is replaced by S n' and the assumption n' + 0 = - n' is added to the context (with the name IHn', i.e., the - Induction Hypothesis for n'). The goal in this case becomes (S - n') + 0 = S n', which simplifies to S (n' + 0) = S n', which in - turn follows from the induction hypothesis. -
-
- -
-Theorem minus_diag : ∀n,
-  minus n n = 0.
-Proof.
-  (* WORKED IN CLASS *)
-  intros n. induction n as [| n'].
-  Case "n = 0".
-    simpl. reflexivity.
-  Case "n = S n'".
-    simpl. rewrite → IHn'. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (basic_induction)

- -
- - Prove the following lemmas using induction. You might need - previously proven results. -
-
- -
-Theorem mult_0_r : ∀n:nat,
-  n × 0 = 0.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem plus_n_Sm : ∀n m : nat,
-  S (n + m) = n + (S m).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem plus_comm : ∀n m : nat,
-  n + m = m + n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem plus_assoc : ∀n m p : nat,
-  n + (m + p) = (n + m) + p.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (double_plus)

- -
- - Consider the following function, which doubles its argument: -
-
- -
-Fixpoint double (n:nat) :=
-  match n with
-  | O ⇒ O
-  | S n' ⇒ S (S (double n'))
-  end.
- -
-
- -
-Use induction to prove this simple fact about double: -
-
- -
-Lemma double_plus : ∀n, double n = n + n .
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (destruct_induction)

- Briefly explain the difference between the tactics - destruct and induction. - -
- -(* FILL IN HERE *)
- -
- - ☐ -
-
- -
-
- -
-

Proofs Within Proofs

- -
- - In Coq, as in informal mathematics, large proofs are very - often broken into a sequence of theorems, with later proofs - referring to earlier theorems. Occasionally, however, a proof - will need some miscellaneous fact that is too trivial (and of too - little general interest) to bother giving it its own top-level - name. In such cases, it is convenient to be able to simply state - and prove the needed "sub-theorem" right at the point where it is - used. The assert tactic allows us to do this. For example, our - earlier proof of the mult_0_plus theorem referred to a previous - theorem named plus_O_n. We can also use assert to state and - prove plus_O_n in-line: -
-
- -
-Theorem mult_0_plus' : ∀n m : nat,
-  (0 + n) × m = n × m.
-Proof.
-  intros n m.
-  assert (H: 0 + n = n).
-    Case "Proof of assertion". reflexivity.
-  rewrite → H.
-  reflexivity. Qed.
- -
-
- -
-The assert tactic introduces two sub-goals. The first is - the assertion itself; by prefixing it with H: we name the - assertion H. (Note that we could also name the assertion with - as just as we did above with destruct and induction, i.e., - assert (0 + n = n) as H. Also note that we mark the proof of - this assertion with a Case, both for readability and so that, - when using Coq interactively, we can see when we're finished - proving the assertion by observing when the "Proof of assertion" - string disappears from the context.) The second goal is the same - as the one at the point where we invoke assert, except that, in - the context, we have the assumption H that 0 + n = n. That - is, assert generates one subgoal where we must prove the - asserted fact and a second subgoal where we can use the asserted - fact to make progress on whatever we were trying to prove in the - first place. -
- - Actually, assert will turn out to be handy in many sorts of - situations. For example, suppose we want to prove that (n + m) - + (p + q) = (m + n) + (p + q). The only difference between the - two sides of the = is that the arguments m and n to the - first inner + are swapped, so it seems we should be able to - use the commutativity of addition (plus_comm) to rewrite one - into the other. However, the rewrite tactic is a little stupid - about where it applies the rewrite. There are three uses of - + here, and it turns out that doing rewrite → plus_comm - will affect only the outer one. -
-
- -
-Theorem plus_rearrange_firsttry : ∀n m p q : nat,
-  (n + m) + (p + q) = (m + n) + (p + q).
-Proof.
-  intros n m p q.
-  (* We just need to swap (n + m) for (m + n)...
-     it seems like plus_comm should do the trick! *)
-  rewrite → plus_comm.
-  (* Doesn't work...Coq rewrote the wrong plus! *)
-Abort.
- -
-
- -
-To get plus_comm to apply at the point where we want it, we can - introduce a local lemma stating that n + m = m + n (for - the particular m and n that we are talking about here), prove - this lemma using plus_comm, and then use this lemma to do the - desired rewrite. -
-
- -
-Theorem plus_rearrange : ∀n m p q : nat,
-  (n + m) + (p + q) = (m + n) + (p + q).
-Proof.
-  intros n m p q.
-  assert (H: n + m = m + n).
-    Case "Proof of assertion".
-    rewrite → plus_comm. reflexivity.
-  rewrite → H. reflexivity. Qed.
- -
-
- -
-

Exercise: 4 stars (mult_comm)

- Use assert to help prove this theorem. You shouldn't need to - use induction. -
-
- -
-Theorem plus_swap : ∀n m p : nat,
-  n + (m + p) = m + (n + p).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Now prove commutativity of multiplication. (You will probably - need to define and prove a separate subsidiary theorem to be used - in the proof of this one.) You may find that plus_swap comes in - handy. -
-
- -
-Theorem mult_comm : ∀m n : nat,
- m × n = n × m.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (evenb_n__oddb_Sn)

- -
- - Prove the following simple fact: -
-
- -
-Theorem evenb_n__oddb_Sn : ∀n : nat,
-  evenb n = negb (evenb (S n)).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

More Exercises

- -
- -

Exercise: 3 stars, optional (more_exercises)

- Take a piece of paper. For each of the following theorems, first - think about whether (a) it can be proved using only - simplification and rewriting, (b) it also requires case - analysis (destruct), or (c) it also requires induction. Write - down your prediction. Then fill in the proof. (There is no need - to turn in your piece of paper; this is just to encourage you to - reflect before hacking!) -
-
- -
-Theorem ble_nat_refl : ∀n:nat,
-  true = ble_nat n n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem zero_nbeq_S : ∀n:nat,
-  beq_nat 0 (S n) = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem andb_false_r : ∀b : bool,
-  andb b false = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem plus_ble_compat_l : ∀n m p : nat,
-  ble_nat n m = true → ble_nat (p + n) (p + m) = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem S_nbeq_0 : ∀n:nat,
-  beq_nat (S n) 0 = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem mult_1_l : ∀n:nat, 1 × n = n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem all3_spec : ∀b c : bool,
-    orb
-      (andb b c)
-      (orb (negb b)
-               (negb c))
-  = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem mult_plus_distr_r : ∀n m p : nat,
-  (n + m) × p = (n × p) + (m × p).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem mult_assoc : ∀n m p : nat,
-  n × (m × p) = (n × m) × p.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (beq_nat_refl)

- Prove the following theorem. Putting true on the left-hand side -of the equality may seem odd, but this is how the theorem is stated in -the standard library, so we follow suit. Since rewriting -works equally well in either direction, we will have no -problem using the theorem no matter which way we state it. -
-
- -
-Theorem beq_nat_refl : ∀n : nat,
-  true = beq_nat n n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (plus_swap')

- The replace tactic allows you to specify a particular subterm to - rewrite and what you want it rewritten to. More precisely, - replace (t) with (u) replaces (all copies of) expression t in - the goal by expression u, and generates t = u as an additional - subgoal. This is often useful when a plain rewrite acts on the wrong - part of the goal. - -
- - Use the replace tactic to do a proof of plus_swap', just like - plus_swap but without needing assert (n + m = m + n). - -
-
- -
-Theorem plus_swap' : ∀n m p : nat,
-  n + (m + p) = m + (n + p).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (binary_commute)

- Recall the increment and binary-to-unary functions that you - wrote for the binary exercise in the Basics chapter. Prove - that these functions commute — that is, incrementing a binary - number and then converting it to unary yields the same result as - first converting it to unary and then incrementing. - -
- - (Before you start working on this exercise, please copy the - definitions from your solution to the binary exercise here so - that this file can be graded on its own. If you find yourself - wanting to change your original definitions to make the property - easier to prove, feel free to do so.) -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 5 stars, advanced (binary_inverse)

- This exercise is a continuation of the previous exercise about - binary numbers. You will need your definitions and theorems from - the previous exercise to complete this one. - -
- - (a) First, write a function to convert natural numbers to binary - numbers. Then prove that starting with any natural number, - converting to binary, then converting back yields the same - natural number you started with. - -
- - (b) You might naturally think that we should also prove the - opposite direction: that starting with a binary number, - converting to a natural, and then back to binary yields the - same number we started with. However, it is not true! - Explain what the problem is. - -
- - (c) Define a function normalize from binary numbers to binary - numbers such that for any binary number b, converting to a - natural and then back to binary yields (normalize b). Prove - it. - -
- - Again, feel free to change your earlier definitions if this helps - here. - -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Advanced Material

- -
- -

Formal vs. Informal Proof

- -
- - "Informal proofs are algorithms; formal proofs are code." -
- - The question of what, exactly, constitutes a "proof" of a - mathematical claim has challenged philosophers for millennia. A - rough and ready definition, though, could be this: a proof of a - mathematical proposition P is a written (or spoken) text that - instills in the reader or hearer the certainty that P is true. - That is, a proof is an act of communication. - -
- - Now, acts of communication may involve different sorts of readers. - On one hand, the "reader" can be a program like Coq, in which case - the "belief" that is instilled is a simple mechanical check that - P can be derived from a certain set of formal logical rules, and - the proof is a recipe that guides the program in performing this - check. Such recipes are formal proofs. - -
- - Alternatively, the reader can be a human being, in which case the - proof will be written in English or some other natural language, - thus necessarily informal. Here, the criteria for success are - less clearly specified. A "good" proof is one that makes the - reader believe P. But the same proof may be read by many - different readers, some of whom may be convinced by a particular - way of phrasing the argument, while others may not be. One reader - may be particularly pedantic, inexperienced, or just plain - thick-headed; the only way to convince them will be to make the - argument in painstaking detail. But another reader, more familiar - in the area, may find all this detail so overwhelming that they - lose the overall thread. All they want is to be told the main - ideas, because it is easier to fill in the details for themselves. - Ultimately, there is no universal standard, because there is no - single way of writing an informal proof that is guaranteed to - convince every conceivable reader. In practice, however, - mathematicians have developed a rich set of conventions and idioms - for writing about complex mathematical objects that, within a - certain community, make communication fairly reliable. The - conventions of this stylized form of communication give a fairly - clear standard for judging proofs good or bad. - -
- - Because we are using Coq in this course, we will be working - heavily with formal proofs. But this doesn't mean we can ignore - the informal ones! Formal proofs are useful in many ways, but - they are not very efficient ways of communicating ideas between - human beings. -
- - For example, here is a proof that addition is associative: -
-
- -
-Theorem plus_assoc' : ∀n m p : nat,
-  n + (m + p) = (n + m) + p.
-Proof. intros n m p. induction n as [| n']. reflexivity.
-  simpl. rewrite → IHn'. reflexivity. Qed.
- -
-
- -
-Coq is perfectly happy with this as a proof. For a human, - however, it is difficult to make much sense of it. If you're used - to Coq you can probably step through the tactics one after the - other in your mind and imagine the state of the context and goal - stack at each point, but if the proof were even a little bit more - complicated this would be next to impossible. Instead, a - mathematician might write it something like this: -
- -
    -
  • Theorem: For any n, m and p, - -
    - -
    -   n + (m + p) = (n + m) + p. -
    - -
    - Proof: By induction on n. - -
    - -
      -
    • First, suppose n = 0. We must show - -
      - -
      -  0 + (m + p) = (0 + m) + p. -
      - -
      - This follows directly from the definition of +. - -
      - - -
      • -
    • Next, suppose n = S n', where - -
      - -
      -  n' + (m + p) = (n' + m) + p. -
      - -
      - We must show - -
      - -
      -  (S n') + (m + p) = ((S n') + m) + p. -
      - -
      - By the definition of +, this follows from - -
      - -
      -  S (n' + (m + p)) = S ((n' + m) + p), -
      - -
      - which is immediate from the induction hypothesis. ☐ -
      • -
    - -
    • -
- -
- - The overall form of the proof is basically similar. This is - no accident: Coq has been designed so that its induction tactic - generates the same sub-goals, in the same order, as the bullet - points that a mathematician would write. But there are - significant differences of detail: the formal proof is much more - explicit in some ways (e.g., the use of reflexivity) but much - less explicit in others (in particular, the "proof state" at any - given point in the Coq proof is completely implicit, whereas the - informal proof reminds the reader several times where things - stand). -
- - Here is a formal proof that shows the structure more - clearly: -
-
- -
-Theorem plus_assoc'' : ∀n m p : nat,
-  n + (m + p) = (n + m) + p.
-Proof.
-  intros n m p. induction n as [| n'].
-  Case "n = 0".
-    reflexivity.
-  Case "n = S n'".
-    simpl. rewrite → IHn'. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars, advanced (plus_comm_informal)

- Translate your solution for plus_comm into an informal proof. -
- - Theorem: Addition is commutative. - -
- - Proof: (* FILL IN HERE *)
-☐ - -
- -

Exercise: 2 stars, optional (beq_nat_refl_informal)

- Write an informal proof of the following theorem, using the - informal proof of plus_assoc as a model. Don't just - paraphrase the Coq tactics into English! - -
- - Theorem: true = beq_nat n n for any n. - -
- - Proof: (* FILL IN HERE *)
-☐ - -
-
- -
-(* $Date: 2014-02-19 21:36:35 -0500 (Wed, 19 Feb 2014) $ *)
-
-
- - - -
- - - \ No newline at end of file diff --git a/Induction.v b/Induction.v deleted file mode 100644 index 35559a9..0000000 --- a/Induction.v +++ /dev/null @@ -1,643 +0,0 @@ -(** * Induction: Proof by Induction *) - - -(** The next line imports all of our definitions from the - previous chapter. *) - -Require Export Basics. - -(** For it to work, you need to use [coqc] to compile [Basics.v] - into [Basics.vo]. (This is like making a .class file from a .java - file, or a .o file from a .c file.) - - Here are two ways to compile your code: - - - CoqIDE: - - Open [Basics.v]. - In the "Compile" menu, click on "Compile Buffer". - - - Command line: - - Run [coqc Basics.v] - - *) - -(* ###################################################################### *) -(** * Naming Cases *) - -(** The fact that there is no explicit command for moving from - one branch of a case analysis to the next can make proof scripts - rather hard to read. In larger proofs, with nested case analyses, - it can even become hard to stay oriented when you're sitting with - Coq and stepping through the proof. (Imagine trying to remember - that the first five subgoals belong to the inner case analysis and - the remaining seven cases are what remains of the outer one...) - Disciplined use of indentation and comments can help, but a better - way is to use the [Case] tactic. *) - -(** [Case] is not built into Coq: we need to define it ourselves. - There is no need to understand how it works -- you can just skip - over the definition to the example that follows. It uses some - facilities of Coq that we have not discussed -- the string - library (just for the concrete syntax of quoted strings) and the - [Ltac] command, which allows us to declare custom tactics. Kudos - to Aaron Bohannon for this nice hack! *) - -Require String. Open Scope string_scope. - -Ltac move_to_top x := - match reverse goal with - | H : _ |- _ => try move x after H - end. - -Tactic Notation "assert_eq" ident(x) constr(v) := - let H := fresh in - assert (x = v) as H by reflexivity; - clear H. - -Tactic Notation "Case_aux" ident(x) constr(name) := - first [ - set (x := name); move_to_top x - | assert_eq x name; move_to_top x - | fail 1 "because we are working on a different case" ]. - -Tactic Notation "Case" constr(name) := Case_aux Case name. -Tactic Notation "SCase" constr(name) := Case_aux SCase name. -Tactic Notation "SSCase" constr(name) := Case_aux SSCase name. -Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name. -Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name. -Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name. -Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name. -Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name. -(** Here's an example of how [Case] is used. Step through the - following proof and observe how the context changes. *) - -Theorem andb_true_elim1 : forall b c : bool, - andb b c = true -> b = true. -Proof. - intros b c H. - destruct b. - Case "b = true". (* <----- here *) - reflexivity. - Case "b = false". (* <---- and here *) - rewrite <- H. - reflexivity. -Qed. - -(** [Case] does something very straightforward: It simply adds a - string that we choose (tagged with the identifier "Case") to the - context for the current goal. When subgoals are generated, this - string is carried over into their contexts. When the last of - these subgoals is finally proved and the next top-level goal - becomes active, this string will no longer appear in the context - and we will be able to see that the case where we introduced it is - complete. Also, as a sanity check, if we try to execute a new - [Case] tactic while the string left by the previous one is still - in the context, we get a nice clear error message. - - For nested case analyses (e.g., when we want to use a [destruct] - to solve a goal that has itself been generated by a [destruct]), - there is an [SCase] ("subcase") tactic. *) - -(** **** Exercise: 2 stars (andb_true_elim2) *) -(** Prove [andb_true_elim2], marking cases (and subcases) when - you use [destruct]. *) - -Theorem andb_true_elim2 : forall b c : bool, - andb b c = true -> c = true. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** There are no hard and fast rules for how proofs should be - formatted in Coq -- in particular, where lines should be broken - and how sections of the proof should be indented to indicate their - nested structure. However, if the places where multiple subgoals - are generated are marked with explicit [Case] tactics placed at - the beginning of lines, then the proof will be readable almost no - matter what choices are made about other aspects of layout. - - This is a good place to mention one other piece of (possibly - obvious) advice about line lengths. Beginning Coq users sometimes - tend to the extremes, either writing each tactic on its own line - or entire proofs on one line. Good style lies somewhere in the - middle. In particular, one reasonable convention is to limit - yourself to 80-character lines. Lines longer than this are hard - to read and can be inconvenient to display and print. Many - editors have features that help enforce this. *) - -(* ###################################################################### *) -(** * Proof by Induction *) - -(** We proved in the last chapter that [0] is a neutral element - for [+] on the left using a simple argument. The fact that it is - also a neutral element on the _right_... *) - -Theorem plus_0_r_firsttry : forall n:nat, - n + 0 = n. - -(** ... cannot be proved in the same simple way. Just applying - [reflexivity] doesn't work: the [n] in [n + 0] is an arbitrary - unknown number, so the [match] in the definition of [+] can't be - simplified. *) - -Proof. - intros n. - simpl. (* Does nothing! *) -Abort. - -(** *** *) - -(** And reasoning by cases using [destruct n] doesn't get us much - further: the branch of the case analysis where we assume [n = 0] - goes through, but in the branch where [n = S n'] for some [n'] we - get stuck in exactly the same way. We could use [destruct n'] to - get one step further, but since [n] can be arbitrarily large, if we - try to keep on like this we'll never be done. *) - -Theorem plus_0_r_secondtry : forall n:nat, - n + 0 = n. -Proof. - intros n. destruct n as [| n']. - Case "n = 0". - reflexivity. (* so far so good... *) - Case "n = S n'". - simpl. (* ...but here we are stuck again *) -Abort. - -(** *** *) - -(** To prove such facts -- indeed, to prove most interesting - facts about numbers, lists, and other inductively defined sets -- - we need a more powerful reasoning principle: _induction_. - - Recall (from high school) the principle of induction over natural - numbers: If [P(n)] is some proposition involving a natural number - [n] and we want to show that P holds for _all_ numbers [n], we can - reason like this: - - show that [P(O)] holds; - - show that, for any [n'], if [P(n')] holds, then so does - [P(S n')]; - - conclude that [P(n)] holds for all [n]. - - In Coq, the steps are the same but the order is backwards: we - begin with the goal of proving [P(n)] for all [n] and break it - down (by applying the [induction] tactic) into two separate - subgoals: first showing [P(O)] and then showing [P(n') -> P(S - n')]. Here's how this works for the theorem we are trying to - prove at the moment: *) - -(** *** *) - -Theorem plus_0_r : forall n:nat, n + 0 = n. -Proof. - intros n. induction n as [| n']. - Case "n = 0". reflexivity. - Case "n = S n'". simpl. rewrite -> IHn'. reflexivity. Qed. - -(** Like [destruct], the [induction] tactic takes an [as...] - clause that specifies the names of the variables to be introduced - in the subgoals. In the first branch, [n] is replaced by [0] and - the goal becomes [0 + 0 = 0], which follows by simplification. In - the second, [n] is replaced by [S n'] and the assumption [n' + 0 = - n'] is added to the context (with the name [IHn'], i.e., the - Induction Hypothesis for [n']). The goal in this case becomes [(S - n') + 0 = S n'], which simplifies to [S (n' + 0) = S n'], which in - turn follows from the induction hypothesis. *) - -Theorem minus_diag : forall n, - minus n n = 0. -Proof. - (* WORKED IN CLASS *) - intros n. induction n as [| n']. - Case "n = 0". - simpl. reflexivity. - Case "n = S n'". - simpl. rewrite -> IHn'. reflexivity. Qed. - -(** **** Exercise: 2 stars (basic_induction) *) - -(** Prove the following lemmas using induction. You might need - previously proven results. *) - -Theorem mult_0_r : forall n:nat, - n * 0 = 0. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem plus_n_Sm : forall n m : nat, - S (n + m) = n + (S m). -Proof. - (* FILL IN HERE *) Admitted. - - -Theorem plus_comm : forall n m : nat, - n + m = m + n. -Proof. - (* FILL IN HERE *) Admitted. - - -Theorem plus_assoc : forall n m p : nat, - n + (m + p) = (n + m) + p. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (double_plus) *) - -(** Consider the following function, which doubles its argument: *) - -Fixpoint double (n:nat) := - match n with - | O => O - | S n' => S (S (double n')) - end. - -(** Use induction to prove this simple fact about [double]: *) - -Lemma double_plus : forall n, double n = n + n . -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(** **** Exercise: 1 star (destruct_induction) *) -(** Briefly explain the difference between the tactics - [destruct] and [induction]. - -(* FILL IN HERE *) - -*) -(** [] *) - - -(* ###################################################################### *) -(** * Proofs Within Proofs *) - - -(** In Coq, as in informal mathematics, large proofs are very - often broken into a sequence of theorems, with later proofs - referring to earlier theorems. Occasionally, however, a proof - will need some miscellaneous fact that is too trivial (and of too - little general interest) to bother giving it its own top-level - name. In such cases, it is convenient to be able to simply state - and prove the needed "sub-theorem" right at the point where it is - used. The [assert] tactic allows us to do this. For example, our - earlier proof of the [mult_0_plus] theorem referred to a previous - theorem named [plus_O_n]. We can also use [assert] to state and - prove [plus_O_n] in-line: *) - -Theorem mult_0_plus' : forall n m : nat, - (0 + n) * m = n * m. -Proof. - intros n m. - assert (H: 0 + n = n). - Case "Proof of assertion". reflexivity. - rewrite -> H. - reflexivity. Qed. - -(** The [assert] tactic introduces two sub-goals. The first is - the assertion itself; by prefixing it with [H:] we name the - assertion [H]. (Note that we could also name the assertion with - [as] just as we did above with [destruct] and [induction], i.e., - [assert (0 + n = n) as H]. Also note that we mark the proof of - this assertion with a [Case], both for readability and so that, - when using Coq interactively, we can see when we're finished - proving the assertion by observing when the ["Proof of assertion"] - string disappears from the context.) The second goal is the same - as the one at the point where we invoke [assert], except that, in - the context, we have the assumption [H] that [0 + n = n]. That - is, [assert] generates one subgoal where we must prove the - asserted fact and a second subgoal where we can use the asserted - fact to make progress on whatever we were trying to prove in the - first place. *) - -(** Actually, [assert] will turn out to be handy in many sorts of - situations. For example, suppose we want to prove that [(n + m) - + (p + q) = (m + n) + (p + q)]. The only difference between the - two sides of the [=] is that the arguments [m] and [n] to the - first inner [+] are swapped, so it seems we should be able to - use the commutativity of addition ([plus_comm]) to rewrite one - into the other. However, the [rewrite] tactic is a little stupid - about _where_ it applies the rewrite. There are three uses of - [+] here, and it turns out that doing [rewrite -> plus_comm] - will affect only the _outer_ one. *) - -Theorem plus_rearrange_firsttry : forall n m p q : nat, - (n + m) + (p + q) = (m + n) + (p + q). -Proof. - intros n m p q. - (* We just need to swap (n + m) for (m + n)... - it seems like plus_comm should do the trick! *) - rewrite -> plus_comm. - (* Doesn't work...Coq rewrote the wrong plus! *) -Abort. - -(** To get [plus_comm] to apply at the point where we want it, we can - introduce a local lemma stating that [n + m = m + n] (for - the particular [m] and [n] that we are talking about here), prove - this lemma using [plus_comm], and then use this lemma to do the - desired rewrite. *) - -Theorem plus_rearrange : forall n m p q : nat, - (n + m) + (p + q) = (m + n) + (p + q). -Proof. - intros n m p q. - assert (H: n + m = m + n). - Case "Proof of assertion". - rewrite -> plus_comm. reflexivity. - rewrite -> H. reflexivity. Qed. - -(** **** Exercise: 4 stars (mult_comm) *) -(** Use [assert] to help prove this theorem. You shouldn't need to - use induction. *) - -Theorem plus_swap : forall n m p : nat, - n + (m + p) = m + (n + p). -Proof. - (* FILL IN HERE *) Admitted. - - -(** Now prove commutativity of multiplication. (You will probably - need to define and prove a separate subsidiary theorem to be used - in the proof of this one.) You may find that [plus_swap] comes in - handy. *) - -Theorem mult_comm : forall m n : nat, - m * n = n * m. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, optional (evenb_n__oddb_Sn) *) - -(** Prove the following simple fact: *) - -Theorem evenb_n__oddb_Sn : forall n : nat, - evenb n = negb (evenb (S n)). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** * More Exercises *) - -(** **** Exercise: 3 stars, optional (more_exercises) *) -(** Take a piece of paper. For each of the following theorems, first - _think_ about whether (a) it can be proved using only - simplification and rewriting, (b) it also requires case - analysis ([destruct]), or (c) it also requires induction. Write - down your prediction. Then fill in the proof. (There is no need - to turn in your piece of paper; this is just to encourage you to - reflect before hacking!) *) - -Theorem ble_nat_refl : forall n:nat, - true = ble_nat n n. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem zero_nbeq_S : forall n:nat, - beq_nat 0 (S n) = false. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem andb_false_r : forall b : bool, - andb b false = false. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem plus_ble_compat_l : forall n m p : nat, - ble_nat n m = true -> ble_nat (p + n) (p + m) = true. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem S_nbeq_0 : forall n:nat, - beq_nat (S n) 0 = false. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem mult_1_l : forall n:nat, 1 * n = n. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem all3_spec : forall b c : bool, - orb - (andb b c) - (orb (negb b) - (negb c)) - = true. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem mult_plus_distr_r : forall n m p : nat, - (n + m) * p = (n * p) + (m * p). -Proof. - (* FILL IN HERE *) Admitted. - -Theorem mult_assoc : forall n m p : nat, - n * (m * p) = (n * m) * p. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, optional (beq_nat_refl) *) -(** Prove the following theorem. Putting [true] on the left-hand side -of the equality may seem odd, but this is how the theorem is stated in -the standard library, so we follow suit. Since rewriting -works equally well in either direction, we will have no -problem using the theorem no matter which way we state it. *) - -Theorem beq_nat_refl : forall n : nat, - true = beq_nat n n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, optional (plus_swap') *) -(** The [replace] tactic allows you to specify a particular subterm to - rewrite and what you want it rewritten to. More precisely, - [replace (t) with (u)] replaces (all copies of) expression [t] in - the goal by expression [u], and generates [t = u] as an additional - subgoal. This is often useful when a plain [rewrite] acts on the wrong - part of the goal. - - Use the [replace] tactic to do a proof of [plus_swap'], just like - [plus_swap] but without needing [assert (n + m = m + n)]. -*) - -Theorem plus_swap' : forall n m p : nat, - n + (m + p) = m + (n + p). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(** **** Exercise: 3 stars (binary_commute) *) -(** Recall the [increment] and [binary-to-unary] functions that you - wrote for the [binary] exercise in the [Basics] chapter. Prove - that these functions commute -- that is, incrementing a binary - number and then converting it to unary yields the same result as - first converting it to unary and then incrementing. - - (Before you start working on this exercise, please copy the - definitions from your solution to the [binary] exercise here so - that this file can be graded on its own. If you find yourself - wanting to change your original definitions to make the property - easier to prove, feel free to do so.) *) - -(* FILL IN HERE *) -(** [] *) - - -(** **** Exercise: 5 stars, advanced (binary_inverse) *) -(** This exercise is a continuation of the previous exercise about - binary numbers. You will need your definitions and theorems from - the previous exercise to complete this one. - - (a) First, write a function to convert natural numbers to binary - numbers. Then prove that starting with any natural number, - converting to binary, then converting back yields the same - natural number you started with. - - (b) You might naturally think that we should also prove the - opposite direction: that starting with a binary number, - converting to a natural, and then back to binary yields the - same number we started with. However, it is not true! - Explain what the problem is. - - (c) Define a function [normalize] from binary numbers to binary - numbers such that for any binary number b, converting to a - natural and then back to binary yields [(normalize b)]. Prove - it. - - Again, feel free to change your earlier definitions if this helps - here. -*) - -(* FILL IN HERE *) -(** [] *) - -(* ###################################################################### *) -(** * Advanced Material *) - -(** ** Formal vs. Informal Proof *) - -(** "Informal proofs are algorithms; formal proofs are code." *) - -(** The question of what, exactly, constitutes a "proof" of a - mathematical claim has challenged philosophers for millennia. A - rough and ready definition, though, could be this: a proof of a - mathematical proposition [P] is a written (or spoken) text that - instills in the reader or hearer the certainty that [P] is true. - That is, a proof is an act of communication. - - Now, acts of communication may involve different sorts of readers. - On one hand, the "reader" can be a program like Coq, in which case - the "belief" that is instilled is a simple mechanical check that - [P] can be derived from a certain set of formal logical rules, and - the proof is a recipe that guides the program in performing this - check. Such recipes are _formal_ proofs. - - Alternatively, the reader can be a human being, in which case the - proof will be written in English or some other natural language, - thus necessarily _informal_. Here, the criteria for success are - less clearly specified. A "good" proof is one that makes the - reader believe [P]. But the same proof may be read by many - different readers, some of whom may be convinced by a particular - way of phrasing the argument, while others may not be. One reader - may be particularly pedantic, inexperienced, or just plain - thick-headed; the only way to convince them will be to make the - argument in painstaking detail. But another reader, more familiar - in the area, may find all this detail so overwhelming that they - lose the overall thread. All they want is to be told the main - ideas, because it is easier to fill in the details for themselves. - Ultimately, there is no universal standard, because there is no - single way of writing an informal proof that is guaranteed to - convince every conceivable reader. In practice, however, - mathematicians have developed a rich set of conventions and idioms - for writing about complex mathematical objects that, within a - certain community, make communication fairly reliable. The - conventions of this stylized form of communication give a fairly - clear standard for judging proofs good or bad. - - Because we are using Coq in this course, we will be working - heavily with formal proofs. But this doesn't mean we can ignore - the informal ones! Formal proofs are useful in many ways, but - they are _not_ very efficient ways of communicating ideas between - human beings. *) - -(** For example, here is a proof that addition is associative: *) - -Theorem plus_assoc' : forall n m p : nat, - n + (m + p) = (n + m) + p. -Proof. intros n m p. induction n as [| n']. reflexivity. - simpl. rewrite -> IHn'. reflexivity. Qed. - -(** Coq is perfectly happy with this as a proof. For a human, - however, it is difficult to make much sense of it. If you're used - to Coq you can probably step through the tactics one after the - other in your mind and imagine the state of the context and goal - stack at each point, but if the proof were even a little bit more - complicated this would be next to impossible. Instead, a - mathematician might write it something like this: *) -(** - _Theorem_: For any [n], [m] and [p], - n + (m + p) = (n + m) + p. - _Proof_: By induction on [n]. - - - First, suppose [n = 0]. We must show - 0 + (m + p) = (0 + m) + p. - This follows directly from the definition of [+]. - - - Next, suppose [n = S n'], where - n' + (m + p) = (n' + m) + p. - We must show - (S n') + (m + p) = ((S n') + m) + p. - By the definition of [+], this follows from - S (n' + (m + p)) = S ((n' + m) + p), - which is immediate from the induction hypothesis. [] *) - -(** The overall form of the proof is basically similar. This is - no accident: Coq has been designed so that its [induction] tactic - generates the same sub-goals, in the same order, as the bullet - points that a mathematician would write. But there are - significant differences of detail: the formal proof is much more - explicit in some ways (e.g., the use of [reflexivity]) but much - less explicit in others (in particular, the "proof state" at any - given point in the Coq proof is completely implicit, whereas the - informal proof reminds the reader several times where things - stand). *) - -(** Here is a formal proof that shows the structure more - clearly: *) - -Theorem plus_assoc'' : forall n m p : nat, - n + (m + p) = (n + m) + p. -Proof. - intros n m p. induction n as [| n']. - Case "n = 0". - reflexivity. - Case "n = S n'". - simpl. rewrite -> IHn'. reflexivity. Qed. - -(** **** Exercise: 2 stars, advanced (plus_comm_informal) *) -(** Translate your solution for [plus_comm] into an informal proof. *) - -(** Theorem: Addition is commutative. - - Proof: (* FILL IN HERE *) -[] -*) - -(** **** Exercise: 2 stars, optional (beq_nat_refl_informal) *) -(** Write an informal proof of the following theorem, using the - informal proof of [plus_assoc] as a model. Don't just - paraphrase the Coq tactics into English! - - Theorem: [true = beq_nat n n] for any [n]. - - Proof: (* FILL IN HERE *) -[] - *) - -(* $Date: 2014-02-19 21:36:35 -0500 (Wed, 19 Feb 2014) $ *) diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 3dca8a2..0000000 --- a/LICENSE +++ /dev/null @@ -1,19 +0,0 @@ -Copyright (c) 2012 - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. diff --git a/Lists.html b/Lists.html deleted file mode 100644 index 2dcf8d0..0000000 --- a/Lists.html +++ /dev/null @@ -1,1766 +0,0 @@ - - - - - -Lists: Working with Structured Data - - - - - - -
- - - -
- -

ListsWorking with Structured Data

- -
-
- -
- -
-
- -
-Require Export Induction.
- -
-Module NatList.
- -
-
- -
-

Pairs of Numbers

- -
- - In an Inductive type definition, each constructor can take - any number of arguments — none (as with true and O), one (as - with S), or more than one, as in this definition: -
-
- -
-Inductive natprod : Type :=
-  pair : nat → nat → natprod.
- -
-
- -
-This declaration can be read: "There is just one way to - construct a pair of numbers: by applying the constructor pair to - two arguments of type nat." -
- - We can construct an element of natprod like this: -
-
- -
-Check (pair 3 5).
- -
-
- -
-

- -
- - Here are two simple function definitions for extracting the - first and second components of a pair. (The definitions also - illustrate how to do pattern matching on two-argument - constructors.) -
-
- -
-Definition fst (p : natprod) : nat :=
-  match p with
-  | pair x y ⇒ x
-  end.
-Definition snd (p : natprod) : nat :=
-  match p with
-  | pair x y ⇒ y
-  end.
- -
-Eval compute in (fst (pair 3 5)).
-(* ===> 3 *)
- -
-
- -
-

- -
- - Since pairs are used quite a bit, it is nice to be able to - write them with the standard mathematical notation (x,y) instead - of pair x y. We can tell Coq to allow this with a Notation - declaration. -
-
- -
-Notation "( x , y )" := (pair x y).
- -
-
- -
-The new notation can be used both in expressions and in - pattern matches (indeed, we've seen it already in the previous - chapter — this notation is provided as part of the standard - library): -
-
- -
-Eval compute in (fst (3,5)).
- -
-Definition fst' (p : natprod) : nat :=
-  match p with
-  | (x,y) ⇒ x
-  end.
-Definition snd' (p : natprod) : nat :=
-  match p with
-  | (x,y) ⇒ y
-  end.
- -
-Definition swap_pair (p : natprod) : natprod :=
-  match p with
-  | (x,y) ⇒ (y,x)
-  end.
- -
-
- -
-

- -
- - Let's try and prove a few simple facts about pairs. If we - state the lemmas in a particular (and slightly peculiar) way, we - can prove them with just reflexivity (and its built-in - simplification): -
-
- -
-Theorem surjective_pairing' : ∀(n m : nat),
-  (n,m) = (fst (n,m), snd (n,m)).
-Proof.
-  reflexivity. Qed.
- -
-
- -
-Note that reflexivity is not enough if we state the lemma in a - more natural way: -
-
- -
-Theorem surjective_pairing_stuck : ∀(p : natprod),
-  p = (fst p, snd p).
-Proof.
-  simpl. (* Doesn't reduce anything! *)
-Abort.
- -
-
- -
-

- We have to expose the structure of p so that simpl can - perform the pattern match in fst and snd. We can do this with - destruct. - -
- - Notice that, unlike for nats, destruct doesn't generate an - extra subgoal here. That's because natprods can only be - constructed in one way. -
-
- -
-Theorem surjective_pairing : ∀(p : natprod),
-  p = (fst p, snd p).
-Proof.
-  intros p. destruct p as [n m]. simpl. reflexivity. Qed.
- -
-
- -
-

Exercise: 1 star (snd_fst_is_swap)

- -
-
-Theorem snd_fst_is_swap : ∀(p : natprod),
-  (snd p, fst p) = swap_pair p.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (fst_swap_is_snd)

- -
-
-Theorem fst_swap_is_snd : ∀(p : natprod),
-  fst (swap_pair p) = snd p.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Lists of Numbers

- -
- - Generalizing the definition of pairs a little, we can - describe the type of lists of numbers like this: "A list is - either the empty list or else a pair of a number and another - list." -
-
- -
-Inductive natlist : Type :=
-  | nil : natlist
-  | cons : nat → natlist → natlist.
- -
-
- -
-For example, here is a three-element list: -
-
- -
-Definition mylist := cons 1 (cons 2 (cons 3 nil)).
- -
-
- -
-

- As with pairs, it is more convenient to write lists in - familiar programming notation. The following two declarations - allow us to use :: as an infix cons operator and square - brackets as an "outfix" notation for constructing lists. -
-
- -
-Notation "x :: l" := (cons x l) (at level 60, right associativity).
-Notation "[ ]" := nil.
-Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).
- -
-
- -
-It is not necessary to fully understand these declarations, - but in case you are interested, here is roughly what's going on. - -
- - The right associativity annotation tells Coq how to parenthesize - expressions involving several uses of :: so that, for example, - the next three declarations mean exactly the same thing: -
-
- -
-Definition mylist1 := 1 :: (2 :: (3 :: nil)).
-Definition mylist2 := 1 :: 2 :: 3 :: nil.
-Definition mylist3 := [1;2;3].
- -
-
- -
-The at level 60 part tells Coq how to parenthesize - expressions that involve both :: and some other infix operator. - For example, since we defined + as infix notation for the plus - function at level 50, - -
- -
-Notation "x + y" := (plus x y)  
-                    (at level 50, left associativity). -
- -
- The + operator will bind tighter than ::, so 1 + 2 :: [3] - will be parsed, as we'd expect, as (1 + 2) :: [3] rather than 1 - + (2 :: [3]). - -
- - (By the way, it's worth noting in passing that expressions like "1 - + 2 :: [3]" can be a little confusing when you read them in a .v - file. The inner brackets, around 3, indicate a list, but the outer - brackets, which are invisible in the HTML rendering, are there to - instruct the "coqdoc" tool that the bracketed part should be - displayed as Coq code rather than running text.) - -
- - The second and third Notation declarations above introduce the - standard square-bracket notation for lists; the right-hand side of - the third one illustrates Coq's syntax for declaring n-ary - notations and translating them to nested sequences of binary - constructors. -
- -

Repeat

- A number of functions are useful for manipulating lists. - For example, the repeat function takes a number n and a - count and returns a list of length count where every element - is n. -
-
- -
-Fixpoint repeat (n count : nat) : natlist :=
-  match count with
-  | O ⇒ nil
-  | S count' ⇒ n :: (repeat n count')
-  end.
- -
-
- -
-

Length

- The length function calculates the length of a list. -
-
- -
-Fixpoint length (l:natlist) : nat :=
-  match l with
-  | nil ⇒ O
-  | h :: t ⇒ S (length t)
-  end.
- -
-
- -
-

Append

- The app ("append") function concatenates two lists. -
-
- -
-Fixpoint app (l1 l2 : natlist) : natlist :=
-  match l1 with
-  | nil ⇒ l2
-  | h :: t ⇒ h :: (app t l2)
-  end.
- -
-
- -
-Actually, app will be used a lot in some parts of what - follows, so it is convenient to have an infix operator for it. -
-
- -
-Notation "x ++ y" := (app x y)
-                     (right associativity, at level 60).
- -
-Example test_app1: [1;2;3] ++ [4;5] = [1;2;3;4;5].
-Proof. reflexivity. Qed.
-Example test_app2: nil ++ [4;5] = [4;5].
-Proof. reflexivity. Qed.
-Example test_app3: [1;2;3] ++ nil = [1;2;3].
-Proof. reflexivity. Qed.
- -
-
- -
-Here are two smaller examples of programming with lists. - The hd function returns the first element (the "head") of the - list, while tl returns everything but the first - element (the "tail"). - Of course, the empty list has no first element, so we - must pass a default value to be returned in that case. -
- -

Head (with default) and Tail

- -
-
-Definition hd (default:nat) (l:natlist) : nat :=
-  match l with
-  | nil ⇒ default
-  | h :: t ⇒ h
-  end.
- -
-Definition tl (l:natlist) : natlist :=
-  match l with
-  | nil ⇒ nil
-  | h :: t ⇒ t
-  end.
- -
-Example test_hd1: hd 0 [1;2;3] = 1.
-Proof. reflexivity. Qed.
-Example test_hd2: hd 0 [] = 0.
-Proof. reflexivity. Qed.
-Example test_tl: tl [1;2;3] = [2;3].
-Proof. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (list_funs)

- Complete the definitions of nonzeros, oddmembers and - countoddmembers below. Have a look at the tests to understand - what these functions should do. -
-
- -
-Fixpoint nonzeros (l:natlist) : natlist :=
-  (* FILL IN HERE *) admit.
- -
-Example test_nonzeros: nonzeros [0;1;0;2;3;0;0] = [1;2;3].
- (* FILL IN HERE *) Admitted.
- -
-Fixpoint oddmembers (l:natlist) : natlist :=
-  (* FILL IN HERE *) admit.
- -
-Example test_oddmembers: oddmembers [0;1;0;2;3;0;0] = [1;3].
- (* FILL IN HERE *) Admitted.
- -
-Fixpoint countoddmembers (l:natlist) : nat :=
-  (* FILL IN HERE *) admit.
- -
-Example test_countoddmembers1: countoddmembers [1;0;3;1;4;5] = 4.
- (* FILL IN HERE *) Admitted.
-Example test_countoddmembers2: countoddmembers [0;2;4] = 0.
- (* FILL IN HERE *) Admitted.
-Example test_countoddmembers3: countoddmembers nil = 0.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (alternate)

- Complete the definition of alternate, which "zips up" two lists - into one, alternating between elements taken from the first list - and elements from the second. See the tests below for more - specific examples. - -
- - Note: one natural and elegant way of writing alternate will fail - to satisfy Coq's requirement that all Fixpoint definitions be - "obviously terminating." If you find yourself in this rut, look - for a slightly more verbose solution that considers elements of - both lists at the same time. (One possible solution requires - defining a new kind of pairs, but this is not the only way.) -
-
- -
-Fixpoint alternate (l1 l2 : natlist) : natlist :=
-  (* FILL IN HERE *) admit.
- -
-Example test_alternate1: alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
- (* FILL IN HERE *) Admitted.
-Example test_alternate2: alternate [1] [4;5;6] = [1;4;5;6].
- (* FILL IN HERE *) Admitted.
-Example test_alternate3: alternate [1;2;3] [4] = [1;4;2;3].
- (* FILL IN HERE *) Admitted.
-Example test_alternate4: alternate [] [20;30] = [20;30].
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Bags via Lists

- -
- - A bag (or multiset) is like a set, but each element can appear - multiple times instead of just once. One reasonable - implementation of bags is to represent a bag of numbers as a - list. -
-
- -
-Definition bag := natlist.
- -
-
- -
-

Exercise: 3 stars (bag_functions)

- Complete the following definitions for the functions - count, sum, add, and member for bags. -
-
- -
-Fixpoint count (v:nat) (s:bag) : nat :=
-  (* FILL IN HERE *) admit.
- -
-
- -
-All these proofs can be done just by reflexivity. -
-
- -
-Example test_count1: count 1 [1;2;3;1;4;1] = 3.
- (* FILL IN HERE *) Admitted.
-Example test_count2: count 6 [1;2;3;1;4;1] = 0.
- (* FILL IN HERE *) Admitted.
- -
-
- -
-Multiset sum is similar to set union: sum a b contains - all the elements of a and of b. (Mathematicians usually - define union on multisets a little bit differently, which - is why we don't use that name for this operation.) - For sum we're giving you a header that does not give explicit - names to the arguments. Moreover, it uses the keyword - Definition instead of Fixpoint, so even if you had names for - the arguments, you wouldn't be able to process them recursively. - The point of stating the question this way is to encourage you to - think about whether sum can be implemented in another way — - perhaps by using functions that have already been defined. -
-
- -
-Definition sum : bag → bag → bag :=
-  (* FILL IN HERE *) admit.
- -
-Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3.
- (* FILL IN HERE *) Admitted.
- -
-Definition add (v:nat) (s:bag) : bag :=
-  (* FILL IN HERE *) admit.
- -
-Example test_add1: count 1 (add 1 [1;4;1]) = 3.
- (* FILL IN HERE *) Admitted.
-Example test_add2: count 5 (add 1 [1;4;1]) = 0.
- (* FILL IN HERE *) Admitted.
- -
-Definition member (v:nat) (s:bag) : bool :=
-  (* FILL IN HERE *) admit.
- -
-Example test_member1: member 1 [1;4;1] = true.
- (* FILL IN HERE *) Admitted.
-Example test_member2: member 2 [1;4;1] = false.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (bag_more_functions)

- Here are some more bag functions for you to practice with. -
-
- -
-Fixpoint remove_one (v:nat) (s:bag) : bag :=
-  (* When remove_one is applied to a bag without the number to remove,
-     it should return the same bag unchanged. *)
-  (* FILL IN HERE *) admit.
- -
-Example test_remove_one1: count 5 (remove_one 5 [2;1;5;4;1]) = 0.
- (* FILL IN HERE *) Admitted.
-Example test_remove_one2: count 5 (remove_one 5 [2;1;4;1]) = 0.
- (* FILL IN HERE *) Admitted.
-Example test_remove_one3: count 4 (remove_one 5 [2;1;4;5;1;4]) = 2.
- (* FILL IN HERE *) Admitted.
-Example test_remove_one4: count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1.
- (* FILL IN HERE *) Admitted.
- -
-Fixpoint remove_all (v:nat) (s:bag) : bag :=
-  (* FILL IN HERE *) admit.
- -
-Example test_remove_all1: count 5 (remove_all 5 [2;1;5;4;1]) = 0.
- (* FILL IN HERE *) Admitted.
-Example test_remove_all2: count 5 (remove_all 5 [2;1;4;1]) = 0.
- (* FILL IN HERE *) Admitted.
-Example test_remove_all3: count 4 (remove_all 5 [2;1;4;5;1;4]) = 2.
- (* FILL IN HERE *) Admitted.
-Example test_remove_all4: count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0.
- (* FILL IN HERE *) Admitted.
- -
-Fixpoint subset (s1:bag) (s2:bag) : bool :=
-  (* FILL IN HERE *) admit.
- -
-Example test_subset1: subset [1;2] [2;1;4;1] = true.
- (* FILL IN HERE *) Admitted.
-Example test_subset2: subset [1;2;2] [2;1;4;1] = false.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (bag_theorem)

- Write down an interesting theorem about bags involving the - functions count and add, and prove it. Note that, since this - problem is somewhat open-ended, it's possible that you may come up - with a theorem which is true, but whose proof requires techniques - you haven't learned yet. Feel free to ask for help if you get - stuck! -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Reasoning About Lists

- -
- - Just as with numbers, simple facts about list-processing - functions can sometimes be proved entirely by simplification. For - example, the simplification performed by reflexivity is enough - for this theorem... -
-
- -
-Theorem nil_app : ∀l:natlist,
-  [] ++ l = l.
-Proof. reflexivity. Qed.
- -
-
- -
-... because the [] is substituted into the match position - in the definition of app, allowing the match itself to be - simplified. -
- - Also, as with numbers, it is sometimes helpful to perform case - analysis on the possible shapes (empty or non-empty) of an unknown - list. -
-
- -
-Theorem tl_length_pred : ∀l:natlist,
-  pred (length l) = length (tl l).
-Proof.
-  intros l. destruct l as [| n l'].
-  Case "l = nil".
-    reflexivity.
-  Case "l = cons n l'".
-    reflexivity. Qed.
- -
-
- -
-Here, the nil case works because we've chosen to define - tl nil = nil. Notice that the as annotation on the destruct - tactic here introduces two names, n and l', corresponding to - the fact that the cons constructor for lists takes two - arguments (the head and tail of the list it is constructing). -
- - Usually, though, interesting theorems about lists require - induction for their proofs. -
-
- -
-
- -
-

Micro-Sermon

- -
- - Simply reading example proofs will not get you very far! It is - very important to work through the details of each one, using Coq - and thinking about what each step of the proof achieves. - Otherwise it is more or less guaranteed that the exercises will - make no sense. -
-
- -
-
- -
-

Induction on Lists

- -
- - Proofs by induction over datatypes like natlist are - perhaps a little less familiar than standard natural number - induction, but the basic idea is equally simple. Each Inductive - declaration defines a set of data values that can be built up from - the declared constructors: a boolean can be either true or - false; a number can be either O or S applied to a number; a - list can be either nil or cons applied to a number and a list. - -
- - Moreover, applications of the declared constructors to one another - are the only possible shapes that elements of an inductively - defined set can have, and this fact directly gives rise to a way - of reasoning about inductively defined sets: a number is either - O or else it is S applied to some smaller number; a list is - either nil or else it is cons applied to some number and some - smaller list; etc. So, if we have in mind some proposition P - that mentions a list l and we want to argue that P holds for - all lists, we can reason as follows: - -
- -
    -
  • First, show that P is true of l when l is nil. - -
    - - -
    • -
  • Then show that P is true of l when l is cons n l' for - some number n and some smaller list l', assuming that P - is true for l'. - -
    • -
- -
- - Since larger lists can only be built up from smaller ones, - eventually reaching nil, these two things together establish the - truth of P for all lists l. Here's a concrete example: -
-
- -
-Theorem app_assoc : ∀l1 l2 l3 : natlist,
-  (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
-Proof.
-  intros l1 l2 l3. induction l1 as [| n l1'].
-  Case "l1 = nil".
-    reflexivity.
-  Case "l1 = cons n l1'".
-    simpl. rewrite → IHl1'. reflexivity. Qed.
- -
-
- -
-Again, this Coq proof is not especially illuminating as a - static written document — it is easy to see what's going on if - you are reading the proof in an interactive Coq session and you - can see the current goal and context at each point, but this state - is not visible in the written-down parts of the Coq proof. So a - natural-language proof — one written for human readers — will - need to include more explicit signposts; in particular, it will - help the reader stay oriented if we remind them exactly what the - induction hypothesis is in the second case. -
- -

Informal version

- -
- - Theorem: For all lists l1, l2, and l3, - (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3). - -
- - Proof: By induction on l1. - -
- -
    -
  • First, suppose l1 = []. We must show - -
    - -
    -  ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3), -
    - -
    - which follows directly from the definition of ++. - -
    - - -
    • -
  • Next, suppose l1 = n::l1', with - -
    - -
    -  (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3) -
    - -
    - (the induction hypothesis). We must show - -
    - -
    -  ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3). -
    - -
    - By the definition of ++, this follows from - -
    - -
    -  n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)), -
    - -
    - which is immediate from the induction hypothesis. ☐ - -
    • -
- -
- -

Another example

- -
- - Here is a similar example to be worked together in class: -
-
- -
-Theorem app_length : ∀l1 l2 : natlist,
-  length (l1 ++ l2) = (length l1) + (length l2).
-Proof.
-  (* WORKED IN CLASS *)
-  intros l1 l2. induction l1 as [| n l1'].
-  Case "l1 = nil".
-    reflexivity.
-  Case "l1 = cons".
-    simpl. rewrite → IHl1'. reflexivity. Qed.
- -
-
- -
-

Reversing a list

- For a slightly more involved example of an inductive proof - over lists, suppose we define a "cons on the right" function - snoc like this... -
-
- -
-Fixpoint snoc (l:natlist) (v:nat) : natlist :=
-  match l with
-  | nil ⇒ [v]
-  | h :: t ⇒ h :: (snoc t v)
-  end.
- -
-
- -
-... and use it to define a list-reversing function rev - like this: -
-
- -
-Fixpoint rev (l:natlist) : natlist :=
-  match l with
-  | nil ⇒ nil
-  | h :: t ⇒ snoc (rev t) h
-  end.
- -
-Example test_rev1: rev [1;2;3] = [3;2;1].
-Proof. reflexivity. Qed.
-Example test_rev2: rev nil = nil.
-Proof. reflexivity. Qed.
- -
-
- -
-

Proofs about reverse

- Now let's prove some more list theorems using our newly - defined snoc and rev. For something a little more challenging - than the inductive proofs we've seen so far, let's prove that - reversing a list does not change its length. Our first attempt at - this proof gets stuck in the successor case... -
-
- -
-Theorem rev_length_firsttry : ∀l : natlist,
-  length (rev l) = length l.
-Proof.
-  intros l. induction l as [| n l'].
-  Case "l = []".
-    reflexivity.
-  Case "l = n :: l'".
-    (* This is the tricky case.  Let's begin as usual 
-       by simplifying. *)
-    simpl.
-    (* Now we seem to be stuck: the goal is an equality 
-       involving snoc, but we don't have any equations 
-       in either the immediate context or the global 
-       environment that have anything to do with snoc! 
-
-       We can make a little progress by using the IH to 
-       rewrite the goal... *)
-    rewrite ← IHl'.
-    (* ... but now we can't go any further. *)
-Abort.
- -
-
- -
-So let's take the equation about snoc that would have - enabled us to make progress and prove it as a separate lemma. - -
-
- -
-Theorem length_snoc : ∀n : nat, ∀l : natlist,
-  length (snoc l n) = S (length l).
-Proof.
-  intros n l. induction l as [| n' l'].
-  Case "l = nil".
-    reflexivity.
-  Case "l = cons n' l'".
-    simpl. rewrite → IHl'. reflexivity. Qed.
- -
-
- -
- Note that we make the lemma as general as possible: in particular, - we quantify over all natlists, not just those that result - from an application of rev. This should seem natural, - because the truth of the goal clearly doesn't depend on - the list having been reversed. Moreover, it is much easier - to prove the more general property. - -
- - Now we can complete the original proof. -
-
- -
-Theorem rev_length : ∀l : natlist,
-  length (rev l) = length l.
-Proof.
-  intros l. induction l as [| n l'].
-  Case "l = nil".
-    reflexivity.
-  Case "l = cons".
-    simpl. rewrite → length_snoc.
-    rewrite → IHl'. reflexivity. Qed.
- -
-
- -
-For comparison, here are informal proofs of these two theorems: - -
- - Theorem: For all numbers n and lists l, - length (snoc l n) = S (length l). - -
- - Proof: By induction on l. - -
- -
    -
  • First, suppose l = []. We must show - -
    - -
    -  length (snoc [] n) = S (length []), -
    - -
    - which follows directly from the definitions of - length and snoc. - -
    - - -
    • -
  • Next, suppose l = n'::l', with - -
    - -
    -  length (snoc l' n) = S (length l'). -
    - -
    - We must show - -
    - -
    -  length (snoc (n' :: l') n) = S (length (n' :: l')). -
    - -
    - By the definitions of length and snoc, this - follows from - -
    - -
    -  S (length (snoc l' n)) = S (S (length l')), -
    - -
    - which is immediate from the induction hypothesis. ☐ -
    • -
- -
- - Theorem: For all lists l, length (rev l) = length l. - -
- - Proof: By induction on l. - -
- -
    -
  • First, suppose l = []. We must show - -
    - -
    -  length (rev []) = length [], -
    - -
    - which follows directly from the definitions of length - and rev. - -
    - - -
    • -
  • Next, suppose l = n::l', with - -
    - -
    -  length (rev l') = length l'. -
    - -
    - We must show - -
    - -
    -  length (rev (n :: l')) = length (n :: l'). -
    - -
    - By the definition of rev, this follows from - -
    - -
    -  length (snoc (rev l') n) = S (length l') -
    - -
    - which, by the previous lemma, is the same as - -
    - -
    -  S (length (rev l')) = S (length l'). -
    - -
    - This is immediate from the induction hypothesis. ☐ -
    • -
- -
- - Obviously, the style of these proofs is rather longwinded - and pedantic. After the first few, we might find it easier to - follow proofs that give fewer details (since we can easily work - them out in our own minds or on scratch paper if necessary) and - just highlight the non-obvious steps. In this more compressed - style, the above proof might look more like this: -
- - Theorem: - For all lists l, length (rev l) = length l. - -
- - Proof: First, observe that - -
- -
-       length (snoc l n) = S (length l) -
- -
- for any l. This follows by a straightforward induction on l. - The main property now follows by another straightforward - induction on l, using the observation together with the - induction hypothesis in the case where l = n'::l'. ☐ -
- - Which style is preferable in a given situation depends on - the sophistication of the expected audience and on how similar the - proof at hand is to ones that the audience will already be - familiar with. The more pedantic style is a good default for - present purposes. -
-
- -
-
- -
-

SearchAbout

- -
- - We've seen that proofs can make use of other theorems we've - already proved, using rewrite, and later we will see other ways - of reusing previous theorems. But in order to refer to a theorem, - we need to know its name, and remembering the names of all the - theorems we might ever want to use can become quite difficult! It - is often hard even to remember what theorems have been proven, - much less what they are named. - -
- - Coq's SearchAbout command is quite helpful with this. Typing - SearchAbout foo will cause Coq to display a list of all theorems - involving foo. For example, try uncommenting the following to - see a list of theorems that we have proved about rev: -
-
- -
-(*  SearchAbout rev. *)
- -
-
- -
-Keep SearchAbout in mind as you do the following exercises and - throughout the rest of the course; it can save you a lot of time! -
- - Also, if you are using ProofGeneral, you can run SearchAbout - with C-c C-a C-a. Pasting its response into your buffer can be - accomplished with C-c C-;. -
-
- -
-
- -
-

List Exercises, Part 1

- -
- -

Exercise: 3 stars (list_exercises)

- More practice with lists. -
-
- -
-Theorem app_nil_end : ∀l : natlist,
-  l ++ [] = l.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem rev_involutive : ∀l : natlist,
-  rev (rev l) = l.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-There is a short solution to the next exercise. If you find - yourself getting tangled up, step back and try to look for a - simpler way. -
-
- -
-Theorem app_assoc4 : ∀l1 l2 l3 l4 : natlist,
-  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem snoc_append : ∀(l:natlist) (n:nat),
-  snoc l n = l ++ [n].
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem distr_rev : ∀l1 l2 : natlist,
-  rev (l1 ++ l2) = (rev l2) ++ (rev l1).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-An exercise about your implementation of nonzeros: -
-
- -
-Lemma nonzeros_app : ∀l1 l2 : natlist,
-  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (beq_natlist)

- Fill in the definition of beq_natlist, which compares - lists of numbers for equality. Prove that beq_natlist l l - yields true for every list l. -
-
- -
-Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
-  (* FILL IN HERE *) admit.
- -
-Example test_beq_natlist1 : (beq_natlist nil nil = true).
- (* FILL IN HERE *) Admitted.
-Example test_beq_natlist2 : beq_natlist [1;2;3] [1;2;3] = true.
- (* FILL IN HERE *) Admitted.
-Example test_beq_natlist3 : beq_natlist [1;2;3] [1;2;4] = false.
- (* FILL IN HERE *) Admitted.
- -
-Theorem beq_natlist_refl : ∀l:natlist,
-  true = beq_natlist l l.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

List Exercises, Part 2

- -
- -

Exercise: 2 stars (list_design)

- Design exercise: - -
- -
    -
  • Write down a non-trivial theorem involving cons - (::), snoc, and app (++). - -
    • -
  • Prove it. -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (bag_proofs)

- Here are a couple of little theorems to prove about your - definitions about bags earlier in the file. -
-
- -
-Theorem count_member_nonzero : ∀(s : bag),
-  ble_nat 1 (count 1 (1 :: s)) = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-The following lemma about ble_nat might help you in the next proof. -
-
- -
-Theorem ble_n_Sn : ∀n,
-  ble_nat n (S n) = true.
-Proof.
-  intros n. induction n as [| n'].
-  Case "0".
-    simpl. reflexivity.
-  Case "S n'".
-    simpl. rewrite IHn'. reflexivity. Qed.
- -
-Theorem remove_decreases_count: ∀(s : bag),
-  ble_nat (count 0 (remove_one 0 s)) (count 0 s) = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (bag_count_sum)

- Write down an interesting theorem about bags involving the - functions count and sum, and prove it. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (rev_injective)

- Prove that the rev function is injective, that is, - -
- - -
- -
-    ∀(l1 l2 : natlist), rev l1 = rev l2 → l1 = l2. -
- -
- -
- -There is a hard way and an easy way to solve this exercise. - -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Options

- -
- - One use of natoption is as a way of returning "error - codes" from functions. For example, suppose we want to write a - function that returns the nth element of some list. If we give - it type nat → natlist → nat, then we'll have to return some - number when the list is too short! -
-
- -
-Fixpoint index_bad (n:nat) (l:natlist) : nat :=
-  match l with
-  | nil ⇒ 42 (* arbitrary! *)
-  | a :: l' ⇒ match beq_nat n O with
-               | true ⇒ a
-               | false ⇒ index_bad (pred n) l'
-               end
-  end.
- -
-
- -
-

- On the other hand, if we give it type nat → natlist → - natoption, then we can return None when the list is too short - and Some a when the list has enough members and a appears at - position n. -
-
- -
-Inductive natoption : Type :=
-  | Some : nat → natoption
-  | None : natoption.
- -
-Fixpoint index (n:nat) (l:natlist) : natoption :=
-  match l with
-  | nil ⇒ None
-  | a :: l' ⇒ match beq_nat n O with
-               | true ⇒ Some a
-               | false ⇒ index (pred n) l'
-               end
-  end.
- -
-Example test_index1 : index 0 [4;5;6;7] = Some 4.
-Proof. reflexivity. Qed.
-Example test_index2 : index 3 [4;5;6;7] = Some 7.
-Proof. reflexivity. Qed.
-Example test_index3 : index 10 [4;5;6;7] = None.
-Proof. reflexivity. Qed.
- -
-
- -
-This example is also an opportunity to introduce one more - small feature of Coq's programming language: conditional - expressions... -
- -

- -
-
- -
-Fixpoint index' (n:nat) (l:natlist) : natoption :=
-  match l with
-  | nil ⇒ None
-  | a :: l' ⇒ if beq_nat n O then Some a else index' (pred n) l'
-  end.
- -
-
- -
-Coq's conditionals are exactly like those found in any other - language, with one small generalization. Since the boolean type - is not built in, Coq actually allows conditional expressions over - any inductively defined type with exactly two constructors. The - guard is considered true if it evaluates to the first constructor - in the Inductive definition and false if it evaluates to the - second. -
- - The function below pulls the nat out of a natoption, returning - a supplied default in the None case. -
-
- -
-Definition option_elim (d : nat) (o : natoption) : nat :=
-  match o with
-  | Some n' ⇒ n'
-  | None ⇒ d
-  end.
- -
-
- -
-

Exercise: 2 stars (hd_opt)

- Using the same idea, fix the hd function from earlier so we don't - have to pass a default element for the nil case. -
-
- -
-Definition hd_opt (l : natlist) : natoption :=
-  (* FILL IN HERE *) admit.
- -
-Example test_hd_opt1 : hd_opt [] = None.
- (* FILL IN HERE *) Admitted.
- -
-Example test_hd_opt2 : hd_opt [1] = Some 1.
- (* FILL IN HERE *) Admitted.
- -
-Example test_hd_opt3 : hd_opt [5;6] = Some 5.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (option_elim_hd)

- This exercise relates your new hd_opt to the old hd. -
-
- -
-Theorem option_elim_hd : ∀(l:natlist) (default:nat),
-  hd default l = option_elim default (hd_opt l).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Dictionaries

- -
- - As a final illustration of how fundamental data structures - can be defined in Coq, here is the declaration of a simple - dictionary data type, using numbers for both the keys and the - values stored under these keys. (That is, a dictionary represents - a finite map from numbers to numbers.) -
-
- -
-Module Dictionary.
- -
-Inductive dictionary : Type :=
-  | empty : dictionary
-  | record : nat → nat → dictionary → dictionary.
- -
-
- -
-This declaration can be read: "There are two ways to construct a - dictionary: either using the constructor empty to represent an - empty dictionary, or by applying the constructor record to - a key, a value, and an existing dictionary to construct a - dictionary with an additional key to value mapping." -
-
- -
-Definition insert (key value : nat) (d : dictionary) : dictionary :=
-  (record key value d).
- -
-
- -
-Here is a function find that searches a dictionary for a - given key. It evaluates evaluates to None if the key was not - found and Some val if the key was mapped to val in the - dictionary. If the same key is mapped to multiple values, find - will return the first one it finds. -
-
- -
-Fixpoint find (key : nat) (d : dictionary) : natoption :=
-  match d with
-  | empty ⇒ None
-  | record k v d' ⇒ if (beq_nat key k)
-                       then (Some v)
-                       else (find key d')
-  end.
- -
-
- -
-

Exercise: 1 star (dictionary_invariant1)

- Complete the following proof. -
-
- -
-Theorem dictionary_invariant1' : ∀(d : dictionary) (k v: nat),
-  (find k (insert k v d)) = Some v.
-Proof.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (dictionary_invariant2)

- Complete the following proof. -
-
- -
-Theorem dictionary_invariant2' : ∀(d : dictionary) (m n o: nat),
-  beq_nat m n = false → find m d = find m (insert n o d).
-Proof.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-End Dictionary.
- -
-End NatList.
- -
-(* $Date: 2014-01-28 13:19:45 -0500 (Tue, 28 Jan 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Lists.v b/Lists.v deleted file mode 100644 index cd5cfe6..0000000 --- a/Lists.v +++ /dev/null @@ -1,1016 +0,0 @@ -(** * Lists: Working with Structured Data *) - -Require Export Induction. - -Module NatList. - -(* ###################################################### *) -(** * Pairs of Numbers *) - -(** In an [Inductive] type definition, each constructor can take - any number of arguments -- none (as with [true] and [O]), one (as - with [S]), or more than one, as in this definition: *) - -Inductive natprod : Type := - pair : nat -> nat -> natprod. - -(** This declaration can be read: "There is just one way to - construct a pair of numbers: by applying the constructor [pair] to - two arguments of type [nat]." *) - -(** We can construct an element of [natprod] like this: *) - -Check (pair 3 5). - -(** *** *) - -(** Here are two simple function definitions for extracting the - first and second components of a pair. (The definitions also - illustrate how to do pattern matching on two-argument - constructors.) *) - -Definition fst (p : natprod) : nat := - match p with - | pair x y => x - end. -Definition snd (p : natprod) : nat := - match p with - | pair x y => y - end. - -Eval compute in (fst (pair 3 5)). -(* ===> 3 *) - -(** *** *) - -(** Since pairs are used quite a bit, it is nice to be able to - write them with the standard mathematical notation [(x,y)] instead - of [pair x y]. We can tell Coq to allow this with a [Notation] - declaration. *) - -Notation "( x , y )" := (pair x y). - -(** The new notation can be used both in expressions and in - pattern matches (indeed, we've seen it already in the previous - chapter -- this notation is provided as part of the standard - library): *) - -Eval compute in (fst (3,5)). - -Definition fst' (p : natprod) : nat := - match p with - | (x,y) => x - end. -Definition snd' (p : natprod) : nat := - match p with - | (x,y) => y - end. - -Definition swap_pair (p : natprod) : natprod := - match p with - | (x,y) => (y,x) - end. - -(** *** *) - -(** Let's try and prove a few simple facts about pairs. If we - state the lemmas in a particular (and slightly peculiar) way, we - can prove them with just reflexivity (and its built-in - simplification): *) - -Theorem surjective_pairing' : forall (n m : nat), - (n,m) = (fst (n,m), snd (n,m)). -Proof. - reflexivity. Qed. - -(** Note that [reflexivity] is not enough if we state the lemma in a - more natural way: *) - -Theorem surjective_pairing_stuck : forall (p : natprod), - p = (fst p, snd p). -Proof. - simpl. (* Doesn't reduce anything! *) -Abort. - -(** *** *) -(** We have to expose the structure of [p] so that [simpl] can - perform the pattern match in [fst] and [snd]. We can do this with - [destruct]. - - Notice that, unlike for [nat]s, [destruct] doesn't generate an - extra subgoal here. That's because [natprod]s can only be - constructed in one way. *) - -Theorem surjective_pairing : forall (p : natprod), - p = (fst p, snd p). -Proof. - intros p. destruct p as [n m]. simpl. reflexivity. Qed. - -(** **** Exercise: 1 star (snd_fst_is_swap) *) -Theorem snd_fst_is_swap : forall (p : natprod), - (snd p, fst p) = swap_pair p. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (fst_swap_is_snd) *) -Theorem fst_swap_is_snd : forall (p : natprod), - fst (swap_pair p) = snd p. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** * Lists of Numbers *) - -(** Generalizing the definition of pairs a little, we can - describe the type of _lists_ of numbers like this: "A list is - either the empty list or else a pair of a number and another - list." *) - -Inductive natlist : Type := - | nil : natlist - | cons : nat -> natlist -> natlist. - -(** For example, here is a three-element list: *) - -Definition mylist := cons 1 (cons 2 (cons 3 nil)). - - -(** *** *) -(** As with pairs, it is more convenient to write lists in - familiar programming notation. The following two declarations - allow us to use [::] as an infix [cons] operator and square - brackets as an "outfix" notation for constructing lists. *) - -Notation "x :: l" := (cons x l) (at level 60, right associativity). -Notation "[ ]" := nil. -Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..). - -(** It is not necessary to fully understand these declarations, - but in case you are interested, here is roughly what's going on. - - The [right associativity] annotation tells Coq how to parenthesize - expressions involving several uses of [::] so that, for example, - the next three declarations mean exactly the same thing: *) - -Definition mylist1 := 1 :: (2 :: (3 :: nil)). -Definition mylist2 := 1 :: 2 :: 3 :: nil. -Definition mylist3 := [1;2;3]. - -(** The [at level 60] part tells Coq how to parenthesize - expressions that involve both [::] and some other infix operator. - For example, since we defined [+] as infix notation for the [plus] - function at level 50, -Notation "x + y" := (plus x y) - (at level 50, left associativity). - The [+] operator will bind tighter than [::], so [1 + 2 :: [3]] - will be parsed, as we'd expect, as [(1 + 2) :: [3]] rather than [1 - + (2 :: [3])]. - - (By the way, it's worth noting in passing that expressions like "[1 - + 2 :: [3]]" can be a little confusing when you read them in a .v - file. The inner brackets, around 3, indicate a list, but the outer - brackets, which are invisible in the HTML rendering, are there to - instruct the "coqdoc" tool that the bracketed part should be - displayed as Coq code rather than running text.) - - The second and third [Notation] declarations above introduce the - standard square-bracket notation for lists; the right-hand side of - the third one illustrates Coq's syntax for declaring n-ary - notations and translating them to nested sequences of binary - constructors. *) - -(** *** Repeat *) -(** A number of functions are useful for manipulating lists. - For example, the [repeat] function takes a number [n] and a - [count] and returns a list of length [count] where every element - is [n]. *) - -Fixpoint repeat (n count : nat) : natlist := - match count with - | O => nil - | S count' => n :: (repeat n count') - end. - -(** *** Length *) -(** The [length] function calculates the length of a list. *) - -Fixpoint length (l:natlist) : nat := - match l with - | nil => O - | h :: t => S (length t) - end. - -(** *** Append *) -(** The [app] ("append") function concatenates two lists. *) - -Fixpoint app (l1 l2 : natlist) : natlist := - match l1 with - | nil => l2 - | h :: t => h :: (app t l2) - end. - -(** Actually, [app] will be used a lot in some parts of what - follows, so it is convenient to have an infix operator for it. *) - -Notation "x ++ y" := (app x y) - (right associativity, at level 60). - -Example test_app1: [1;2;3] ++ [4;5] = [1;2;3;4;5]. -Proof. reflexivity. Qed. -Example test_app2: nil ++ [4;5] = [4;5]. -Proof. reflexivity. Qed. -Example test_app3: [1;2;3] ++ nil = [1;2;3]. -Proof. reflexivity. Qed. - -(** Here are two smaller examples of programming with lists. - The [hd] function returns the first element (the "head") of the - list, while [tl] returns everything but the first - element (the "tail"). - Of course, the empty list has no first element, so we - must pass a default value to be returned in that case. *) - -(** *** Head (with default) and Tail *) -Definition hd (default:nat) (l:natlist) : nat := - match l with - | nil => default - | h :: t => h - end. - -Definition tl (l:natlist) : natlist := - match l with - | nil => nil - | h :: t => t - end. - -Example test_hd1: hd 0 [1;2;3] = 1. -Proof. reflexivity. Qed. -Example test_hd2: hd 0 [] = 0. -Proof. reflexivity. Qed. -Example test_tl: tl [1;2;3] = [2;3]. -Proof. reflexivity. Qed. - -(** **** Exercise: 2 stars (list_funs) *) -(** Complete the definitions of [nonzeros], [oddmembers] and - [countoddmembers] below. Have a look at the tests to understand - what these functions should do. *) - -Fixpoint nonzeros (l:natlist) : natlist := - (* FILL IN HERE *) admit. - -Example test_nonzeros: nonzeros [0;1;0;2;3;0;0] = [1;2;3]. - (* FILL IN HERE *) Admitted. - -Fixpoint oddmembers (l:natlist) : natlist := - (* FILL IN HERE *) admit. - -Example test_oddmembers: oddmembers [0;1;0;2;3;0;0] = [1;3]. - (* FILL IN HERE *) Admitted. - -Fixpoint countoddmembers (l:natlist) : nat := - (* FILL IN HERE *) admit. - -Example test_countoddmembers1: countoddmembers [1;0;3;1;4;5] = 4. - (* FILL IN HERE *) Admitted. -Example test_countoddmembers2: countoddmembers [0;2;4] = 0. - (* FILL IN HERE *) Admitted. -Example test_countoddmembers3: countoddmembers nil = 0. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (alternate) *) -(** Complete the definition of [alternate], which "zips up" two lists - into one, alternating between elements taken from the first list - and elements from the second. See the tests below for more - specific examples. - - Note: one natural and elegant way of writing [alternate] will fail - to satisfy Coq's requirement that all [Fixpoint] definitions be - "obviously terminating." If you find yourself in this rut, look - for a slightly more verbose solution that considers elements of - both lists at the same time. (One possible solution requires - defining a new kind of pairs, but this is not the only way.) *) - - -Fixpoint alternate (l1 l2 : natlist) : natlist := - (* FILL IN HERE *) admit. - - -Example test_alternate1: alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6]. - (* FILL IN HERE *) Admitted. -Example test_alternate2: alternate [1] [4;5;6] = [1;4;5;6]. - (* FILL IN HERE *) Admitted. -Example test_alternate3: alternate [1;2;3] [4] = [1;4;2;3]. - (* FILL IN HERE *) Admitted. -Example test_alternate4: alternate [] [20;30] = [20;30]. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** ** Bags via Lists *) - -(** A [bag] (or [multiset]) is like a set, but each element can appear - multiple times instead of just once. One reasonable - implementation of bags is to represent a bag of numbers as a - list. *) - -Definition bag := natlist. - -(** **** Exercise: 3 stars (bag_functions) *) -(** Complete the following definitions for the functions - [count], [sum], [add], and [member] for bags. *) - -Fixpoint count (v:nat) (s:bag) : nat := - (* FILL IN HERE *) admit. - -(** All these proofs can be done just by [reflexivity]. *) - -Example test_count1: count 1 [1;2;3;1;4;1] = 3. - (* FILL IN HERE *) Admitted. -Example test_count2: count 6 [1;2;3;1;4;1] = 0. - (* FILL IN HERE *) Admitted. - -(** Multiset [sum] is similar to set [union]: [sum a b] contains - all the elements of [a] and of [b]. (Mathematicians usually - define [union] on multisets a little bit differently, which - is why we don't use that name for this operation.) - For [sum] we're giving you a header that does not give explicit - names to the arguments. Moreover, it uses the keyword - [Definition] instead of [Fixpoint], so even if you had names for - the arguments, you wouldn't be able to process them recursively. - The point of stating the question this way is to encourage you to - think about whether [sum] can be implemented in another way -- - perhaps by using functions that have already been defined. *) - -Definition sum : bag -> bag -> bag := - (* FILL IN HERE *) admit. - -Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3. - (* FILL IN HERE *) Admitted. - -Definition add (v:nat) (s:bag) : bag := - (* FILL IN HERE *) admit. - -Example test_add1: count 1 (add 1 [1;4;1]) = 3. - (* FILL IN HERE *) Admitted. -Example test_add2: count 5 (add 1 [1;4;1]) = 0. - (* FILL IN HERE *) Admitted. - -Definition member (v:nat) (s:bag) : bool := - (* FILL IN HERE *) admit. - -Example test_member1: member 1 [1;4;1] = true. - (* FILL IN HERE *) Admitted. -Example test_member2: member 2 [1;4;1] = false. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (bag_more_functions) *) -(** Here are some more bag functions for you to practice with. *) - -Fixpoint remove_one (v:nat) (s:bag) : bag := - (* When remove_one is applied to a bag without the number to remove, - it should return the same bag unchanged. *) - (* FILL IN HERE *) admit. - -Example test_remove_one1: count 5 (remove_one 5 [2;1;5;4;1]) = 0. - (* FILL IN HERE *) Admitted. -Example test_remove_one2: count 5 (remove_one 5 [2;1;4;1]) = 0. - (* FILL IN HERE *) Admitted. -Example test_remove_one3: count 4 (remove_one 5 [2;1;4;5;1;4]) = 2. - (* FILL IN HERE *) Admitted. -Example test_remove_one4: count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1. - (* FILL IN HERE *) Admitted. - -Fixpoint remove_all (v:nat) (s:bag) : bag := - (* FILL IN HERE *) admit. - -Example test_remove_all1: count 5 (remove_all 5 [2;1;5;4;1]) = 0. - (* FILL IN HERE *) Admitted. -Example test_remove_all2: count 5 (remove_all 5 [2;1;4;1]) = 0. - (* FILL IN HERE *) Admitted. -Example test_remove_all3: count 4 (remove_all 5 [2;1;4;5;1;4]) = 2. - (* FILL IN HERE *) Admitted. -Example test_remove_all4: count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0. - (* FILL IN HERE *) Admitted. - -Fixpoint subset (s1:bag) (s2:bag) : bool := - (* FILL IN HERE *) admit. - -Example test_subset1: subset [1;2] [2;1;4;1] = true. - (* FILL IN HERE *) Admitted. -Example test_subset2: subset [1;2;2] [2;1;4;1] = false. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (bag_theorem) *) -(** Write down an interesting theorem about bags involving the - functions [count] and [add], and prove it. Note that, since this - problem is somewhat open-ended, it's possible that you may come up - with a theorem which is true, but whose proof requires techniques - you haven't learned yet. Feel free to ask for help if you get - stuck! *) - -(* FILL IN HERE *) -(** [] *) - -(* ###################################################### *) -(** * Reasoning About Lists *) - -(** Just as with numbers, simple facts about list-processing - functions can sometimes be proved entirely by simplification. For - example, the simplification performed by [reflexivity] is enough - for this theorem... *) - -Theorem nil_app : forall l:natlist, - [] ++ l = l. -Proof. reflexivity. Qed. - -(** ... because the [[]] is substituted into the match position - in the definition of [app], allowing the match itself to be - simplified. *) - -(** Also, as with numbers, it is sometimes helpful to perform case - analysis on the possible shapes (empty or non-empty) of an unknown - list. *) - -Theorem tl_length_pred : forall l:natlist, - pred (length l) = length (tl l). -Proof. - intros l. destruct l as [| n l']. - Case "l = nil". - reflexivity. - Case "l = cons n l'". - reflexivity. Qed. - -(** Here, the [nil] case works because we've chosen to define - [tl nil = nil]. Notice that the [as] annotation on the [destruct] - tactic here introduces two names, [n] and [l'], corresponding to - the fact that the [cons] constructor for lists takes two - arguments (the head and tail of the list it is constructing). *) - -(** Usually, though, interesting theorems about lists require - induction for their proofs. *) - -(* ###################################################### *) -(** ** Micro-Sermon *) - -(** Simply reading example proofs will not get you very far! It is - very important to work through the details of each one, using Coq - and thinking about what each step of the proof achieves. - Otherwise it is more or less guaranteed that the exercises will - make no sense. *) - -(* ###################################################### *) -(** ** Induction on Lists *) - -(** Proofs by induction over datatypes like [natlist] are - perhaps a little less familiar than standard natural number - induction, but the basic idea is equally simple. Each [Inductive] - declaration defines a set of data values that can be built up from - the declared constructors: a boolean can be either [true] or - [false]; a number can be either [O] or [S] applied to a number; a - list can be either [nil] or [cons] applied to a number and a list. - - Moreover, applications of the declared constructors to one another - are the _only_ possible shapes that elements of an inductively - defined set can have, and this fact directly gives rise to a way - of reasoning about inductively defined sets: a number is either - [O] or else it is [S] applied to some _smaller_ number; a list is - either [nil] or else it is [cons] applied to some number and some - _smaller_ list; etc. So, if we have in mind some proposition [P] - that mentions a list [l] and we want to argue that [P] holds for - _all_ lists, we can reason as follows: - - - First, show that [P] is true of [l] when [l] is [nil]. - - - Then show that [P] is true of [l] when [l] is [cons n l'] for - some number [n] and some smaller list [l'], assuming that [P] - is true for [l']. - - Since larger lists can only be built up from smaller ones, - eventually reaching [nil], these two things together establish the - truth of [P] for all lists [l]. Here's a concrete example: *) - -Theorem app_assoc : forall l1 l2 l3 : natlist, - (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3). -Proof. - intros l1 l2 l3. induction l1 as [| n l1']. - Case "l1 = nil". - reflexivity. - Case "l1 = cons n l1'". - simpl. rewrite -> IHl1'. reflexivity. Qed. - -(** Again, this Coq proof is not especially illuminating as a - static written document -- it is easy to see what's going on if - you are reading the proof in an interactive Coq session and you - can see the current goal and context at each point, but this state - is not visible in the written-down parts of the Coq proof. So a - natural-language proof -- one written for human readers -- will - need to include more explicit signposts; in particular, it will - help the reader stay oriented if we remind them exactly what the - induction hypothesis is in the second case. *) - -(** *** Informal version *) - -(** _Theorem_: For all lists [l1], [l2], and [l3], - [(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3)]. - - _Proof_: By induction on [l1]. - - - First, suppose [l1 = []]. We must show - ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3), - which follows directly from the definition of [++]. - - - Next, suppose [l1 = n::l1'], with - (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3) - (the induction hypothesis). We must show - ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3). -]] - By the definition of [++], this follows from - n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)), - which is immediate from the induction hypothesis. [] -*) - -(** *** Another example *) -(** - Here is a similar example to be worked together in class: *) - -Theorem app_length : forall l1 l2 : natlist, - length (l1 ++ l2) = (length l1) + (length l2). -Proof. - (* WORKED IN CLASS *) - intros l1 l2. induction l1 as [| n l1']. - Case "l1 = nil". - reflexivity. - Case "l1 = cons". - simpl. rewrite -> IHl1'. reflexivity. Qed. - - -(** *** Reversing a list *) -(** For a slightly more involved example of an inductive proof - over lists, suppose we define a "cons on the right" function - [snoc] like this... *) - -Fixpoint snoc (l:natlist) (v:nat) : natlist := - match l with - | nil => [v] - | h :: t => h :: (snoc t v) - end. - -(** ... and use it to define a list-reversing function [rev] - like this: *) - -Fixpoint rev (l:natlist) : natlist := - match l with - | nil => nil - | h :: t => snoc (rev t) h - end. - -Example test_rev1: rev [1;2;3] = [3;2;1]. -Proof. reflexivity. Qed. -Example test_rev2: rev nil = nil. -Proof. reflexivity. Qed. - -(** *** Proofs about reverse *) -(** Now let's prove some more list theorems using our newly - defined [snoc] and [rev]. For something a little more challenging - than the inductive proofs we've seen so far, let's prove that - reversing a list does not change its length. Our first attempt at - this proof gets stuck in the successor case... *) - -Theorem rev_length_firsttry : forall l : natlist, - length (rev l) = length l. -Proof. - intros l. induction l as [| n l']. - Case "l = []". - reflexivity. - Case "l = n :: l'". - (* This is the tricky case. Let's begin as usual - by simplifying. *) - simpl. - (* Now we seem to be stuck: the goal is an equality - involving [snoc], but we don't have any equations - in either the immediate context or the global - environment that have anything to do with [snoc]! - - We can make a little progress by using the IH to - rewrite the goal... *) - rewrite <- IHl'. - (* ... but now we can't go any further. *) -Abort. - -(** So let's take the equation about [snoc] that would have - enabled us to make progress and prove it as a separate lemma. -*) - -Theorem length_snoc : forall n : nat, forall l : natlist, - length (snoc l n) = S (length l). -Proof. - intros n l. induction l as [| n' l']. - Case "l = nil". - reflexivity. - Case "l = cons n' l'". - simpl. rewrite -> IHl'. reflexivity. Qed. - -(** - Note that we make the lemma as _general_ as possible: in particular, - we quantify over _all_ [natlist]s, not just those that result - from an application of [rev]. This should seem natural, - because the truth of the goal clearly doesn't depend on - the list having been reversed. Moreover, it is much easier - to prove the more general property. -*) - -(** Now we can complete the original proof. *) - -Theorem rev_length : forall l : natlist, - length (rev l) = length l. -Proof. - intros l. induction l as [| n l']. - Case "l = nil". - reflexivity. - Case "l = cons". - simpl. rewrite -> length_snoc. - rewrite -> IHl'. reflexivity. Qed. - -(** For comparison, here are informal proofs of these two theorems: - - _Theorem_: For all numbers [n] and lists [l], - [length (snoc l n) = S (length l)]. - - _Proof_: By induction on [l]. - - - First, suppose [l = []]. We must show - length (snoc [] n) = S (length []), - which follows directly from the definitions of - [length] and [snoc]. - - - Next, suppose [l = n'::l'], with - length (snoc l' n) = S (length l'). - We must show - length (snoc (n' :: l') n) = S (length (n' :: l')). - By the definitions of [length] and [snoc], this - follows from - S (length (snoc l' n)) = S (S (length l')), -]] - which is immediate from the induction hypothesis. [] *) - -(** _Theorem_: For all lists [l], [length (rev l) = length l]. - - _Proof_: By induction on [l]. - - - First, suppose [l = []]. We must show - length (rev []) = length [], - which follows directly from the definitions of [length] - and [rev]. - - - Next, suppose [l = n::l'], with - length (rev l') = length l'. - We must show - length (rev (n :: l')) = length (n :: l'). - By the definition of [rev], this follows from - length (snoc (rev l') n) = S (length l') - which, by the previous lemma, is the same as - S (length (rev l')) = S (length l'). - This is immediate from the induction hypothesis. [] *) - -(** Obviously, the style of these proofs is rather longwinded - and pedantic. After the first few, we might find it easier to - follow proofs that give fewer details (since we can easily work - them out in our own minds or on scratch paper if necessary) and - just highlight the non-obvious steps. In this more compressed - style, the above proof might look more like this: *) - -(** _Theorem_: - For all lists [l], [length (rev l) = length l]. - - _Proof_: First, observe that - length (snoc l n) = S (length l) - for any [l]. This follows by a straightforward induction on [l]. - The main property now follows by another straightforward - induction on [l], using the observation together with the - induction hypothesis in the case where [l = n'::l']. [] *) - -(** Which style is preferable in a given situation depends on - the sophistication of the expected audience and on how similar the - proof at hand is to ones that the audience will already be - familiar with. The more pedantic style is a good default for - present purposes. *) - -(* ###################################################### *) -(** ** [SearchAbout] *) - -(** We've seen that proofs can make use of other theorems we've - already proved, using [rewrite], and later we will see other ways - of reusing previous theorems. But in order to refer to a theorem, - we need to know its name, and remembering the names of all the - theorems we might ever want to use can become quite difficult! It - is often hard even to remember what theorems have been proven, - much less what they are named. - - Coq's [SearchAbout] command is quite helpful with this. Typing - [SearchAbout foo] will cause Coq to display a list of all theorems - involving [foo]. For example, try uncommenting the following to - see a list of theorems that we have proved about [rev]: *) - -(* SearchAbout rev. *) - -(** Keep [SearchAbout] in mind as you do the following exercises and - throughout the rest of the course; it can save you a lot of time! *) - -(** Also, if you are using ProofGeneral, you can run [SearchAbout] - with [C-c C-a C-a]. Pasting its response into your buffer can be - accomplished with [C-c C-;]. *) - -(* ###################################################### *) -(** ** List Exercises, Part 1 *) - -(** **** Exercise: 3 stars (list_exercises) *) -(** More practice with lists. *) - -Theorem app_nil_end : forall l : natlist, - l ++ [] = l. -Proof. - (* FILL IN HERE *) Admitted. - - -Theorem rev_involutive : forall l : natlist, - rev (rev l) = l. -Proof. - (* FILL IN HERE *) Admitted. - -(** There is a short solution to the next exercise. If you find - yourself getting tangled up, step back and try to look for a - simpler way. *) - -Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist, - l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem snoc_append : forall (l:natlist) (n:nat), - snoc l n = l ++ [n]. -Proof. - (* FILL IN HERE *) Admitted. - - -Theorem distr_rev : forall l1 l2 : natlist, - rev (l1 ++ l2) = (rev l2) ++ (rev l1). -Proof. - (* FILL IN HERE *) Admitted. - -(** An exercise about your implementation of [nonzeros]: *) - -Lemma nonzeros_app : forall l1 l2 : natlist, - nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (beq_natlist) *) -(** Fill in the definition of [beq_natlist], which compares - lists of numbers for equality. Prove that [beq_natlist l l] - yields [true] for every list [l]. *) - -Fixpoint beq_natlist (l1 l2 : natlist) : bool := - (* FILL IN HERE *) admit. - -Example test_beq_natlist1 : (beq_natlist nil nil = true). - (* FILL IN HERE *) Admitted. -Example test_beq_natlist2 : beq_natlist [1;2;3] [1;2;3] = true. - (* FILL IN HERE *) Admitted. -Example test_beq_natlist3 : beq_natlist [1;2;3] [1;2;4] = false. - (* FILL IN HERE *) Admitted. - -Theorem beq_natlist_refl : forall l:natlist, - true = beq_natlist l l. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** ** List Exercises, Part 2 *) - -(** **** Exercise: 2 stars (list_design) *) -(** Design exercise: - - Write down a non-trivial theorem involving [cons] - ([::]), [snoc], and [app] ([++]). - - Prove it. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars, advanced (bag_proofs) *) -(** Here are a couple of little theorems to prove about your - definitions about bags earlier in the file. *) - -Theorem count_member_nonzero : forall (s : bag), - ble_nat 1 (count 1 (1 :: s)) = true. -Proof. - (* FILL IN HERE *) Admitted. - -(** The following lemma about [ble_nat] might help you in the next proof. *) - -Theorem ble_n_Sn : forall n, - ble_nat n (S n) = true. -Proof. - intros n. induction n as [| n']. - Case "0". - simpl. reflexivity. - Case "S n'". - simpl. rewrite IHn'. reflexivity. Qed. - -Theorem remove_decreases_count: forall (s : bag), - ble_nat (count 0 (remove_one 0 s)) (count 0 s) = true. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (bag_count_sum) *) -(** Write down an interesting theorem about bags involving the - functions [count] and [sum], and prove it.*) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 4 stars, advanced (rev_injective) *) -(** Prove that the [rev] function is injective, that is, - - forall (l1 l2 : natlist), rev l1 = rev l2 -> l1 = l2. - -There is a hard way and an easy way to solve this exercise. -*) - -(* FILL IN HERE *) -(** [] *) - - -(* ###################################################### *) -(** * Options *) - - -(** One use of [natoption] is as a way of returning "error - codes" from functions. For example, suppose we want to write a - function that returns the [n]th element of some list. If we give - it type [nat -> natlist -> nat], then we'll have to return some - number when the list is too short! *) - -Fixpoint index_bad (n:nat) (l:natlist) : nat := - match l with - | nil => 42 (* arbitrary! *) - | a :: l' => match beq_nat n O with - | true => a - | false => index_bad (pred n) l' - end - end. - -(** *** *) -(** On the other hand, if we give it type [nat -> natlist -> - natoption], then we can return [None] when the list is too short - and [Some a] when the list has enough members and [a] appears at - position [n]. *) - -Inductive natoption : Type := - | Some : nat -> natoption - | None : natoption. - - -Fixpoint index (n:nat) (l:natlist) : natoption := - match l with - | nil => None - | a :: l' => match beq_nat n O with - | true => Some a - | false => index (pred n) l' - end - end. - -Example test_index1 : index 0 [4;5;6;7] = Some 4. -Proof. reflexivity. Qed. -Example test_index2 : index 3 [4;5;6;7] = Some 7. -Proof. reflexivity. Qed. -Example test_index3 : index 10 [4;5;6;7] = None. -Proof. reflexivity. Qed. - -(** This example is also an opportunity to introduce one more - small feature of Coq's programming language: conditional - expressions... *) - -(** *** *) - -Fixpoint index' (n:nat) (l:natlist) : natoption := - match l with - | nil => None - | a :: l' => if beq_nat n O then Some a else index' (pred n) l' - end. - -(** Coq's conditionals are exactly like those found in any other - language, with one small generalization. Since the boolean type - is not built in, Coq actually allows conditional expressions over - _any_ inductively defined type with exactly two constructors. The - guard is considered true if it evaluates to the first constructor - in the [Inductive] definition and false if it evaluates to the - second. *) - -(** The function below pulls the [nat] out of a [natoption], returning - a supplied default in the [None] case. *) - -Definition option_elim (d : nat) (o : natoption) : nat := - match o with - | Some n' => n' - | None => d - end. - -(** **** Exercise: 2 stars (hd_opt) *) -(** Using the same idea, fix the [hd] function from earlier so we don't - have to pass a default element for the [nil] case. *) - -Definition hd_opt (l : natlist) : natoption := - (* FILL IN HERE *) admit. - -Example test_hd_opt1 : hd_opt [] = None. - (* FILL IN HERE *) Admitted. - -Example test_hd_opt2 : hd_opt [1] = Some 1. - (* FILL IN HERE *) Admitted. - -Example test_hd_opt3 : hd_opt [5;6] = Some 5. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (option_elim_hd) *) -(** This exercise relates your new [hd_opt] to the old [hd]. *) - -Theorem option_elim_hd : forall (l:natlist) (default:nat), - hd default l = option_elim default (hd_opt l). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** * Dictionaries *) - -(** As a final illustration of how fundamental data structures - can be defined in Coq, here is the declaration of a simple - [dictionary] data type, using numbers for both the keys and the - values stored under these keys. (That is, a dictionary represents - a finite map from numbers to numbers.) *) - -Module Dictionary. - -Inductive dictionary : Type := - | empty : dictionary - | record : nat -> nat -> dictionary -> dictionary. - -(** This declaration can be read: "There are two ways to construct a - [dictionary]: either using the constructor [empty] to represent an - empty dictionary, or by applying the constructor [record] to - a key, a value, and an existing [dictionary] to construct a - [dictionary] with an additional key to value mapping." *) - -Definition insert (key value : nat) (d : dictionary) : dictionary := - (record key value d). - -(** Here is a function [find] that searches a [dictionary] for a - given key. It evaluates evaluates to [None] if the key was not - found and [Some val] if the key was mapped to [val] in the - dictionary. If the same key is mapped to multiple values, [find] - will return the first one it finds. *) - -Fixpoint find (key : nat) (d : dictionary) : natoption := - match d with - | empty => None - | record k v d' => if (beq_nat key k) - then (Some v) - else (find key d') - end. - - - -(** **** Exercise: 1 star (dictionary_invariant1) *) -(** Complete the following proof. *) - -Theorem dictionary_invariant1' : forall (d : dictionary) (k v: nat), - (find k (insert k v d)) = Some v. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star (dictionary_invariant2) *) -(** Complete the following proof. *) - -Theorem dictionary_invariant2' : forall (d : dictionary) (m n o: nat), - beq_nat m n = false -> find m d = find m (insert n o d). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - -End Dictionary. - -End NatList. - -(* $Date: 2014-01-28 13:19:45 -0500 (Tue, 28 Jan 2014) $ *) - diff --git a/Logic.html b/Logic.html deleted file mode 100644 index 07cf275..0000000 --- a/Logic.html +++ /dev/null @@ -1,1194 +0,0 @@ - - - - - -Logic: Logic in Coq - - - - - - -
- - - -
- -

LogicLogic in Coq

- -
-
- -
- -
-
- -
-Require Export MoreCoq.
- -
-
- -
-Coq's built-in logic is very small: the only primitives are - Inductive definitions, universal quantification (∀), and - implication (→), while all the other familiar logical - connectives — conjunction, disjunction, negation, existential - quantification, even equality — can be encoded using just these. - -
- - This chapter explains the encodings and shows how the tactics - we've seen can be used to carry out standard forms of logical - reasoning involving these connectives. -
-
- -
-
- -
-

Propositions

- -
- - In previous chapters, we have seen many examples of factual - claims (propositions) and ways of presenting evidence of their - truth (proofs). In particular, we have worked extensively with - equality propositions of the form e1 = e2, with - implications (P → Q), and with quantified propositions - (∀ x, P). - -
- - In Coq, the type of things that can (potentially) - be proven is Prop. -
- - Here is an example of a provable proposition: -
-
- -
-Check (3 = 3).
-(* ===> Prop *)
- -
-
- -
-Here is an example of an unprovable proposition: -
-
- -
-Check (∀(n:nat), n = 2).
-(* ===> Prop *)
- -
-
- -
-Recall that Check asks Coq to tell us the type of the indicated - expression. -
-
- -
-
- -
-

Proofs and Evidence

- -
- - In Coq, propositions have the same status as other types, such as - nat. Just as the natural numbers 0, 1, 2, etc. inhabit - the type nat, a Coq proposition P is inhabited by its - proofs. We will refer to such inhabitants as proof term or - proof object or evidence for the truth of P. - -
- - In Coq, when we state and then prove a lemma such as: - -
- - -
- -
-Lemma silly : 0 × 3 = 0.
-Proof. reflexivity. Qed. -
- -
- -
- - the tactics we use within the Proof...Qed keywords tell Coq - how to construct a proof term that inhabits the proposition. In - this case, the proposition 0 × 3 = 0 is justified by a - combination of the definition of mult, which says that 0 × 3 - simplifies to just 0, and the reflexive principle of - equality, which says that 0 = 0. - -
- - -
- -

- -
-
- -
-Lemma silly : 0 × 3 = 0.
-Proof. reflexivity. Qed.
- -
-
- -
-We can see which proof term Coq constructs for a given Lemma by -using the Print directive: -
-
- -
-Print silly.
-(* ===> silly = eq_refl : 0 * 3 = 0 *)
- -
-
- -
-Here, the eq_refl proof term witnesses the equality. (More on equality later!) -
- -

Implications are functions

- -
- - Just as we can implement natural number multiplication as a -function: - -
- - -mult : nat → nat → nat - - -
- -The proof term for an implication P → Q is a function that takes evidence for P as input and produces evidence for Q as its output. - -
-
- -
-Lemma silly_implication : (1 + 1) = 2 → 0 × 3 = 0.
-Proof. intros H. reflexivity. Qed.
- -
-
- -
-We can see that the proof term for the above lemma is indeed a -function: -
-
- -
-Print silly_implication.
-(* ===> silly_implication = fun _ : 1 + 1 = 2 => eq_refl
-     : 1 + 1 = 2 -> 0 * 3 = 0 *)
- -
-
- -
-

Defining Propositions

- -
- - Just as we can create user-defined inductive types (like the - lists, binary representations of natural numbers, etc., that we - seen before), we can also create user-defined propositions. - -
- - Question: How do you define the meaning of a proposition? - -
- -

- -
- - The meaning of a proposition is given by rules and definitions - that say how to construct evidence for the truth of the - proposition from other evidence. - -
- -
    -
  • Typically, rules are defined inductively, just like any other datatype. - -
    - - -
    • -
  • Sometimes a proposition is declared to be true without substantiating evidence. Such propositions are called axioms. - -
    • -
- -
- - -
- - In this, and subsequence chapters, we'll see more about how these - proof terms work in more detail. - -
-
- -
-
- -
-

Conjunction (Logical "and")

- -
- - The logical conjunction of propositions P and Q can be - represented using an Inductive definition with one - constructor. -
-
- -
-Inductive and (P Q : Prop) : Prop :=
-  conj : P → Q → (and P Q).
- -
-
- -
-The intuition behind this definition is simple: to - construct evidence for and P Q, we must provide evidence - for P and evidence for Q. More precisely: - -
- -
    -
  • conj p q can be taken as evidence for and P Q if p - is evidence for P and q is evidence for Q; and - -
    - - -
    • -
  • this is the only way to give evidence for and P Q — - that is, if someone gives us evidence for and P Q, we - know it must have the form conj p q, where p is - evidence for P and q is evidence for Q. - -
    • -
- -
- - Since we'll be using conjunction a lot, let's introduce a more - familiar-looking infix notation for it. -
-
- -
-Notation "P ∧ Q" := (and P Q) : type_scope.
- -
-
- -
-(The type_scope annotation tells Coq that this notation - will be appearing in propositions, not values.) -
- - Consider the "type" of the constructor conj: -
-
- -
-Check conj.
-(* ===>  forall P Q : Prop, P -> Q -> P /\ Q *)
- -
-
- -
-Notice that it takes 4 inputs — namely the propositions P - and Q and evidence for P and Q — and returns as output the - evidence of P ∧ Q. -
- -

"Introducing" Conjuctions

- Besides the elegance of building everything up from a tiny - foundation, what's nice about defining conjunction this way is - that we can prove statements involving conjunction using the - tactics that we already know. For example, if the goal statement - is a conjuction, we can prove it by applying the single - constructor conj, which (as can be seen from the type of conj) - solves the current goal and leaves the two parts of the - conjunction as subgoals to be proved separately. -
-
- -
-Theorem and_example :
-  (0 = 0) ∧ (4 = mult 2 2).
-Proof.
-  apply conj.
-  Case "left". reflexivity.
-  Case "right". reflexivity. Qed.
- -
-
- -
-Just for convenience, we can use the tactic split as a shorthand for - apply conj. -
-
- -
-Theorem and_example' :
-  (0 = 0) ∧ (4 = mult 2 2).
-Proof.
-  split.
-    Case "left". reflexivity.
-    Case "right". reflexivity. Qed.
- -
-
- -
-

"Eliminating" conjunctions

- Conversely, the inversion tactic can be used to take a - conjunction hypothesis in the context, calculate what evidence - must have been used to build it, and add variables representing - this evidence to the proof context. -
-
- -
-Theorem proj1 : ∀P Q : Prop,
-  P ∧ Q → P.
-Proof.
-  intros P Q H.
-  inversion H as [HP HQ].
-  apply HP. Qed.
- -
-
- -
-

Exercise: 1 star, optional (proj2)

- -
-
-Theorem proj2 : ∀P Q : Prop,
-  P ∧ Q → Q.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-Theorem and_commut : ∀P Q : Prop,
-  P ∧ Q → Q ∧ P.
-Proof.
-  (* WORKED IN CLASS *)
-  intros P Q H.
-  inversion H as [HP HQ].
-  split.
-    Case "left". apply HQ.
-    Case "right". apply HP. Qed.
- -
-
- -
-

Exercise: 2 stars (and_assoc)

- In the following proof, notice how the nested pattern in the - inversion breaks the hypothesis H : P ∧ (Q ∧ R) down into - HP: P, HQ : Q, and HR : R. Finish the proof from there: -
-
- -
-Theorem and_assoc : ∀P Q R : Prop,
-  P ∧ (Q ∧ R) → (P ∧ Q) ∧ R.
-Proof.
-  intros P Q R H.
-  inversion H as [HP [HQ HR]].
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Iff

- -
- - The handy "if and only if" connective is just the conjunction of - two implications. -
-
- -
-Definition iff (P Q : Prop) := (P → Q) ∧ (Q → P).
- -
-Notation "P ↔ Q" := (iff P Q)
-                      (at level 95, no associativity)
-                      : type_scope.
- -
-Theorem iff_implies : ∀P Q : Prop,
-  (P ↔ Q) → P → Q.
-Proof.
-  intros P Q H.
-  inversion H as [HAB HBA]. apply HAB. Qed.
- -
-Theorem iff_sym : ∀P Q : Prop,
-  (P ↔ Q) → (Q ↔ P).
-Proof.
-  (* WORKED IN CLASS *)
-  intros P Q H.
-  inversion H as [HAB HBA].
-  split.
-    Case "→". apply HBA.
-    Case "←". apply HAB. Qed.
- -
-
- -
-

Exercise: 1 star, optional (iff_properties)

- Using the above proof that ↔ is symmetric (iff_sym) as - a guide, prove that it is also reflexive and transitive. -
-
- -
-Theorem iff_refl : ∀P : Prop,
-  P ↔ P.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem iff_trans : ∀P Q R : Prop,
-  (P ↔ Q) → (Q ↔ R) → (P ↔ R).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Hint: If you have an iff hypothesis in the context, you can use - inversion to break it into two separate implications. (Think - about why this works.) ☐ -
- - Some of Coq's tactics treat iff statements specially, thus - avoiding the need for some low-level manipulation when reasoning - with them. In particular, rewrite can be used with iff - statements, not just equalities. -
-
- -
-
- -
-

Disjunction (Logical "or")

- -
- -

Implementing Disjunction

- -
- - Disjunction ("logical or") can also be defined as an - inductive proposition. -
-
- -
-Inductive or (P Q : Prop) : Prop :=
-  | or_introl : P → or P Q
-  | or_intror : Q → or P Q.
- -
-Notation "P ∨ Q" := (or P Q) : type_scope.
- -
-
- -
-Consider the "type" of the constructor or_introl: -
-
- -
-Check or_introl.
-(* ===>  forall P Q : Prop, P -> P \/ Q *)
- -
-
- -
-It takes 3 inputs, namely the propositions P, Q and - evidence of P, and returns, as output, the evidence of P ∨ Q. - Next, look at the type of or_intror: -
-
- -
-Check or_intror.
-(* ===>  forall P Q : Prop, Q -> P \/ Q *)
- -
-
- -
-It is like or_introl but it requires evidence of Q - instead of evidence of P. -
- - Intuitively, there are two ways of giving evidence for P ∨ Q: - -
- -
    -
  • give evidence for P (and say that it is P you are giving - evidence for — this is the function of the or_introl - constructor), or - -
    - - -
    • -
  • give evidence for Q, tagged with the or_intror - constructor. -
    • -
- -
- -

- Since P ∨ Q has two constructors, doing inversion on a - hypothesis of type P ∨ Q yields two subgoals. -
-
- -
-Theorem or_commut : ∀P Q : Prop,
-  P ∨ Q → Q ∨ P.
-Proof.
-  intros P Q H.
-  inversion H as [HP | HQ].
-    Case "left". apply or_intror. apply HP.
-    Case "right". apply or_introl. apply HQ. Qed.
- -
-
- -
-From here on, we'll use the shorthand tactics left and right - in place of apply or_introl and apply or_intror. -
-
- -
-Theorem or_commut' : ∀P Q : Prop,
-  P ∨ Q → Q ∨ P.
-Proof.
-  intros P Q H.
-  inversion H as [HP | HQ].
-    Case "left". right. apply HP.
-    Case "right". left. apply HQ. Qed.
- -
-Theorem or_distributes_over_and_1 : ∀P Q R : Prop,
-  P ∨ (Q ∧ R) → (P ∨ Q) ∧ (P ∨ R).
-Proof.
-  intros P Q R. intros H. inversion H as [HP | [HQ HR]].
-    Case "left". split.
-      SCase "left". left. apply HP.
-      SCase "right". left. apply HP.
-    Case "right". split.
-      SCase "left". right. apply HQ.
-      SCase "right". right. apply HR. Qed.
- -
-
- -
-

Exercise: 2 stars (or_distributes_over_and_2)

- -
-
-Theorem or_distributes_over_and_2 : ∀P Q R : Prop,
-  (P ∨ Q) ∧ (P ∨ R) → P ∨ (Q ∧ R).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (or_distributes_over_and)

- -
-
-Theorem or_distributes_over_and : ∀P Q R : Prop,
-  P ∨ (Q ∧ R) ↔ (P ∨ Q) ∧ (P ∨ R).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Relating ∧ and ∨ with andb and orb (advanced)

- -
- - We've already seen several places where analogous structures - can be found in Coq's computational (Type) and logical (Prop) - worlds. Here is one more: the boolean operators andb and orb - are clearly analogs of the logical connectives ∧ and ∨. - This analogy can be made more precise by the following theorems, - which show how to translate knowledge about andb and orb's - behaviors on certain inputs into propositional facts about those - inputs. -
-
- -
-Theorem andb_prop : ∀b c,
-  andb b c = true → b = true ∧ c = true.
-Proof.
-  (* WORKED IN CLASS *)
-  intros b c H.
-  destruct b.
-    Case "b = true". destruct c.
-      SCase "c = true". apply conj. reflexivity. reflexivity.
-      SCase "c = false". inversion H.
-    Case "b = false". inversion H. Qed.
- -
-Theorem andb_true_intro : ∀b c,
-  b = true ∧ c = true → andb b c = true.
-Proof.
-  (* WORKED IN CLASS *)
-  intros b c H.
-  inversion H.
-  rewrite H0. rewrite H1. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars, optional (bool_prop)

- -
-
-Theorem andb_false : ∀b c,
-  andb b c = false → b = false ∨ c = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem orb_prop : ∀b c,
-  orb b c = true → b = true ∨ c = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem orb_false_elim : ∀b c,
-  orb b c = false → b = false ∧ c = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Falsehood

- -
- - Logical falsehood can be represented in Coq as an inductively - defined proposition with no constructors. -
-
- -
-Inductive False : Prop := .
- -
-
- -
-Intuition: False is a proposition for which there is no way - to give evidence. -
- - Since False has no constructors, inverting an assumption - of type False always yields zero subgoals, allowing us to - immediately prove any goal. -
-
- -
-Theorem False_implies_nonsense :
-  False → 2 + 2 = 5.
-Proof.
-  intros contra.
-  inversion contra. Qed.
- -
-
- -
-How does this work? The inversion tactic breaks contra into - each of its possible cases, and yields a subgoal for each case. - As contra is evidence for False, it has no possible cases, - hence, there are no possible subgoals and the proof is done. -
- -

- Conversely, the only way to prove False is if there is already - something nonsensical or contradictory in the context: -
-
- -
-Theorem nonsense_implies_False :
-  2 + 2 = 5 → False.
-Proof.
-  intros contra.
-  inversion contra. Qed.
- -
-
- -
-Actually, since the proof of False_implies_nonsense - doesn't actually have anything to do with the specific nonsensical - thing being proved; it can easily be generalized to work for an - arbitrary P: -
-
- -
-Theorem ex_falso_quodlibet : ∀(P:Prop),
-  False → P.
-Proof.
-  (* WORKED IN CLASS *)
-  intros P contra.
-  inversion contra. Qed.
- -
-
- -
-The Latin ex falso quodlibet means, literally, "from - falsehood follows whatever you please." This theorem is also - known as the principle of explosion. -
-
- -
-
- -
-

Truth

- -
- - Since we have defined falsehood in Coq, one might wonder whether - it is possible to define truth in the same way. We can. -
- -

Exercise: 2 stars, advanced (True)

- Define True as another inductively defined proposition. (The - intution is that True should be a proposition for which it is - trivial to give evidence.) -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- - However, unlike False, which we'll use extensively, True is - used fairly rarely. By itself, it is trivial (and therefore - uninteresting) to prove as a goal, and it carries no useful - information as a hypothesis. But it can be useful when defining - complex Props using conditionals, or as a parameter to - higher-order Props. -
-
- -
-
- -
-

Negation

- -
- - The logical complement of a proposition P is written not - P or, for shorthand, ¬P: -
-
- -
-Definition not (P:Prop) := P → False.
- -
-
- -
-The intuition is that, if P is not true, then anything at - all (even False) follows from assuming P. -
-
- -
-Notation "¬ x" := (not x) : type_scope.
- -
-Check not.
-(* ===> Prop -> Prop *)
- -
-
- -
-It takes a little practice to get used to working with - negation in Coq. Even though you can see perfectly well why - something is true, it can be a little hard at first to get things - into the right configuration so that Coq can see it! Here are - proofs of a few familiar facts about negation to get you warmed - up. -
-
- -
-Theorem not_False :
-  ¬ False.
-Proof.
-  unfold not. intros H. inversion H. Qed.
- -
-
- -
-

- -
-
-Theorem contradiction_implies_anything : ∀P Q : Prop,
-  (P ∧ ¬P) → Q.
-Proof.
-  (* WORKED IN CLASS *)
-  intros P Q H. inversion H as [HP HNA]. unfold not in HNA.
-  apply HNA in HP. inversion HP. Qed.
- -
-Theorem double_neg : ∀P : Prop,
-  P → ~~P.
-Proof.
-  (* WORKED IN CLASS *)
-  intros P H. unfold not. intros G. apply G. apply H. Qed.
- -
-
- -
-

Exercise: 2 stars, advanced (double_neg_inf)

- Write an informal proof of double_neg: - -
- - Theorem: P implies ~~P, for any proposition P. - -
- - Proof: -(* FILL IN HERE *)
- ☐ - -
- -

Exercise: 2 stars (contrapositive)

- -
-
-Theorem contrapositive : ∀P Q : Prop,
-  (P → Q) → (¬Q → ¬P).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star (not_both_true_and_false)

- -
-
-Theorem not_both_true_and_false : ∀P : Prop,
-  ¬ (P ∧ ¬P).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, advanced (informal_not_PNP)

- Write an informal proof (in English) of the proposition ∀ P - : Prop, ~(P ∧ ¬P). -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Constructive logic

- Note that some theorems that are true in classical logic are not - provable in Coq's (constructive) logic. E.g., let's look at how - this proof gets stuck... -
-
- -
-Theorem classic_double_neg : ∀P : Prop,
-  ~~P → P.
-Proof.
-  (* WORKED IN CLASS *)
-  intros P H. unfold not in H.
-  (* But now what? There is no way to "invent" evidence for ¬P 
-     from evidence for P. *)
-  Abort.
- -
-
- -
-

Exercise: 5 stars, advanced, optional (classical_axioms)

- For those who like a challenge, here is an exercise - taken from the Coq'Art book (p. 123). The following five - statements are often considered as characterizations of - classical logic (as opposed to constructive logic, which is - what is "built in" to Coq). We can't prove them in Coq, but - we can consistently add any one of them as an unproven axiom - if we wish to work in classical logic. Prove that these five - propositions are equivalent. -
-
- -
-Definition peirce := ∀P Q: Prop,
-  ((P→Q)→P)→P.
-Definition classic := ∀P:Prop,
-  ~~P → P.
-Definition excluded_middle := ∀P:Prop,
-  P ∨ ¬P.
-Definition de_morgan_not_and_not := ∀P Q:Prop,
-  ~(~P ∧ ¬Q) → P∨Q.
-Definition implies_to_or := ∀P Q:Prop,
-  (P→Q) → (¬P∨Q).
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars (excluded_middle_irrefutable)

- This theorem implies that it is always safe to add a decidability -axiom (i.e. an instance of excluded middle) for any particular Prop P. -Why? Because we cannot prove the negation of such an axiom; if we could, -we would have both ¬ (P ∨ ¬P) and ¬ ¬ (P ∨ ¬P), a contradiction. -
-
- -
-Theorem excluded_middle_irrefutable: ∀(P:Prop), ¬ ¬ (P ∨ ¬ P).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Inequality

- -
- - Saying x ≠ y is just the same as saying ~(x = y). -
-
- -
-Notation "x ≠ y" := (¬ (x = y)) : type_scope.
- -
-
- -
-Since inequality involves a negation, it again requires - a little practice to be able to work with it fluently. Here - is one very useful trick. If you are trying to prove a goal - that is nonsensical (e.g., the goal state is false = true), - apply the lemma ex_falso_quodlibet to change the goal to - False. This makes it easier to use assumptions of the form - ¬P that are available in the context — in particular, - assumptions of the form x≠y. -
-
- -
-Theorem not_false_then_true : ∀b : bool,
-  b ≠ false → b = true.
-Proof.
-  intros b H. destruct b.
-  Case "b = true". reflexivity.
-  Case "b = false".
-    unfold not in H.
-    apply ex_falso_quodlibet.
-    apply H. reflexivity. Qed.
- -
-
- -
-

- -
- -

- -
- -

- -
- -

- -
- -

- -
- -

Exercise: 2 stars (false_beq_nat)

- -
-
-Theorem false_beq_nat : ∀n m : nat,
-     n ≠ m →
-     beq_nat n m = false.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (beq_nat_false)

- -
-
-Theorem beq_nat_false : ∀n m,
-  beq_nat n m = false → n ≠ m.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Logic.v b/Logic.v deleted file mode 100644 index 317ecf1..0000000 --- a/Logic.v +++ /dev/null @@ -1,688 +0,0 @@ -(** * Logic: Logic in Coq *) - -Require Export MoreCoq. - - - -(** Coq's built-in logic is very small: the only primitives are - [Inductive] definitions, universal quantification ([forall]), and - implication ([->]), while all the other familiar logical - connectives -- conjunction, disjunction, negation, existential - quantification, even equality -- can be encoded using just these. - - This chapter explains the encodings and shows how the tactics - we've seen can be used to carry out standard forms of logical - reasoning involving these connectives. *) - -(* ########################################################### *) -(** * Propositions *) - -(** In previous chapters, we have seen many examples of factual - claims (_propositions_) and ways of presenting evidence of their - truth (_proofs_). In particular, we have worked extensively with - _equality propositions_ of the form [e1 = e2], with - implications ([P -> Q]), and with quantified propositions - ([forall x, P]). -*) - - -(** In Coq, the type of things that can (potentially) - be proven is [Prop]. *) - -(** Here is an example of a provable proposition: *) - -Check (3 = 3). -(* ===> Prop *) - -(** Here is an example of an unprovable proposition: *) - -Check (forall (n:nat), n = 2). -(* ===> Prop *) - -(** Recall that [Check] asks Coq to tell us the type of the indicated - expression. *) - -(* ########################################################### *) -(** * Proofs and Evidence *) - -(** In Coq, propositions have the same status as other types, such as - [nat]. Just as the natural numbers [0], [1], [2], etc. inhabit - the type [nat], a Coq proposition [P] is inhabited by its - _proofs_. We will refer to such inhabitants as _proof term_ or - _proof object_ or _evidence_ for the truth of [P]. - - In Coq, when we state and then prove a lemma such as: - -Lemma silly : 0 * 3 = 0. -Proof. reflexivity. Qed. - - the tactics we use within the [Proof]...[Qed] keywords tell Coq - how to construct a proof term that inhabits the proposition. In - this case, the proposition [0 * 3 = 0] is justified by a - combination of the _definition_ of [mult], which says that [0 * 3] - _simplifies_ to just [0], and the _reflexive_ principle of - equality, which says that [0 = 0]. - - -*) - -(** *** *) - -Lemma silly : 0 * 3 = 0. -Proof. reflexivity. Qed. - -(** We can see which proof term Coq constructs for a given Lemma by -using the [Print] directive: *) - -Print silly. -(* ===> silly = eq_refl : 0 * 3 = 0 *) - -(** Here, the [eq_refl] proof term witnesses the equality. (More on equality later!)*) - -(** ** Implications _are_ functions *) - -(** Just as we can implement natural number multiplication as a -function: - -[ -mult : nat -> nat -> nat -] - -The _proof term_ for an implication [P -> Q] is a _function_ that takes evidence for [P] as input and produces evidence for [Q] as its output. -*) - -Lemma silly_implication : (1 + 1) = 2 -> 0 * 3 = 0. -Proof. intros H. reflexivity. Qed. - -(** We can see that the proof term for the above lemma is indeed a -function: *) - -Print silly_implication. -(* ===> silly_implication = fun _ : 1 + 1 = 2 => eq_refl - : 1 + 1 = 2 -> 0 * 3 = 0 *) - -(** ** Defining Propositions *) - -(** Just as we can create user-defined inductive types (like the - lists, binary representations of natural numbers, etc., that we - seen before), we can also create _user-defined_ propositions. - - Question: How do you define the meaning of a proposition? -*) - -(** *** *) - -(** The meaning of a proposition is given by _rules_ and _definitions_ - that say how to construct _evidence_ for the truth of the - proposition from other evidence. - - - Typically, rules are defined _inductively_, just like any other datatype. - - - Sometimes a proposition is declared to be true without substantiating evidence. Such propositions are called _axioms_. - - - In this, and subsequence chapters, we'll see more about how these - proof terms work in more detail. -*) - -(* ########################################################### *) -(** * Conjunction (Logical "and") *) - -(** The logical conjunction of propositions [P] and [Q] can be - represented using an [Inductive] definition with one - constructor. *) - -Inductive and (P Q : Prop) : Prop := - conj : P -> Q -> (and P Q). - -(** The intuition behind this definition is simple: to - construct evidence for [and P Q], we must provide evidence - for [P] and evidence for [Q]. More precisely: - - - [conj p q] can be taken as evidence for [and P Q] if [p] - is evidence for [P] and [q] is evidence for [Q]; and - - - this is the _only_ way to give evidence for [and P Q] -- - that is, if someone gives us evidence for [and P Q], we - know it must have the form [conj p q], where [p] is - evidence for [P] and [q] is evidence for [Q]. - - Since we'll be using conjunction a lot, let's introduce a more - familiar-looking infix notation for it. *) - -Notation "P /\ Q" := (and P Q) : type_scope. - -(** (The [type_scope] annotation tells Coq that this notation - will be appearing in propositions, not values.) *) - -(** Consider the "type" of the constructor [conj]: *) - -Check conj. -(* ===> forall P Q : Prop, P -> Q -> P /\ Q *) - -(** Notice that it takes 4 inputs -- namely the propositions [P] - and [Q] and evidence for [P] and [Q] -- and returns as output the - evidence of [P /\ Q]. *) - -(** ** "Introducing" Conjuctions *) -(** Besides the elegance of building everything up from a tiny - foundation, what's nice about defining conjunction this way is - that we can prove statements involving conjunction using the - tactics that we already know. For example, if the goal statement - is a conjuction, we can prove it by applying the single - constructor [conj], which (as can be seen from the type of [conj]) - solves the current goal and leaves the two parts of the - conjunction as subgoals to be proved separately. *) - -Theorem and_example : - (0 = 0) /\ (4 = mult 2 2). -Proof. - apply conj. - Case "left". reflexivity. - Case "right". reflexivity. Qed. - -(** Just for convenience, we can use the tactic [split] as a shorthand for - [apply conj]. *) - -Theorem and_example' : - (0 = 0) /\ (4 = mult 2 2). -Proof. - split. - Case "left". reflexivity. - Case "right". reflexivity. Qed. - -(** ** "Eliminating" conjunctions *) -(** Conversely, the [inversion] tactic can be used to take a - conjunction hypothesis in the context, calculate what evidence - must have been used to build it, and add variables representing - this evidence to the proof context. *) - -Theorem proj1 : forall P Q : Prop, - P /\ Q -> P. -Proof. - intros P Q H. - inversion H as [HP HQ]. - apply HP. Qed. - -(** **** Exercise: 1 star, optional (proj2) *) -Theorem proj2 : forall P Q : Prop, - P /\ Q -> Q. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -Theorem and_commut : forall P Q : Prop, - P /\ Q -> Q /\ P. -Proof. - (* WORKED IN CLASS *) - intros P Q H. - inversion H as [HP HQ]. - split. - Case "left". apply HQ. - Case "right". apply HP. Qed. - - -(** **** Exercise: 2 stars (and_assoc) *) -(** In the following proof, notice how the _nested pattern_ in the - [inversion] breaks the hypothesis [H : P /\ (Q /\ R)] down into - [HP: P], [HQ : Q], and [HR : R]. Finish the proof from there: *) - -Theorem and_assoc : forall P Q R : Prop, - P /\ (Q /\ R) -> (P /\ Q) /\ R. -Proof. - intros P Q R H. - inversion H as [HP [HQ HR]]. -(* FILL IN HERE *) Admitted. -(** [] *) - - - -(* ###################################################### *) -(** * Iff *) - -(** The handy "if and only if" connective is just the conjunction of - two implications. *) - -Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P). - -Notation "P <-> Q" := (iff P Q) - (at level 95, no associativity) - : type_scope. - -Theorem iff_implies : forall P Q : Prop, - (P <-> Q) -> P -> Q. -Proof. - intros P Q H. - inversion H as [HAB HBA]. apply HAB. Qed. - -Theorem iff_sym : forall P Q : Prop, - (P <-> Q) -> (Q <-> P). -Proof. - (* WORKED IN CLASS *) - intros P Q H. - inversion H as [HAB HBA]. - split. - Case "->". apply HBA. - Case "<-". apply HAB. Qed. - -(** **** Exercise: 1 star, optional (iff_properties) *) -(** Using the above proof that [<->] is symmetric ([iff_sym]) as - a guide, prove that it is also reflexive and transitive. *) - -Theorem iff_refl : forall P : Prop, - P <-> P. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem iff_trans : forall P Q R : Prop, - (P <-> Q) -> (Q <-> R) -> (P <-> R). -Proof. - (* FILL IN HERE *) Admitted. - -(** Hint: If you have an iff hypothesis in the context, you can use - [inversion] to break it into two separate implications. (Think - about why this works.) *) -(** [] *) - - - -(** Some of Coq's tactics treat [iff] statements specially, thus - avoiding the need for some low-level manipulation when reasoning - with them. In particular, [rewrite] can be used with [iff] - statements, not just equalities. *) - -(* ############################################################ *) -(** * Disjunction (Logical "or") *) - -(** ** Implementing Disjunction *) - -(** Disjunction ("logical or") can also be defined as an - inductive proposition. *) - -Inductive or (P Q : Prop) : Prop := - | or_introl : P -> or P Q - | or_intror : Q -> or P Q. - -Notation "P \/ Q" := (or P Q) : type_scope. - -(** Consider the "type" of the constructor [or_introl]: *) - -Check or_introl. -(* ===> forall P Q : Prop, P -> P \/ Q *) - -(** It takes 3 inputs, namely the propositions [P], [Q] and - evidence of [P], and returns, as output, the evidence of [P \/ Q]. - Next, look at the type of [or_intror]: *) - -Check or_intror. -(* ===> forall P Q : Prop, Q -> P \/ Q *) - -(** It is like [or_introl] but it requires evidence of [Q] - instead of evidence of [P]. *) - -(** Intuitively, there are two ways of giving evidence for [P \/ Q]: - - - give evidence for [P] (and say that it is [P] you are giving - evidence for -- this is the function of the [or_introl] - constructor), or - - - give evidence for [Q], tagged with the [or_intror] - constructor. *) - -(** *** *) -(** Since [P \/ Q] has two constructors, doing [inversion] on a - hypothesis of type [P \/ Q] yields two subgoals. *) - -Theorem or_commut : forall P Q : Prop, - P \/ Q -> Q \/ P. -Proof. - intros P Q H. - inversion H as [HP | HQ]. - Case "left". apply or_intror. apply HP. - Case "right". apply or_introl. apply HQ. Qed. - -(** From here on, we'll use the shorthand tactics [left] and [right] - in place of [apply or_introl] and [apply or_intror]. *) - -Theorem or_commut' : forall P Q : Prop, - P \/ Q -> Q \/ P. -Proof. - intros P Q H. - inversion H as [HP | HQ]. - Case "left". right. apply HP. - Case "right". left. apply HQ. Qed. - - - - - -Theorem or_distributes_over_and_1 : forall P Q R : Prop, - P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R). -Proof. - intros P Q R. intros H. inversion H as [HP | [HQ HR]]. - Case "left". split. - SCase "left". left. apply HP. - SCase "right". left. apply HP. - Case "right". split. - SCase "left". right. apply HQ. - SCase "right". right. apply HR. Qed. - -(** **** Exercise: 2 stars (or_distributes_over_and_2) *) -Theorem or_distributes_over_and_2 : forall P Q R : Prop, - (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (or_distributes_over_and) *) -Theorem or_distributes_over_and : forall P Q R : Prop, - P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ################################################### *) -(** ** Relating [/\] and [\/] with [andb] and [orb] (advanced) *) - -(** We've already seen several places where analogous structures - can be found in Coq's computational ([Type]) and logical ([Prop]) - worlds. Here is one more: the boolean operators [andb] and [orb] - are clearly analogs of the logical connectives [/\] and [\/]. - This analogy can be made more precise by the following theorems, - which show how to translate knowledge about [andb] and [orb]'s - behaviors on certain inputs into propositional facts about those - inputs. *) - -Theorem andb_prop : forall b c, - andb b c = true -> b = true /\ c = true. -Proof. - (* WORKED IN CLASS *) - intros b c H. - destruct b. - Case "b = true". destruct c. - SCase "c = true". apply conj. reflexivity. reflexivity. - SCase "c = false". inversion H. - Case "b = false". inversion H. Qed. - -Theorem andb_true_intro : forall b c, - b = true /\ c = true -> andb b c = true. -Proof. - (* WORKED IN CLASS *) - intros b c H. - inversion H. - rewrite H0. rewrite H1. reflexivity. Qed. - -(** **** Exercise: 2 stars, optional (bool_prop) *) -Theorem andb_false : forall b c, - andb b c = false -> b = false \/ c = false. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem orb_prop : forall b c, - orb b c = true -> b = true \/ c = true. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem orb_false_elim : forall b c, - orb b c = false -> b = false /\ c = false. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - -(* ################################################### *) -(** * Falsehood *) - -(** Logical falsehood can be represented in Coq as an inductively - defined proposition with no constructors. *) - -Inductive False : Prop := . - -(** Intuition: [False] is a proposition for which there is no way - to give evidence. *) - - -(** Since [False] has no constructors, inverting an assumption - of type [False] always yields zero subgoals, allowing us to - immediately prove any goal. *) - -Theorem False_implies_nonsense : - False -> 2 + 2 = 5. -Proof. - intros contra. - inversion contra. Qed. - -(** How does this work? The [inversion] tactic breaks [contra] into - each of its possible cases, and yields a subgoal for each case. - As [contra] is evidence for [False], it has _no_ possible cases, - hence, there are no possible subgoals and the proof is done. *) - -(** *** *) -(** Conversely, the only way to prove [False] is if there is already - something nonsensical or contradictory in the context: *) - -Theorem nonsense_implies_False : - 2 + 2 = 5 -> False. -Proof. - intros contra. - inversion contra. Qed. - -(** Actually, since the proof of [False_implies_nonsense] - doesn't actually have anything to do with the specific nonsensical - thing being proved; it can easily be generalized to work for an - arbitrary [P]: *) - -Theorem ex_falso_quodlibet : forall (P:Prop), - False -> P. -Proof. - (* WORKED IN CLASS *) - intros P contra. - inversion contra. Qed. - -(** The Latin _ex falso quodlibet_ means, literally, "from - falsehood follows whatever you please." This theorem is also - known as the _principle of explosion_. *) - - -(* #################################################### *) -(** ** Truth *) - -(** Since we have defined falsehood in Coq, one might wonder whether - it is possible to define truth in the same way. We can. *) - -(** **** Exercise: 2 stars, advanced (True) *) -(** Define [True] as another inductively defined proposition. (The - intution is that [True] should be a proposition for which it is - trivial to give evidence.) *) - -(* FILL IN HERE *) -(** [] *) - -(** However, unlike [False], which we'll use extensively, [True] is - used fairly rarely. By itself, it is trivial (and therefore - uninteresting) to prove as a goal, and it carries no useful - information as a hypothesis. But it can be useful when defining - complex [Prop]s using conditionals, or as a parameter to - higher-order [Prop]s. *) - -(* #################################################### *) -(** * Negation *) - -(** The logical complement of a proposition [P] is written [not - P] or, for shorthand, [~P]: *) - -Definition not (P:Prop) := P -> False. - -(** The intuition is that, if [P] is not true, then anything at - all (even [False]) follows from assuming [P]. *) - -Notation "~ x" := (not x) : type_scope. - -Check not. -(* ===> Prop -> Prop *) - -(** It takes a little practice to get used to working with - negation in Coq. Even though you can see perfectly well why - something is true, it can be a little hard at first to get things - into the right configuration so that Coq can see it! Here are - proofs of a few familiar facts about negation to get you warmed - up. *) - -Theorem not_False : - ~ False. -Proof. - unfold not. intros H. inversion H. Qed. - -(** *** *) -Theorem contradiction_implies_anything : forall P Q : Prop, - (P /\ ~P) -> Q. -Proof. - (* WORKED IN CLASS *) - intros P Q H. inversion H as [HP HNA]. unfold not in HNA. - apply HNA in HP. inversion HP. Qed. - -Theorem double_neg : forall P : Prop, - P -> ~~P. -Proof. - (* WORKED IN CLASS *) - intros P H. unfold not. intros G. apply G. apply H. Qed. - -(** **** Exercise: 2 stars, advanced (double_neg_inf) *) -(** Write an informal proof of [double_neg]: - - _Theorem_: [P] implies [~~P], for any proposition [P]. - - _Proof_: -(* FILL IN HERE *) - [] -*) - -(** **** Exercise: 2 stars (contrapositive) *) -Theorem contrapositive : forall P Q : Prop, - (P -> Q) -> (~Q -> ~P). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star (not_both_true_and_false) *) -Theorem not_both_true_and_false : forall P : Prop, - ~ (P /\ ~P). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, advanced (informal_not_PNP) *) -(** Write an informal proof (in English) of the proposition [forall P - : Prop, ~(P /\ ~P)]. *) - -(* FILL IN HERE *) -(** [] *) - -(** *** Constructive logic *) -(** Note that some theorems that are true in classical logic are _not_ - provable in Coq's (constructive) logic. E.g., let's look at how - this proof gets stuck... *) - -Theorem classic_double_neg : forall P : Prop, - ~~P -> P. -Proof. - (* WORKED IN CLASS *) - intros P H. unfold not in H. - (* But now what? There is no way to "invent" evidence for [~P] - from evidence for [P]. *) - Abort. - -(** **** Exercise: 5 stars, advanced, optional (classical_axioms) *) -(** For those who like a challenge, here is an exercise - taken from the Coq'Art book (p. 123). The following five - statements are often considered as characterizations of - classical logic (as opposed to constructive logic, which is - what is "built in" to Coq). We can't prove them in Coq, but - we can consistently add any one of them as an unproven axiom - if we wish to work in classical logic. Prove that these five - propositions are equivalent. *) - -Definition peirce := forall P Q: Prop, - ((P->Q)->P)->P. -Definition classic := forall P:Prop, - ~~P -> P. -Definition excluded_middle := forall P:Prop, - P \/ ~P. -Definition de_morgan_not_and_not := forall P Q:Prop, - ~(~P /\ ~Q) -> P\/Q. -Definition implies_to_or := forall P Q:Prop, - (P->Q) -> (~P\/Q). - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars (excluded_middle_irrefutable) *) -(** This theorem implies that it is always safe to add a decidability -axiom (i.e. an instance of excluded middle) for any _particular_ Prop [P]. -Why? Because we cannot prove the negation of such an axiom; if we could, -we would have both [~ (P \/ ~P)] and [~ ~ (P \/ ~P)], a contradiction. *) - -Theorem excluded_middle_irrefutable: forall (P:Prop), ~ ~ (P \/ ~ P). -Proof. - (* FILL IN HERE *) Admitted. - - -(* ########################################################## *) -(** ** Inequality *) - -(** Saying [x <> y] is just the same as saying [~(x = y)]. *) - -Notation "x <> y" := (~ (x = y)) : type_scope. - -(** Since inequality involves a negation, it again requires - a little practice to be able to work with it fluently. Here - is one very useful trick. If you are trying to prove a goal - that is nonsensical (e.g., the goal state is [false = true]), - apply the lemma [ex_falso_quodlibet] to change the goal to - [False]. This makes it easier to use assumptions of the form - [~P] that are available in the context -- in particular, - assumptions of the form [x<>y]. *) - -Theorem not_false_then_true : forall b : bool, - b <> false -> b = true. -Proof. - intros b H. destruct b. - Case "b = true". reflexivity. - Case "b = false". - unfold not in H. - apply ex_falso_quodlibet. - apply H. reflexivity. Qed. - - -(** *** *) - -(** *** *) - -(** *** *) - -(** *** *) - -(** *** *) - -(** **** Exercise: 2 stars (false_beq_nat) *) -Theorem false_beq_nat : forall n m : nat, - n <> m -> - beq_nat n m = false. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, optional (beq_nat_false) *) -Theorem beq_nat_false : forall n m, - beq_nat n m = false -> n <> m. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - - - -(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *) - diff --git a/Makefile b/Makefile deleted file mode 100644 index 82033db..0000000 --- a/Makefile +++ /dev/null @@ -1,220 +0,0 @@ -############################################################################# -## v # The Coq Proof Assistant ## -## "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) - -%.v.beautified: - $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $* - -# WARNING -# -# This Makefile has been automagically generated -# Edit at your own risks ! -# -# END OF WARNING - -include .depend diff --git a/MoreCoq.html b/MoreCoq.html deleted file mode 100644 index b256a98..0000000 --- a/MoreCoq.html +++ /dev/null @@ -1,1772 +0,0 @@ - - - - - -MoreCoq: More About Coq - - - - - - -
- - - -
- -

MoreCoqMore About Coq

- -
-
- -
- -
-
- -
-Require Export Poly.
- -
-
- -
-This chapter introduces several more Coq tactics that, - together, allow us to prove many more theorems about the - functional programs we are writing. -
-
- -
-
- -
-

The apply Tactic

- -
- - We often encounter situations where the goal to be proved is - exactly the same as some hypothesis in the context or some - previously proved lemma. -
-
- -
-Theorem silly1 : ∀(n m o p : nat),
-     n = m →
-     [n;o] = [n;p] →
-     [n;o] = [m;p].
-Proof.
-  intros n m o p eq1 eq2.
-  rewrite ← eq1.
-  (* At this point, we could finish with 
-     "rewrite → eq2. reflexivity." as we have 
-     done several times above. But we can achieve the
-     same effect in a single step by using the 
-     apply tactic instead: *)
-  apply eq2. Qed.
- -
-
- -
-The apply tactic also works with conditional hypotheses - and lemmas: if the statement being applied is an implication, then - the premises of this implication will be added to the list of - subgoals needing to be proved. -
-
- -
-Theorem silly2 : ∀(n m o p : nat),
-     n = m →
-     (∀(q r : nat), q = r → [q;o] = [r;p]) →
-     [n;o] = [m;p].
-Proof.
-  intros n m o p eq1 eq2.
-  apply eq2. apply eq1. Qed.
- -
-
- -
-You may find it instructive to experiment with this proof - and see if there is a way to complete it using just rewrite - instead of apply. -
- - Typically, when we use apply H, the statement H will - begin with a ∀ binding some universal variables. When - Coq matches the current goal against the conclusion of H, it - will try to find appropriate values for these variables. For - example, when we do apply eq2 in the following proof, the - universal variable q in eq2 gets instantiated with n and r - gets instantiated with m. -
-
- -
-Theorem silly2a : ∀(n m : nat),
-     (n,n) = (m,m) →
-     (∀(q r : nat), (q,q) = (r,r) → [q] = [r]) →
-     [n] = [m].
-Proof.
-  intros n m eq1 eq2.
-  apply eq2. apply eq1. Qed.
- -
-
- -
-

Exercise: 2 stars, optional (silly_ex)

- Complete the following proof without using simpl. -
-
- -
-Theorem silly_ex :
-     (∀n, evenb n = true → oddb (S n) = true) →
-     evenb 3 = true →
-     oddb 4 = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - To use the apply tactic, the (conclusion of the) fact - being applied must match the goal exactly — for example, apply - will not work if the left and right sides of the equality are - swapped. -
-
- -
-Theorem silly3_firsttry : ∀(n : nat),
-     true = beq_nat n 5 →
-     beq_nat (S (S n)) 7 = true.
-Proof.
-  intros n H.
-  simpl.
-  (* Here we cannot use apply directly *)
-Abort.
- -
-
- -
-In this case we can use the symmetry tactic, which switches the - left and right sides of an equality in the goal. -
-
- -
-Theorem silly3 : ∀(n : nat),
-     true = beq_nat n 5 →
-     beq_nat (S (S n)) 7 = true.
-Proof.
-  intros n H.
-  symmetry.
-  simpl. (* Actually, this simpl is unnecessary, since 
-            apply will perform simplification first. *)
-  apply H. Qed.
- -
-
- -
-

Exercise: 3 stars (apply_exercise1)

- Hint: you can use apply with previously defined lemmas, not - just hypotheses in the context. Remember that SearchAbout is - your friend. -
-
- -
-Theorem rev_exercise1 : ∀(l l' : list nat),
-     l = rev l' →
-     l' = rev l.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (apply_rewrite)

- Briefly explain the difference between the tactics apply and - rewrite. Are there situations where both can usefully be - applied? - (* FILL IN HERE *)
- ☐ -
-
- -
-
- -
-

The apply ... with ... Tactic

- -
- - The following silly example uses two rewrites in a row to - get from [a,b] to [e,f]. -
-
- -
-Example trans_eq_example : ∀(a b c d e f : nat),
-     [a;b] = [c;d] →
-     [c;d] = [e;f] →
-     [a;b] = [e;f].
-Proof.
-  intros a b c d e f eq1 eq2.
-  rewrite → eq1. rewrite → eq2. reflexivity. Qed.
- -
-
- -
-Since this is a common pattern, we might - abstract it out as a lemma recording once and for all - the fact that equality is transitive. -
-
- -
-Theorem trans_eq : ∀(X:Type) (n m o : X),
-  n = m → m = o → n = o.
-Proof.
-  intros X n m o eq1 eq2. rewrite → eq1. rewrite → eq2.
-  reflexivity. Qed.
- -
-
- -
-Now, we should be able to use trans_eq to - prove the above example. However, to do this we need - a slight refinement of the apply tactic. -
-
- -
-Example trans_eq_example' : ∀(a b c d e f : nat),
-     [a;b] = [c;d] →
-     [c;d] = [e;f] →
-     [a;b] = [e;f].
-Proof.
-  intros a b c d e f eq1 eq2.
-  (* If we simply tell Coq apply trans_eq at this point,
-     it can tell (by matching the goal against the
-     conclusion of the lemma) that it should instantiate X
-     with [nat], n with [a,b], and o with [e,f].
-     However, the matching process doesn't determine an
-     instantiation for m: we have to supply one explicitly
-     by adding with (m:=[c,d]) to the invocation of
-     apply. *)
-  apply trans_eq with (m:=[c;d]). apply eq1. apply eq2. Qed.
- -
-
- -
- Actually, we usually don't have to include the name m - in the with clause; Coq is often smart enough to - figure out which instantiation we're giving. We could - instead write: apply trans_eq with [c,d]. -
- -

Exercise: 3 stars, optional (apply_with_exercise)

- -
-
-Example trans_eq_exercise : ∀(n m o p : nat),
-     m = (minustwo o) →
-     (n + p) = m →
-     (n + p) = (minustwo o).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

The inversion tactic

- -
- - Recall the definition of natural numbers: - -
- -
-     Inductive nat : Type :=
-       | O : nat
-       | S : nat → nat. -
- -
- It is clear from this definition that every number has one of two - forms: either it is the constructor O or it is built by applying - the constructor S to another number. But there is more here than - meets the eye: implicit in the definition (and in our informal - understanding of how datatype declarations work in other - programming languages) are two other facts: - -
- -
    -
  • The constructor S is injective. That is, the only way we can - have S n = S m is if n = m. - -
    - - -
    • -
  • The constructors O and S are disjoint. That is, O is not - equal to S n for any n. -
    • -
- -
- - Similar principles apply to all inductively defined types: all - constructors are injective, and the values built from distinct - constructors are never equal. For lists, the cons constructor is - injective and nil is different from every non-empty list. For - booleans, true and false are unequal. (Since neither true - nor false take any arguments, their injectivity is not an issue.) -
- - Coq provides a tactic called inversion that allows us to exploit - these principles in proofs. - -
- - The inversion tactic is used like this. Suppose H is a - hypothesis in the context (or a previously proven lemma) of the - form - -
- -
-      c a1 a2 ... an = d b1 b2 ... bm -
- -
- for some constructors c and d and arguments a1 ... an and - b1 ... bm. Then inversion H instructs Coq to "invert" this - equality to extract the information it contains about these terms: - -
- -
    -
  • If c and d are the same constructor, then we know, by the - injectivity of this constructor, that a1 = b1, a2 = b2, - etc.; inversion H adds these facts to the context, and tries - to use them to rewrite the goal. - -
    - - -
    • -
  • If c and d are different constructors, then the hypothesis - H is contradictory. That is, a false assumption has crept - into the context, and this means that any goal whatsoever is - provable! In this case, inversion H marks the current goal as - completed and pops it off the goal stack. -
    • -
- -
- - The inversion tactic is probably easier to understand by - seeing it in action than from general descriptions like the above. - Below you will find example theorems that demonstrate the use of - inversion and exercises to test your understanding. -
-
- -
-Theorem eq_add_S : ∀(n m : nat),
-     S n = S m →
-     n = m.
-Proof.
-  intros n m eq. inversion eq. reflexivity. Qed.
- -
-Theorem silly4 : ∀(n m : nat),
-     [n] = [m] →
-     n = m.
-Proof.
-  intros n o eq. inversion eq. reflexivity. Qed.
- -
-
- -
-As a convenience, the inversion tactic can also - destruct equalities between complex values, binding - multiple variables as it goes. -
-
- -
-Theorem silly5 : ∀(n m o : nat),
-     [n;m] = [o;o] →
-     [n] = [m].
-Proof.
-  intros n m o eq. inversion eq. reflexivity. Qed.
- -
-
- -
-

Exercise: 1 star (sillyex1)

- -
-
-Example sillyex1 : ∀(X : Type) (x y z : X) (l j : list X),
-     x :: y :: l = z :: j →
-     y :: l = x :: j →
-     x = y.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-Theorem silly6 : ∀(n : nat),
-     S n = O →
-     2 + 2 = 5.
-Proof.
-  intros n contra. inversion contra. Qed.
- -
-Theorem silly7 : ∀(n m : nat),
-     false = true →
-     [n] = [m].
-Proof.
-  intros n m contra. inversion contra. Qed.
- -
-
- -
-

Exercise: 1 star (sillyex2)

- -
-
-Example sillyex2 : ∀(X : Type) (x y z : X) (l j : list X),
-     x :: y :: l = [] →
-     y :: l = z :: j →
-     x = z.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - While the injectivity of constructors allows us to reason - ∀ (n m : nat), S n = S m → n = m, the reverse direction of - the implication is an instance of a more general fact about - constructors and functions, which we will often find useful: -
-
- -
-Theorem f_equal : ∀(A B : Type) (f: A → B) (x y: A),
-    x = y → f x = f y.
-Proof. intros A B f x y eq. rewrite eq. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars, optional (practice)

- A couple more nontrivial but not-too-complicated proofs to work - together in class, or for you to work as exercises. -
-
- -
-Theorem beq_nat_0_l : ∀n,
-   beq_nat 0 n = true → n = 0.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem beq_nat_0_r : ∀n,
-   beq_nat n 0 = true → n = 0.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Using Tactics on Hypotheses

- -
- - By default, most tactics work on the goal formula and leave - the context unchanged. However, most tactics also have a variant - that performs a similar operation on a statement in the context. - -
- - For example, the tactic simpl in H performs simplification in - the hypothesis named H in the context. -
-
- -
-Theorem S_inj : ∀(n m : nat) (b : bool),
-     beq_nat (S n) (S m) = b →
-     beq_nat n m = b.
-Proof.
-  intros n m b H. simpl in H. apply H. Qed.
- -
-
- -
-Similarly, the tactic apply L in H matches some - conditional statement L (of the form L1 → L2, say) against a - hypothesis H in the context. However, unlike ordinary - apply (which rewrites a goal matching L2 into a subgoal L1), - apply L in H matches H against L1 and, if successful, - replaces it with L2. - -
- - In other words, apply L in H gives us a form of "forward - reasoning" — from L1 → L2 and a hypothesis matching L1, it - gives us a hypothesis matching L2. By contrast, apply L is - "backward reasoning" — it says that if we know L1→L2 and we - are trying to prove L2, it suffices to prove L1. - -
- - Here is a variant of a proof from above, using forward reasoning - throughout instead of backward reasoning. -
-
- -
-Theorem silly3' : ∀(n : nat),
-  (beq_nat n 5 = true → beq_nat (S (S n)) 7 = true) →
-     true = beq_nat n 5 →
-     true = beq_nat (S (S n)) 7.
-Proof.
-  intros n eq H.
-  symmetry in H. apply eq in H. symmetry in H.
-  apply H. Qed.
- -
-
- -
-Forward reasoning starts from what is given (premises, - previously proven theorems) and iteratively draws conclusions from - them until the goal is reached. Backward reasoning starts from - the goal, and iteratively reasons about what would imply the - goal, until premises or previously proven theorems are reached. - If you've seen informal proofs before (for example, in a math or - computer science class), they probably used forward reasoning. In - general, Coq tends to favor backward reasoning, but in some - situations the forward style can be easier to use or to think - about. -
- -

Exercise: 3 stars (plus_n_n_injective)

- Practice using "in" variants in this exercise. -
-
- -
-Theorem plus_n_n_injective : ∀n m,
-     n + n = m + m →
-     n = m.
-Proof.
-  intros n. induction n as [| n'].
-    (* Hint: use the plus_n_Sm lemma *)
-    (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Varying the Induction Hypothesis

- -
- - Sometimes it is important to control the exact form of the - induction hypothesis when carrying out inductive proofs in Coq. - In particular, we need to be careful about which of the - assumptions we move (using intros) from the goal to the context - before invoking the induction tactic. For example, suppose - we want to show that the double function is injective — i.e., - that it always maps different arguments to different results: - -
- -
-    Theorem double_injective: ∀n m, double n = double m → n = m. -
- -
- The way we start this proof is a little bit delicate: if we - begin it with - -
- -
-      intros n. induction n. -
- -
- all is well. But if we begin it with - -
- -
-      intros n m. induction n. -
- -
- we get stuck in the middle of the inductive case... -
-
- -
-Theorem double_injective_FAILED : ∀n m,
-     double n = double m →
-     n = m.
-Proof.
-  intros n m. induction n as [| n'].
-  Case "n = O". simpl. intros eq. destruct m as [| m'].
-    SCase "m = O". reflexivity.
-    SCase "m = S m'". inversion eq.
-  Case "n = S n'". intros eq. destruct m as [| m'].
-    SCase "m = O". inversion eq.
-    SCase "m = S m'". apply f_equal.
-      (* Here we are stuck.  The induction hypothesis, IHn', does
-         not give us n' = m' -- there is an extra S in the
-         way -- so the goal is not provable. *)
-      Abort.
- -
-
- -
-What went wrong? -
- - The problem is that, at the point we invoke the induction - hypothesis, we have already introduced m into the context — - intuitively, we have told Coq, "Let's consider some particular - n and m..." and we now have to prove that, if double n = - double m for this particular n and m, then n = m. - -
- - The next tactic, induction n says to Coq: We are going to show - the goal by induction on n. That is, we are going to prove that - the proposition - -
- -
    -
  • P n = "if double n = double m, then n = m" - -
    • -
- -
- - holds for all n by showing - -
- -
    -
  • P O - -
    - - (i.e., "if double O = double m then O = m") - -
    - - -
    • -
  • P n → P (S n) - -
    - - (i.e., "if double n = double m then n = m" implies "if - double (S n) = double m then S n = m"). - -
    • -
- -
- - If we look closely at the second statement, it is saying something - rather strange: it says that, for a particular m, if we know - -
- -
    -
  • "if double n = double m then n = m" - -
    • -
- -
- - then we can prove - -
- -
    -
  • "if double (S n) = double m then S n = m". - -
    • -
- -
- - To see why this is strange, let's think of a particular m — - say, 5. The statement is then saying that, if we know - -
- -
    -
  • Q = "if double n = 10 then n = 5" - -
    • -
- -
- - then we can prove - -
- -
    -
  • R = "if double (S n) = 10 then S n = 5". - -
    • -
- -
- - But knowing Q doesn't give us any help with proving R! (If we - tried to prove R from Q, we would say something like "Suppose - double (S n) = 10..." but then we'd be stuck: knowing that - double (S n) is 10 tells us nothing about whether double n - is 10, so Q is useless at this point.) -
- - To summarize: Trying to carry out this proof by induction on n - when m is already in the context doesn't work because we are - trying to prove a relation involving every n but just a - single m. -
- - The good proof of double_injective leaves m in the goal - statement at the point where the induction tactic is invoked on - n: -
-
- -
-Theorem double_injective : ∀n m,
-     double n = double m →
-     n = m.
-Proof.
-  intros n. induction n as [| n'].
-  Case "n = O". simpl. intros m eq. destruct m as [| m'].
-    SCase "m = O". reflexivity.
-    SCase "m = S m'". inversion eq.
-  Case "n = S n'".
-    (* Notice that both the goal and the induction
-       hypothesis have changed: the goal asks us to prove
-       something more general (i.e., to prove the
-       statement for _every_ m), but the IH is
-       correspondingly more flexible, allowing us to
-       choose any m we like when we apply the IH.  *)
-    intros m eq.
-    (* Now we choose a particular m and introduce the
-       assumption that double n = double m.  Since we
-       are doing a case analysis on n, we need a case
-       analysis on m to keep the two "in sync." *)
-    destruct m as [| m'].
-    SCase "m = O".
-      (* The 0 case is trivial *)
-      inversion eq.
-    SCase "m = S m'".
-      apply f_equal.
-      (* At this point, since we are in the second
-         branch of the destruct m, the m' mentioned
-         in the context at this point is actually the
-         predecessor of the one we started out talking
-         about.  Since we are also in the S branch of
-         the induction, this is perfect: if we
-         instantiate the generic m in the IH with the
-         m' that we are talking about right now (this
-         instantiation is performed automatically by
-         apply), then IHn' gives us exactly what we
-         need to finish the proof. *)
-      apply IHn'. inversion eq. reflexivity. Qed.
- -
-
- -
-What this teaches us is that we need to be careful about using - induction to try to prove something too specific: If we're proving - a property of n and m by induction on n, we may need to - leave m generic. -
- - The proof of this theorem (left as an exercise) has to be treated similarly: -
- -

Exercise: 2 stars (beq_nat_true)

- -
-
-Theorem beq_nat_true : ∀n m,
-    beq_nat n m = true → n = m.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, advanced (beq_nat_true_informal)

- Give a careful informal proof of beq_nat_true, being as explicit - as possible about quantifiers. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- - The strategy of doing fewer intros before an induction doesn't - always work directly; sometimes a little rearrangement of - quantified variables is needed. Suppose, for example, that we - wanted to prove double_injective by induction on m instead of - n. -
-
- -
-Theorem double_injective_take2_FAILED : ∀n m,
-     double n = double m →
-     n = m.
-Proof.
-  intros n m. induction m as [| m'].
-  Case "m = O". simpl. intros eq. destruct n as [| n'].
-    SCase "n = O". reflexivity.
-    SCase "n = S n'". inversion eq.
-  Case "m = S m'". intros eq. destruct n as [| n'].
-    SCase "n = O". inversion eq.
-    SCase "n = S n'". apply f_equal.
-        (* Stuck again here, just like before. *)
-Abort.
- -
-
- -
-The problem is that, to do induction on m, we must first - introduce n. (If we simply say induction m without - introducing anything first, Coq will automatically introduce - n for us!) -
- - What can we do about this? One possibility is to rewrite the - statement of the lemma so that m is quantified before n. This - will work, but it's not nice: We don't want to have to mangle the - statements of lemmas to fit the needs of a particular strategy for - proving them — we want to state them in the most clear and - natural way. -
- - What we can do instead is to first introduce all the - quantified variables and then re-generalize one or more of - them, taking them out of the context and putting them back at - the beginning of the goal. The generalize dependent tactic - does this. -
-
- -
-Theorem double_injective_take2 : ∀n m,
-     double n = double m →
-     n = m.
-Proof.
-  intros n m.
-  (* n and m are both in the context *)
-  generalize dependent n.
-  (* Now n is back in the goal and we can do induction on
-     m and get a sufficiently general IH. *)
-  induction m as [| m'].
-  Case "m = O". simpl. intros n eq. destruct n as [| n'].
-    SCase "n = O". reflexivity.
-    SCase "n = S n'". inversion eq.
-  Case "m = S m'". intros n eq. destruct n as [| n'].
-    SCase "n = O". inversion eq.
-    SCase "n = S n'". apply f_equal.
-      apply IHm'. inversion eq. reflexivity. Qed.
- -
-
- -
-Let's look at an informal proof of this theorem. Note that - the proposition we prove by induction leaves n quantified, - corresponding to the use of generalize dependent in our formal - proof. - -
- -Theorem: For any nats n and m, if double n = double m, then - n = m. - -
- -Proof: Let m be a nat. We prove by induction on m that, for - any n, if double n = double m then n = m. - -
- -
    -
  • First, suppose m = 0, and suppose n is a number such - that double n = double m. We must show that n = 0. - -
    - - Since m = 0, by the definition of double we have double n = - 0. There are two cases to consider for n. If n = 0 we are - done, since this is what we wanted to show. Otherwise, if n = S - n' for some n', we derive a contradiction: by the definition of - double we would have double n = S (S (double n')), but this - contradicts the assumption that double n = 0. - -
    - - -
    • -
  • Otherwise, suppose m = S m' and that n is again a number such - that double n = double m. We must show that n = S m', with - the induction hypothesis that for every number s, if double s = - double m' then s = m'. - -
    - - By the fact that m = S m' and the definition of double, we - have double n = S (S (double m')). There are two cases to - consider for n. - -
    - - If n = 0, then by definition double n = 0, a contradiction. - Thus, we may assume that n = S n' for some n', and again by - the definition of double we have S (S (double n')) = S (S - (double m')), which implies by inversion that double n' = double - m'. - -
    - - Instantiating the induction hypothesis with n' thus allows us to - conclude that n' = m', and it follows immediately that S n' = S - m'. Since S n' = n and S m' = m, this is just what we wanted - to show. ☐ -
    • -
- -
- - Here's another illustration of inversion and using an - appropriately general induction hypothesis. This is a slightly - roundabout way of stating a fact that we have already proved - above. The extra equalities force us to do a little more - equational reasoning and exercise some of the tactics we've seen - recently. -
-
- -
-Theorem length_snoc' : ∀(X : Type) (v : X)
-                              (l : list X) (n : nat),
-     length l = n →
-     length (snoc l v) = S n.
-Proof.
-  intros X v l. induction l as [| v' l'].
- -
-  Case "l = []".
-    intros n eq. rewrite ← eq. reflexivity.
- -
-  Case "l = v' :: l'".
-    intros n eq. simpl. destruct n as [| n'].
-    SCase "n = 0". inversion eq.
-    SCase "n = S n'".
-      apply f_equal. apply IHl'. inversion eq. reflexivity. Qed.
- -
-
- -
-It might be tempting to start proving the above theorem - by introducing n and eq at the outset. However, this leads - to an induction hypothesis that is not strong enough. Compare - the above to the following (aborted) attempt: -
-
- -
-Theorem length_snoc_bad : ∀(X : Type) (v : X)
-                              (l : list X) (n : nat),
-     length l = n →
-     length (snoc l v) = S n.
-Proof.
-  intros X v l n eq. induction l as [| v' l'].
- -
-  Case "l = []".
-    rewrite ← eq. reflexivity.
- -
-  Case "l = v' :: l'".
-    simpl. destruct n as [| n'].
-    SCase "n = 0". inversion eq.
-    SCase "n = S n'".
-      apply f_equal. Abort. (* apply IHl'. *) (* The IH doesn't apply! *)
- -
-
- -
-As in the double examples, the problem is that by - introducing n before doing induction on l, the induction - hypothesis is specialized to one particular natural number, namely - n. In the induction case, however, we need to be able to use - the induction hypothesis on some other natural number n'. - Retaining the more general form of the induction hypothesis thus - gives us more flexibility. - -
- - In general, a good rule of thumb is to make the induction hypothesis - as general as possible. -
- -

Exercise: 3 stars (gen_dep_practice)

- -
- - Prove this by induction on l. -
-
- -
-Theorem index_after_last: ∀(n : nat) (X : Type) (l : list X),
-     length l = n →
-     index n l = None.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced, optional (index_after_last_informal)

- Write an informal proof corresponding to your Coq proof - of index_after_last: - -
- - Theorem: For all sets X, lists l : list X, and numbers - n, if length l = n then index n l = None. - -
- - Proof: - (* FILL IN HERE *)
-☐ - -
- -

Exercise: 3 stars, optional (gen_dep_practice_more)

- Prove this by induction on l. -
-
- -
-Theorem length_snoc''' : ∀(n : nat) (X : Type)
-                              (v : X) (l : list X),
-     length l = n →
-     length (snoc l v) = S n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (app_length_cons)

- Prove this by induction on l1, without using app_length. -
-
- -
-Theorem app_length_cons : ∀(X : Type) (l1 l2 : list X)
-                                  (x : X) (n : nat),
-     length (l1 ++ (x :: l2)) = n →
-     S (length (l1 ++ l2)) = n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 4 stars, optional (app_length_twice)

- Prove this by induction on l, without using app_length. -
-
- -
-Theorem app_length_twice : ∀(X:Type) (n:nat) (l:list X),
-     length l = n →
-     length (l ++ l) = n + n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (double_induction)

- Prove the following principle of induction over two naturals. -
-
- -
-Theorem double_induction: ∀(P : nat → nat → Prop),
-  P 0 0 →
-  (∀m, P m 0 → P (S m) 0) →
-  (∀n, P 0 n → P 0 (S n)) →
-  (∀m n, P m n → P (S m) (S n)) →
-  ∀m n, P m n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Using destruct on Compound Expressions

- -
- - We have seen many examples where the destruct tactic is - used to perform case analysis of the value of some variable. But - sometimes we need to reason by cases on the result of some - expression. We can also do this with destruct. - -
- - Here are some examples: -
-
- -
-Definition sillyfun (n : nat) : bool :=
-  if beq_nat n 3 then false
-  else if beq_nat n 5 then false
-  else false.
- -
-Theorem sillyfun_false : ∀(n : nat),
-  sillyfun n = false.
-Proof.
-  intros n. unfold sillyfun.
-  destruct (beq_nat n 3).
-    Case "beq_nat n 3 = true". reflexivity.
-    Case "beq_nat n 3 = false". destruct (beq_nat n 5).
-      SCase "beq_nat n 5 = true". reflexivity.
-      SCase "beq_nat n 5 = false". reflexivity. Qed.
- -
-
- -
-After unfolding sillyfun in the above proof, we find that - we are stuck on if (beq_nat n 3) then ... else .... Well, - either n is equal to 3 or it isn't, so we use destruct - (beq_nat n 3) to let us reason about the two cases. - -
- - In general, the destruct tactic can be used to perform case - analysis of the results of arbitrary computations. If e is an - expression whose type is some inductively defined type T, then, - for each constructor c of T, destruct e generates a subgoal - in which all occurrences of e (in the goal and in the context) - are replaced by c. - -
- - -
- -

Exercise: 1 star (override_shadow)

- -
-
-Theorem override_shadow : ∀(X:Type) x1 x2 k1 k2 (f : nat→X),
-  (override (override f k1 x2) k1 x1) k2 = (override f k1 x1) k2.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (combine_split)

- Complete the proof below -
-
- -
-Theorem combine_split : ∀X Y (l : list (X × Y)) l1 l2,
-  split l = (l1, l2) →
-  combine l1 l2 = l.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Sometimes, doing a destruct on a compound expression (a - non-variable) will erase information we need to complete a proof. For example, suppose - we define a function sillyfun1 like this: -
-
- -
-Definition sillyfun1 (n : nat) : bool :=
-  if beq_nat n 3 then true
-  else if beq_nat n 5 then true
-  else false.
- -
-
- -
-And suppose that we want to convince Coq of the rather - obvious observation that sillyfun1 n yields true only when n - is odd. By analogy with the proofs we did with sillyfun above, - it is natural to start the proof like this: -
-
- -
-Theorem sillyfun1_odd_FAILED : ∀(n : nat),
-     sillyfun1 n = true →
-     oddb n = true.
-Proof.
-  intros n eq. unfold sillyfun1 in eq.
-  destruct (beq_nat n 3).
-  (* stuck... *)
-Abort.
- -
-
- -
-We get stuck at this point because the context does not - contain enough information to prove the goal! The problem is that - the substitution peformed by destruct is too brutal — it threw - away every occurrence of beq_nat n 3, but we need to keep some - memory of this expression and how it was destructed, because we - need to be able to reason that since, in this branch of the case - analysis, beq_nat n 3 = true, it must be that n = 3, from - which it follows that n is odd. - -
- - What we would really like is to substitute away all existing - occurences of beq_nat n 3, but at the same time add an equation - to the context that records which case we are in. The eqn: - qualifier allows us to introduce such an equation (with whatever - name we choose). -
-
- -
-Theorem sillyfun1_odd : ∀(n : nat),
-     sillyfun1 n = true →
-     oddb n = true.
-Proof.
-  intros n eq. unfold sillyfun1 in eq.
-  destruct (beq_nat n 3) eqn:Heqe3.
-  (* Now we have the same state as at the point where we got stuck
-    above, except that the context contains an extra equality
-    assumption, which is exactly what we need to make progress. *)
-    Case "e3 = true". apply beq_nat_true in Heqe3.
-      rewrite → Heqe3. reflexivity.
-    Case "e3 = false".
-     (* When we come to the second equality test in the body of the
-       function we are reasoning about, we can use eqn: again in the
-       same way, allow us to finish the proof. *)
-      destruct (beq_nat n 5) eqn:Heqe5.
-        SCase "e5 = true".
-          apply beq_nat_true in Heqe5.
-          rewrite → Heqe5. reflexivity.
-        SCase "e5 = false". inversion eq. Qed.
- -
-
- -
-

Exercise: 2 stars (destruct_eqn_practice)

- -
-
-Theorem bool_fn_applied_thrice :
-  ∀(f : bool → bool) (b : bool),
-  f (f (f b)) = f b.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (override_same)

- -
-
-Theorem override_same : ∀(X:Type) x1 k1 k2 (f : nat→X),
-  f k1 = x1 →
-  (override f k1 x1) k2 = f k2.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Review

- -
- - We've now seen a bunch of Coq's fundamental tactics. We'll - introduce a few more as we go along through the coming lectures, - and later in the course we'll introduce some more powerful - automation tactics that make Coq do more of the low-level work - in many cases. But basically we've got what we need to get work - done. - -
- - Here are the ones we've seen: - -
- -
    -
  • intros: - move hypotheses/variables from goal to context - -
    - - -
    • -
  • reflexivity: - finish the proof (when the goal looks like e = e) - -
    - - -
    • -
  • apply: - prove goal using a hypothesis, lemma, or constructor - -
    - - -
    • -
  • apply... in H: - apply a hypothesis, lemma, or constructor to a hypothesis in - the context (forward reasoning) - -
    - - -
    • -
  • apply... with...: - explicitly specify values for variables that cannot be - determined by pattern matching - -
    - - -
    • -
  • simpl: - simplify computations in the goal - -
    - - -
    • -
  • simpl in H: - ... or a hypothesis - -
    - - -
    • -
  • rewrite: - use an equality hypothesis (or lemma) to rewrite the goal - -
    - - -
    • -
  • rewrite ... in H: - ... or a hypothesis - -
    - - -
    • -
  • symmetry: - changes a goal of the form t=u into u=t - -
    - - -
    • -
  • symmetry in H: - changes a hypothesis of the form t=u into u=t - -
    - - -
    • -
  • unfold: - replace a defined constant by its right-hand side in the goal - -
    - - -
    • -
  • unfold... in H: - ... or a hypothesis - -
    - - -
    • -
  • destruct... as...: - case analysis on values of inductively defined types - -
    - - -
    • -
  • destruct... eqn:...: - specify the name of an equation to be added to the context, - recording the result of the case analysis - -
    - - -
    • -
  • induction... as...: - induction on values of inductively defined types - -
    - - -
    • -
  • inversion: - reason by injectivity and distinctness of constructors - -
    - - -
    • -
  • assert (e) as H: - introduce a "local lemma" e and call it H - -
    - - -
    • -
  • generalize dependent x: - move the variable x (and anything else that depends on it) - from the context back to an explicit hypothesis in the goal - formula - -
    • -
- -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 3 stars (beq_nat_sym)

- -
-
-Theorem beq_nat_sym : ∀(n m : nat),
-  beq_nat n m = beq_nat m n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced, optional (beq_nat_sym_informal)

- Give an informal proof of this lemma that corresponds to your - formal proof above: - -
- - Theorem: For any nats n m, beq_nat n m = beq_nat m n. - -
- - Proof: - (* FILL IN HERE *)
-☐ - -
- -

Exercise: 3 stars, optional (beq_nat_trans)

- -
-
-Theorem beq_nat_trans : ∀n m p,
-  beq_nat n m = true →
-  beq_nat m p = true →
-  beq_nat n p = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (split_combine)

- We have just proven that for all lists of pairs, combine is the - inverse of split. How would you formalize the statement that - split is the inverse of combine? - -
- - Complete the definition of split_combine_statement below with a - property that states that split is the inverse of - combine. Then, prove that the property holds. (Be sure to leave - your induction hypothesis general by not doing intros on more - things than necessary. Hint: what property do you need of l1 - and l2 for split combine l1 l2 = (l1,l2) to be true?) -
-
- -
-Definition split_combine_statement : Prop :=
-(* FILL IN HERE *) admit.
- -
-Theorem split_combine : split_combine_statement.
-Proof.
-(* FILL IN HERE *) Admitted.
- -
-
- -
-☐ -
- -

Exercise: 3 stars (override_permute)

- -
-
-Theorem override_permute : ∀(X:Type) x1 x2 k1 k2 k3 (f : nat→X),
-  beq_nat k2 k1 = false →
-  (override (override f k2 x2) k1 x1) k3 = (override (override f k1 x1) k2 x2) k3.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (filter_exercise)

- This one is a bit challenging. Pay attention to the form of your IH. -
-
- -
-Theorem filter_exercise : ∀(X : Type) (test : X → bool)
-                             (x : X) (l lf : list X),
-     filter test l = x :: lf →
-     test x = true.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (forall_exists_challenge)

- Define two recursive Fixpoints, forallb and existsb. The - first checks whether every element in a list satisfies a given - predicate: - -
- -
-      forallb oddb [1;3;5;7;9] = true
-
-      forallb negb [false;false] = true
-  
-      forallb evenb [0;2;4;5] = false
-  
-      forallb (beq_nat 5) [] = true -
- -
- The second checks whether there exists an element in the list that - satisfies a given predicate: - -
- -
-      existsb (beq_nat 5) [0;2;3;6] = false
- 
-      existsb (andb true) [true;true;false] = true
- 
-      existsb oddb [1;0;0;0;0;3] = true
- 
-      existsb evenb [] = false -
- -
- Next, define a nonrecursive version of existsb — call it - existsb' — using forallb and negb. - -
- - Prove that existsb' and existsb have the same behavior. - -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-(* $Date: 2014-02-04 07:15:43 -0500 (Tue, 04 Feb 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/MoreCoq.v b/MoreCoq.v deleted file mode 100644 index 3aaf8de..0000000 --- a/MoreCoq.v +++ /dev/null @@ -1,1070 +0,0 @@ -(** * MoreCoq: More About Coq *) - -Require Export Poly. - -(** This chapter introduces several more Coq tactics that, - together, allow us to prove many more theorems about the - functional programs we are writing. *) - -(* ###################################################### *) -(** * The [apply] Tactic *) - -(** We often encounter situations where the goal to be proved is - exactly the same as some hypothesis in the context or some - previously proved lemma. *) - -Theorem silly1 : forall (n m o p : nat), - n = m -> - [n;o] = [n;p] -> - [n;o] = [m;p]. -Proof. - intros n m o p eq1 eq2. - rewrite <- eq1. - (* At this point, we could finish with - "[rewrite -> eq2. reflexivity.]" as we have - done several times above. But we can achieve the - same effect in a single step by using the - [apply] tactic instead: *) - apply eq2. Qed. - -(** The [apply] tactic also works with _conditional_ hypotheses - and lemmas: if the statement being applied is an implication, then - the premises of this implication will be added to the list of - subgoals needing to be proved. *) - -Theorem silly2 : forall (n m o p : nat), - n = m -> - (forall (q r : nat), q = r -> [q;o] = [r;p]) -> - [n;o] = [m;p]. -Proof. - intros n m o p eq1 eq2. - apply eq2. apply eq1. Qed. - -(** You may find it instructive to experiment with this proof - and see if there is a way to complete it using just [rewrite] - instead of [apply]. *) - -(** Typically, when we use [apply H], the statement [H] will - begin with a [forall] binding some _universal variables_. When - Coq matches the current goal against the conclusion of [H], it - will try to find appropriate values for these variables. For - example, when we do [apply eq2] in the following proof, the - universal variable [q] in [eq2] gets instantiated with [n] and [r] - gets instantiated with [m]. *) - -Theorem silly2a : forall (n m : nat), - (n,n) = (m,m) -> - (forall (q r : nat), (q,q) = (r,r) -> [q] = [r]) -> - [n] = [m]. -Proof. - intros n m eq1 eq2. - apply eq2. apply eq1. Qed. - -(** **** Exercise: 2 stars, optional (silly_ex) *) -(** Complete the following proof without using [simpl]. *) - -Theorem silly_ex : - (forall n, evenb n = true -> oddb (S n) = true) -> - evenb 3 = true -> - oddb 4 = true. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** To use the [apply] tactic, the (conclusion of the) fact - being applied must match the goal _exactly_ -- for example, [apply] - will not work if the left and right sides of the equality are - swapped. *) - -Theorem silly3_firsttry : forall (n : nat), - true = beq_nat n 5 -> - beq_nat (S (S n)) 7 = true. -Proof. - intros n H. - simpl. - (* Here we cannot use [apply] directly *) -Abort. - -(** In this case we can use the [symmetry] tactic, which switches the - left and right sides of an equality in the goal. *) - -Theorem silly3 : forall (n : nat), - true = beq_nat n 5 -> - beq_nat (S (S n)) 7 = true. -Proof. - intros n H. - symmetry. - simpl. (* Actually, this [simpl] is unnecessary, since - [apply] will perform simplification first. *) - apply H. Qed. - -(** **** Exercise: 3 stars (apply_exercise1) *) -(** Hint: you can use [apply] with previously defined lemmas, not - just hypotheses in the context. Remember that [SearchAbout] is - your friend. *) - -Theorem rev_exercise1 : forall (l l' : list nat), - l = rev l' -> - l' = rev l. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (apply_rewrite) *) -(** Briefly explain the difference between the tactics [apply] and - [rewrite]. Are there situations where both can usefully be - applied? - (* FILL IN HERE *) -*) -(** [] *) - - -(* ###################################################### *) -(** * The [apply ... with ...] Tactic *) - -(** The following silly example uses two rewrites in a row to - get from [[a,b]] to [[e,f]]. *) - -Example trans_eq_example : forall (a b c d e f : nat), - [a;b] = [c;d] -> - [c;d] = [e;f] -> - [a;b] = [e;f]. -Proof. - intros a b c d e f eq1 eq2. - rewrite -> eq1. rewrite -> eq2. reflexivity. Qed. - -(** Since this is a common pattern, we might - abstract it out as a lemma recording once and for all - the fact that equality is transitive. *) - -Theorem trans_eq : forall (X:Type) (n m o : X), - n = m -> m = o -> n = o. -Proof. - intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2. - reflexivity. Qed. - -(** Now, we should be able to use [trans_eq] to - prove the above example. However, to do this we need - a slight refinement of the [apply] tactic. *) - -Example trans_eq_example' : forall (a b c d e f : nat), - [a;b] = [c;d] -> - [c;d] = [e;f] -> - [a;b] = [e;f]. -Proof. - intros a b c d e f eq1 eq2. - (* If we simply tell Coq [apply trans_eq] at this point, - it can tell (by matching the goal against the - conclusion of the lemma) that it should instantiate [X] - with [[nat]], [n] with [[a,b]], and [o] with [[e,f]]. - However, the matching process doesn't determine an - instantiation for [m]: we have to supply one explicitly - by adding [with (m:=[c,d])] to the invocation of - [apply]. *) - apply trans_eq with (m:=[c;d]). apply eq1. apply eq2. Qed. - -(** Actually, we usually don't have to include the name [m] - in the [with] clause; Coq is often smart enough to - figure out which instantiation we're giving. We could - instead write: [apply trans_eq with [c,d]]. *) - -(** **** Exercise: 3 stars, optional (apply_with_exercise) *) -Example trans_eq_exercise : forall (n m o p : nat), - m = (minustwo o) -> - (n + p) = m -> - (n + p) = (minustwo o). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ###################################################### *) -(** * The [inversion] tactic *) - -(** Recall the definition of natural numbers: - Inductive nat : Type := - | O : nat - | S : nat -> nat. - It is clear from this definition that every number has one of two - forms: either it is the constructor [O] or it is built by applying - the constructor [S] to another number. But there is more here than - meets the eye: implicit in the definition (and in our informal - understanding of how datatype declarations work in other - programming languages) are two other facts: - - - The constructor [S] is _injective_. That is, the only way we can - have [S n = S m] is if [n = m]. - - - The constructors [O] and [S] are _disjoint_. That is, [O] is not - equal to [S n] for any [n]. *) - -(** Similar principles apply to all inductively defined types: all - constructors are injective, and the values built from distinct - constructors are never equal. For lists, the [cons] constructor is - injective and [nil] is different from every non-empty list. For - booleans, [true] and [false] are unequal. (Since neither [true] - nor [false] take any arguments, their injectivity is not an issue.) *) - -(** Coq provides a tactic called [inversion] that allows us to exploit - these principles in proofs. - - The [inversion] tactic is used like this. Suppose [H] is a - hypothesis in the context (or a previously proven lemma) of the - form - c a1 a2 ... an = d b1 b2 ... bm - for some constructors [c] and [d] and arguments [a1 ... an] and - [b1 ... bm]. Then [inversion H] instructs Coq to "invert" this - equality to extract the information it contains about these terms: - - - If [c] and [d] are the same constructor, then we know, by the - injectivity of this constructor, that [a1 = b1], [a2 = b2], - etc.; [inversion H] adds these facts to the context, and tries - to use them to rewrite the goal. - - - If [c] and [d] are different constructors, then the hypothesis - [H] is contradictory. That is, a false assumption has crept - into the context, and this means that any goal whatsoever is - provable! In this case, [inversion H] marks the current goal as - completed and pops it off the goal stack. *) - -(** The [inversion] tactic is probably easier to understand by - seeing it in action than from general descriptions like the above. - Below you will find example theorems that demonstrate the use of - [inversion] and exercises to test your understanding. *) - -Theorem eq_add_S : forall (n m : nat), - S n = S m -> - n = m. -Proof. - intros n m eq. inversion eq. reflexivity. Qed. - -Theorem silly4 : forall (n m : nat), - [n] = [m] -> - n = m. -Proof. - intros n o eq. inversion eq. reflexivity. Qed. - -(** As a convenience, the [inversion] tactic can also - destruct equalities between complex values, binding - multiple variables as it goes. *) - -Theorem silly5 : forall (n m o : nat), - [n;m] = [o;o] -> - [n] = [m]. -Proof. - intros n m o eq. inversion eq. reflexivity. Qed. - -(** **** Exercise: 1 star (sillyex1) *) -Example sillyex1 : forall (X : Type) (x y z : X) (l j : list X), - x :: y :: l = z :: j -> - y :: l = x :: j -> - x = y. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -Theorem silly6 : forall (n : nat), - S n = O -> - 2 + 2 = 5. -Proof. - intros n contra. inversion contra. Qed. - -Theorem silly7 : forall (n m : nat), - false = true -> - [n] = [m]. -Proof. - intros n m contra. inversion contra. Qed. - -(** **** Exercise: 1 star (sillyex2) *) -Example sillyex2 : forall (X : Type) (x y z : X) (l j : list X), - x :: y :: l = [] -> - y :: l = z :: j -> - x = z. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** While the injectivity of constructors allows us to reason - [forall (n m : nat), S n = S m -> n = m], the reverse direction of - the implication is an instance of a more general fact about - constructors and functions, which we will often find useful: *) - -Theorem f_equal : forall (A B : Type) (f: A -> B) (x y: A), - x = y -> f x = f y. -Proof. intros A B f x y eq. rewrite eq. reflexivity. Qed. - - - - -(** **** Exercise: 2 stars, optional (practice) *) -(** A couple more nontrivial but not-too-complicated proofs to work - together in class, or for you to work as exercises. *) - - -Theorem beq_nat_0_l : forall n, - beq_nat 0 n = true -> n = 0. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem beq_nat_0_r : forall n, - beq_nat n 0 = true -> n = 0. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ###################################################### *) -(** * Using Tactics on Hypotheses *) - -(** By default, most tactics work on the goal formula and leave - the context unchanged. However, most tactics also have a variant - that performs a similar operation on a statement in the context. - - For example, the tactic [simpl in H] performs simplification in - the hypothesis named [H] in the context. *) - -Theorem S_inj : forall (n m : nat) (b : bool), - beq_nat (S n) (S m) = b -> - beq_nat n m = b. -Proof. - intros n m b H. simpl in H. apply H. Qed. - -(** Similarly, the tactic [apply L in H] matches some - conditional statement [L] (of the form [L1 -> L2], say) against a - hypothesis [H] in the context. However, unlike ordinary - [apply] (which rewrites a goal matching [L2] into a subgoal [L1]), - [apply L in H] matches [H] against [L1] and, if successful, - replaces it with [L2]. - - In other words, [apply L in H] gives us a form of "forward - reasoning" -- from [L1 -> L2] and a hypothesis matching [L1], it - gives us a hypothesis matching [L2]. By contrast, [apply L] is - "backward reasoning" -- it says that if we know [L1->L2] and we - are trying to prove [L2], it suffices to prove [L1]. - - Here is a variant of a proof from above, using forward reasoning - throughout instead of backward reasoning. *) - -Theorem silly3' : forall (n : nat), - (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) -> - true = beq_nat n 5 -> - true = beq_nat (S (S n)) 7. -Proof. - intros n eq H. - symmetry in H. apply eq in H. symmetry in H. - apply H. Qed. - -(** Forward reasoning starts from what is _given_ (premises, - previously proven theorems) and iteratively draws conclusions from - them until the goal is reached. Backward reasoning starts from - the _goal_, and iteratively reasons about what would imply the - goal, until premises or previously proven theorems are reached. - If you've seen informal proofs before (for example, in a math or - computer science class), they probably used forward reasoning. In - general, Coq tends to favor backward reasoning, but in some - situations the forward style can be easier to use or to think - about. *) - -(** **** Exercise: 3 stars (plus_n_n_injective) *) -(** Practice using "in" variants in this exercise. *) - -Theorem plus_n_n_injective : forall n m, - n + n = m + m -> - n = m. -Proof. - intros n. induction n as [| n']. - (* Hint: use the plus_n_Sm lemma *) - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** * Varying the Induction Hypothesis *) - -(** Sometimes it is important to control the exact form of the - induction hypothesis when carrying out inductive proofs in Coq. - In particular, we need to be careful about which of the - assumptions we move (using [intros]) from the goal to the context - before invoking the [induction] tactic. For example, suppose - we want to show that the [double] function is injective -- i.e., - that it always maps different arguments to different results: - Theorem double_injective: forall n m, double n = double m -> n = m. - The way we _start_ this proof is a little bit delicate: if we - begin it with - intros n. induction n. -]] - all is well. But if we begin it with - intros n m. induction n. - we get stuck in the middle of the inductive case... *) - -Theorem double_injective_FAILED : forall n m, - double n = double m -> - n = m. -Proof. - intros n m. induction n as [| n']. - Case "n = O". simpl. intros eq. destruct m as [| m']. - SCase "m = O". reflexivity. - SCase "m = S m'". inversion eq. - Case "n = S n'". intros eq. destruct m as [| m']. - SCase "m = O". inversion eq. - SCase "m = S m'". apply f_equal. - (* Here we are stuck. The induction hypothesis, [IHn'], does - not give us [n' = m'] -- there is an extra [S] in the - way -- so the goal is not provable. *) - Abort. - -(** What went wrong? *) - -(** The problem is that, at the point we invoke the induction - hypothesis, we have already introduced [m] into the context -- - intuitively, we have told Coq, "Let's consider some particular - [n] and [m]..." and we now have to prove that, if [double n = - double m] for _this particular_ [n] and [m], then [n = m]. - - The next tactic, [induction n] says to Coq: We are going to show - the goal by induction on [n]. That is, we are going to prove that - the proposition - - - [P n] = "if [double n = double m], then [n = m]" - - holds for all [n] by showing - - - [P O] - - (i.e., "if [double O = double m] then [O = m]") - - - [P n -> P (S n)] - - (i.e., "if [double n = double m] then [n = m]" implies "if - [double (S n) = double m] then [S n = m]"). - - If we look closely at the second statement, it is saying something - rather strange: it says that, for a _particular_ [m], if we know - - - "if [double n = double m] then [n = m]" - - then we can prove - - - "if [double (S n) = double m] then [S n = m]". - - To see why this is strange, let's think of a particular [m] -- - say, [5]. The statement is then saying that, if we know - - - [Q] = "if [double n = 10] then [n = 5]" - - then we can prove - - - [R] = "if [double (S n) = 10] then [S n = 5]". - - But knowing [Q] doesn't give us any help with proving [R]! (If we - tried to prove [R] from [Q], we would say something like "Suppose - [double (S n) = 10]..." but then we'd be stuck: knowing that - [double (S n)] is [10] tells us nothing about whether [double n] - is [10], so [Q] is useless at this point.) *) - -(** To summarize: Trying to carry out this proof by induction on [n] - when [m] is already in the context doesn't work because we are - trying to prove a relation involving _every_ [n] but just a - _single_ [m]. *) - -(** The good proof of [double_injective] leaves [m] in the goal - statement at the point where the [induction] tactic is invoked on - [n]: *) - -Theorem double_injective : forall n m, - double n = double m -> - n = m. -Proof. - intros n. induction n as [| n']. - Case "n = O". simpl. intros m eq. destruct m as [| m']. - SCase "m = O". reflexivity. - SCase "m = S m'". inversion eq. - Case "n = S n'". - (* Notice that both the goal and the induction - hypothesis have changed: the goal asks us to prove - something more general (i.e., to prove the - statement for _every_ [m]), but the IH is - correspondingly more flexible, allowing us to - choose any [m] we like when we apply the IH. *) - intros m eq. - (* Now we choose a particular [m] and introduce the - assumption that [double n = double m]. Since we - are doing a case analysis on [n], we need a case - analysis on [m] to keep the two "in sync." *) - destruct m as [| m']. - SCase "m = O". - (* The 0 case is trivial *) - inversion eq. - SCase "m = S m'". - apply f_equal. - (* At this point, since we are in the second - branch of the [destruct m], the [m'] mentioned - in the context at this point is actually the - predecessor of the one we started out talking - about. Since we are also in the [S] branch of - the induction, this is perfect: if we - instantiate the generic [m] in the IH with the - [m'] that we are talking about right now (this - instantiation is performed automatically by - [apply]), then [IHn'] gives us exactly what we - need to finish the proof. *) - apply IHn'. inversion eq. reflexivity. Qed. - -(** What this teaches us is that we need to be careful about using - induction to try to prove something too specific: If we're proving - a property of [n] and [m] by induction on [n], we may need to - leave [m] generic. *) - -(** The proof of this theorem (left as an exercise) has to be treated similarly: *) - -(** **** Exercise: 2 stars (beq_nat_true) *) -Theorem beq_nat_true : forall n m, - beq_nat n m = true -> n = m. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, advanced (beq_nat_true_informal) *) -(** Give a careful informal proof of [beq_nat_true], being as explicit - as possible about quantifiers. *) - -(* FILL IN HERE *) -(** [] *) - - -(** The strategy of doing fewer [intros] before an [induction] doesn't - always work directly; sometimes a little _rearrangement_ of - quantified variables is needed. Suppose, for example, that we - wanted to prove [double_injective] by induction on [m] instead of - [n]. *) - -Theorem double_injective_take2_FAILED : forall n m, - double n = double m -> - n = m. -Proof. - intros n m. induction m as [| m']. - Case "m = O". simpl. intros eq. destruct n as [| n']. - SCase "n = O". reflexivity. - SCase "n = S n'". inversion eq. - Case "m = S m'". intros eq. destruct n as [| n']. - SCase "n = O". inversion eq. - SCase "n = S n'". apply f_equal. - (* Stuck again here, just like before. *) -Abort. - -(** The problem is that, to do induction on [m], we must first - introduce [n]. (If we simply say [induction m] without - introducing anything first, Coq will automatically introduce - [n] for us!) *) - -(** What can we do about this? One possibility is to rewrite the - statement of the lemma so that [m] is quantified before [n]. This - will work, but it's not nice: We don't want to have to mangle the - statements of lemmas to fit the needs of a particular strategy for - proving them -- we want to state them in the most clear and - natural way. *) - -(** What we can do instead is to first introduce all the - quantified variables and then _re-generalize_ one or more of - them, taking them out of the context and putting them back at - the beginning of the goal. The [generalize dependent] tactic - does this. *) - -Theorem double_injective_take2 : forall n m, - double n = double m -> - n = m. -Proof. - intros n m. - (* [n] and [m] are both in the context *) - generalize dependent n. - (* Now [n] is back in the goal and we can do induction on - [m] and get a sufficiently general IH. *) - induction m as [| m']. - Case "m = O". simpl. intros n eq. destruct n as [| n']. - SCase "n = O". reflexivity. - SCase "n = S n'". inversion eq. - Case "m = S m'". intros n eq. destruct n as [| n']. - SCase "n = O". inversion eq. - SCase "n = S n'". apply f_equal. - apply IHm'. inversion eq. reflexivity. Qed. - -(** Let's look at an informal proof of this theorem. Note that - the proposition we prove by induction leaves [n] quantified, - corresponding to the use of generalize dependent in our formal - proof. - -_Theorem_: For any nats [n] and [m], if [double n = double m], then - [n = m]. - -_Proof_: Let [m] be a [nat]. We prove by induction on [m] that, for - any [n], if [double n = double m] then [n = m]. - - - First, suppose [m = 0], and suppose [n] is a number such - that [double n = double m]. We must show that [n = 0]. - - Since [m = 0], by the definition of [double] we have [double n = - 0]. There are two cases to consider for [n]. If [n = 0] we are - done, since this is what we wanted to show. Otherwise, if [n = S - n'] for some [n'], we derive a contradiction: by the definition of - [double] we would have [double n = S (S (double n'))], but this - contradicts the assumption that [double n = 0]. - - - Otherwise, suppose [m = S m'] and that [n] is again a number such - that [double n = double m]. We must show that [n = S m'], with - the induction hypothesis that for every number [s], if [double s = - double m'] then [s = m']. - - By the fact that [m = S m'] and the definition of [double], we - have [double n = S (S (double m'))]. There are two cases to - consider for [n]. - - If [n = 0], then by definition [double n = 0], a contradiction. - Thus, we may assume that [n = S n'] for some [n'], and again by - the definition of [double] we have [S (S (double n')) = S (S - (double m'))], which implies by inversion that [double n' = double - m']. - - Instantiating the induction hypothesis with [n'] thus allows us to - conclude that [n' = m'], and it follows immediately that [S n' = S - m']. Since [S n' = n] and [S m' = m], this is just what we wanted - to show. [] *) - - - -(** Here's another illustration of [inversion] and using an - appropriately general induction hypothesis. This is a slightly - roundabout way of stating a fact that we have already proved - above. The extra equalities force us to do a little more - equational reasoning and exercise some of the tactics we've seen - recently. *) - -Theorem length_snoc' : forall (X : Type) (v : X) - (l : list X) (n : nat), - length l = n -> - length (snoc l v) = S n. -Proof. - intros X v l. induction l as [| v' l']. - - Case "l = []". - intros n eq. rewrite <- eq. reflexivity. - - Case "l = v' :: l'". - intros n eq. simpl. destruct n as [| n']. - SCase "n = 0". inversion eq. - SCase "n = S n'". - apply f_equal. apply IHl'. inversion eq. reflexivity. Qed. - -(** It might be tempting to start proving the above theorem - by introducing [n] and [eq] at the outset. However, this leads - to an induction hypothesis that is not strong enough. Compare - the above to the following (aborted) attempt: *) - -Theorem length_snoc_bad : forall (X : Type) (v : X) - (l : list X) (n : nat), - length l = n -> - length (snoc l v) = S n. -Proof. - intros X v l n eq. induction l as [| v' l']. - - Case "l = []". - rewrite <- eq. reflexivity. - - Case "l = v' :: l'". - simpl. destruct n as [| n']. - SCase "n = 0". inversion eq. - SCase "n = S n'". - apply f_equal. Abort. (* apply IHl'. *) (* The IH doesn't apply! *) - - -(** As in the double examples, the problem is that by - introducing [n] before doing induction on [l], the induction - hypothesis is specialized to one particular natural number, namely - [n]. In the induction case, however, we need to be able to use - the induction hypothesis on some other natural number [n']. - Retaining the more general form of the induction hypothesis thus - gives us more flexibility. - - In general, a good rule of thumb is to make the induction hypothesis - as general as possible. *) - -(** **** Exercise: 3 stars (gen_dep_practice) *) - -(** Prove this by induction on [l]. *) - -Theorem index_after_last: forall (n : nat) (X : Type) (l : list X), - length l = n -> - index n l = None. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced, optional (index_after_last_informal) *) -(** Write an informal proof corresponding to your Coq proof - of [index_after_last]: - - _Theorem_: For all sets [X], lists [l : list X], and numbers - [n], if [length l = n] then [index n l = None]. - - _Proof_: - (* FILL IN HERE *) -[] -*) - -(** **** Exercise: 3 stars, optional (gen_dep_practice_more) *) -(** Prove this by induction on [l]. *) - -Theorem length_snoc''' : forall (n : nat) (X : Type) - (v : X) (l : list X), - length l = n -> - length (snoc l v) = S n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (app_length_cons) *) -(** Prove this by induction on [l1], without using [app_length]. *) - -Theorem app_length_cons : forall (X : Type) (l1 l2 : list X) - (x : X) (n : nat), - length (l1 ++ (x :: l2)) = n -> - S (length (l1 ++ l2)) = n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 4 stars, optional (app_length_twice) *) -(** Prove this by induction on [l], without using app_length. *) - -Theorem app_length_twice : forall (X:Type) (n:nat) (l:list X), - length l = n -> - length (l ++ l) = n + n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(** **** Exercise: 3 stars, optional (double_induction) *) -(** Prove the following principle of induction over two naturals. *) - -Theorem double_induction: forall (P : nat -> nat -> Prop), - P 0 0 -> - (forall m, P m 0 -> P (S m) 0) -> - (forall n, P 0 n -> P 0 (S n)) -> - (forall m n, P m n -> P (S m) (S n)) -> - forall m n, P m n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ###################################################### *) -(** * Using [destruct] on Compound Expressions *) - -(** We have seen many examples where the [destruct] tactic is - used to perform case analysis of the value of some variable. But - sometimes we need to reason by cases on the result of some - _expression_. We can also do this with [destruct]. - - Here are some examples: *) - -Definition sillyfun (n : nat) : bool := - if beq_nat n 3 then false - else if beq_nat n 5 then false - else false. - -Theorem sillyfun_false : forall (n : nat), - sillyfun n = false. -Proof. - intros n. unfold sillyfun. - destruct (beq_nat n 3). - Case "beq_nat n 3 = true". reflexivity. - Case "beq_nat n 3 = false". destruct (beq_nat n 5). - SCase "beq_nat n 5 = true". reflexivity. - SCase "beq_nat n 5 = false". reflexivity. Qed. - -(** After unfolding [sillyfun] in the above proof, we find that - we are stuck on [if (beq_nat n 3) then ... else ...]. Well, - either [n] is equal to [3] or it isn't, so we use [destruct - (beq_nat n 3)] to let us reason about the two cases. - - In general, the [destruct] tactic can be used to perform case - analysis of the results of arbitrary computations. If [e] is an - expression whose type is some inductively defined type [T], then, - for each constructor [c] of [T], [destruct e] generates a subgoal - in which all occurrences of [e] (in the goal and in the context) - are replaced by [c]. - -*) - -(** **** Exercise: 1 star (override_shadow) *) -Theorem override_shadow : forall (X:Type) x1 x2 k1 k2 (f : nat->X), - (override (override f k1 x2) k1 x1) k2 = (override f k1 x1) k2. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (combine_split) *) -(** Complete the proof below *) - -Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2, - split l = (l1, l2) -> - combine l1 l2 = l. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Sometimes, doing a [destruct] on a compound expression (a - non-variable) will erase information we need to complete a proof. *) -(** For example, suppose - we define a function [sillyfun1] like this: *) - -Definition sillyfun1 (n : nat) : bool := - if beq_nat n 3 then true - else if beq_nat n 5 then true - else false. - -(** And suppose that we want to convince Coq of the rather - obvious observation that [sillyfun1 n] yields [true] only when [n] - is odd. By analogy with the proofs we did with [sillyfun] above, - it is natural to start the proof like this: *) - -Theorem sillyfun1_odd_FAILED : forall (n : nat), - sillyfun1 n = true -> - oddb n = true. -Proof. - intros n eq. unfold sillyfun1 in eq. - destruct (beq_nat n 3). - (* stuck... *) -Abort. - -(** We get stuck at this point because the context does not - contain enough information to prove the goal! The problem is that - the substitution peformed by [destruct] is too brutal -- it threw - away every occurrence of [beq_nat n 3], but we need to keep some - memory of this expression and how it was destructed, because we - need to be able to reason that since, in this branch of the case - analysis, [beq_nat n 3 = true], it must be that [n = 3], from - which it follows that [n] is odd. - - What we would really like is to substitute away all existing - occurences of [beq_nat n 3], but at the same time add an equation - to the context that records which case we are in. The [eqn:] - qualifier allows us to introduce such an equation (with whatever - name we choose). *) - -Theorem sillyfun1_odd : forall (n : nat), - sillyfun1 n = true -> - oddb n = true. -Proof. - intros n eq. unfold sillyfun1 in eq. - destruct (beq_nat n 3) eqn:Heqe3. - (* Now we have the same state as at the point where we got stuck - above, except that the context contains an extra equality - assumption, which is exactly what we need to make progress. *) - Case "e3 = true". apply beq_nat_true in Heqe3. - rewrite -> Heqe3. reflexivity. - Case "e3 = false". - (* When we come to the second equality test in the body of the - function we are reasoning about, we can use [eqn:] again in the - same way, allow us to finish the proof. *) - destruct (beq_nat n 5) eqn:Heqe5. - SCase "e5 = true". - apply beq_nat_true in Heqe5. - rewrite -> Heqe5. reflexivity. - SCase "e5 = false". inversion eq. Qed. - - -(** **** Exercise: 2 stars (destruct_eqn_practice) *) -Theorem bool_fn_applied_thrice : - forall (f : bool -> bool) (b : bool), - f (f (f b)) = f b. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (override_same) *) -Theorem override_same : forall (X:Type) x1 k1 k2 (f : nat->X), - f k1 = x1 -> - (override f k1 x1) k2 = f k2. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ################################################################## *) -(** * Review *) - -(** We've now seen a bunch of Coq's fundamental tactics. We'll - introduce a few more as we go along through the coming lectures, - and later in the course we'll introduce some more powerful - _automation_ tactics that make Coq do more of the low-level work - in many cases. But basically we've got what we need to get work - done. - - Here are the ones we've seen: - - - [intros]: - move hypotheses/variables from goal to context - - - [reflexivity]: - finish the proof (when the goal looks like [e = e]) - - - [apply]: - prove goal using a hypothesis, lemma, or constructor - - - [apply... in H]: - apply a hypothesis, lemma, or constructor to a hypothesis in - the context (forward reasoning) - - - [apply... with...]: - explicitly specify values for variables that cannot be - determined by pattern matching - - - [simpl]: - simplify computations in the goal - - - [simpl in H]: - ... or a hypothesis - - - [rewrite]: - use an equality hypothesis (or lemma) to rewrite the goal - - - [rewrite ... in H]: - ... or a hypothesis - - - [symmetry]: - changes a goal of the form [t=u] into [u=t] - - - [symmetry in H]: - changes a hypothesis of the form [t=u] into [u=t] - - - [unfold]: - replace a defined constant by its right-hand side in the goal - - - [unfold... in H]: - ... or a hypothesis - - - [destruct... as...]: - case analysis on values of inductively defined types - - - [destruct... eqn:...]: - specify the name of an equation to be added to the context, - recording the result of the case analysis - - - [induction... as...]: - induction on values of inductively defined types - - - [inversion]: - reason by injectivity and distinctness of constructors - - - [assert (e) as H]: - introduce a "local lemma" [e] and call it [H] - - - [generalize dependent x]: - move the variable [x] (and anything else that depends on it) - from the context back to an explicit hypothesis in the goal - formula -*) - -(* ###################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 3 stars (beq_nat_sym) *) -Theorem beq_nat_sym : forall (n m : nat), - beq_nat n m = beq_nat m n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced, optional (beq_nat_sym_informal) *) -(** Give an informal proof of this lemma that corresponds to your - formal proof above: - - Theorem: For any [nat]s [n] [m], [beq_nat n m = beq_nat m n]. - - Proof: - (* FILL IN HERE *) -[] - *) - -(** **** Exercise: 3 stars, optional (beq_nat_trans) *) -Theorem beq_nat_trans : forall n m p, - beq_nat n m = true -> - beq_nat m p = true -> - beq_nat n p = true. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (split_combine) *) -(** We have just proven that for all lists of pairs, [combine] is the - inverse of [split]. How would you formalize the statement that - [split] is the inverse of [combine]? - - Complete the definition of [split_combine_statement] below with a - property that states that [split] is the inverse of - [combine]. Then, prove that the property holds. (Be sure to leave - your induction hypothesis general by not doing [intros] on more - things than necessary. Hint: what property do you need of [l1] - and [l2] for [split] [combine l1 l2 = (l1,l2)] to be true?) *) - -Definition split_combine_statement : Prop := -(* FILL IN HERE *) admit. - -Theorem split_combine : split_combine_statement. -Proof. -(* FILL IN HERE *) Admitted. - - -(** [] *) - -(** **** Exercise: 3 stars (override_permute) *) -Theorem override_permute : forall (X:Type) x1 x2 k1 k2 k3 (f : nat->X), - beq_nat k2 k1 = false -> - (override (override f k2 x2) k1 x1) k3 = (override (override f k1 x1) k2 x2) k3. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (filter_exercise) *) -(** This one is a bit challenging. Pay attention to the form of your IH. *) - -Theorem filter_exercise : forall (X : Type) (test : X -> bool) - (x : X) (l lf : list X), - filter test l = x :: lf -> - test x = true. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 4 stars, advanced (forall_exists_challenge) *) -(** Define two recursive [Fixpoints], [forallb] and [existsb]. The - first checks whether every element in a list satisfies a given - predicate: - forallb oddb [1;3;5;7;9] = true - - forallb negb [false;false] = true - - forallb evenb [0;2;4;5] = false - - forallb (beq_nat 5) [] = true - The second checks whether there exists an element in the list that - satisfies a given predicate: - existsb (beq_nat 5) [0;2;3;6] = false - - existsb (andb true) [true;true;false] = true - - existsb oddb [1;0;0;0;0;3] = true - - existsb evenb [] = false - Next, define a _nonrecursive_ version of [existsb] -- call it - [existsb'] -- using [forallb] and [negb]. - - Prove that [existsb'] and [existsb] have the same behavior. -*) - -(* FILL IN HERE *) -(** [] *) - -(* $Date: 2014-02-04 07:15:43 -0500 (Tue, 04 Feb 2014) $ *) - - - diff --git a/MoreInd.html b/MoreInd.html deleted file mode 100644 index 7c39080..0000000 --- a/MoreInd.html +++ /dev/null @@ -1,1978 +0,0 @@ - - - - - -MoreInd: More on Induction - - - - - - -
- - - -
- -

MoreIndMore on Induction

- -
-
- -
- -
-
- -
-Require Export "ProofObjects".
- -
-
- -
-

Induction Principles

- -
- - This is a good point to pause and take a deeper look at induction - principles. - -
- - Every time we declare a new Inductive datatype, Coq - automatically generates and proves an induction principle - for this type. - -
- - The induction principle for a type t is called t_ind. Here is - the one for natural numbers: -
-
- -
-Check nat_ind.
-(*  ===> nat_ind : 
-           forall P : nat -> Prop,
-              P 0  ->
-              (forall n : nat, P n -> P (S n))  ->
-              forall n : nat, P n  *)
- -
-
- -
-

- The induction tactic is a straightforward wrapper that, at - its core, simply performs apply t_ind. To see this more - clearly, let's experiment a little with using apply nat_ind - directly, instead of the induction tactic, to carry out some - proofs. Here, for example, is an alternate proof of a theorem - that we saw in the Basics chapter. -
-
- -
-Theorem mult_0_r' : ∀n:nat,
-  n × 0 = 0.
-Proof.
-  apply nat_ind.
-  Case "O". reflexivity.
-  Case "S". simpl. intros n IHn. rewrite → IHn.
-    reflexivity. Qed.
- -
-
- -
-This proof is basically the same as the earlier one, but a - few minor differences are worth noting. First, in the induction - step of the proof (the "S" case), we have to do a little - bookkeeping manually (the intros) that induction does - automatically. - -
- - Second, we do not introduce n into the context before applying - nat_ind — the conclusion of nat_ind is a quantified formula, - and apply needs this conclusion to exactly match the shape of - the goal state, including the quantifier. The induction tactic - works either with a variable in the context or a quantified - variable in the goal. - -
- - Third, the apply tactic automatically chooses variable names for - us (in the second subgoal, here), whereas induction lets us - specify (with the as... clause) what names should be used. The - automatic choice is actually a little unfortunate, since it - re-uses the name n for a variable that is different from the n - in the original theorem. This is why the Case annotation is - just S — if we tried to write it out in the more explicit form - that we've been using for most proofs, we'd have to write n = S - n, which doesn't make a lot of sense! All of these conveniences - make induction nicer to use in practice than applying induction - principles like nat_ind directly. But it is important to - realize that, modulo this little bit of bookkeeping, applying - nat_ind is what we are really doing. -
- -

Exercise: 2 stars, optional (plus_one_r')

- Complete this proof as we did mult_0_r' above, without using - the induction tactic. -
-
- -
-Theorem plus_one_r' : ∀n:nat,
-  n + 1 = S n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Coq generates induction principles for every datatype defined with - Inductive, including those that aren't recursive. (Although - we don't need induction to prove properties of non-recursive - datatypes, the idea of an induction principle still makes sense - for them: it gives a way to prove that a property holds for all - values of the type.) - -
- - These generated principles follow a similar pattern. If we define a - type t with constructors c1 ... cn, Coq generates a theorem - with this shape: - -
- -
-    t_ind :
-       ∀P : t → Prop,
-            ... case for c1 ... →
-            ... case for c2 ... →
-            ...
-            ... case for cn ... →
-            ∀n : t, P n -
- -
- The specific shape of each case depends on the arguments to the - corresponding constructor. Before trying to write down a general - rule, let's look at some more examples. First, an example where - the constructors take no arguments: -
-
- -
-Inductive yesno : Type :=
-  | yes : yesno
-  | no : yesno.
- -
-Check yesno_ind.
-(* ===> yesno_ind : forall P : yesno -> Prop, 
-                      P yes  ->
-                      P no  ->
-                      forall y : yesno, P y *)
- -
-
- -
-

Exercise: 1 star, optional (rgb)

- Write out the induction principle that Coq will generate for the - following datatype. Write down your answer on paper or type it - into a comment, and then compare it with what Coq prints. -
-
- -
-Inductive rgb : Type :=
-  | red : rgb
-  | green : rgb
-  | blue : rgb.
-Check rgb_ind.
-
- -
-☐ -
- - Here's another example, this time with one of the constructors - taking some arguments. -
-
- -
-Inductive natlist : Type :=
-  | nnil : natlist
-  | ncons : nat → natlist → natlist.
- -
-Check natlist_ind.
-(* ===> (modulo a little variable renaming for clarity)
-   natlist_ind :
-      forall P : natlist -> Prop,
-         P nnil  ->
-         (forall (n : nat) (l : natlist), P l -> P (ncons n l)) ->
-         forall n : natlist, P n *)
- -
-
- -
-

Exercise: 1 star, optional (natlist1)

- Suppose we had written the above definition a little - differently: -
-
- -
-Inductive natlist1 : Type :=
-  | nnil1 : natlist1
-  | nsnoc1 : natlist1 → nat → natlist1.
- -
-
- -
-Now what will the induction principle look like? ☐ -
- - From these examples, we can extract this general rule: - -
- -
    -
  • The type declaration gives several constructors; each - corresponds to one clause of the induction principle. - -
    • -
  • Each constructor c takes argument types a1...an. - -
    • -
  • Each ai can be either t (the datatype we are defining) or - some other type s. - -
    • -
  • The corresponding case of the induction principle - says (in English): -
      -
    • "for all values x1...xn of types a1...an, if P - holds for each of the inductive arguments (each xi of - type t), then P holds for c x1 ... xn". - -
      • -
    - -
    • -
- -
- - -
- -

Exercise: 1 star, optional (byntree_ind)

- Write out the induction principle that Coq will generate for the - following datatype. Write down your answer on paper or type it - into a comment, and then compare it with what Coq prints. -
-
- -
-Inductive byntree : Type :=
- | bempty : byntree
- | bleaf : yesno → byntree
- | nbranch : yesno → byntree → byntree → byntree.
-
- -
-☐ -
- -

Exercise: 1 star, optional (ex_set)

- Here is an induction principle for an inductively defined - set. - -
- -
-      ExSet_ind :
-         ∀P : ExSet → Prop,
-             (∀b : bool, P (con1 b)) →
-             (∀(n : nat) (e : ExSet), P e → P (con2 n e)) →
-             ∀e : ExSet, P e -
- -
- Give an Inductive definition of ExSet: -
-
- -
-Inductive ExSet : Type :=
-  (* FILL IN HERE *)
-.
-
- -
-☐ -
- - What about polymorphic datatypes? - -
- - The inductive definition of polymorphic lists - -
- -
-      Inductive list (X:Type) : Type :=
-        | nil : list X
-        | cons : X → list X → list X. -
- -
- is very similar to that of natlist. The main difference is - that, here, the whole definition is parameterized on a set X: - that is, we are defining a family of inductive types list X, - one for each X. (Note that, wherever list appears in the body - of the declaration, it is always applied to the parameter X.) - The induction principle is likewise parameterized on X: - -
- -
-     list_ind :
-       ∀(X : Type) (P : list X → Prop),
-          P [] →
-          (∀(x : X) (l : list X), P l → P (x :: l)) →
-          ∀l : list X, P l -
- -
- Note the wording here (and, accordingly, the form of list_ind): - The whole induction principle is parameterized on X. That is, - list_ind can be thought of as a polymorphic function that, when - applied to a type X, gives us back an induction principle - specialized to the type list X. -
- -

Exercise: 1 star, optional (tree)

- Write out the induction principle that Coq will generate for - the following datatype. Compare your answer with what Coq - prints. -
-
- -
-Inductive tree (X:Type) : Type :=
-  | leaf : X → tree X
-  | node : tree X → tree X → tree X.
-Check tree_ind.
-
- -
-☐ -
- -

Exercise: 1 star, optional (mytype)

- Find an inductive definition that gives rise to the - following induction principle: - -
- -
-      mytype_ind :
-        ∀(X : Type) (P : mytype X → Prop),
-            (∀x : X, P (constr1 X x)) →
-            (∀n : nat, P (constr2 X n)) →
-            (∀m : mytype X, P m → 
-               ∀n : nat, P (constr3 X m n)) →
-            ∀m : mytype X, P m                    -
- -
- ☐ -
- -

Exercise: 1 star, optional (foo)

- Find an inductive definition that gives rise to the - following induction principle: - -
- -
-      foo_ind :
-        ∀(X Y : Type) (P : foo X Y → Prop),
-             (∀x : X, P (bar X Y x)) →
-             (∀y : Y, P (baz X Y y)) →
-             (∀f1 : nat → foo X Y,
-               (∀n : nat, P (f1 n)) → P (quux X Y f1)) →
-             ∀f2 : foo X Y, P f2        -
- -
- ☐ -
- -

Exercise: 1 star, optional (foo')

- Consider the following inductive definition: -
-
- -
-Inductive foo' (X:Type) : Type :=
-  | C1 : list X → foo' X → foo' X
-  | C2 : foo' X.
- -
-
- -
-What induction principle will Coq generate for foo'? Fill - in the blanks, then check your answer with Coq.) - -
- -
-     foo'_ind :
-        ∀(X : Type) (P : foo' X → Prop),
-              (∀(l : list X) (f : foo' X),
-                    _______________________ → 
-                    _______________________   ) →
-             ___________________________________________ →
-             ∀f : foo' X, ________________________ -
- -
- -
- - ☐ -
-
- -
-
- -
-

Induction Hypotheses

- -
- - Where does the phrase "induction hypothesis" fit into this story? - -
- - The induction principle for numbers - -
- -
-       ∀P : nat → Prop,
-            P 0  →
-            (∀n : nat, P n → P (S n))  →
-            ∀n : nat, P n -
- -
- is a generic statement that holds for all propositions - P (strictly speaking, for all families of propositions P - indexed by a number n). Each time we use this principle, we - are choosing P to be a particular expression of type - nat→Prop. - -
- - We can make the proof more explicit by giving this expression a - name. For example, instead of stating the theorem mult_0_r as - "∀ n, n × 0 = 0," we can write it as "∀ n, P_m0r - n", where P_m0r is defined as... -
-
- -
-Definition P_m0r (n:nat) : Prop :=
-  n × 0 = 0.
- -
-
- -
-... or equivalently... -
-
- -
-Definition P_m0r' : nat→Prop :=
-  fun n ⇒ n × 0 = 0.
- -
-
- -
-Now when we do the proof it is easier to see where P_m0r - appears. -
-
- -
-Theorem mult_0_r'' : ∀n:nat,
-  P_m0r n.
-Proof.
-  apply nat_ind.
-  Case "n = O". reflexivity.
-  Case "n = S n'".
-    (* Note the proof state at this point! *)
-    intros n IHn.
-    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.
- -
-
- -
-This extra naming step isn't something that we'll do in - normal proofs, but it is useful to do it explicitly for an example - or two, because it allows us to see exactly what the induction - hypothesis is. If we prove ∀ n, P_m0r n by induction on - n (using either induction or apply nat_ind), we see that the - first subgoal requires us to prove P_m0r 0 ("P holds for - zero"), while the second subgoal requires us to prove ∀ n', - P_m0r n' → P_m0r n' (S n') (that is "P holds of S n' if it - holds of n'" or, more elegantly, "P is preserved by S"). - The induction hypothesis is the premise of this latter - implication — the assumption that P holds of n', which we are - allowed to use in proving that P holds for S n'. -
-
- -
-
- -
-

More on the induction Tactic

- -
- - The induction tactic actually does even more low-level - bookkeeping for us than we discussed above. - -
- - Recall the informal statement of the induction principle for - natural numbers: - -
- -
    -
  • If P n is some proposition involving a natural number n, and - we want to show that P holds for all numbers n, we can - reason like this: -
      -
    • show that P O holds - -
      • -
    • show that, if P n' holds, then so does P (S n') - -
      • -
    • conclude that P n holds for all n. - -
      • -
    - -
    • -
- So, when we begin a proof with intros n and then induction n, - we are first telling Coq to consider a particular n (by - introducing it into the context) and then telling it to prove - something about all numbers (by using induction). - -
- - What Coq actually does in this situation, internally, is to - "re-generalize" the variable we perform induction on. For - example, in our original proof that plus is associative... - -
-
- -
-Theorem plus_assoc' : ∀n m p : nat,
-  n + (m + p) = (n + m) + p.
-Proof.
-  (* ...we first introduce all 3 variables into the context,
-     which amounts to saying "Consider an arbitrary n, m, and
-     p..." *)
-  intros n m p.
-  (* ...We now use the induction tactic to prove P n (that
-     is, n + (m + p) = (n + m) + p) for _all_ n,
-     and hence also for the particular n that is in the context
-     at the moment. *)
-  induction n as [| n'].
-  Case "n = O". reflexivity.
-  Case "n = S n'".
-    (* In the second subgoal generated by induction -- the
-       "inductive step" -- we must prove that P n' implies 
-       P (S n') for all n'.  The induction tactic 
-       automatically introduces n' and P n' into the context
-       for us, leaving just P (S n') as the goal. *)
-    simpl. rewrite → IHn'. reflexivity. Qed.
- -
-
- -
-It also works to apply induction to a variable that is - quantified in the goal. -
-
- -
-Theorem plus_comm' : ∀n m : nat,
-  n + m = m + n.
-Proof.
-  induction n as [| n'].
-  Case "n = O". intros m. rewrite → plus_0_r. reflexivity.
-  Case "n = S n'". intros m. simpl. rewrite → IHn'.
-    rewrite ← plus_n_Sm. reflexivity. Qed.
- -
-
- -
-Note that induction n leaves m still bound in the goal — - i.e., what we are proving inductively is a statement beginning - with ∀ m. - -
- - If we do induction on a variable that is quantified in the goal - after some other quantifiers, the induction tactic will - automatically introduce the variables bound by these quantifiers - into the context. -
-
- -
-Theorem plus_comm'' : ∀n m : nat,
-  n + m = m + n.
-Proof.
-  (* Let's do induction on m this time, instead of n... *)
-  induction m as [| m'].
-  Case "m = O". simpl. rewrite → plus_0_r. reflexivity.
-  Case "m = S m'". simpl. rewrite ← IHm'.
-    rewrite ← plus_n_Sm. reflexivity. Qed.
- -
-
- -
-

Exercise: 1 star, optional (plus_explicit_prop)

- Rewrite both plus_assoc' and plus_comm' and their proofs in - the same style as mult_0_r'' above — that is, for each theorem, - give an explicit Definition of the proposition being proved by - induction, and state the theorem and proof in terms of this - defined proposition. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Generalizing Inductions.

- -
- - One potentially confusing feature of the induction tactic is -that it happily lets you try to set up an induction over a term -that isn't sufficiently general. The net effect of this will be -to lose information (much as destruct can do), and leave -you unable to complete the proof. Here's an example: -
-
- -
-Lemma one_not_beautiful_FAILED: ¬ beautiful 1.
-Proof.
-  intro H.
-  (* Just doing an inversion on H won't get us very far in the b_sum
-    case. (Try it!). So we'll need induction. A naive first attempt: *)
-  induction H.
-  (* But now, although we get four cases, as we would expect from
-     the definition of beautiful, we lose all information about H ! *)
-Abort.
- -
-
- -
-The problem is that induction over a Prop only works properly over - completely general instances of the Prop, i.e. one in which all - the arguments are free (unconstrained) variables. - In this respect it behaves more - like destruct than like inversion. - -
- - When you're tempted to do use induction like this, it is generally - an indication that you need to be proving something more general. - But in some cases, it suffices to pull out any concrete arguments - into separate equations, like this: -
-
- -
-Lemma one_not_beautiful: ∀n, n = 1 → ¬ beautiful n.
-Proof.
- intros n E H.
-  induction H as [| | | p q Hp IHp Hq IHq].
-    Case "b_0".
-      inversion E.
-    Case "b_3".
-      inversion E.
-    Case "b_5".
-      inversion E.
-    Case "b_sum".
-      (* the rest is a tedious case analysis *)
-      destruct p as [|p'].
-      SCase "p = 0".
-        destruct q as [|q'].
-        SSCase "q = 0".
-          inversion E.
-        SSCase "q = S q'".
-          apply IHq. apply E.
-      SCase "p = S p'".
-        destruct q as [|q'].
-        SSCase "q = 0".
-          apply IHp. rewrite plus_0_r in E. apply E.
-        SSCase "q = S q'".
-          simpl in E. inversion E. destruct p'. inversion H0. inversion H0.
-Qed.
- -
-
- -
-There's a handy remember tactic that can generate the second -proof state out of the original one. -
-
- -
-Lemma one_not_beautiful': ¬ beautiful 1.
-Proof.
-  intros H.
-  remember 1 as n eqn:E.
-  (* now carry on as above *)
-  induction H.
-Admitted.
- -
-
- -
-

Informal Proofs (Advanced)

- -
- - Q: What is the relation between a formal proof of a proposition - P and an informal proof of the same proposition P? - -
- - A: The latter should teach the reader how to produce the - former. - -
- - Q: How much detail is needed?? - -
- - Unfortunately, There is no single right answer; rather, there is a - range of choices. - -
- - At one end of the spectrum, we can essentially give the reader the - whole formal proof (i.e., the informal proof amounts to just - transcribing the formal one into words). This gives the reader - the ability to reproduce the formal one for themselves, but it - doesn't teach them anything. - -
- - At the other end of the spectrum, we can say "The theorem is true - and you can figure out why for yourself if you think about it hard - enough." This is also not a good teaching strategy, because - usually writing the proof requires some deep insights into the - thing we're proving, and most readers will give up before they - rediscover all the same insights as we did. - -
- - In the middle is the golden mean — a proof that includes all of - the essential insights (saving the reader the hard part of work - that we went through to find the proof in the first place) and - clear high-level suggestions for the more routine parts to save the - reader from spending too much time reconstructing these - parts (e.g., what the IH says and what must be shown in each case - of an inductive proof), but not so much detail that the main ideas - are obscured. - -
- - Another key point: if we're comparing a formal proof of a - proposition P and an informal proof of P, the proposition P - doesn't change. That is, formal and informal proofs are talking - about the same world and they must play by the same rules.

Informal Proofs by Induction

- -
- - Since we've spent much of this chapter looking "under the hood" at - formal proofs by induction, now is a good moment to talk a little - about informal proofs by induction. - -
- - In the real world of mathematical communication, written proofs - range from extremely longwinded and pedantic to extremely brief - and telegraphic. The ideal is somewhere in between, of course, - but while you are getting used to the style it is better to start - out at the pedantic end. Also, during the learning phase, it is - probably helpful to have a clear standard to compare against. - With this in mind, we offer two templates below — one for proofs - by induction over data (i.e., where the thing we're doing - induction on lives in Type) and one for proofs by induction over - evidence (i.e., where the inductively defined thing lives in - Prop). In the rest of this course, please follow one of the two - for all of your inductive proofs. -
- -

Induction Over an Inductively Defined Set

- -
- - Template: - -
- -
    -
  • Theorem: <Universally quantified proposition of the form - "For all n:S, P(n)," where S is some inductively defined - set.> - -
    - - Proof: By induction on n. - -
    - - <one case for each constructor c of S...> - -
    - -
      -
    • Suppose n = c a1 ... ak, where <...and here we state - the IH for each of the a's that has type S, if any>. - We must show <...and here we restate P(c a1 ... ak)>. - -
      - - <go on and prove P(n) to finish the case...> - -
      - - -
      • -
    • <other cases similarly...> ☐ - -
      • -
    - -
    • -
- -
- - Example: - -
- -
    -
  • Theorem: For all sets X, lists l : list X, and numbers - n, if length l = n then index (S n) l = None. - -
    - - Proof: By induction on l. - -
    - -
      -
    • Suppose l = []. We must show, for all numbers n, - that, if length [] = n, then index (S n) [] = - None. - -
      - - This follows immediately from the definition of index. - -
      - - -
      • -
    • Suppose l = x :: l' for some x and l', where - length l' = n' implies index (S n') l' = None, for - any number n'. We must show, for all n, that, if - length (x::l') = n then index (S n) (x::l') = - None. - -
      - - Let n be a number with length l = n. Since - -
      - -
      -  length l = length (x::l') = S (length l'), -
      - -
      - it suffices to show that - -
      - -
      -  index (S (length l')) l' = None. -
      - -
      - But this follows directly from the induction hypothesis, - picking n' to be length l'. ☐ -
      • -
    - -
    • -
- -
- -

Induction Over an Inductively Defined Proposition

- -
- - Since inductively defined proof objects are often called - "derivation trees," this form of proof is also known as induction - on derivations. - -
- - Template: - -
- -
    -
  • Theorem: <Proposition of the form "Q → P," where Q is - some inductively defined proposition (more generally, - "For all x y z, Q x y z → P x y z")> - -
    - - Proof: By induction on a derivation of Q. <Or, more - generally, "Suppose we are given x, y, and z. We - show that Q x y z implies P x y z, by induction on a - derivation of Q x y z"...> - -
    - - <one case for each constructor c of Q...> - -
    - -
      -
    • Suppose the final rule used to show Q is c. Then - <...and here we state the types of all of the a's - together with any equalities that follow from the - definition of the constructor and the IH for each of - the a's that has type Q, if there are any>. We must - show <...and here we restate P>. - -
      - - <go on and prove P to finish the case...> - -
      - - -
      • -
    • <other cases similarly...> ☐ - -
      • -
    - -
    • -
- -
- - Example - - -
- -
    -
  • Theorem: The ≤ relation is transitive — i.e., for all - numbers n, m, and o, if n ≤ m and m ≤ o, then - n ≤ o. - -
    - - Proof: By induction on a derivation of m ≤ o. - -
    - -
      -
    • Suppose the final rule used to show m ≤ o is - le_n. Then m = o and we must show that n ≤ m, - which is immediate by hypothesis. - -
      - - -
      • -
    • Suppose the final rule used to show m ≤ o is - le_S. Then o = S o' for some o' with m ≤ o'. - We must show that n ≤ S o'. - By induction hypothesis, n ≤ o'. - -
      - - But then, by le_S, n ≤ S o'. ☐ -
      • -
    - -
    • -
- -
-
- -
-
- -
-

Optional Material

- -
- - The remainder of this chapter offers some additional details on - how induction works in Coq, the process of building proof - trees, and the "trusted computing base" that underlies - Coq proofs. It can safely be skimmed on a first reading. (We - recommend skimming rather than skipping over it outright: it - answers some questions that occur to many Coq users at some point, - so it is useful to have a rough idea of what's here.) -
-
- -
-
- -
-

Induction Principles in Prop

- -
- - Earlier, we looked in detail at the induction principles that Coq - generates for inductively defined sets. The induction - principles for inductively defined propositions like gorgeous - are a tiny bit more complicated. As with all induction - principles, we want to use the induction principle on gorgeous - to prove things by inductively considering the possible shapes - that something in gorgeous can have — either it is evidence - that 0 is gorgeous, or it is evidence that, for some n, 3+n - is gorgeous, or it is evidence that, for some n, 5+n is - gorgeous and it includes evidence that n itself is. Intuitively - speaking, however, what we want to prove are not statements about - evidence but statements about numbers. So we want an - induction principle that lets us prove properties of numbers by - induction on evidence. - -
- - For example, from what we've said so far, you might expect the - inductive definition of gorgeous... - -
- -
-    Inductive gorgeous : nat → Prop :=
-         g_0 : gorgeous 0
-       | g_plus3 : ∀n, gorgeous n → gorgeous (3+m)
-       | g_plus5 : ∀n, gorgeous n → gorgeous (5+m). -
- -
- ...to give rise to an induction principle that looks like this... - -
- -
-    gorgeous_ind_max :
-       ∀P : (∀n : nat, gorgeous n → Prop),
-            P O g_0 →
-            (∀(m : nat) (e : gorgeous m), 
-               P m e → P (3+m) (g_plus3 m e) →
-            (∀(m : nat) (e : gorgeous m), 
-               P m e → P (5+m) (g_plus5 m e) →
-            ∀(n : nat) (e : gorgeous n), P n e -
- -
- ... because: - -
- -
    -
  • Since gorgeous is indexed by a number n (every gorgeous - object e is a piece of evidence that some particular number - n is gorgeous), the proposition P is parameterized by both - n and e — that is, the induction principle can be used to - prove assertions involving both a gorgeous number and the - evidence that it is gorgeous. - -
    - - -
    • -
  • Since there are three ways of giving evidence of gorgeousness - (gorgeous has three constructors), applying the induction - principle generates three subgoals: - -
    - -
      -
    • We must prove that P holds for O and b_0. - -
      - - -
      • -
    • We must prove that, whenever n is a gorgeous - number and e is an evidence of its gorgeousness, - if P holds of n and e, - then it also holds of 3+m and g_plus3 n e. - -
      - - -
      • -
    • We must prove that, whenever n is a gorgeous - number and e is an evidence of its gorgeousness, - if P holds of n and e, - then it also holds of 5+m and g_plus5 n e. - -
      - - -
      • -
    - -
    • -
  • If these subgoals can be proved, then the induction principle - tells us that P is true for all gorgeous numbers n and - evidence e of their gorgeousness. - -
    • -
- -
- - But this is a little more flexibility than we actually need or - want: it is giving us a way to prove logical assertions where the - assertion involves properties of some piece of evidence of - gorgeousness, while all we really care about is proving - properties of numbers that are gorgeous — we are interested in - assertions about numbers, not about evidence. It would therefore - be more convenient to have an induction principle for proving - propositions P that are parameterized just by n and whose - conclusion establishes P for all gorgeous numbers n: - -
- -
-       ∀P : nat → Prop,
-          ... →
-             ∀n : nat, gorgeous n → P n -
- -
- For this reason, Coq actually generates the following simplified - induction principle for gorgeous: -
-
- -
-Check gorgeous_ind.
-(* ===>  gorgeous_ind
-     : forall P : nat -> Prop,
-       P 0 ->
-       (forall n : nat, gorgeous n -> P n -> P (3 + n)) ->
-       (forall n : nat, gorgeous n -> P n -> P (5 + n)) ->
-       forall n : nat, gorgeous n -> P n *)
- -
-
- -
-In particular, Coq has dropped the evidence term e as a - parameter of the the proposition P, and consequently has - rewritten the assumption ∀ (n : nat) (e: gorgeous n), ... - to be ∀ (n : nat), gorgeous n → ...; i.e., we no longer - require explicit evidence of the provability of gorgeous n. -
- - In English, gorgeous_ind says: - -
- -
    -
  • Suppose, P is a property of natural numbers (that is, P n is - a Prop for every n). To show that P n holds whenever n - is gorgeous, it suffices to show: - -
    - -
      -
    • P holds for 0, - -
      - - -
      • -
    • for any n, if n is gorgeous and P holds for - n, then P holds for 3+n, - -
      - - -
      • -
    • for any n, if n is gorgeous and P holds for - n, then P holds for 5+n. -
      • -
    - -
    • -
- -
- - As expected, we can apply gorgeous_ind directly instead of using induction. -
-
- -
-Theorem gorgeous__beautiful' : ∀n, gorgeous n → beautiful n.
-Proof.
-   intros.
-   apply gorgeous_ind.
-   Case "g_0".
-       apply b_0.
-   Case "g_plus3".
-       intros.
-       apply b_sum. apply b_3.
-       apply H1.
-   Case "g_plus5".
-       intros.
-       apply b_sum. apply b_5.
-       apply H1.
-   apply H.
-Qed.
- -
-
- -
-The precise form of an Inductive definition can affect the - induction principle Coq generates. - -
- -For example, in Logic, we have defined ≤ as: -
-
- -
-(* Inductive le : nat -> nat -> Prop :=
-     | le_n : forall n, le n n
-     | le_S : forall n m, (le n m) -> (le n (S m)). *)
- -
-
- -
-This definition can be streamlined a little by observing that the - left-hand argument n is the same everywhere in the definition, - so we can actually make it a "general parameter" to the whole - definition, rather than an argument to each constructor. -
-
- -
-Inductive le (n:nat) : nat → Prop :=
-  | le_n : le n n
-  | le_S : ∀m, (le n m) → (le n (S m)).
- -
-Notation "m ≤ n" := (le m n).
- -
-
- -
-The second one is better, even though it looks less symmetric. - Why? Because it gives us a simpler induction principle. -
-
- -
-Check le_ind.
-(* ===>  forall (n : nat) (P : nat -> Prop),
-           P n ->
-           (forall m : nat, n <= m -> P m -> P (S m)) ->
-           forall n0 : nat, n <= n0 -> P n0 *)
- -
-
- -
-By contrast, the induction principle that Coq calculates for the - first definition has a lot of extra quantifiers, which makes it - messier to work with when proving things by induction. Here is - the induction principle for the first le: -
-
- -
-(* le_ind : 
-     forall P : nat -> nat -> Prop,
-     (forall n : nat, P n n) ->
-     (forall n m : nat, le n m -> P n m -> P n (S m)) ->
-     forall n n0 : nat, le n n0 -> P n n0 *)
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 2 stars, optional (foo_ind_principle)

- Suppose we make the following inductive definition: - -
- -
-   Inductive foo (X : Set) (Y : Set) : Set :=
-     | foo1 : X → foo X Y
-     | foo2 : Y → foo X Y
-     | foo3 : foo X Y → foo X Y. -
- -
- Fill in the blanks to complete the induction principle that will be - generated by Coq. - -
- -
-   foo_ind
-        : ∀(X Y : Set) (P : foo X Y → Prop),   
-          (∀x : X, __________________________________) →
-          (∀y : Y, __________________________________) →
-          (________________________________________________) →
-           ________________________________________________ -
- -
- -
- - ☐ -
- -

Exercise: 2 stars, optional (bar_ind_principle)

- Consider the following induction principle: - -
- -
-   bar_ind
-        : ∀P : bar → Prop,
-          (∀n : nat, P (bar1 n)) →
-          (∀b : bar, P b → P (bar2 b)) →
-          (∀(b : bool) (b0 : bar), P b0 → P (bar3 b b0)) →
-          ∀b : bar, P b -
- -
- Write out the corresponding inductive set definition. - -
- -
-   Inductive bar : Set :=
-     | bar1 : ________________________________________
-     | bar2 : ________________________________________
-     | bar3 : ________________________________________. -
- -
- -
- - ☐ -
- -

Exercise: 2 stars, optional (no_longer_than_ind)

- Given the following inductively defined proposition: - -
- -
-  Inductive no_longer_than (X : Set) : (list X) → nat → Prop :=
-    | nlt_nil  : ∀n, no_longer_than X [] n
-    | nlt_cons : ∀x l n, no_longer_than X l n → 
-                               no_longer_than X (x::l) (S n)
-    | nlt_succ : ∀l n, no_longer_than X l n → 
-                             no_longer_than X l (S n). -
- -
- write the induction principle generated by Coq. - -
- -
-  no_longer_than_ind
-       : ∀(X : Set) (P : list X → nat → Prop),
-         (∀n : nat, ____________________) →
-         (∀(x : X) (l : list X) (n : nat),
-          no_longer_than X l n → ____________________ → 
-                                  _____________________________ →
-         (∀(l : list X) (n : nat),
-          no_longer_than X l n → ____________________ → 
-                                  _____________________________ →
-         ∀(l : list X) (n : nat), no_longer_than X l n → 
-           ____________________ -
- -
- -
- - ☐ -
-
- -
-
- -
-

Induction Principles for other Logical Propositions

- -
- - Similarly, in Logic we have defined eq as: -
-
- -
-(* Inductive eq (X:Type) : X -> X -> Prop :=
-       refl_equal : forall x, eq X x x. *)
- -
-
- -
-In the Coq standard library, the definition of equality is - slightly different: -
-
- -
-Inductive eq' (X:Type) (x:X) : X → Prop :=
-    refl_equal' : eq' X x x.
- -
-
- -
-The advantage of this definition is that the induction - principle that Coq derives for it is precisely the familiar - principle of Leibniz equality: what we mean when we say "x and - y are equal" is that every property on P that is true of x - is also true of y. -
-
- -
-Check eq'_ind.
-(* ===> 
-     forall (X : Type) (x : X) (P : X -> Prop),
-       P x -> forall y : X, x =' y -> P y 
-
-   ===>  (i.e., after a little reorganization)
-     forall (X : Type) (x : X) forall y : X, 
-       x =' y -> 
-       forall P : X -> Prop, P x -> P y *)
- -
-
- -
-The induction principles for conjunction and disjunction are a - good illustration of Coq's way of generating simplified induction - principles for Inductively defined propositions, which we - discussed above. You try first: -
- -

Exercise: 1 star, optional (and_ind_principle)

- See if you can predict the induction principle for conjunction. -
-
- -
-(* Check and_ind. *)
-
- -
-☐ -
- -

Exercise: 1 star, optional (or_ind_principle)

- See if you can predict the induction principle for disjunction. -
-
- -
-(* Check or_ind. *)
-
- -
-☐ -
-
- -
-Check and_ind.
- -
-
- -
-From the inductive definition of the proposition and P Q - -
- -
-     Inductive and (P Q : Prop) : Prop :=
-       conj : P → Q → (and P Q). -
- -
- we might expect Coq to generate this induction principle - -
- -
-     and_ind_max :
-       ∀(P Q : Prop) (P0 : P ∧ Q → Prop),
-            (∀(a : P) (b : Q), P0 (conj P Q a b)) →
-            ∀a : P ∧ Q, P0 a -
- -
- but actually it generates this simpler and more useful one: - -
- -
-     and_ind :
-       ∀P Q P0 : Prop,
-            (P → Q → P0) →
-            P ∧ Q → P0 -
- -
- In the same way, when given the inductive definition of or P Q - -
- -
-     Inductive or (P Q : Prop) : Prop :=
-       | or_introl : P → or P Q
-       | or_intror : Q → or P Q. -
- -
- instead of the "maximal induction principle" - -
- -
-     or_ind_max :
-       ∀(P Q : Prop) (P0 : P ∨ Q → Prop),
-            (∀a : P, P0 (or_introl P Q a)) →
-            (∀b : Q, P0 (or_intror P Q b)) →
-            ∀o : P ∨ Q, P0 o -
- -
- what Coq actually generates is this: - -
- -
-     or_ind :
-       ∀P Q P0 : Prop,
-            (P → P0) →
-            (Q → P0) →
-            P ∨ Q → P0 -
- -
- -
- -

Exercise: 1 star, optional (False_ind_principle)

- Can you predict the induction principle for falsehood? -
-
- -
-(* Check False_ind. *)
-
- -
-☐ -
- - Here's the induction principle that Coq generates for existentials: -
-
- -
-Check ex_ind.
-(* ===>  forall (X:Type) (P: X->Prop) (Q: Prop),
-         (forall witness:X, P witness -> Q) -> 
-          ex X P -> 
-           Q *)
- -
-
- -
-This induction principle can be understood as follows: If we have - a function f that can construct evidence for Q given any - witness of type X together with evidence that this witness has - property P, then from a proof of ex X P we can extract the - witness and evidence that must have been supplied to the - constructor, give these to f, and thus obtain a proof of Q. -
-
- -
-
- -
-

Explicit Proof Objects for Induction

- -
- - Although tactic-based proofs are normally much easier to - work with, the ability to write a proof term directly is sometimes - very handy, particularly when we want Coq to do something slightly - non-standard. -
- - Recall the induction principle on naturals that Coq generates for - us automatically from the Inductive declation for nat. -
-
- -
-Check nat_ind.
-(* ===> 
-   nat_ind : forall P : nat -> Prop,
-      P 0 -> 
-      (forall n : nat, P n -> P (S n)) -> 
-      forall n : nat, P n  *)
- -
-
- -
-There's nothing magic about this induction lemma: it's just - another Coq lemma that requires a proof. Coq generates the proof - automatically too... -
-
- -
-Print nat_ind.
-Print nat_rect.
-(* ===> (after some manual inlining and tidying)
-   nat_ind =
-    fun (P : nat -> Prop) 
-        (f : P 0) 
-        (f0 : forall n : nat, P n -> P (S n)) =>
-          fix F (n : nat) : P n :=
-             match n with
-            | 0 => f
-            | S n0 => f0 n0 (F n0)
-            end.
-*)
- -
-
- -
-We can read this as follows: - Suppose we have evidence f that P holds on 0, and - evidence f0 that ∀ n:nat, P n → P (S n). - Then we can prove that P holds of an arbitrary nat n via - a recursive function F (here defined using the expression - form Fix rather than by a top-level Fixpoint - declaration). F pattern matches on n: - -
- -
    -
  • If it finds 0, F uses f to show that P n holds. - -
    • -
  • If it finds S n0, F applies itself recursively on n0 - to obtain evidence that P n0 holds; then it applies f0 - on that evidence to show that P (S n) holds. - -
    • -
- F is just an ordinary recursive function that happens to - operate on evidence in Prop rather than on terms in Set. - -
- - -
- - We can adapt this approach to proving nat_ind to help prove - non-standard induction principles too. Recall our desire to - prove that - -
- - ∀ n : nat, even n → ev n. - -
- - Attempts to do this by standard induction on n fail, because the - induction principle only lets us proceed when we can prove that - even n → even (S n) — which is of course never provable. What - we did in Logic was a bit of a hack: - -
- - Theorem even__ev : ∀ n : nat, - (even n → ev n) ∧ (even (S n) → ev (S n)). - -
- - We can make a much better proof by defining and proving a - non-standard induction principle that goes "by twos": - -
- - -
-
- -
- Definition nat_ind2 :
-    ∀(P : nat → Prop),
-    P 0 →
-    P 1 →
-    (∀n : nat, P n → P (S(S n))) →
-    ∀n : nat , P n :=
-       fun P ⇒ fun P0 ⇒ fun P1 ⇒ fun PSS ⇒
-          fix f (n:nat) := match n with
-                             0 ⇒ P0
-                           | 1 ⇒ P1
-                           | S (S n') ⇒ PSS n' (f n')
-                          end.
- -
-
- -
-Once you get the hang of it, it is entirely straightforward to - give an explicit proof term for induction principles like this. - Proving this as a lemma using tactics is much less intuitive (try - it!). - -
- - The induction ... using tactic variant gives a convenient way to - specify a non-standard induction principle like this. -
-
- -
-Lemma even__ev' : ∀n, even n → ev n.
-Proof.
- intros.
- induction n as [ | |n'] using nat_ind2.
-  Case "even 0".
-    apply ev_0.
-  Case "even 1".
-    inversion H.
-  Case "even (S(S n'))".
-    apply ev_SS.
-    apply IHn'. unfold even. unfold even in H. simpl in H. apply H.
-Qed.
- -
-
- -
-

The Coq Trusted Computing Base

- -
- - One issue that arises with any automated proof assistant is "why - trust it?": what if there is a bug in the implementation that - renders all its reasoning suspect? - -
- - While it is impossible to allay such concerns completely, the fact - that Coq is based on the Curry-Howard correspondence gives it a - strong foundation. Because propositions are just types and proofs - are just terms, checking that an alleged proof of a proposition is - valid just amounts to type-checking the term. Type checkers are - relatively small and straightforward programs, so the "trusted - computing base" for Coq — the part of the code that we have to - believe is operating correctly — is small too. - -
- - What must a typechecker do? Its primary job is to make sure that - in each function application the expected and actual argument - types match, that the arms of a match expression are constructor - patterns belonging to the inductive type being matched over and - all arms of the match return the same type, and so on. - -
- - There are a few additional wrinkles: - -
- -
    -
  • Since Coq types can themselves be expressions, the checker must - normalize these (by using the computation rules) before - comparing them. - -
    - - -
    • -
  • The checker must make sure that match expressions are - exhaustive. That is, there must be an arm for every possible - constructor. To see why, consider the following alleged proof - object: - -
    - -
    -Definition or_bogus : ∀P Q, P ∨ Q → P :=
    -  fun (P Q : Prop) (A : P ∨ Q) ⇒
    -     match A with
    -     | or_introl H ⇒ H
    -     end. -
    - -
    - All the types here match correctly, but the match only - considers one of the possible constructors for or. Coq's - exhaustiveness check will reject this definition. - -
    - - -
    • -
  • The checker must make sure that each fix expression - terminates. It does this using a syntactic check to make sure - that each recursive call is on a subexpression of the original - argument. To see why this is essential, consider this alleged - proof: - -
    - -
    -    Definition nat_false : ∀(n:nat), False :=
    -       fix f (n:nat) : False := f n. -
    - -
    - Again, this is perfectly well-typed, but (fortunately) Coq will - reject it. -
    • -
- -
- - Note that the soundness of Coq depends only on the correctness of - this typechecking engine, not on the tactic machinery. If there - is a bug in a tactic implementation (and this certainly does - happen!), that tactic might construct an invalid proof term. But - when you type Qed, Coq checks the term for validity from - scratch. Only lemmas whose proofs pass the type-checker can be - used in further proof developments. -
-
- -
-(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/MoreInd.v b/MoreInd.v deleted file mode 100644 index 7d68b78..0000000 --- a/MoreInd.v +++ /dev/null @@ -1,1158 +0,0 @@ -(** * MoreInd: More on Induction *) - -Require Export "ProofObjects". - -(* ##################################################### *) -(** * Induction Principles *) - -(** This is a good point to pause and take a deeper look at induction - principles. - - Every time we declare a new [Inductive] datatype, Coq - automatically generates and proves an _induction principle_ - for this type. - - The induction principle for a type [t] is called [t_ind]. Here is - the one for natural numbers: *) - -Check nat_ind. -(* ===> nat_ind : - forall P : nat -> Prop, - P 0 -> - (forall n : nat, P n -> P (S n)) -> - forall n : nat, P n *) - -(** *** *) -(** The [induction] tactic is a straightforward wrapper that, at - its core, simply performs [apply t_ind]. To see this more - clearly, let's experiment a little with using [apply nat_ind] - directly, instead of the [induction] tactic, to carry out some - proofs. Here, for example, is an alternate proof of a theorem - that we saw in the [Basics] chapter. *) - -Theorem mult_0_r' : forall n:nat, - n * 0 = 0. -Proof. - apply nat_ind. - Case "O". reflexivity. - Case "S". simpl. intros n IHn. rewrite -> IHn. - reflexivity. Qed. - - -(** This proof is basically the same as the earlier one, but a - few minor differences are worth noting. First, in the induction - step of the proof (the ["S"] case), we have to do a little - bookkeeping manually (the [intros]) that [induction] does - automatically. - - Second, we do not introduce [n] into the context before applying - [nat_ind] -- the conclusion of [nat_ind] is a quantified formula, - and [apply] needs this conclusion to exactly match the shape of - the goal state, including the quantifier. The [induction] tactic - works either with a variable in the context or a quantified - variable in the goal. - - Third, the [apply] tactic automatically chooses variable names for - us (in the second subgoal, here), whereas [induction] lets us - specify (with the [as...] clause) what names should be used. The - automatic choice is actually a little unfortunate, since it - re-uses the name [n] for a variable that is different from the [n] - in the original theorem. This is why the [Case] annotation is - just [S] -- if we tried to write it out in the more explicit form - that we've been using for most proofs, we'd have to write [n = S - n], which doesn't make a lot of sense! All of these conveniences - make [induction] nicer to use in practice than applying induction - principles like [nat_ind] directly. But it is important to - realize that, modulo this little bit of bookkeeping, applying - [nat_ind] is what we are really doing. *) - -(** **** Exercise: 2 stars, optional (plus_one_r') *) -(** Complete this proof as we did [mult_0_r'] above, without using - the [induction] tactic. *) - -Theorem plus_one_r' : forall n:nat, - n + 1 = S n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Coq generates induction principles for every datatype defined with - [Inductive], including those that aren't recursive. (Although - we don't need induction to prove properties of non-recursive - datatypes, the idea of an induction principle still makes sense - for them: it gives a way to prove that a property holds for all - values of the type.) - - These generated principles follow a similar pattern. If we define a - type [t] with constructors [c1] ... [cn], Coq generates a theorem - with this shape: - t_ind : - forall P : t -> Prop, - ... case for c1 ... -> - ... case for c2 ... -> - ... - ... case for cn ... -> - forall n : t, P n - The specific shape of each case depends on the arguments to the - corresponding constructor. Before trying to write down a general - rule, let's look at some more examples. First, an example where - the constructors take no arguments: *) - -Inductive yesno : Type := - | yes : yesno - | no : yesno. - -Check yesno_ind. -(* ===> yesno_ind : forall P : yesno -> Prop, - P yes -> - P no -> - forall y : yesno, P y *) - -(** **** Exercise: 1 star, optional (rgb) *) -(** Write out the induction principle that Coq will generate for the - following datatype. Write down your answer on paper or type it - into a comment, and then compare it with what Coq prints. *) - -Inductive rgb : Type := - | red : rgb - | green : rgb - | blue : rgb. -Check rgb_ind. -(** [] *) - -(** Here's another example, this time with one of the constructors - taking some arguments. *) - -Inductive natlist : Type := - | nnil : natlist - | ncons : nat -> natlist -> natlist. - -Check natlist_ind. -(* ===> (modulo a little variable renaming for clarity) - natlist_ind : - forall P : natlist -> Prop, - P nnil -> - (forall (n : nat) (l : natlist), P l -> P (ncons n l)) -> - forall n : natlist, P n *) - -(** **** Exercise: 1 star, optional (natlist1) *) -(** Suppose we had written the above definition a little - differently: *) - -Inductive natlist1 : Type := - | nnil1 : natlist1 - | nsnoc1 : natlist1 -> nat -> natlist1. - -(** Now what will the induction principle look like? *) -(** [] *) - -(** From these examples, we can extract this general rule: - - - The type declaration gives several constructors; each - corresponds to one clause of the induction principle. - - Each constructor [c] takes argument types [a1]...[an]. - - Each [ai] can be either [t] (the datatype we are defining) or - some other type [s]. - - The corresponding case of the induction principle - says (in English): - - "for all values [x1]...[xn] of types [a1]...[an], if [P] - holds for each of the inductive arguments (each [xi] of - type [t]), then [P] holds for [c x1 ... xn]". - -*) - - - -(** **** Exercise: 1 star, optional (byntree_ind) *) -(** Write out the induction principle that Coq will generate for the - following datatype. Write down your answer on paper or type it - into a comment, and then compare it with what Coq prints. *) - -Inductive byntree : Type := - | bempty : byntree - | bleaf : yesno -> byntree - | nbranch : yesno -> byntree -> byntree -> byntree. -(** [] *) - - -(** **** Exercise: 1 star, optional (ex_set) *) -(** Here is an induction principle for an inductively defined - set. - ExSet_ind : - forall P : ExSet -> Prop, - (forall b : bool, P (con1 b)) -> - (forall (n : nat) (e : ExSet), P e -> P (con2 n e)) -> - forall e : ExSet, P e - Give an [Inductive] definition of [ExSet]: *) - -Inductive ExSet : Type := - (* FILL IN HERE *) -. -(** [] *) - -(** What about polymorphic datatypes? - - The inductive definition of polymorphic lists - Inductive list (X:Type) : Type := - | nil : list X - | cons : X -> list X -> list X. - is very similar to that of [natlist]. The main difference is - that, here, the whole definition is _parameterized_ on a set [X]: - that is, we are defining a _family_ of inductive types [list X], - one for each [X]. (Note that, wherever [list] appears in the body - of the declaration, it is always applied to the parameter [X].) - The induction principle is likewise parameterized on [X]: - list_ind : - forall (X : Type) (P : list X -> Prop), - P [] -> - (forall (x : X) (l : list X), P l -> P (x :: l)) -> - forall l : list X, P l - Note the wording here (and, accordingly, the form of [list_ind]): - The _whole_ induction principle is parameterized on [X]. That is, - [list_ind] can be thought of as a polymorphic function that, when - applied to a type [X], gives us back an induction principle - specialized to the type [list X]. *) - -(** **** Exercise: 1 star, optional (tree) *) -(** Write out the induction principle that Coq will generate for - the following datatype. Compare your answer with what Coq - prints. *) - -Inductive tree (X:Type) : Type := - | leaf : X -> tree X - | node : tree X -> tree X -> tree X. -Check tree_ind. -(** [] *) - -(** **** Exercise: 1 star, optional (mytype) *) -(** Find an inductive definition that gives rise to the - following induction principle: - mytype_ind : - forall (X : Type) (P : mytype X -> Prop), - (forall x : X, P (constr1 X x)) -> - (forall n : nat, P (constr2 X n)) -> - (forall m : mytype X, P m -> - forall n : nat, P (constr3 X m n)) -> - forall m : mytype X, P m -*) -(** [] *) - -(** **** Exercise: 1 star, optional (foo) *) -(** Find an inductive definition that gives rise to the - following induction principle: - foo_ind : - forall (X Y : Type) (P : foo X Y -> Prop), - (forall x : X, P (bar X Y x)) -> - (forall y : Y, P (baz X Y y)) -> - (forall f1 : nat -> foo X Y, - (forall n : nat, P (f1 n)) -> P (quux X Y f1)) -> - forall f2 : foo X Y, P f2 -*) -(** [] *) - -(** **** Exercise: 1 star, optional (foo') *) -(** Consider the following inductive definition: *) - -Inductive foo' (X:Type) : Type := - | C1 : list X -> foo' X -> foo' X - | C2 : foo' X. - -(** What induction principle will Coq generate for [foo']? Fill - in the blanks, then check your answer with Coq.) - foo'_ind : - forall (X : Type) (P : foo' X -> Prop), - (forall (l : list X) (f : foo' X), - _______________________ -> - _______________________ ) -> - ___________________________________________ -> - forall f : foo' X, ________________________ -*) - -(** [] *) - -(* ##################################################### *) -(** ** Induction Hypotheses *) - -(** Where does the phrase "induction hypothesis" fit into this story? - - The induction principle for numbers - forall P : nat -> Prop, - P 0 -> - (forall n : nat, P n -> P (S n)) -> - forall n : nat, P n - is a generic statement that holds for all propositions - [P] (strictly speaking, for all families of propositions [P] - indexed by a number [n]). Each time we use this principle, we - are choosing [P] to be a particular expression of type - [nat->Prop]. - - We can make the proof more explicit by giving this expression a - name. For example, instead of stating the theorem [mult_0_r] as - "[forall n, n * 0 = 0]," we can write it as "[forall n, P_m0r - n]", where [P_m0r] is defined as... *) - -Definition P_m0r (n:nat) : Prop := - n * 0 = 0. - -(** ... or equivalently... *) - -Definition P_m0r' : nat->Prop := - fun n => n * 0 = 0. - -(** Now when we do the proof it is easier to see where [P_m0r] - appears. *) - -Theorem mult_0_r'' : forall n:nat, - P_m0r n. -Proof. - apply nat_ind. - Case "n = O". reflexivity. - Case "n = S n'". - (* Note the proof state at this point! *) - intros n IHn. - unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed. - -(** This extra naming step isn't something that we'll do in - normal proofs, but it is useful to do it explicitly for an example - or two, because it allows us to see exactly what the induction - hypothesis is. If we prove [forall n, P_m0r n] by induction on - [n] (using either [induction] or [apply nat_ind]), we see that the - first subgoal requires us to prove [P_m0r 0] ("[P] holds for - zero"), while the second subgoal requires us to prove [forall n', - P_m0r n' -> P_m0r n' (S n')] (that is "[P] holds of [S n'] if it - holds of [n']" or, more elegantly, "[P] is preserved by [S]"). - The _induction hypothesis_ is the premise of this latter - implication -- the assumption that [P] holds of [n'], which we are - allowed to use in proving that [P] holds for [S n']. *) - -(* ##################################################### *) -(** ** More on the [induction] Tactic *) - -(** The [induction] tactic actually does even more low-level - bookkeeping for us than we discussed above. - - Recall the informal statement of the induction principle for - natural numbers: - - If [P n] is some proposition involving a natural number n, and - we want to show that P holds for _all_ numbers n, we can - reason like this: - - show that [P O] holds - - show that, if [P n'] holds, then so does [P (S n')] - - conclude that [P n] holds for all n. - So, when we begin a proof with [intros n] and then [induction n], - we are first telling Coq to consider a _particular_ [n] (by - introducing it into the context) and then telling it to prove - something about _all_ numbers (by using induction). - - What Coq actually does in this situation, internally, is to - "re-generalize" the variable we perform induction on. For - example, in our original proof that [plus] is associative... -*) - -Theorem plus_assoc' : forall n m p : nat, - n + (m + p) = (n + m) + p. -Proof. - (* ...we first introduce all 3 variables into the context, - which amounts to saying "Consider an arbitrary [n], [m], and - [p]..." *) - intros n m p. - (* ...We now use the [induction] tactic to prove [P n] (that - is, [n + (m + p) = (n + m) + p]) for _all_ [n], - and hence also for the particular [n] that is in the context - at the moment. *) - induction n as [| n']. - Case "n = O". reflexivity. - Case "n = S n'". - (* In the second subgoal generated by [induction] -- the - "inductive step" -- we must prove that [P n'] implies - [P (S n')] for all [n']. The [induction] tactic - automatically introduces [n'] and [P n'] into the context - for us, leaving just [P (S n')] as the goal. *) - simpl. rewrite -> IHn'. reflexivity. Qed. - - -(** It also works to apply [induction] to a variable that is - quantified in the goal. *) - -Theorem plus_comm' : forall n m : nat, - n + m = m + n. -Proof. - induction n as [| n']. - Case "n = O". intros m. rewrite -> plus_0_r. reflexivity. - Case "n = S n'". intros m. simpl. rewrite -> IHn'. - rewrite <- plus_n_Sm. reflexivity. Qed. - -(** Note that [induction n] leaves [m] still bound in the goal -- - i.e., what we are proving inductively is a statement beginning - with [forall m]. - - If we do [induction] on a variable that is quantified in the goal - _after_ some other quantifiers, the [induction] tactic will - automatically introduce the variables bound by these quantifiers - into the context. *) - -Theorem plus_comm'' : forall n m : nat, - n + m = m + n. -Proof. - (* Let's do induction on [m] this time, instead of [n]... *) - induction m as [| m']. - Case "m = O". simpl. rewrite -> plus_0_r. reflexivity. - Case "m = S m'". simpl. rewrite <- IHm'. - rewrite <- plus_n_Sm. reflexivity. Qed. - -(** **** Exercise: 1 star, optional (plus_explicit_prop) *) -(** Rewrite both [plus_assoc'] and [plus_comm'] and their proofs in - the same style as [mult_0_r''] above -- that is, for each theorem, - give an explicit [Definition] of the proposition being proved by - induction, and state the theorem and proof in terms of this - defined proposition. *) - -(* FILL IN HERE *) -(** [] *) - - -(** ** Generalizing Inductions. *) - -(** One potentially confusing feature of the [induction] tactic is -that it happily lets you try to set up an induction over a term -that isn't sufficiently general. The net effect of this will be -to lose information (much as [destruct] can do), and leave -you unable to complete the proof. Here's an example: *) - -Lemma one_not_beautiful_FAILED: ~ beautiful 1. -Proof. - intro H. - (* Just doing an [inversion] on [H] won't get us very far in the [b_sum] - case. (Try it!). So we'll need induction. A naive first attempt: *) - induction H. - (* But now, although we get four cases, as we would expect from - the definition of [beautiful], we lose all information about [H] ! *) -Abort. - -(** The problem is that [induction] over a Prop only works properly over - completely general instances of the Prop, i.e. one in which all - the arguments are free (unconstrained) variables. - In this respect it behaves more - like [destruct] than like [inversion]. - - When you're tempted to do use [induction] like this, it is generally - an indication that you need to be proving something more general. - But in some cases, it suffices to pull out any concrete arguments - into separate equations, like this: *) - -Lemma one_not_beautiful: forall n, n = 1 -> ~ beautiful n. -Proof. - intros n E H. - induction H as [| | | p q Hp IHp Hq IHq]. - Case "b_0". - inversion E. - Case "b_3". - inversion E. - Case "b_5". - inversion E. - Case "b_sum". - (* the rest is a tedious case analysis *) - destruct p as [|p']. - SCase "p = 0". - destruct q as [|q']. - SSCase "q = 0". - inversion E. - SSCase "q = S q'". - apply IHq. apply E. - SCase "p = S p'". - destruct q as [|q']. - SSCase "q = 0". - apply IHp. rewrite plus_0_r in E. apply E. - SSCase "q = S q'". - simpl in E. inversion E. destruct p'. inversion H0. inversion H0. -Qed. - -(** There's a handy [remember] tactic that can generate the second -proof state out of the original one. *) - -Lemma one_not_beautiful': ~ beautiful 1. -Proof. - intros H. - remember 1 as n eqn:E. - (* now carry on as above *) - induction H. -Admitted. - - -(* ####################################################### *) -(** * Informal Proofs (Advanced) *) - -(** Q: What is the relation between a formal proof of a proposition - [P] and an informal proof of the same proposition [P]? - - A: The latter should _teach_ the reader how to produce the - former. - - Q: How much detail is needed?? - - Unfortunately, There is no single right answer; rather, there is a - range of choices. - - At one end of the spectrum, we can essentially give the reader the - whole formal proof (i.e., the informal proof amounts to just - transcribing the formal one into words). This gives the reader - the _ability_ to reproduce the formal one for themselves, but it - doesn't _teach_ them anything. - - At the other end of the spectrum, we can say "The theorem is true - and you can figure out why for yourself if you think about it hard - enough." This is also not a good teaching strategy, because - usually writing the proof requires some deep insights into the - thing we're proving, and most readers will give up before they - rediscover all the same insights as we did. - - In the middle is the golden mean -- a proof that includes all of - the essential insights (saving the reader the hard part of work - that we went through to find the proof in the first place) and - clear high-level suggestions for the more routine parts to save the - reader from spending too much time reconstructing these - parts (e.g., what the IH says and what must be shown in each case - of an inductive proof), but not so much detail that the main ideas - are obscured. - - Another key point: if we're comparing a formal proof of a - proposition [P] and an informal proof of [P], the proposition [P] - doesn't change. That is, formal and informal proofs are _talking - about the same world_ and they _must play by the same rules_. *) -(** ** Informal Proofs by Induction *) - -(** Since we've spent much of this chapter looking "under the hood" at - formal proofs by induction, now is a good moment to talk a little - about _informal_ proofs by induction. - - In the real world of mathematical communication, written proofs - range from extremely longwinded and pedantic to extremely brief - and telegraphic. The ideal is somewhere in between, of course, - but while you are getting used to the style it is better to start - out at the pedantic end. Also, during the learning phase, it is - probably helpful to have a clear standard to compare against. - With this in mind, we offer two templates below -- one for proofs - by induction over _data_ (i.e., where the thing we're doing - induction on lives in [Type]) and one for proofs by induction over - _evidence_ (i.e., where the inductively defined thing lives in - [Prop]). In the rest of this course, please follow one of the two - for _all_ of your inductive proofs. *) - -(** *** Induction Over an Inductively Defined Set *) - -(** _Template_: - - - _Theorem_: - - _Proof_: By induction on [n]. - - - - - Suppose [n = c a1 ... ak], where <...and here we state - the IH for each of the [a]'s that has type [S], if any>. - We must show <...and here we restate [P(c a1 ... ak)]>. - - - - - [] - - _Example_: - - - _Theorem_: For all sets [X], lists [l : list X], and numbers - [n], if [length l = n] then [index (S n) l = None]. - - _Proof_: By induction on [l]. - - - Suppose [l = []]. We must show, for all numbers [n], - that, if length [[] = n], then [index (S n) [] = - None]. - - This follows immediately from the definition of index. - - - Suppose [l = x :: l'] for some [x] and [l'], where - [length l' = n'] implies [index (S n') l' = None], for - any number [n']. We must show, for all [n], that, if - [length (x::l') = n] then [index (S n) (x::l') = - None]. - - Let [n] be a number with [length l = n]. Since - length l = length (x::l') = S (length l'), - it suffices to show that - index (S (length l')) l' = None. -]] - But this follows directly from the induction hypothesis, - picking [n'] to be length [l']. [] *) - -(** *** Induction Over an Inductively Defined Proposition *) - -(** Since inductively defined proof objects are often called - "derivation trees," this form of proof is also known as _induction - on derivations_. - - _Template_: - - - _Theorem_: P]," where [Q] is - some inductively defined proposition (more generally, - "For all [x] [y] [z], [Q x y z -> P x y z]")> - - _Proof_: By induction on a derivation of [Q]. - - - - - Suppose the final rule used to show [Q] is [c]. Then - <...and here we state the types of all of the [a]'s - together with any equalities that follow from the - definition of the constructor and the IH for each of - the [a]'s that has type [Q], if there are any>. We must - show <...and here we restate [P]>. - - - - - [] - - _Example_ - - - _Theorem_: The [<=] relation is transitive -- i.e., for all - numbers [n], [m], and [o], if [n <= m] and [m <= o], then - [n <= o]. - - _Proof_: By induction on a derivation of [m <= o]. - - - Suppose the final rule used to show [m <= o] is - [le_n]. Then [m = o] and we must show that [n <= m], - which is immediate by hypothesis. - - - Suppose the final rule used to show [m <= o] is - [le_S]. Then [o = S o'] for some [o'] with [m <= o']. - We must show that [n <= S o']. - By induction hypothesis, [n <= o']. - - But then, by [le_S], [n <= S o']. [] *) - - - -(* ##################################################### *) -(** * Optional Material *) - -(** The remainder of this chapter offers some additional details on - how induction works in Coq, the process of building proof - trees, and the "trusted computing base" that underlies - Coq proofs. It can safely be skimmed on a first reading. (We - recommend skimming rather than skipping over it outright: it - answers some questions that occur to many Coq users at some point, - so it is useful to have a rough idea of what's here.) *) - - -(* ##################################################### *) -(** ** Induction Principles in [Prop] *) - - -(** Earlier, we looked in detail at the induction principles that Coq - generates for inductively defined _sets_. The induction - principles for inductively defined _propositions_ like [gorgeous] - are a tiny bit more complicated. As with all induction - principles, we want to use the induction principle on [gorgeous] - to prove things by inductively considering the possible shapes - that something in [gorgeous] can have -- either it is evidence - that [0] is gorgeous, or it is evidence that, for some [n], [3+n] - is gorgeous, or it is evidence that, for some [n], [5+n] is - gorgeous and it includes evidence that [n] itself is. Intuitively - speaking, however, what we want to prove are not statements about - _evidence_ but statements about _numbers_. So we want an - induction principle that lets us prove properties of numbers by - induction on evidence. - - For example, from what we've said so far, you might expect the - inductive definition of [gorgeous]... - Inductive gorgeous : nat -> Prop := - g_0 : gorgeous 0 - | g_plus3 : forall n, gorgeous n -> gorgeous (3+m) - | g_plus5 : forall n, gorgeous n -> gorgeous (5+m). - ...to give rise to an induction principle that looks like this... - gorgeous_ind_max : - forall P : (forall n : nat, gorgeous n -> Prop), - P O g_0 -> - (forall (m : nat) (e : gorgeous m), - P m e -> P (3+m) (g_plus3 m e) -> - (forall (m : nat) (e : gorgeous m), - P m e -> P (5+m) (g_plus5 m e) -> - forall (n : nat) (e : gorgeous n), P n e - ... because: - - - Since [gorgeous] is indexed by a number [n] (every [gorgeous] - object [e] is a piece of evidence that some particular number - [n] is gorgeous), the proposition [P] is parameterized by both - [n] and [e] -- that is, the induction principle can be used to - prove assertions involving both a gorgeous number and the - evidence that it is gorgeous. - - - Since there are three ways of giving evidence of gorgeousness - ([gorgeous] has three constructors), applying the induction - principle generates three subgoals: - - - We must prove that [P] holds for [O] and [b_0]. - - - We must prove that, whenever [n] is a gorgeous - number and [e] is an evidence of its gorgeousness, - if [P] holds of [n] and [e], - then it also holds of [3+m] and [g_plus3 n e]. - - - We must prove that, whenever [n] is a gorgeous - number and [e] is an evidence of its gorgeousness, - if [P] holds of [n] and [e], - then it also holds of [5+m] and [g_plus5 n e]. - - - If these subgoals can be proved, then the induction principle - tells us that [P] is true for _all_ gorgeous numbers [n] and - evidence [e] of their gorgeousness. - - But this is a little more flexibility than we actually need or - want: it is giving us a way to prove logical assertions where the - assertion involves properties of some piece of _evidence_ of - gorgeousness, while all we really care about is proving - properties of _numbers_ that are gorgeous -- we are interested in - assertions about numbers, not about evidence. It would therefore - be more convenient to have an induction principle for proving - propositions [P] that are parameterized just by [n] and whose - conclusion establishes [P] for all gorgeous numbers [n]: - forall P : nat -> Prop, - ... -> - forall n : nat, gorgeous n -> P n - For this reason, Coq actually generates the following simplified - induction principle for [gorgeous]: *) - - - -Check gorgeous_ind. -(* ===> gorgeous_ind - : forall P : nat -> Prop, - P 0 -> - (forall n : nat, gorgeous n -> P n -> P (3 + n)) -> - (forall n : nat, gorgeous n -> P n -> P (5 + n)) -> - forall n : nat, gorgeous n -> P n *) - -(** In particular, Coq has dropped the evidence term [e] as a - parameter of the the proposition [P], and consequently has - rewritten the assumption [forall (n : nat) (e: gorgeous n), ...] - to be [forall (n : nat), gorgeous n -> ...]; i.e., we no longer - require explicit evidence of the provability of [gorgeous n]. *) - -(** In English, [gorgeous_ind] says: - - - Suppose, [P] is a property of natural numbers (that is, [P n] is - a [Prop] for every [n]). To show that [P n] holds whenever [n] - is gorgeous, it suffices to show: - - - [P] holds for [0], - - - for any [n], if [n] is gorgeous and [P] holds for - [n], then [P] holds for [3+n], - - - for any [n], if [n] is gorgeous and [P] holds for - [n], then [P] holds for [5+n]. *) - -(** As expected, we can apply [gorgeous_ind] directly instead of using [induction]. *) - -Theorem gorgeous__beautiful' : forall n, gorgeous n -> beautiful n. -Proof. - intros. - apply gorgeous_ind. - Case "g_0". - apply b_0. - Case "g_plus3". - intros. - apply b_sum. apply b_3. - apply H1. - Case "g_plus5". - intros. - apply b_sum. apply b_5. - apply H1. - apply H. -Qed. - - - -(** The precise form of an Inductive definition can affect the - induction principle Coq generates. - -For example, in [Logic], we have defined [<=] as: *) - -(* Inductive le : nat -> nat -> Prop := - | le_n : forall n, le n n - | le_S : forall n m, (le n m) -> (le n (S m)). *) - -(** This definition can be streamlined a little by observing that the - left-hand argument [n] is the same everywhere in the definition, - so we can actually make it a "general parameter" to the whole - definition, rather than an argument to each constructor. *) - -Inductive le (n:nat) : nat -> Prop := - | le_n : le n n - | le_S : forall m, (le n m) -> (le n (S m)). - -Notation "m <= n" := (le m n). - -(** The second one is better, even though it looks less symmetric. - Why? Because it gives us a simpler induction principle. *) - -Check le_ind. -(* ===> forall (n : nat) (P : nat -> Prop), - P n -> - (forall m : nat, n <= m -> P m -> P (S m)) -> - forall n0 : nat, n <= n0 -> P n0 *) - -(** By contrast, the induction principle that Coq calculates for the - first definition has a lot of extra quantifiers, which makes it - messier to work with when proving things by induction. Here is - the induction principle for the first [le]: *) - -(* le_ind : - forall P : nat -> nat -> Prop, - (forall n : nat, P n n) -> - (forall n m : nat, le n m -> P n m -> P n (S m)) -> - forall n n0 : nat, le n n0 -> P n n0 *) - - -(* ##################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 2 stars, optional (foo_ind_principle) *) -(** Suppose we make the following inductive definition: - Inductive foo (X : Set) (Y : Set) : Set := - | foo1 : X -> foo X Y - | foo2 : Y -> foo X Y - | foo3 : foo X Y -> foo X Y. - Fill in the blanks to complete the induction principle that will be - generated by Coq. - foo_ind - : forall (X Y : Set) (P : foo X Y -> Prop), - (forall x : X, __________________________________) -> - (forall y : Y, __________________________________) -> - (________________________________________________) -> - ________________________________________________ - -*) -(** [] *) - -(** **** Exercise: 2 stars, optional (bar_ind_principle) *) -(** Consider the following induction principle: - bar_ind - : forall P : bar -> Prop, - (forall n : nat, P (bar1 n)) -> - (forall b : bar, P b -> P (bar2 b)) -> - (forall (b : bool) (b0 : bar), P b0 -> P (bar3 b b0)) -> - forall b : bar, P b - Write out the corresponding inductive set definition. - Inductive bar : Set := - | bar1 : ________________________________________ - | bar2 : ________________________________________ - | bar3 : ________________________________________. - -*) -(** [] *) - -(** **** Exercise: 2 stars, optional (no_longer_than_ind) *) -(** Given the following inductively defined proposition: - Inductive no_longer_than (X : Set) : (list X) -> nat -> Prop := - | nlt_nil : forall n, no_longer_than X [] n - | nlt_cons : forall x l n, no_longer_than X l n -> - no_longer_than X (x::l) (S n) - | nlt_succ : forall l n, no_longer_than X l n -> - no_longer_than X l (S n). - write the induction principle generated by Coq. - no_longer_than_ind - : forall (X : Set) (P : list X -> nat -> Prop), - (forall n : nat, ____________________) -> - (forall (x : X) (l : list X) (n : nat), - no_longer_than X l n -> ____________________ -> - _____________________________ -> - (forall (l : list X) (n : nat), - no_longer_than X l n -> ____________________ -> - _____________________________ -> - forall (l : list X) (n : nat), no_longer_than X l n -> - ____________________ - -*) -(** [] *) - - -(* ##################################################### *) -(** ** Induction Principles for other Logical Propositions *) - -(** Similarly, in [Logic] we have defined [eq] as: *) - -(* Inductive eq (X:Type) : X -> X -> Prop := - refl_equal : forall x, eq X x x. *) - -(** In the Coq standard library, the definition of equality is - slightly different: *) - -Inductive eq' (X:Type) (x:X) : X -> Prop := - refl_equal' : eq' X x x. - -(** The advantage of this definition is that the induction - principle that Coq derives for it is precisely the familiar - principle of _Leibniz equality_: what we mean when we say "[x] and - [y] are equal" is that every property on [P] that is true of [x] - is also true of [y]. *) - -Check eq'_ind. -(* ===> - forall (X : Type) (x : X) (P : X -> Prop), - P x -> forall y : X, x =' y -> P y - - ===> (i.e., after a little reorganization) - forall (X : Type) (x : X) forall y : X, - x =' y -> - forall P : X -> Prop, P x -> P y *) - - - -(** The induction principles for conjunction and disjunction are a - good illustration of Coq's way of generating simplified induction - principles for [Inductive]ly defined propositions, which we - discussed above. You try first: *) - -(** **** Exercise: 1 star, optional (and_ind_principle) *) -(** See if you can predict the induction principle for conjunction. *) - -(* Check and_ind. *) -(** [] *) - -(** **** Exercise: 1 star, optional (or_ind_principle) *) -(** See if you can predict the induction principle for disjunction. *) - -(* Check or_ind. *) -(** [] *) - -Check and_ind. - -(** From the inductive definition of the proposition [and P Q] - Inductive and (P Q : Prop) : Prop := - conj : P -> Q -> (and P Q). - we might expect Coq to generate this induction principle - and_ind_max : - forall (P Q : Prop) (P0 : P /\ Q -> Prop), - (forall (a : P) (b : Q), P0 (conj P Q a b)) -> - forall a : P /\ Q, P0 a - but actually it generates this simpler and more useful one: - and_ind : - forall P Q P0 : Prop, - (P -> Q -> P0) -> - P /\ Q -> P0 - In the same way, when given the inductive definition of [or P Q] - Inductive or (P Q : Prop) : Prop := - | or_introl : P -> or P Q - | or_intror : Q -> or P Q. - instead of the "maximal induction principle" - or_ind_max : - forall (P Q : Prop) (P0 : P \/ Q -> Prop), - (forall a : P, P0 (or_introl P Q a)) -> - (forall b : Q, P0 (or_intror P Q b)) -> - forall o : P \/ Q, P0 o - what Coq actually generates is this: - or_ind : - forall P Q P0 : Prop, - (P -> P0) -> - (Q -> P0) -> - P \/ Q -> P0 -]] -*) - -(** **** Exercise: 1 star, optional (False_ind_principle) *) -(** Can you predict the induction principle for falsehood? *) - -(* Check False_ind. *) -(** [] *) - -(** Here's the induction principle that Coq generates for existentials: *) - -Check ex_ind. -(* ===> forall (X:Type) (P: X->Prop) (Q: Prop), - (forall witness:X, P witness -> Q) -> - ex X P -> - Q *) - -(** This induction principle can be understood as follows: If we have - a function [f] that can construct evidence for [Q] given _any_ - witness of type [X] together with evidence that this witness has - property [P], then from a proof of [ex X P] we can extract the - witness and evidence that must have been supplied to the - constructor, give these to [f], and thus obtain a proof of [Q]. *) - - - -(* ######################################################### *) -(** ** Explicit Proof Objects for Induction *) - - -(** Although tactic-based proofs are normally much easier to - work with, the ability to write a proof term directly is sometimes - very handy, particularly when we want Coq to do something slightly - non-standard. *) - -(** Recall the induction principle on naturals that Coq generates for - us automatically from the Inductive declation for [nat]. *) - -Check nat_ind. -(* ===> - nat_ind : forall P : nat -> Prop, - P 0 -> - (forall n : nat, P n -> P (S n)) -> - forall n : nat, P n *) - -(** There's nothing magic about this induction lemma: it's just - another Coq lemma that requires a proof. Coq generates the proof - automatically too... *) - -Print nat_ind. -Print nat_rect. -(* ===> (after some manual inlining and tidying) - nat_ind = - fun (P : nat -> Prop) - (f : P 0) - (f0 : forall n : nat, P n -> P (S n)) => - fix F (n : nat) : P n := - match n with - | 0 => f - | S n0 => f0 n0 (F n0) - end. -*) - -(** We can read this as follows: - Suppose we have evidence [f] that [P] holds on 0, and - evidence [f0] that [forall n:nat, P n -> P (S n)]. - Then we can prove that [P] holds of an arbitrary nat [n] via - a recursive function [F] (here defined using the expression - form [Fix] rather than by a top-level [Fixpoint] - declaration). [F] pattern matches on [n]: - - If it finds 0, [F] uses [f] to show that [P n] holds. - - If it finds [S n0], [F] applies itself recursively on [n0] - to obtain evidence that [P n0] holds; then it applies [f0] - on that evidence to show that [P (S n)] holds. - [F] is just an ordinary recursive function that happens to - operate on evidence in [Prop] rather than on terms in [Set]. - -*) - - -(** We can adapt this approach to proving [nat_ind] to help prove - _non-standard_ induction principles too. Recall our desire to - prove that - - [forall n : nat, even n -> ev n]. - - Attempts to do this by standard induction on [n] fail, because the - induction principle only lets us proceed when we can prove that - [even n -> even (S n)] -- which is of course never provable. What - we did in [Logic] was a bit of a hack: - - [Theorem even__ev : forall n : nat, - (even n -> ev n) /\ (even (S n) -> ev (S n))]. - - We can make a much better proof by defining and proving a - non-standard induction principle that goes "by twos": - - *) - - Definition nat_ind2 : - forall (P : nat -> Prop), - P 0 -> - P 1 -> - (forall n : nat, P n -> P (S(S n))) -> - forall n : nat , P n := - fun P => fun P0 => fun P1 => fun PSS => - fix f (n:nat) := match n with - 0 => P0 - | 1 => P1 - | S (S n') => PSS n' (f n') - end. - - (** Once you get the hang of it, it is entirely straightforward to - give an explicit proof term for induction principles like this. - Proving this as a lemma using tactics is much less intuitive (try - it!). - - The [induction ... using] tactic variant gives a convenient way to - specify a non-standard induction principle like this. *) - -Lemma even__ev' : forall n, even n -> ev n. -Proof. - intros. - induction n as [ | |n'] using nat_ind2. - Case "even 0". - apply ev_0. - Case "even 1". - inversion H. - Case "even (S(S n'))". - apply ev_SS. - apply IHn'. unfold even. unfold even in H. simpl in H. apply H. -Qed. - -(* ######################################################### *) -(** ** The Coq Trusted Computing Base *) - -(** One issue that arises with any automated proof assistant is "why - trust it?": what if there is a bug in the implementation that - renders all its reasoning suspect? - - While it is impossible to allay such concerns completely, the fact - that Coq is based on the Curry-Howard correspondence gives it a - strong foundation. Because propositions are just types and proofs - are just terms, checking that an alleged proof of a proposition is - valid just amounts to _type-checking_ the term. Type checkers are - relatively small and straightforward programs, so the "trusted - computing base" for Coq -- the part of the code that we have to - believe is operating correctly -- is small too. - - What must a typechecker do? Its primary job is to make sure that - in each function application the expected and actual argument - types match, that the arms of a [match] expression are constructor - patterns belonging to the inductive type being matched over and - all arms of the [match] return the same type, and so on. - - There are a few additional wrinkles: - - - Since Coq types can themselves be expressions, the checker must - normalize these (by using the computation rules) before - comparing them. - - - The checker must make sure that [match] expressions are - _exhaustive_. That is, there must be an arm for every possible - constructor. To see why, consider the following alleged proof - object: - Definition or_bogus : forall P Q, P \/ Q -> P := - fun (P Q : Prop) (A : P \/ Q) => - match A with - | or_introl H => H - end. - All the types here match correctly, but the [match] only - considers one of the possible constructors for [or]. Coq's - exhaustiveness check will reject this definition. - - - The checker must make sure that each [fix] expression - terminates. It does this using a syntactic check to make sure - that each recursive call is on a subexpression of the original - argument. To see why this is essential, consider this alleged - proof: - Definition nat_false : forall (n:nat), False := - fix f (n:nat) : False := f n. - Again, this is perfectly well-typed, but (fortunately) Coq will - reject it. *) - -(** Note that the soundness of Coq depends only on the correctness of - this typechecking engine, not on the tactic machinery. If there - is a bug in a tactic implementation (and this certainly does - happen!), that tactic might construct an invalid proof term. But - when you type [Qed], Coq checks the term for validity from - scratch. Only lemmas whose proofs pass the type-checker can be - used in further proof developments. *) - -(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *) - - diff --git a/MoreLogic.html b/MoreLogic.html deleted file mode 100644 index c0c11f2..0000000 --- a/MoreLogic.html +++ /dev/null @@ -1,787 +0,0 @@ - - - - - -MoreLogic - - - - - - -
- - - -
- -

MoreLogic

- -
-
- -
-

More Logic

- -
-
- -
-Require Export "Prop".
- -
-
- -
-

Existential Quantification

- -
- - Another critical logical connective is existential - quantification. We can express it with the following - definition: -
-
- -
-Inductive ex (X:Type) (P : X→Prop) : Prop :=
-  ex_intro : ∀(witness:X), P witness → ex X P.
- -
-
- -
-That is, ex is a family of propositions indexed by a type X - and a property P over X. In order to give evidence for the - assertion "there exists an x for which the property P holds" - we must actually name a witness — a specific value x — and - then give evidence for P x, i.e., evidence that x has the - property P. - -
- - -
- -

- Coq's Notation facility can be used to introduce more - familiar notation for writing existentially quantified - propositions, exactly parallel to the built-in syntax for - universally quantified propositions. Instead of writing ex nat - ev to express the proposition that there exists some number that - is even, for example, we can write ∃ x:nat, ev x. (It is - not necessary to understand exactly how the Notation definition - works.) -
-
- -
-Notation "'exists' x , p" := (ex _ (fun x ⇒ p))
-  (at level 200, x ident, right associativity) : type_scope.
-Notation "'exists' x : X , p" := (ex _ (fun x:X ⇒ p))
-  (at level 200, x ident, right associativity) : type_scope.
- -
-
- -
-

- We can use the usual set of tactics for - manipulating existentials. For example, to prove an - existential, we can apply the constructor ex_intro. Since the - premise of ex_intro involves a variable (witness) that does - not appear in its conclusion, we need to explicitly give its value - when we use apply. -
-
- -
-Example exists_example_1 : ∃n, n + (n × n) = 6.
-Proof.
-  apply ex_intro with (witness:=2).
-  reflexivity. Qed.
- -
-
- -
-Note that we have to explicitly give the witness. -
- -

- Or, instead of writing apply ex_intro with (witness:=e) all the - time, we can use the convenient shorthand ∃ e, which means - the same thing. -
-
- -
-Example exists_example_1' : ∃n, n + (n × n) = 6.
-Proof.
-  ∃2.
-  reflexivity. Qed.
- -
-
- -
-

- Conversely, if we have an existential hypothesis in the - context, we can eliminate it with inversion. Note the use - of the as... pattern to name the variable that Coq - introduces to name the witness value and get evidence that - the hypothesis holds for the witness. (If we don't - explicitly choose one, Coq will just call it witness, which - makes proofs confusing.) -
-
- -
-Theorem exists_example_2 : ∀n,
-  (∃m, n = 4 + m) →
-  (∃o, n = 2 + o).
-Proof.
-  intros n H.
-  inversion H as [m Hm].
-  ∃(2 + m).
-  apply Hm. Qed.
- -
-
- -
-Here is another example of how to work with existentials. -
-
-Lemma exists_example_3 :
-  ∃(n:nat), even n ∧ beautiful n.
-Proof.
-(* WORKED IN CLASS *)
-  ∃8.
-  split.
-  unfold even. simpl. reflexivity.
-  apply b_sum with (n:=3) (m:=5).
-  apply b_3. apply b_5.
-Qed.
- -
-
- -
-

Exercise: 1 star, optional (english_exists)

- In English, what does the proposition - -
- -
-      ex nat (fun n ⇒ beautiful (S n)) -
- -
- mean? -
-
- -
-(* FILL IN HERE *)
- -
-(*
-*)
-
- -
-

Exercise: 1 star (dist_not_exists)

- Prove that "P holds for all x" implies "there is no x for - which P does not hold." -
-
- -
-Theorem dist_not_exists : ∀(X:Type) (P : X → Prop),
-  (∀x, P x) → ¬ (∃x, ¬ P x).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (not_exists_dist)

- (The other direction of this theorem requires the classical "law - of the excluded middle".) -
-
- -
-Theorem not_exists_dist :
-  excluded_middle →
-  ∀(X:Type) (P : X → Prop),
-    ¬ (∃x, ¬ P x) → (∀x, P x).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (dist_exists_or)

- Prove that existential quantification distributes over - disjunction. -
-
- -
-Theorem dist_exists_or : ∀(X:Type) (P Q : X → Prop),
-  (∃x, P x ∨ Q x) ↔ (∃x, P x) ∨ (∃x, Q x).
-Proof.
-   (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Evidence-carrying booleans.

- -
- - So far we've seen two different forms of equality predicates: -eq, which produces a Prop, and -the type-specific forms, like beq_nat, that produce boolean -values. The former are more convenient to reason about, but -we've relied on the latter to let us use equality tests -in computations. While it is straightforward to write lemmas -(e.g. beq_nat_true and beq_nat_false) that connect the two forms, -using these lemmas quickly gets tedious. - -
- -

- -
- -It turns out that we can get the benefits of both forms at once -by using a construct called sumbool. -
-
- -
-Inductive sumbool (A B : Prop) : Set :=
- | left : A → sumbool A B
- | right : B → sumbool A B.
- -
-Notation "{ A } + { B }" := (sumbool A B) : type_scope.
- -
-
- -
-Think of sumbool as being like the boolean type, but instead -of its values being just true and false, they carry evidence -of truth or falsity. This means that when we destruct them, we -are left with the relevant evidence as a hypothesis — just as with or. -(In fact, the definition of sumbool is almost the same as for or. -The only difference is that values of sumbool are declared to be in -Set rather than in Prop; this is a technical distinction -that allows us to compute with them.) -
- -

- -
- - Here's how we can define a sumbool for equality on nats -
-
- -
-Theorem eq_nat_dec : ∀n m : nat, {n = m} + {n ≠ m}.
-Proof.
-  (* WORKED IN CLASS *)
-  intros n.
-  induction n as [|n'].
-  Case "n = 0".
-    intros m.
-    destruct m as [|m'].
-    SCase "m = 0".
-      left. reflexivity.
-    SCase "m = S m'".
-      right. intros contra. inversion contra.
-  Case "n = S n'".
-    intros m.
-    destruct m as [|m'].
-    SCase "m = 0".
-      right. intros contra. inversion contra.
-    SCase "m = S m'".
-      destruct IHn' with (m := m') as [eq | neq].
-      left. apply f_equal. apply eq.
-      right. intros Heq. inversion Heq as [Heq']. apply neq. apply Heq'.
-Defined.
- -
-
- -
-Read as a theorem, this says that equality on nats is decidable: -that is, given two nat values, we can always produce either -evidence that they are equal or evidence that they are not. -Read computationally, eq_nat_dec takes two nat values and returns -a sumbool constructed with left if they are equal and right -if they are not; this result can be tested with a match or, better, -with an if-then-else, just like a regular boolean. -(Notice that we ended this proof with Defined rather than Qed. -The only difference this makes is that the proof becomes transparent, -meaning that its definition is available when Coq tries to do reductions, -which is important for the computational interpretation.) - -
- -

- -
- -Here's a simple example illustrating the advantages of the sumbool form. -
-
- -
-Definition override' {X: Type} (f: nat→X) (k:nat) (x:X) : nat→X:=
-  fun (k':nat) ⇒ if eq_nat_dec k k' then x else f k'.
- -
-Theorem override_same' : ∀(X:Type) x1 k1 k2 (f : nat→X),
-  f k1 = x1 →
-  (override' f k1 x1) k2 = f k2.
-Proof.
-  intros X x1 k1 k2 f. intros Hx1.
-  unfold override'.
-  destruct (eq_nat_dec k1 k2). (* observe what appears as a hypothesis *)
-  Case "k1 = k2".
-    rewrite ← e.
-    symmetry. apply Hx1.
-  Case "k1 ≠ k2".
-    reflexivity. Qed.
- -
-
- -
-Compare this to the more laborious proof (in MoreCoq.v) for the - version of override defined using beq_nat, where we had to - use the auxiliary lemma beq_nat_true to convert a fact about booleans - to a Prop. -
- -

Exercise: 1 star (override_shadow')

- -
-
-Theorem override_shadow' : ∀(X:Type) x1 x2 k1 k2 (f : nat→X),
-  (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 3 stars (all_forallb)

- Inductively define a property all of lists, parameterized by a - type X and a property P : X → Prop, such that all X P l - asserts that P is true for every element of the list l. -
-
- -
-Inductive all (X : Type) (P : X → Prop) : list X → Prop :=
-  (* FILL IN HERE *)
-.
- -
-
- -
-Recall the function forallb, from the exercise - forall_exists_challenge in chapter Poly: -
-
- -
-Fixpoint forallb {X : Type} (test : X → bool) (l : list X) : bool :=
-  match l with
-    | [] ⇒ true
-    | x :: l' ⇒ andb (test x) (forallb test l')
-  end.
- -
-
- -
-Using the property all, write down a specification for forallb, - and prove that it satisfies the specification. Try to make your - specification as precise as possible. - -
- - Are there any important properties of the function forallb which - are not captured by your specification? -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (filter_challenge)

- One of the main purposes of Coq is to prove that programs match - their specifications. To this end, let's prove that our - definition of filter matches a specification. Here is the - specification, written out informally in English. - -
- - Suppose we have a set X, a function test: X→bool, and a list - l of type list X. Suppose further that l is an "in-order - merge" of two lists, l1 and l2, such that every item in l1 - satisfies test and no item in l2 satisfies test. Then filter - test l = l1. - -
- - A list l is an "in-order merge" of l1 and l2 if it contains - all the same elements as l1 and l2, in the same order as l1 - and l2, but possibly interleaved. For example, - -
- -
-    [1,4,6,2,3] -
- -
- is an in-order merge of - -
- -
-    [1,6,2] -
- -
- and - -
- -
-    [4,3]. -
- -
- Your job is to translate this specification into a Coq theorem and - prove it. (Hint: You'll need to begin by defining what it means - for one list to be a merge of two others. Do this with an - inductive relation, not a Fixpoint.) -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 5 stars, advanced, optional (filter_challenge_2)

- A different way to formally characterize the behavior of filter - goes like this: Among all subsequences of l with the property - that test evaluates to true on all their members, filter test - l is the longest. Express this claim formally and prove it. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (no_repeats)

- The following inductively defined proposition... -
-
- -
-Inductive appears_in {X:Type} (a:X) : list X → Prop :=
-  | ai_here : ∀l, appears_in a (a::l)
-  | ai_later : ∀b l, appears_in a l → appears_in a (b::l).
- -
-
- -
-...gives us a precise way of saying that a value a appears at - least once as a member of a list l. - -
- - Here's a pair of warm-ups about appears_in. - -
-
- -
-Lemma appears_in_app : ∀(X:Type) (xs ys : list X) (x:X),
-     appears_in x (xs ++ ys) → appears_in x xs ∨ appears_in x ys.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Lemma app_appears_in : ∀(X:Type) (xs ys : list X) (x:X),
-     appears_in x xs ∨ appears_in x ys → appears_in x (xs ++ ys).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Now use appears_in to define a proposition disjoint X l1 l2, - which should be provable exactly when l1 and l2 are - lists (with elements of type X) that have no elements in common. -
-
- -
-(* FILL IN HERE *)
- -
-
- -
-Next, use appears_in to define an inductive proposition - no_repeats X l, which should be provable exactly when l is a - list (with elements of type X) where every member is different - from every other. For example, no_repeats nat [1,2,3,4] and - no_repeats bool [] should be provable, while no_repeats nat - [1,2,1] and no_repeats bool [true,true] should not be. -
-
- -
-(* FILL IN HERE *)
- -
-
- -
-Finally, state and prove one or more interesting theorems relating - disjoint, no_repeats and ++ (list append). -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars (nostutter)

- Formulating inductive definitions of predicates is an important - skill you'll need in this course. Try to solve this exercise - without any help at all (except from your study group partner, if - you have one). - -
- - We say that a list of numbers "stutters" if it repeats the same - number consecutively. The predicate "nostutter mylist" means - that mylist does not stutter. Formulate an inductive definition - for nostutter. (This is different from the no_repeats - predicate in the exercise above; the sequence 1,4,1 repeats but - does not stutter.) -
-
- -
-Inductive nostutter: list nat → Prop :=
- (* FILL IN HERE *)
-.
- -
-
- -
-Make sure each of these tests succeeds, but you are free - to change the proof if the given one doesn't work for you. - Your definition might be different from mine and still correct, - in which case the examples might need a different proof. - -
- - The suggested proofs for the examples (in comments) use a number - of tactics we haven't talked about, to try to make them robust - with respect to different possible ways of defining nostutter. - You should be able to just uncomment and use them as-is, but if - you prefer you can also prove each example with more basic - tactics. -
-
- -
-Example test_nostutter_1: nostutter [3;1;4;1;5;6].
-(* FILL IN HERE *) Admitted.
-(* 
-  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
-*)
- -
-Example test_nostutter_2: nostutter [].
-(* FILL IN HERE *) Admitted.
-(* 
-  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
-*)
- -
-Example test_nostutter_3: nostutter [5].
-(* FILL IN HERE *) Admitted.
-(* 
-  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
-*)
- -
-Example test_nostutter_4: not (nostutter [3;1;1;4]).
-(* FILL IN HERE *) Admitted.
-(* 
-  Proof. intro.
-  repeat match goal with 
-    h: nostutter _ |- _ => inversion h; clear h; subst 
-  end.
-  contradiction H1; auto. Qed.
-*)
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (pigeonhole principle)

- The "pigeonhole principle" states a basic fact about counting: - if you distribute more than n items into n pigeonholes, some - pigeonhole must contain at least two items. As is often the case, - this apparently trivial fact about numbers requires non-trivial - machinery to prove, but we now have enough... -
- - First a pair of useful lemmas (we already proved these for lists - of naturals, but not for arbitrary lists). -
-
- -
-Lemma app_length : ∀(X:Type) (l1 l2 : list X),
-  length (l1 ++ l2) = length l1 + length l2.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Lemma appears_in_app_split : ∀(X:Type) (x:X) (l:list X),
-  appears_in x l →
-  ∃l1, ∃l2, l = l1 ++ (x::l2).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-Now define a predicate repeats (analogous to no_repeats in the - exercise above), such that repeats X l asserts that l contains - at least one repeated element (of type X). -
-
- -
-Inductive repeats {X:Type} : list X → Prop :=
-  (* FILL IN HERE *)
-.
- -
-
- -
-Now here's a way to formalize the pigeonhole principle. List l2 - represents a list of pigeonhole labels, and list l1 represents - the labels assigned to a list of items: if there are more items - than labels, at least two items must have the same label. This - proof is much easier if you use the excluded_middle hypothesis - to show that appears_in is decidable, i.e. ∀ x - l, (appears_in x l) ∨ ¬ (appears_in x l). However, it is also - possible to make the proof go through without assuming that - appears_in is decidable; if you can manage to do this, you will - not need the excluded_middle hypothesis. -
-
- -
-Theorem pigeonhole_principle: ∀(X:Type) (l1 l2:list X),
-   excluded_middle →
-   (∀x, appears_in x l1 → appears_in x l2) →
-   length l2 < length l1 →
-   repeats l1.
-Proof.
-   intros X l1. induction l1 as [|x l1'].
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-(* FILL IN HERE *)
- -
-(* $Date: 2014-02-22 09:43:41 -0500 (Sat, 22 Feb 2014) $ *)
-
-
- - - -
- - - \ No newline at end of file diff --git a/MoreLogic.v b/MoreLogic.v deleted file mode 100644 index 5196f7a..0000000 --- a/MoreLogic.v +++ /dev/null @@ -1,473 +0,0 @@ -(** * More Logic *) - -Require Export "Prop". - -(* ############################################################ *) -(** * Existential Quantification *) - -(** Another critical logical connective is _existential - quantification_. We can express it with the following - definition: *) - -Inductive ex (X:Type) (P : X->Prop) : Prop := - ex_intro : forall (witness:X), P witness -> ex X P. - -(** That is, [ex] is a family of propositions indexed by a type [X] - and a property [P] over [X]. In order to give evidence for the - assertion "there exists an [x] for which the property [P] holds" - we must actually name a _witness_ -- a specific value [x] -- and - then give evidence for [P x], i.e., evidence that [x] has the - property [P]. - -*) - - -(** *** *) -(** Coq's [Notation] facility can be used to introduce more - familiar notation for writing existentially quantified - propositions, exactly parallel to the built-in syntax for - universally quantified propositions. Instead of writing [ex nat - ev] to express the proposition that there exists some number that - is even, for example, we can write [exists x:nat, ev x]. (It is - not necessary to understand exactly how the [Notation] definition - works.) *) - -Notation "'exists' x , p" := (ex _ (fun x => p)) - (at level 200, x ident, right associativity) : type_scope. -Notation "'exists' x : X , p" := (ex _ (fun x:X => p)) - (at level 200, x ident, right associativity) : type_scope. - -(** *** *) -(** We can use the usual set of tactics for - manipulating existentials. For example, to prove an - existential, we can [apply] the constructor [ex_intro]. Since the - premise of [ex_intro] involves a variable ([witness]) that does - not appear in its conclusion, we need to explicitly give its value - when we use [apply]. *) - -Example exists_example_1 : exists n, n + (n * n) = 6. -Proof. - apply ex_intro with (witness:=2). - reflexivity. Qed. - -(** Note that we have to explicitly give the witness. *) - -(** *** *) -(** Or, instead of writing [apply ex_intro with (witness:=e)] all the - time, we can use the convenient shorthand [exists e], which means - the same thing. *) - -Example exists_example_1' : exists n, n + (n * n) = 6. -Proof. - exists 2. - reflexivity. Qed. - -(** *** *) -(** Conversely, if we have an existential hypothesis in the - context, we can eliminate it with [inversion]. Note the use - of the [as...] pattern to name the variable that Coq - introduces to name the witness value and get evidence that - the hypothesis holds for the witness. (If we don't - explicitly choose one, Coq will just call it [witness], which - makes proofs confusing.) *) - -Theorem exists_example_2 : forall n, - (exists m, n = 4 + m) -> - (exists o, n = 2 + o). -Proof. - intros n H. - inversion H as [m Hm]. - exists (2 + m). - apply Hm. Qed. - - -(** Here is another example of how to work with existentials. *) -Lemma exists_example_3 : - exists (n:nat), even n /\ beautiful n. -Proof. -(* WORKED IN CLASS *) - exists 8. - split. - unfold even. simpl. reflexivity. - apply b_sum with (n:=3) (m:=5). - apply b_3. apply b_5. -Qed. - -(** **** Exercise: 1 star, optional (english_exists) *) -(** In English, what does the proposition - ex nat (fun n => beautiful (S n)) -]] - mean? *) - -(* FILL IN HERE *) - -(* -*) -(** **** Exercise: 1 star (dist_not_exists) *) -(** Prove that "[P] holds for all [x]" implies "there is no [x] for - which [P] does not hold." *) - -Theorem dist_not_exists : forall (X:Type) (P : X -> Prop), - (forall x, P x) -> ~ (exists x, ~ P x). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (not_exists_dist) *) -(** (The other direction of this theorem requires the classical "law - of the excluded middle".) *) - -Theorem not_exists_dist : - excluded_middle -> - forall (X:Type) (P : X -> Prop), - ~ (exists x, ~ P x) -> (forall x, P x). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (dist_exists_or) *) -(** Prove that existential quantification distributes over - disjunction. *) - -Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop), - (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** * Evidence-carrying booleans. *) - -(** So far we've seen two different forms of equality predicates: -[eq], which produces a [Prop], and -the type-specific forms, like [beq_nat], that produce [boolean] -values. The former are more convenient to reason about, but -we've relied on the latter to let us use equality tests -in _computations_. While it is straightforward to write lemmas -(e.g. [beq_nat_true] and [beq_nat_false]) that connect the two forms, -using these lemmas quickly gets tedious. -*) - -(** *** *) -(** -It turns out that we can get the benefits of both forms at once -by using a construct called [sumbool]. *) - -Inductive sumbool (A B : Prop) : Set := - | left : A -> sumbool A B - | right : B -> sumbool A B. - -Notation "{ A } + { B }" := (sumbool A B) : type_scope. - -(** Think of [sumbool] as being like the [boolean] type, but instead -of its values being just [true] and [false], they carry _evidence_ -of truth or falsity. This means that when we [destruct] them, we -are left with the relevant evidence as a hypothesis -- just as with [or]. -(In fact, the definition of [sumbool] is almost the same as for [or]. -The only difference is that values of [sumbool] are declared to be in -[Set] rather than in [Prop]; this is a technical distinction -that allows us to compute with them.) *) - -(** *** *) - -(** Here's how we can define a [sumbool] for equality on [nat]s *) - -Theorem eq_nat_dec : forall n m : nat, {n = m} + {n <> m}. -Proof. - (* WORKED IN CLASS *) - intros n. - induction n as [|n']. - Case "n = 0". - intros m. - destruct m as [|m']. - SCase "m = 0". - left. reflexivity. - SCase "m = S m'". - right. intros contra. inversion contra. - Case "n = S n'". - intros m. - destruct m as [|m']. - SCase "m = 0". - right. intros contra. inversion contra. - SCase "m = S m'". - destruct IHn' with (m := m') as [eq | neq]. - left. apply f_equal. apply eq. - right. intros Heq. inversion Heq as [Heq']. apply neq. apply Heq'. -Defined. - -(** Read as a theorem, this says that equality on [nat]s is decidable: -that is, given two [nat] values, we can always produce either -evidence that they are equal or evidence that they are not. -Read computationally, [eq_nat_dec] takes two [nat] values and returns -a [sumbool] constructed with [left] if they are equal and [right] -if they are not; this result can be tested with a [match] or, better, -with an [if-then-else], just like a regular [boolean]. -(Notice that we ended this proof with [Defined] rather than [Qed]. -The only difference this makes is that the proof becomes _transparent_, -meaning that its definition is available when Coq tries to do reductions, -which is important for the computational interpretation.) -*) - -(** *** *) -(** -Here's a simple example illustrating the advantages of the [sumbool] form. *) - -Definition override' {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:= - fun (k':nat) => if eq_nat_dec k k' then x else f k'. - -Theorem override_same' : forall (X:Type) x1 k1 k2 (f : nat->X), - f k1 = x1 -> - (override' f k1 x1) k2 = f k2. -Proof. - intros X x1 k1 k2 f. intros Hx1. - unfold override'. - destruct (eq_nat_dec k1 k2). (* observe what appears as a hypothesis *) - Case "k1 = k2". - rewrite <- e. - symmetry. apply Hx1. - Case "k1 <> k2". - reflexivity. Qed. - -(** Compare this to the more laborious proof (in MoreCoq.v) for the - version of [override] defined using [beq_nat], where we had to - use the auxiliary lemma [beq_nat_true] to convert a fact about booleans - to a Prop. *) - - -(** **** Exercise: 1 star (override_shadow') *) -Theorem override_shadow' : forall (X:Type) x1 x2 k1 k2 (f : nat->X), - (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - - - - -(* ####################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 3 stars (all_forallb) *) -(** Inductively define a property [all] of lists, parameterized by a - type [X] and a property [P : X -> Prop], such that [all X P l] - asserts that [P] is true for every element of the list [l]. *) - -Inductive all (X : Type) (P : X -> Prop) : list X -> Prop := - (* FILL IN HERE *) -. - -(** Recall the function [forallb], from the exercise - [forall_exists_challenge] in chapter [Poly]: *) - -Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool := - match l with - | [] => true - | x :: l' => andb (test x) (forallb test l') - end. - -(** Using the property [all], write down a specification for [forallb], - and prove that it satisfies the specification. Try to make your - specification as precise as possible. - - Are there any important properties of the function [forallb] which - are not captured by your specification? *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 4 stars, advanced (filter_challenge) *) -(** One of the main purposes of Coq is to prove that programs match - their specifications. To this end, let's prove that our - definition of [filter] matches a specification. Here is the - specification, written out informally in English. - - Suppose we have a set [X], a function [test: X->bool], and a list - [l] of type [list X]. Suppose further that [l] is an "in-order - merge" of two lists, [l1] and [l2], such that every item in [l1] - satisfies [test] and no item in [l2] satisfies test. Then [filter - test l = l1]. - - A list [l] is an "in-order merge" of [l1] and [l2] if it contains - all the same elements as [l1] and [l2], in the same order as [l1] - and [l2], but possibly interleaved. For example, - [1,4,6,2,3] - is an in-order merge of - [1,6,2] - and - [4,3]. - Your job is to translate this specification into a Coq theorem and - prove it. (Hint: You'll need to begin by defining what it means - for one list to be a merge of two others. Do this with an - inductive relation, not a [Fixpoint].) *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 5 stars, advanced, optional (filter_challenge_2) *) -(** A different way to formally characterize the behavior of [filter] - goes like this: Among all subsequences of [l] with the property - that [test] evaluates to [true] on all their members, [filter test - l] is the longest. Express this claim formally and prove it. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 4 stars, advanced (no_repeats) *) -(** The following inductively defined proposition... *) - -Inductive appears_in {X:Type} (a:X) : list X -> Prop := - | ai_here : forall l, appears_in a (a::l) - | ai_later : forall b l, appears_in a l -> appears_in a (b::l). - -(** ...gives us a precise way of saying that a value [a] appears at - least once as a member of a list [l]. - - Here's a pair of warm-ups about [appears_in]. -*) - -Lemma appears_in_app : forall (X:Type) (xs ys : list X) (x:X), - appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys. -Proof. - (* FILL IN HERE *) Admitted. - -Lemma app_appears_in : forall (X:Type) (xs ys : list X) (x:X), - appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys). -Proof. - (* FILL IN HERE *) Admitted. - -(** Now use [appears_in] to define a proposition [disjoint X l1 l2], - which should be provable exactly when [l1] and [l2] are - lists (with elements of type X) that have no elements in common. *) - -(* FILL IN HERE *) - -(** Next, use [appears_in] to define an inductive proposition - [no_repeats X l], which should be provable exactly when [l] is a - list (with elements of type [X]) where every member is different - from every other. For example, [no_repeats nat [1,2,3,4]] and - [no_repeats bool []] should be provable, while [no_repeats nat - [1,2,1]] and [no_repeats bool [true,true]] should not be. *) - -(* FILL IN HERE *) - -(** Finally, state and prove one or more interesting theorems relating - [disjoint], [no_repeats] and [++] (list append). *) - -(* FILL IN HERE *) -(** [] *) - - -(** **** Exercise: 3 stars (nostutter) *) -(** Formulating inductive definitions of predicates is an important - skill you'll need in this course. Try to solve this exercise - without any help at all (except from your study group partner, if - you have one). - - We say that a list of numbers "stutters" if it repeats the same - number consecutively. The predicate "[nostutter mylist]" means - that [mylist] does not stutter. Formulate an inductive definition - for [nostutter]. (This is different from the [no_repeats] - predicate in the exercise above; the sequence [1,4,1] repeats but - does not stutter.) *) - -Inductive nostutter: list nat -> Prop := - (* FILL IN HERE *) -. - -(** Make sure each of these tests succeeds, but you are free - to change the proof if the given one doesn't work for you. - Your definition might be different from mine and still correct, - in which case the examples might need a different proof. - - The suggested proofs for the examples (in comments) use a number - of tactics we haven't talked about, to try to make them robust - with respect to different possible ways of defining [nostutter]. - You should be able to just uncomment and use them as-is, but if - you prefer you can also prove each example with more basic - tactics. *) - -Example test_nostutter_1: nostutter [3;1;4;1;5;6]. -(* FILL IN HERE *) Admitted. -(* - Proof. repeat constructor; apply beq_nat_false; auto. Qed. -*) - -Example test_nostutter_2: nostutter []. -(* FILL IN HERE *) Admitted. -(* - Proof. repeat constructor; apply beq_nat_false; auto. Qed. -*) - -Example test_nostutter_3: nostutter [5]. -(* FILL IN HERE *) Admitted. -(* - Proof. repeat constructor; apply beq_nat_false; auto. Qed. -*) - -Example test_nostutter_4: not (nostutter [3;1;1;4]). -(* FILL IN HERE *) Admitted. -(* - Proof. intro. - repeat match goal with - h: nostutter _ |- _ => inversion h; clear h; subst - end. - contradiction H1; auto. Qed. -*) -(** [] *) - -(** **** Exercise: 4 stars, advanced (pigeonhole principle) *) -(** The "pigeonhole principle" states a basic fact about counting: - if you distribute more than [n] items into [n] pigeonholes, some - pigeonhole must contain at least two items. As is often the case, - this apparently trivial fact about numbers requires non-trivial - machinery to prove, but we now have enough... *) - -(** First a pair of useful lemmas (we already proved these for lists - of naturals, but not for arbitrary lists). *) - -Lemma app_length : forall (X:Type) (l1 l2 : list X), - length (l1 ++ l2) = length l1 + length l2. -Proof. - (* FILL IN HERE *) Admitted. - -Lemma appears_in_app_split : forall (X:Type) (x:X) (l:list X), - appears_in x l -> - exists l1, exists l2, l = l1 ++ (x::l2). -Proof. - (* FILL IN HERE *) Admitted. - -(** Now define a predicate [repeats] (analogous to [no_repeats] in the - exercise above), such that [repeats X l] asserts that [l] contains - at least one repeated element (of type [X]). *) - -Inductive repeats {X:Type} : list X -> Prop := - (* FILL IN HERE *) -. - -(** Now here's a way to formalize the pigeonhole principle. List [l2] - represents a list of pigeonhole labels, and list [l1] represents - the labels assigned to a list of items: if there are more items - than labels, at least two items must have the same label. This - proof is much easier if you use the [excluded_middle] hypothesis - to show that [appears_in] is decidable, i.e. [forall x - l, (appears_in x l) \/ ~ (appears_in x l)]. However, it is also - possible to make the proof go through _without_ assuming that - [appears_in] is decidable; if you can manage to do this, you will - not need the [excluded_middle] hypothesis. *) - -Theorem pigeonhole_principle: forall (X:Type) (l1 l2:list X), - excluded_middle -> - (forall x, appears_in x l1 -> appears_in x l2) -> - length l2 < length l1 -> - repeats l1. -Proof. - intros X l1. induction l1 as [|x l1']. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* FILL IN HERE *) - - -(* $Date: 2014-02-22 09:43:41 -0500 (Sat, 22 Feb 2014) $ *) diff --git a/MoreStlc.html b/MoreStlc.html deleted file mode 100644 index a7350de..0000000 --- a/MoreStlc.html +++ /dev/null @@ -1,3084 +0,0 @@ - - - - - -MoreStlc: More on the Simply Typed Lambda-Calculus - - - - - - -
- - - -
- -

MoreStlcMore on the Simply Typed Lambda-Calculus

- -
-
- -
- -
-
- -
-Require Export Stlc.
- -
-
- -
-

Simple Extensions to STLC

- -
- - The simply typed lambda-calculus has enough structure to make its - theoretical properties interesting, but it is not much of a - programming language. In this chapter, we begin to close the gap - with real-world languages by introducing a number of familiar - features that have straightforward treatments at the level of - typing. -
- -

Numbers

- -
- - Adding types, constants, and primitive operations for numbers is - easy — just a matter of combining the Types and Stlc - chapters. -
- -

let-bindings

- -
- - When writing a complex expression, it is often useful to give - names to some of its subexpressions: this avoids repetition and - often increases readability. Most languages provide one or more - ways of doing this. In OCaml (and Coq), for example, we can write - let x=t1 in t2 to mean ``evaluate the expression t1 and bind - the name x to the resulting value while evaluating t2.'' - -
- - Our let-binder follows OCaml's in choosing a call-by-value - evaluation order, where the let-bound term must be fully - evaluated before evaluation of the let-body can begin. The - typing rule T_Let tells us that the type of a let can be - calculated by calculating the type of the let-bound term, - extending the context with a binding with this type, and in this - enriched context calculating the type of the body, which is then - the type of the whole let expression. - -
- - At this point in the course, it's probably easier simply to look - at the rules defining this new feature as to wade through a lot of - english text conveying the same information. Here they are: -
- - Syntax: -
-       t ::=                Terms
-           | ...               (other terms same as before)
-           | let x=t in t      let-binding
-
- -
- - -
- - Reduction: -
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Let1)   -
let x=t1 in t2 ⇒ let x=t1' in t2
- - - - - - - - - - -
   - (ST_LetValue)   -
let x=v1 in t2 ⇒ [x:=v1]t2
Typing: -
- - - - - - - - - - -
Γ ⊢ t1 : T1      Γ , x:T1 ⊢ t2 : T2 - (T_Let)   -
Γ ⊢ let x=t1 in t2 : T2
-
- -

Pairs

- -
- - Our functional programming examples in Coq have made - frequent use of pairs of values. The type of such pairs is - called a product type. - -
- - The formalization of pairs is almost too simple to be worth - discussing. However, let's look briefly at the various parts of - the definition to emphasize the common pattern. -
- - In Coq, the primitive way of extracting the components of a pair - is pattern matching. An alternative style is to take fst and - snd — the first- and second-projection operators — as - primitives. Just for fun, let's do our products this way. For - example, here's how we'd write a function that takes a pair of - numbers and returns the pair of their sum and difference: -
-       λx:Nat*Nat. 
-          let sum = x.fst + x.snd in
-          let diff = x.fst - x.snd in
-          (sum,diff)
-
- -
- - Adding pairs to the simply typed lambda-calculus, then, involves - adding two new forms of term — pairing, written (t1,t2), and - projection, written t.fst for the first projection from t and - t.snd for the second projection — plus one new type constructor, - T1×T2, called the product of T1 and T2. -
- - Syntax: -
-       t ::=                Terms
-           | ...               
-           | (t,t)             pair
-           | t.fst             first projection
-           | t.snd             second projection
-
-       v ::=                Values
-           | ...
-           | (v,v)             pair value
-
-       T ::=                Types
-           | ...
-           | T * T             product type
-
- -
- - For evaluation, we need several new rules specifying how pairs and - projection behave. -
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Pair1)   -
(t1,t2) ⇒ (t1',t2)
- - - - - - - - - - -
t2 ⇒ t2' - (ST_Pair2)   -
(v1,t2) ⇒ (v1,t2')
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Fst1)   -
t1.fst ⇒ t1'.fst
- - - - - - - - - - -
   - (ST_FstPair)   -
(v1,v2).fst ⇒ v1
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Snd1)   -
t1.snd ⇒ t1'.snd
- - - - - - - - - - -
   - (ST_SndPair)   -
(v1,v2).snd ⇒ v2
-
- - -
- - Rules ST_FstPair and ST_SndPair specify that, when a fully - evaluated pair meets a first or second projection, the result is - the appropriate component. The congruence rules ST_Fst1 and - ST_Snd1 allow reduction to proceed under projections, when the - term being projected from has not yet been fully evaluated. - ST_Pair1 and ST_Pair2 evaluate the parts of pairs: first the - left part, and then — when a value appears on the left — the right - part. The ordering arising from the use of the metavariables v - and t in these rules enforces a left-to-right evaluation - strategy for pairs. (Note the implicit convention that - metavariables like v and v1 can only denote values.) We've - also added a clause to the definition of values, above, specifying - that (v1,v2) is a value. The fact that the components of a pair - value must themselves be values ensures that a pair passed as an - argument to a function will be fully evaluated before the function - body starts executing. -
- - The typing rules for pairs and projections are straightforward. -
- - - - - - - - - - -
Γ ⊢ t1 : T1       Γ ⊢ t2 : T2 - (T_Pair)   -
Γ ⊢ (t1,t2) : T1*T2
- - - - - - - - - - -
Γ ⊢ t1 : T11*T12 - (T_Fst)   -
Γ ⊢ t1.fst : T11
- - - - - - - - - - -
Γ ⊢ t1 : T11*T12 - (T_Snd)   -
Γ ⊢ t1.snd : T12
-
- - The rule T_Pair says that (t1,t2) has type T1×T2 if t1 has - type T1 and t2 has type T2. Conversely, the rules T_Fst - and T_Snd tell us that, if t1 has a product type - T11×T12 (i.e., if it will evaluate to a pair), then the types of - the projections from this pair are T11 and T12. -
- -

Unit

- -
- - Another handy base type, found especially in languages in - the ML family, is the singleton type Unit. It has a single element — the term constant unit (with a small - u) — and a typing rule making unit an element of Unit. We - also add unit to the set of possible result values of - computations — indeed, unit is the only possible result of - evaluating an expression of type Unit. -
- - Syntax: -
-       t ::=                Terms
-           | ...               
-           | unit              unit value
-
-       v ::=                Values
-           | ...     
-           | unit              unit
-
-       T ::=                Types
-           | ...
-           | Unit              Unit type
-
- Typing: -
- - - - - - - - - - -
   - (T_Unit)   -
Γ ⊢ unit : Unit
-
- - It may seem a little strange to bother defining a type that - has just one element — after all, wouldn't every computation - living in such a type be trivial? - -
- - This is a fair question, and indeed in the STLC the Unit type is - not especially critical (though we'll see two uses for it below). - Where Unit really comes in handy is in richer languages with - various sorts of side effects — e.g., assignment statements - that mutate variables or pointers, exceptions and other sorts of - nonlocal control structures, etc. In such languages, it is - convenient to have a type for the (trivial) result of an - expression that is evaluated only for its effect. -
- -

Sums

- -
- - Many programs need to deal with values that can take two distinct - forms. For example, we might identify employees in an accounting - application using using either their name or their id number. - A search function might return either a matching value or an - error code. - -
- - These are specific examples of a binary sum type, - which describes a set of values drawn from exactly two given types, e.g. -
-       Nat + Bool
-
- -
- - We create elements of these types by tagging elements of - the component types. For example, if n is a Nat then inl v - is an element of Nat+Bool; similarly, if b is a Bool then - inr b is a Nat+Bool. The names of the tags inl and inr - arise from thinking of them as functions - -
- -
-   inl : Nat -> Nat + Bool
-   inr : Bool -> Nat + Bool
-
- -
- - that "inject" elements of Nat or Bool into the left and right - components of the sum type Nat+Bool. (But note that we don't - actually treat them as functions in the way we formalize them: - inl and inr are keywords, and inl t and inr t are primitive - syntactic forms, not function applications. This allows us to give - them their own special typing rules.) -
- - In general, the elements of a type T1 + T2 consist of the - elements of T1 tagged with the token inl, plus the elements of - T2 tagged with inr. -
- - One important usage of sums is signaling errors: -
-    div : Nat -> Nat -> (Nat + Unit) =
-    div =
-      λx:Nat. λy:Nat.
-        if iszero y then
-          inr unit
-        else
-          inl ...
-
- The type Nat + Unit above is in fact isomorphic to option nat - in Coq, and we've already seen how to signal errors with options. -
- - To use elements of sum types, we introduce a case - construct (a very simplified form of Coq's match) to destruct - them. For example, the following procedure converts a Nat+Bool - into a Nat: -
- - -
- -
-    getNat = 
-      λx:Nat+Bool.
-        case x of
-          inl n => n
-        | inr b => if b then 1 else 0
-
- -
- - More formally... -
- - Syntax: -
-       t ::=                Terms
-           | ...               
-           | inl T t           tagging (left)
-           | inr T t           tagging (right)
-           | case t of         case
-               inl x => t
-             | inr x => t 
-
-       v ::=                Values
-           | ...
-           | inl T v           tagged value (left)
-           | inr T v           tagged value (right)
-
-       T ::=                Types
-           | ...
-           | T + T             sum type
-
- -
- - Evaluation: - -
- -
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Inl)   -
inl T t1 ⇒ inl T t1'
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Inr)   -
inr T t1 ⇒ inr T t1'
- - - - - - - - - - - - - - -
t0 ⇒ t0' - (ST_Case)   -
case t0 of inl x1 ⇒ t1 | inr x2 ⇒ t2 ⇒
case t0' of inl x1 ⇒ t1 | inr x2 ⇒ t2
- - - - - - - - - - - - - - -
   - (ST_CaseInl)   -
case (inl T v0) of inl x1 ⇒ t1 | inr x2 ⇒ t2
⇒  [x1:=v0]t1
- - - - - - - - - - - - - - -
   - (ST_CaseInr)   -
case (inr T v0) of inl x1 ⇒ t1 | inr x2 ⇒ t2
⇒  [x2:=v0]t2
-
- - Typing: -
- - - - - - - - - - -
Γ ⊢ t1 :  T1 - (T_Inl)   -
Γ ⊢ inl T2 t1 : T1 + T2
- - - - - - - - - - -
Γ ⊢ t1 : T2 - (T_Inr)   -
Γ ⊢ inr T1 t1 : T1 + T2
- - - - - - - - - - - - - - - - - - -
Γ ⊢ t0 : T1+T2
Γ , x1:T1 ⊢ t1 : T
Γ , x2:T2 ⊢ t2 : T - (T_Case)   -
Γ ⊢ case t0 of inl x1 ⇒ t1 | inr x2 ⇒ t2 : T
-
- - We use the type annotation in inl and inr to make the typing - simpler, similarly to what we did for functions. Without this extra - information, the typing rule T_Inl, for example, would have to - say that, once we have shown that t1 is an element of type T1, - we can derive that inl t1 is an element of T1 + T2 for any - type T2. For example, we could derive both inl 5 : Nat + Nat - and inl 5 : Nat + Bool (and infinitely many other types). - This failure of uniqueness of types would mean that we cannot - build a typechecking algorithm simply by "reading the rules from - bottom to top" as we could for all the other features seen so far. - -
- - There are various ways to deal with this difficulty. One simple - one — which we've adopted here — forces the programmer to - explicitly annotate the "other side" of a sum type when performing - an injection. This is rather heavyweight for programmers (and so - real languages adopt other solutions), but it is easy to - understand and formalize. -
- -

Lists

- -
- - The typing features we have seen can be classified into base - types like Bool, and type constructors like → and × that - build new types from old ones. Another useful type constructor is - List. For every type T, the type List T describes - finite-length lists whose elements are drawn from T. - -
- - In principle, we could encode lists using pairs, sums and - recursive types. But giving semantics to recursive types is - non-trivial. Instead, we'll just discuss the special case of lists - directly. - -
- - Below we give the syntax, semantics, and typing rules for lists. - Except for the fact that explicit type annotations are mandatory - on nil and cannot appear on cons, these lists are essentially - identical to those we built in Coq. We use lcase to destruct - lists, to avoid dealing with questions like "what is the head of - the empty list?" -
- - For example, here is a function that calculates the sum of - the first two elements of a list of numbers: -
-    λx:List Nat.  
-    lcase x of nil -> 0 
-       | a::x' -> lcase x' of nil -> a
-                     | b::x'' -> a+b 
-
- -
- - -
- - Syntax: -
-       t ::=                Terms
-           | ...
-           | nil T
-           | cons t t
-           | lcase t of nil -> t | x::x -> t
-
-       v ::=                Values
-           | ...
-           | nil T             nil value
-           | cons v v          cons value
-
-       T ::=                Types
-           | ...
-           | List T            list of Ts
-
- -
- - Reduction: -
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Cons1)   -
cons t1 t2 ⇒ cons t1' t2
- - - - - - - - - - -
t2 ⇒ t2' - (ST_Cons2)   -
cons v1 t2 ⇒ cons v1 t2'
- - - - - - - - - - - - - - -
t1 ⇒ t1' - (ST_Lcase1)   -
(lcase t1 of nil → t2 | xh::xt → t3) ⇒
(lcase t1' of nil → t2 | xh::xt → t3)
- - - - - - - - - - - - - - -
   - (ST_LcaseNil)   -
(lcase nil T of nil → t2 | xh::xt → t3)
⇒ t2
- - - - - - - - - - - - - - -
   - (ST_LcaseCons)   -
(lcase (cons vh vt) of nil → t2 | xh::xt → t3)
⇒ [xh:=vh,xt:=vt]t3
-
- - Typing: -
- - - - - - - - - - -
   - (T_Nil)   -
Γ ⊢ nil T : List T
- - - - - - - - - - -
Γ ⊢ t1 : T      Γ ⊢ t2 : List T - (T_Cons)   -
Γ ⊢ cons t1 t2: List T
- - - - - - - - - - - - - - - - - - -
Γ ⊢ t1 : List T1
Γ ⊢ t2 : T
Γ , h:T1, t:List T1 ⊢ t3 : T - (T_Lcase)   -
Γ ⊢ (lcase t1 of nil → t2 | h::t → t3) : T
-
- -

General Recursion

- -
- - Another facility found in most programming languages (including - Coq) is the ability to define recursive functions. For example, - we might like to be able to define the factorial function like - this: -
-   fact = λx:Nat. 
-             if x=0 then 1 else x * (fact (pred x)))    
-
- But this would require quite a bit of work to formalize: we'd have - to introduce a notion of "function definitions" and carry around an - "environment" of such definitions in the definition of the step - relation. -
- - Here is another way that is straightforward to formalize: instead - of writing recursive definitions where the right-hand side can - contain the identifier being defined, we can define a fixed-point - operator that performs the "unfolding" of the recursive definition - in the right-hand side lazily during reduction. -
-   fact = 
-       fix
-         (\f:Nat->Nat.
-            λx:Nat. 
-               if x=0 then 1 else x * (f (pred x)))    
-
- -
- - The intuition is that the higher-order function f passed - to fix is a generator for the fact function: if fact is - applied to a function that approximates the desired behavior of - fact up to some number n (that is, a function that returns - correct results on inputs less than or equal to n), then it - returns a better approximation to fact — a function that returns - correct results for inputs up to n+1. Applying fix to this - generator returns its fixed point — a function that gives the - desired behavior for all inputs n. - -
- - (The term "fixed point" has exactly the same sense as in ordinary - mathematics, where a fixed point of a function f is an input x - such that f(x) = x. Here, a fixed point of a function F of - type (say) (Nat→Nat)->(Nat→Nat) is a function f such that F - f is behaviorally equivalent to f.) -
- - Syntax: -
-       t ::=                Terms
-           | ...
-           | fix t             fixed-point operator
-
- Reduction: -
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Fix1)   -
fix t1 ⇒ fix t1'
- - - - - - - - - - -
F = \xf:T1.t2 - (ST_FixAbs)   -
fix F ⇒ [xf:=fix F]t2
Typing: -
- - - - - - - - - - -
Γ ⊢ t1 : T1->T1 - (T_Fix)   -
Γ ⊢ fix t1 : T1
-
- - Let's see how ST_FixAbs works by reducing fact 3 = fix F 3, - where F = (\f. \x. if x=0 then 1 else x × (f (pred x))) (we are - omitting type annotations for brevity here). -
-fix F 3
-
-⇒ ST_FixAbs -
-(\x. if x=0 then 1 else x * (fix F (pred x))) 3
-
-⇒ ST_AppAbs -
-if 3=0 then 1 else 3 * (fix F (pred 3))
-
-⇒ ST_If0_Nonzero -
-3 * (fix F (pred 3))
-
-⇒ ST_FixAbs + ST_Mult2 -
-3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 3))
-
-⇒ ST_PredNat + ST_Mult2 + ST_App2 -
-3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 2)
-
-⇒ ST_AppAbs + ST_Mult2 -
-3 * (if 2=0 then 1 else 2 * (fix F (pred 2)))
-
-⇒ ST_If0_Nonzero + ST_Mult2 -
-3 * (2 * (fix F (pred 2)))
-
-⇒ ST_FixAbs + 2 x ST_Mult2 -
-3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 2)))
-
-⇒ ST_PredNat + 2 x ST_Mult2 + ST_App2 -
-3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 1))
-
-⇒ ST_AppAbs + 2 x ST_Mult2 -
-3 * (2 * (if 1=0 then 1 else 1 * (fix F (pred 1))))
-
-⇒ ST_If0_Nonzero + 2 x ST_Mult2 -
-3 * (2 * (1 * (fix F (pred 1))))
-
-⇒ ST_FixAbs + 3 x ST_Mult2 -
-3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 1))))
-
-⇒ ST_PredNat + 3 x ST_Mult2 + ST_App2 -
-3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 0)))
-
-⇒ ST_AppAbs + 3 x ST_Mult2 -
-3 * (2 * (1 * (if 0=0 then 1 else 0 * (fix F (pred 0)))))
-
-⇒ ST_If0Zero + 3 x ST_Mult2 -
-3 * (2 * (1 * 1))
-
-⇒ ST_MultNats + 2 x ST_Mult2 -
-3 * (2 * 1)
-
-⇒ ST_MultNats + ST_Mult2 -
-3 * 2
-
-⇒ ST_MultNats -
-6
-
- -
- -

Exercise: 1 star (halve_fix)

- Translate this informal recursive definition into one using fix: -
-   halve = 
-     λx:Nat. 
-        if x=0 then 0 
-        else if (pred x)=0 then 0
-        else 1 + (halve (pred (pred x))))
-
-(* FILL IN HERE *)
-☐ - -
- -

Exercise: 1 star (fact_steps)

- Write down the sequence of steps that the term fact 1 goes - through to reduce to a normal form (assuming the usual reduction - rules for arithmetic operations). - -
- - (* FILL IN HERE *)
-☐ - -
- - The ability to form the fixed point of a function of type T→T - for any T has some surprising consequences. In particular, it - implies that every type is inhabited by some term. To see this, - observe that, for every type T, we can define the term - -
- -
-    fix (\x:T.x) -
- -
- By T_Fix and T_Abs, this term has type T. By ST_FixAbs - it reduces to itself, over and over again. Thus it is an - undefined element of T. - -
- - More usefully, here's an example using fix to define a - two-argument recursive function: -
-    equal = 
-      fix 
-        (\eq:Nat->Nat->Bool.
-           λm:Nat. λn:Nat.
-             if m=0 then iszero n 
-             else if n=0 then false
-             else eq (pred m) (pred n))
-
- -
- - And finally, here is an example where fix is used to define a - pair of recursive functions (illustrating the fact that the type - T1 in the rule T_Fix need not be a function type): -
-    evenodd = 
-      fix 
-        (\eo: (Nat->Bool * Nat->Bool).
-           let e = λn:Nat. if n=0 then true  else eo.snd (pred n) in
-           let o = λn:Nat. if n=0 then false else eo.fst (pred n) in
-           (e,o))
-
-    even = evenodd.fst
-    odd  = evenodd.snd
-
- -
-
- -
-
- -
-

Records

- -
- - As a final example of a basic extension of the STLC, let's - look briefly at how to define records and their types. - Intuitively, records can be obtained from pairs by two kinds of - generalization: they are n-ary products (rather than just binary) - and their fields are accessed by label (rather than position). - -
- - Conceptually, this extension is a straightforward generalization - of pairs and product types, but notationally it becomes a little - heavier; for this reason, we postpone its formal treatment to a - separate chapter (Records). -
- - Records are not included in the extended exercise below, but - they will be useful to motivate the Sub chapter. -
- - Syntax: -
-       t ::=                          Terms
-           | ...
-           | {i1=t1, ..., in=tn}         record 
-           | t.i                         projection
-
-       v ::=                          Values
-           | ...
-           | {i1=v1, ..., in=vn}         record value
-
-       T ::=                          Types
-           | ...
-           | {i1:T1, ..., in:Tn}         record type
-
- Intuitively, the generalization is pretty obvious. But it's worth - noticing that what we've actually written is rather informal: in - particular, we've written "..." in several places to mean "any - number of these," and we've omitted explicit mention of the usual - side-condition that the labels of a record should not contain - repetitions. -
-
-(* It is possible to devise informal notations that are
-   more precise, but these tend to be quite heavy and to obscure the
-   main points of the definitions.  So we'll leave these a bit loose
-   here (they are informal anyway, after all) and do the work of
-   tightening things up elsewhere (in chapter Records). *)
- -
-
- -
- Reduction: -
- - - - - - - - - - - - - - -
ti ⇒ ti' - (ST_Rcd)   -
{i1=v1, ..., im=vm, in=ti, ...}
⇒ {i1=v1, ..., im=vm, in=ti', ...}
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Proj1)   -
t1.i ⇒ t1'.i
- - - - - - - - - - -
   - (ST_ProjRcd)   -
{..., i=vi, ...}.i ⇒ vi
Again, these rules are a bit informal. For example, the first rule - is intended to be read "if ti is the leftmost field that is not a - value and if ti steps to ti', then the whole record steps..." - In the last rule, the intention is that there should only be one - field called i, and that all the other fields must contain values. -
- - -
- - Typing: -
- - - - - - - - - - -
Γ ⊢ t1 : T1     ...     Γ ⊢ tn : Tn - (T_Rcd)   -
Γ ⊢ {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}
- - - - - - - - - - -
Γ ⊢ t : {..., i:Ti, ...} - (T_Proj)   -
Γ ⊢ t.i : Ti
-
- - -
-
- -
-
- -
-

Encoding Records (Optional)

- -
- - There are several ways to make the above definitions precise. - -
- -
    -
  • We can directly formalize the syntactic forms and inference - rules, staying as close as possible to the form we've given - them above. This is conceptually straightforward, and it's - probably what we'd want to do if we were building a real - compiler — in particular, it will allow is to print error - messages in the form that programmers will find easy to - understand. But the formal versions of the rules will not be - pretty at all! - -
    - - -
    • -
  • We could look for a smoother way of presenting records — for - example, a binary presentation with one constructor for the - empty record and another constructor for adding a single field - to an existing record, instead of a single monolithic - constructor that builds a whole record at once. This is the - right way to go if we are primarily interested in studying the - metatheory of the calculi with records, since it leads to - clean and elegant definitions and proofs. Chapter Records - shows how this can be done. - -
    - - -
    • -
  • Alternatively, if we like, we can avoid formalizing records - altogether, by stipulating that record notations are just - informal shorthands for more complex expressions involving - pairs and product types. We sketch this approach here. - -
    • -
- -
- - First, observe that we can encode arbitrary-size tuples using - nested pairs and the unit value. To avoid overloading the pair - notation (t1,t2), we'll use curly braces without labels to write - down tuples, so {} is the empty tuple, {5} is a singleton - tuple, {5,6} is a 2-tuple (morally the same as a pair), - {5,6,7} is a triple, etc. -
-    {}                 ---->  unit
-    {t1, t2, ..., tn}  ---->  (t1, trest)
-                              where {t2, ..., tn} ----> trest
-
- Similarly, we can encode tuple types using nested product types: -
-    {}                 ---->  Unit
-    {T1, T2, ..., Tn}  ---->  T1 * TRest
-                              where {T2, ..., Tn} ----> TRest
-
- The operation of projecting a field from a tuple can be encoded - using a sequence of second projections followed by a first projection: -
-    t.0        ---->  t.fst
-    t.(n+1)    ---->  (t.snd).n
-
- -
- - Next, suppose that there is some total ordering on record labels, - so that we can associate each label with a unique natural number. - This number is called the position of the label. For example, - we might assign positions like this: -
-      LABEL   POSITION
-      a       0
-      b       1
-      c       2
-      ...     ...
-      foo     1004
-      ...     ...
-      bar     10562
-      ...     ...
-
- -
- - We use these positions to encode record values as tuples (i.e., as - nested pairs) by sorting the fields according to their positions. - For example: -
-      {a=5, b=6}      ---->   {5,6}
-      {a=5, c=7}      ---->   {5,unit,7}
-      {c=7, a=5}      ---->   {5,unit,7}
-      {c=5, b=3}      ---->   {unit,3,5}
-      {f=8,c=5,a=7}   ---->   {7,unit,5,unit,unit,8}
-      {f=8,c=5}       ---->   {unit,unit,5,unit,unit,8}
-
- Note that each field appears in the position associated with its - label, that the size of the tuple is determined by the label with - the highest position, and that we fill in unused positions with - unit. - -
- - We do exactly the same thing with record types: -
-      {a:Nat, b:Nat}      ---->   {Nat,Nat}
-      {c:Nat, a:Nat}      ---->   {Nat,Unit,Nat}
-      {f:Nat,c:Nat}       ---->   {Unit,Unit,Nat,Unit,Unit,Nat}
-
- -
- - Finally, record projection is encoded as a tuple projection from - the appropriate position: -
-      t.l  ---->  t.(position of l)
-
- -
- - It is not hard to check that all the typing rules for the original - "direct" presentation of records are validated by this - encoding. (The reduction rules are "almost validated" — not - quite, because the encoding reorders fields.) -
- - Of course, this encoding will not be very efficient if we - happen to use a record with label bar! But things are not - actually as bad as they might seem: for example, if we assume that - our compiler can see the whole program at the same time, we can - choose the numbering of labels so that we assign small positions - to the most frequently used labels. Indeed, there are industrial - compilers that essentially do this! -
- -

Variants (Optional Reading)

- -
- - Just as products can be generalized to records, sums can be - generalized to n-ary labeled types called variants. Instead of - T1+T2, we can write something like <l1:T1,l2:T2,...ln:Tn> - where l1,l2,... are field labels which are used both to build - instances and as case arm labels. - -
- - These n-ary variants give us almost enough mechanism to build - arbitrary inductive data types like lists and trees from - scratch — the only thing missing is a way to allow recursion in - type definitions. We won't cover this here, but detailed - treatments can be found in many textbooks — e.g., Types and - Programming Languages. -
-
- -
-
- -
-

Exercise: Formalizing the Extensions

- -
- -

Exercise: 4 stars, advanced (STLC_extensions)

- In this problem you will formalize a couple of the extensions - described above. We've provided the necessary additions to the - syntax of terms and types, and we've included a few examples that - you can test your definitions with to make sure they are working - as expected. You'll fill in the rest of the definitions and - extend all the proofs accordingly. - -
- - To get you started, we've provided implementations for: - -
- -
    -
  • numbers - -
    • -
  • pairs and units - -
    • -
  • sums - -
    • -
  • lists - -
    • -
- -
- - You need to complete the implementations for: - -
- -
    -
  • let (which involves binding) - -
    • -
  • fix - -
    • -
- -
- - A good strategy is to work on the extensions one at a time, in - multiple passes, rather than trying to work through the file from - start to finish in a single pass. For each definition or proof, - begin by reading carefully through the parts that are provided for - you, referring to the text in the Stlc chapter for high-level - intuitions and the embedded comments for detailed mechanics. - -
-
- -
-Module STLCExtended.
- -
-
- -
-

Syntax and Operational Semantics

- -
-
- -
-Inductive ty : Type :=
-  | TArrow : ty → ty → ty
-  | TNat : ty
-  | TUnit : ty
-  | TProd : ty → ty → ty
-  | TSum : ty → ty → ty
-  | TList : ty → ty.
- -
-Tactic Notation "T_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "TArrow" | Case_aux c "TNat"
-  | Case_aux c "TProd" | Case_aux c "TUnit"
-  | Case_aux c "TSum" | Case_aux c "TList" ].
- -
-Inductive tm : Type :=
-  (* pure STLC *)
-  | tvar : id → tm
-  | tapp : tm → tm → tm
-  | tabs : id → ty → tm → tm
-  (* numbers *)
-  | tnat : nat → tm
-  | tsucc : tm → tm
-  | tpred : tm → tm
-  | tmult : tm → tm → tm
-  | tif0 : tm → tm → tm → tm
-  (* pairs *)
-  | tpair : tm → tm → tm
-  | tfst : tm → tm
-  | tsnd : tm → tm
-  (* units *)
-  | tunit : tm
-  (* let *)
-  | tlet : id → tm → tm → tm
-          (* i.e., let x = t1 in t2 *)
-  (* sums *)
-  | tinl : ty → tm → tm
-  | tinr : ty → tm → tm
-  | tcase : tm → id → tm → id → tm → tm
-          (* i.e., case t0 of inl x1 ⇒ t1 | inr x2 ⇒ t2 *)
-  (* lists *)
-  | tnil : ty → tm
-  | tcons : tm → tm → tm
-  | tlcase : tm → tm → id → id → tm → tm
-          (* i.e., lcase t1 of | nil → t2 | x::y → t3 *)
-  (* fix *)
-  | tfix : tm → tm.
- -
-
- -
-Note that, for brevity, we've omitted booleans and instead - provided a single if0 form combining a zero test and a - conditional. That is, instead of writing -
-       if x = 0 then ... else ...
-
- we'll write this: -
-       if0 x then ... else ...
-
- -
-
- -
-Tactic Notation "t_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "tvar" | Case_aux c "tapp" | Case_aux c "tabs"
-  | Case_aux c "tnat" | Case_aux c "tsucc" | Case_aux c "tpred"
-  | Case_aux c "tmult" | Case_aux c "tif0"
-  | Case_aux c "tpair" | Case_aux c "tfst" | Case_aux c "tsnd"
-  | Case_aux c "tunit" | Case_aux c "tlet"
-  | Case_aux c "tinl" | Case_aux c "tinr" | Case_aux c "tcase"
-  | Case_aux c "tnil" | Case_aux c "tcons" | Case_aux c "tlcase"
-  | Case_aux c "tfix" ].
- -
-
- -
-

Substitution

- -
-
- -
-Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
-  match t with
-  | tvar y ⇒
-      if eq_id_dec x y then s else t
-  | tabs y T t1 ⇒
-      tabs y T (if eq_id_dec x y then t1 else (subst x s t1))
-  | tapp t1 t2 ⇒
-      tapp (subst x s t1) (subst x s t2)
-  | tnat n ⇒
-      tnat n
-  | tsucc t1 ⇒
-      tsucc (subst x s t1)
-  | tpred t1 ⇒
-      tpred (subst x s t1)
-  | tmult t1 t2 ⇒
-      tmult (subst x s t1) (subst x s t2)
-  | tif0 t1 t2 t3 ⇒
-      tif0 (subst x s t1) (subst x s t2) (subst x s t3)
-  | tpair t1 t2 ⇒
-      tpair (subst x s t1) (subst x s t2)
-  | tfst t1 ⇒
-      tfst (subst x s t1)
-  | tsnd t1 ⇒
-      tsnd (subst x s t1)
-  | tunit ⇒ tunit
-  (* FILL IN HERE *)
-  | tinl T t1 ⇒
-      tinl T (subst x s t1)
-  | tinr T t1 ⇒
-      tinr T (subst x s t1)
-  | tcase t0 y1 t1 y2 t2 ⇒
-      tcase (subst x s t0)
-         y1 (if eq_id_dec x y1 then t1 else (subst x s t1))
-         y2 (if eq_id_dec x y2 then t2 else (subst x s t2))
-  | tnil T ⇒
-      tnil T
-  | tcons t1 t2 ⇒
-      tcons (subst x s t1) (subst x s t2)
-  | tlcase t1 t2 y1 y2 t3 ⇒
-      tlcase (subst x s t1) (subst x s t2) y1 y2
-        (if eq_id_dec x y1 then
-           t3
-         else if eq_id_dec x y2 then t3
-              else (subst x s t3))
-(* FILL IN HERE *)
-  | _ ⇒ t (* ... and delete this line *)
-  end.
- -
-Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
- -
-
- -
-

Reduction

- -
- - Next we define the values of our language. -
-
- -
-Inductive value : tm → Prop :=
-  | v_abs : ∀x T11 t12,
-      value (tabs x T11 t12)
-  (* Numbers are values: *)
-  | v_nat : ∀n1,
-      value (tnat n1)
-  (* A pair is a value if both components are: *)
-  | v_pair : ∀v1 v2,
-      value v1 →
-      value v2 →
-      value (tpair v1 v2)
-  (* A unit is always a value *)
-  | v_unit : value tunit
-  (* A tagged value is a value:  *)
-  | v_inl : ∀v T,
-      value v →
-      value (tinl T v)
-  | v_inr : ∀v T,
-      value v →
-      value (tinr T v)
-  (* A list is a value iff its head and tail are values: *)
-  | v_lnil : ∀T, value (tnil T)
-  | v_lcons : ∀v1 vl,
-      value v1 →
-      value vl →
-      value (tcons v1 vl)
-  .
- -
-Hint Constructors value.
- -
-Reserved Notation "t1 '⇒' t2" (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_AppAbs : ∀x T11 t12 v2,
-         value v2 →
-         (tapp (tabs x T11 t12) v2) ⇒ [x:=v2]t12
-  | ST_App1 : ∀t1 t1' t2,
-         t1 ⇒ t1' →
-         (tapp t1 t2) ⇒ (tapp t1' t2)
-  | ST_App2 : ∀v1 t2 t2',
-         value v1 →
-         t2 ⇒ t2' →
-         (tapp v1 t2) ⇒ (tapp v1 t2')
-  (* nats *)
-  | ST_Succ1 : ∀t1 t1',
-       t1 ⇒ t1' →
-       (tsucc t1) ⇒ (tsucc t1')
-  | ST_SuccNat : ∀n1,
-       (tsucc (tnat n1)) ⇒ (tnat (S n1))
-  | ST_Pred : ∀t1 t1',
-       t1 ⇒ t1' →
-       (tpred t1) ⇒ (tpred t1')
-  | ST_PredNat : ∀n1,
-       (tpred (tnat n1)) ⇒ (tnat (pred n1))
-  | ST_Mult1 : ∀t1 t1' t2,
-       t1 ⇒ t1' →
-       (tmult t1 t2) ⇒ (tmult t1' t2)
-  | ST_Mult2 : ∀v1 t2 t2',
-       value v1 →
-       t2 ⇒ t2' →
-       (tmult v1 t2) ⇒ (tmult v1 t2')
-  | ST_MultNats : ∀n1 n2,
-       (tmult (tnat n1) (tnat n2)) ⇒ (tnat (mult n1 n2))
-  | ST_If01 : ∀t1 t1' t2 t3,
-       t1 ⇒ t1' →
-       (tif0 t1 t2 t3) ⇒ (tif0 t1' t2 t3)
-  | ST_If0Zero : ∀t2 t3,
-       (tif0 (tnat 0) t2 t3) ⇒ t2
-  | ST_If0Nonzero : ∀n t2 t3,
-       (tif0 (tnat (S n)) t2 t3) ⇒ t3
-  (* pairs *)
-  | ST_Pair1 : ∀t1 t1' t2,
-        t1 ⇒ t1' →
-        (tpair t1 t2) ⇒ (tpair t1' t2)
-  | ST_Pair2 : ∀v1 t2 t2',
-        value v1 →
-        t2 ⇒ t2' →
-        (tpair v1 t2) ⇒ (tpair v1 t2')
-  | ST_Fst1 : ∀t1 t1',
-        t1 ⇒ t1' →
-        (tfst t1) ⇒ (tfst t1')
-  | ST_FstPair : ∀v1 v2,
-        value v1 →
-        value v2 →
-        (tfst (tpair v1 v2)) ⇒ v1
-  | ST_Snd1 : ∀t1 t1',
-        t1 ⇒ t1' →
-        (tsnd t1) ⇒ (tsnd t1')
-  | ST_SndPair : ∀v1 v2,
-        value v1 →
-        value v2 →
-        (tsnd (tpair v1 v2)) ⇒ v2
-  (* let *)
-  (* FILL IN HERE *)
-  (* sums *)
-  | ST_Inl : ∀t1 t1' T,
-        t1 ⇒ t1' →
-        (tinl T t1) ⇒ (tinl T t1')
-  | ST_Inr : ∀t1 t1' T,
-        t1 ⇒ t1' →
-        (tinr T t1) ⇒ (tinr T t1')
-  | ST_Case : ∀t0 t0' x1 t1 x2 t2,
-        t0 ⇒ t0' →
-        (tcase t0 x1 t1 x2 t2) ⇒ (tcase t0' x1 t1 x2 t2)
-  | ST_CaseInl : ∀v0 x1 t1 x2 t2 T,
-        value v0 →
-        (tcase (tinl T v0) x1 t1 x2 t2) ⇒ [x1:=v0]t1
-  | ST_CaseInr : ∀v0 x1 t1 x2 t2 T,
-        value v0 →
-        (tcase (tinr T v0) x1 t1 x2 t2) ⇒ [x2:=v0]t2
-  (* lists *)
-  | ST_Cons1 : ∀t1 t1' t2,
-       t1 ⇒ t1' →
-       (tcons t1 t2) ⇒ (tcons t1' t2)
-  | ST_Cons2 : ∀v1 t2 t2',
-       value v1 →
-       t2 ⇒ t2' →
-       (tcons v1 t2) ⇒ (tcons v1 t2')
-  | ST_Lcase1 : ∀t1 t1' t2 x1 x2 t3,
-       t1 ⇒ t1' →
-       (tlcase t1 t2 x1 x2 t3) ⇒ (tlcase t1' t2 x1 x2 t3)
-  | ST_LcaseNil : ∀T t2 x1 x2 t3,
-       (tlcase (tnil T) t2 x1 x2 t3) ⇒ t2
-  | ST_LcaseCons : ∀v1 vl t2 x1 x2 t3,
-       value v1 →
-       value vl →
-       (tlcase (tcons v1 vl) t2 x1 x2 t3) ⇒ (subst x2 vl (subst x1 v1 t3))
-  (* fix *)
-(* FILL IN HERE *)
-
-where "t1 '⇒' t2" := (step t1 t2).
- -
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2"
-  | Case_aux c "ST_Succ1" | Case_aux c "ST_SuccNat"
-    | Case_aux c "ST_Pred1" | Case_aux c "ST_PredNat"
-    | Case_aux c "ST_Mult1" | Case_aux c "ST_Mult2"
-    | Case_aux c "ST_MultNats" | Case_aux c "ST_If01"
-    | Case_aux c "ST_If0Zero" | Case_aux c "ST_If0Nonzero"
-  | Case_aux c "ST_Pair1" | Case_aux c "ST_Pair2"
-    | Case_aux c "ST_Fst1" | Case_aux c "ST_FstPair"
-    | Case_aux c "ST_Snd1" | Case_aux c "ST_SndPair"
-    (* FILL IN HERE *)
-  | Case_aux c "ST_Inl" | Case_aux c "ST_Inr" | Case_aux c "ST_Case"
-    | Case_aux c "ST_CaseInl" | Case_aux c "ST_CaseInr"
-  | Case_aux c "ST_Cons1" | Case_aux c "ST_Cons2" | Case_aux c "ST_Lcase1"
-    | Case_aux c "ST_LcaseNil" | Case_aux c "ST_LcaseCons"
-(* FILL IN HERE *)
-  ].
- -
-Notation multistep := (multi step).
-Notation "t1 '⇒*' t2" := (multistep t1 t2) (at level 40).
- -
-Hint Constructors step.
- -
-
- -
-

Typing

- -
-
- -
-Definition context := partial_map ty.
- -
-
- -
-Next we define the typing rules. These are nearly direct - transcriptions of the inference rules shown above. -
-
- -
-Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).
- -
-Inductive has_type : context → tm → ty → Prop :=
-  (* Typing rules for proper terms *)
-  | T_Var : ∀Γ x T,
-      Γ x = Some T →
-      Γ ⊢ (tvar x) ∈ T
-  | T_Abs : ∀Γ x T11 T12 t12,
-      (extend Γ x T11) ⊢ t12 ∈ T12 →
-      Γ ⊢ (tabs x T11 t12) ∈ (TArrow T11 T12)
-  | T_App : ∀T1 T2 Γ t1 t2,
-      Γ ⊢ t1 ∈ (TArrow T1 T2) →
-      Γ ⊢ t2 ∈ T1 →
-      Γ ⊢ (tapp t1 t2) ∈ T2
-  (* nats *)
-  | T_Nat : ∀Γ n1,
-      Γ ⊢ (tnat n1) ∈ TNat
-  | T_Succ : ∀Γ t1,
-      Γ ⊢ t1 ∈ TNat →
-      Γ ⊢ (tsucc t1) ∈ TNat
-  | T_Pred : ∀Γ t1,
-      Γ ⊢ t1 ∈ TNat →
-      Γ ⊢ (tpred t1) ∈ TNat
-  | T_Mult : ∀Γ t1 t2,
-      Γ ⊢ t1 ∈ TNat →
-      Γ ⊢ t2 ∈ TNat →
-      Γ ⊢ (tmult t1 t2) ∈ TNat
-  | T_If0 : ∀Γ t1 t2 t3 T1,
-      Γ ⊢ t1 ∈ TNat →
-      Γ ⊢ t2 ∈ T1 →
-      Γ ⊢ t3 ∈ T1 →
-      Γ ⊢ (tif0 t1 t2 t3) ∈ T1
-  (* pairs *)
-  | T_Pair : ∀Γ t1 t2 T1 T2,
-      Γ ⊢ t1 ∈ T1 →
-      Γ ⊢ t2 ∈ T2 →
-      Γ ⊢ (tpair t1 t2) ∈ (TProd T1 T2)
-  | T_Fst : ∀Γ t T1 T2,
-      Γ ⊢ t ∈ (TProd T1 T2) →
-      Γ ⊢ (tfst t) ∈ T1
-  | T_Snd : ∀Γ t T1 T2,
-      Γ ⊢ t ∈ (TProd T1 T2) →
-      Γ ⊢ (tsnd t) ∈ T2
-  (* unit *)
-  | T_Unit : ∀Γ,
-      Γ ⊢ tunit ∈ TUnit
-  (* let *)
-(* FILL IN HERE *)
-  (* sums *)
-  | T_Inl : ∀Γ t1 T1 T2,
-      Γ ⊢ t1 ∈ T1 →
-      Γ ⊢ (tinl T2 t1) ∈ (TSum T1 T2)
-  | T_Inr : ∀Γ t2 T1 T2,
-      Γ ⊢ t2 ∈ T2 →
-      Γ ⊢ (tinr T1 t2) ∈ (TSum T1 T2)
-  | T_Case : ∀Γ t0 x1 T1 t1 x2 T2 t2 T,
-      Γ ⊢ t0 ∈ (TSum T1 T2) →
-      (extend Γ x1 T1) ⊢ t1 ∈ T →
-      (extend Γ x2 T2) ⊢ t2 ∈ T →
-      Γ ⊢ (tcase t0 x1 t1 x2 t2) ∈ T
-  (* lists *)
-  | T_Nil : ∀Γ T,
-      Γ ⊢ (tnil T) ∈ (TList T)
-  | T_Cons : ∀Γ t1 t2 T1,
-      Γ ⊢ t1 ∈ T1 →
-      Γ ⊢ t2 ∈ (TList T1) →
-      Γ ⊢ (tcons t1 t2) ∈ (TList T1)
-  | T_Lcase : ∀Γ t1 T1 t2 x1 x2 t3 T2,
-      Γ ⊢ t1 ∈ (TList T1) →
-      Γ ⊢ t2 ∈ T2 →
-      (extend (extend Γ x2 (TList T1)) x1 T1) ⊢ t3 ∈ T2 →
-      Γ ⊢ (tlcase t1 t2 x1 x2 t3) ∈ T2
-  (* fix *)
-(* FILL IN HERE *)
-
-where "Gamma '⊢' t '∈' T" := (has_type Γ t T).
- -
-Hint Constructors has_type.
- -
-Tactic Notation "has_type_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
-  | Case_aux c "T_Nat" | Case_aux c "T_Succ" | Case_aux c "T_Pred"
-  | Case_aux c "T_Mult" | Case_aux c "T_If0"
-  | Case_aux c "T_Pair" | Case_aux c "T_Fst" | Case_aux c "T_Snd"
-  | Case_aux c "T_Unit"
-(* let *)
-(* FILL IN HERE *)
-  | Case_aux c "T_Inl" | Case_aux c "T_Inr" | Case_aux c "T_Case"
-  | Case_aux c "T_Nil" | Case_aux c "T_Cons" | Case_aux c "T_Lcase"
-(* fix *)
-(* FILL IN HERE *)
-].
- -
-
- -
-

Examples

- -
- - This section presents formalized versions of the examples from - above (plus several more). The ones at the beginning focus on - specific features; you can use these to make sure your definition - of a given feature is reasonable before moving on to extending the - proofs later in the file with the cases relating to this feature. - The later examples require all the features together, so you'll - need to come back to these when you've got all the definitions - filled in. -
-
- -
-Module Examples.
- -
-
- -
-

Preliminaries

- -
- - First, let's define a few variable names: -
-
- -
-Notation a := (Id 0).
-Notation f := (Id 1).
-Notation g := (Id 2).
-Notation l := (Id 3).
-Notation k := (Id 6).
-Notation i1 := (Id 7).
-Notation i2 := (Id 8).
-Notation x := (Id 9).
-Notation y := (Id 10).
-Notation processSum := (Id 11).
-Notation n := (Id 12).
-Notation eq := (Id 13).
-Notation m := (Id 14).
-Notation evenodd := (Id 15).
-Notation even := (Id 16).
-Notation odd := (Id 17).
-Notation eo := (Id 18).
- -
-
- -
-Next, a bit of Coq hackery to automate searching for typing - derivations. You don't need to understand this bit in detail — - just have a look over it so that you'll know what to look for if - you ever find yourself needing to make custom extensions to - auto. - -
- - The following Hint declarations say that, whenever auto - arrives at a goal of the form (Γ ⊢ (tapp e1 e1) ∈ T), it - should consider eapply T_App, leaving an existential variable - for the middle type T1, and similar for lcase. That variable - will then be filled in during the search for type derivations for - e1 and e2. We also include a hint to "try harder" when - solving equality goals; this is useful to automate uses of - T_Var (which includes an equality as a precondition). -
-
- -
-Hint Extern 2 (has_type _ (tapp _ _) _) ⇒
-  eapply T_App; auto.
-(* You'll want to uncomment the following line once 
-   you've defined the T_Lcase constructor for the typing
-   relation: *)
-(* 
-Hint Extern 2 (has_type _ (tlcase _ _ _ _ _) _) => 
-  eapply T_Lcase; auto.
-*)
-Hint Extern 2 (_ = _) ⇒ compute; reflexivity.
- -
-
- -
-

Numbers

- -
-
- -
-Module Numtest.
- -
-(* if0 (pred (succ (pred (2 * 0))) then 5 else 6 *)
-Definition test :=
-  tif0
-    (tpred
-      (tsucc
-        (tpred
-          (tmult
-            (tnat 2)
-            (tnat 0)))))
-    (tnat 5)
-    (tnat 6).
- -
-
- -
-Remove the comment braces once you've implemented enough of the - definitions that you think this should work. -
-
- -
-(* 
-Example typechecks :
-  (@empty ty) |- test ∈ TNat.
-Proof.
-  unfold test.
-  (* This typing derivation is quite deep, so we need to increase the
-     max search depth of auto from the default 5 to 10. *)
-  auto 10. 
-Qed.
-
-Example numtest_reduces :
-  test ==>* tnat 5.
-Proof.
-  unfold test. normalize.
-Qed.
-*)
- -
-End Numtest.
- -
-
- -
-

Products

- -
-
- -
-Module Prodtest.
- -
-(* ((5,6),7).fst.snd *)
-Definition test :=
-  tsnd
-    (tfst
-      (tpair
-        (tpair
-          (tnat 5)
-          (tnat 6))
-        (tnat 7))).
- -
-(* 
-Example typechecks :
-  (@empty ty) |- test ∈ TNat.
-Proof. unfold test. eauto 15. Qed.
-
-Example reduces :
-  test ==>* tnat 6.
-Proof. unfold test. normalize. Qed.
-*)
- -
-End Prodtest.
- -
-
- -
-

let

- -
-
- -
-Module LetTest.
- -
-(* let x = pred 6 in succ x *)
-Definition test :=
-  tlet
-    x
-    (tpred (tnat 6))
-    (tsucc (tvar x)).
- -
-(* 
-Example typechecks :
-  (@empty ty) |- test ∈ TNat.
-Proof. unfold test. eauto 15. Qed.
-
-Example reduces :
-  test ==>* tnat 6.
-Proof. unfold test. normalize. Qed.
-*)
- -
-End LetTest.
- -
-
- -
-

Sums

- -
-
- -
-Module Sumtest1.
- -
-(* case (inl Nat 5) of
-     inl x => x
-   | inr y => y *)
- -
-Definition test :=
-  tcase (tinl TNat (tnat 5))
-    x (tvar x)
-    y (tvar y).
- -
-(* 
-Example typechecks :
-  (@empty ty) |- test ∈ TNat.
-Proof. unfold test. eauto 15. Qed.
-
-Example reduces :
-  test ==>* (tnat 5).
-Proof. unfold test. normalize. Qed.
-*)
- -
-End Sumtest1.
- -
-Module Sumtest2.
- -
-(* let processSum =
-     \x:Nat+Nat.
-        case x of
-          inl n => n
-          inr n => if0 n then 1 else 0 in
-   (processSum (inl Nat 5), processSum (inr Nat 5))    *)
- -
-Definition test :=
-  tlet
-    processSum
-    (tabs x (TSum TNat TNat)
-      (tcase (tvar x)
-         n (tvar n)
-         n (tif0 (tvar n) (tnat 1) (tnat 0))))
-    (tpair
-      (tapp (tvar processSum) (tinl TNat (tnat 5)))
-      (tapp (tvar processSum) (tinr TNat (tnat 5)))).
- -
-(* 
-Example typechecks :
-  (@empty ty) |- test ∈ (TProd TNat TNat).
-Proof. unfold test. eauto 15. Qed.
-
-Example reduces :
-  test ==>* (tpair (tnat 5) (tnat 0)).
-Proof. unfold test. normalize. Qed.
-*)
- -
-End Sumtest2.
- -
-
- -
-

Lists

- -
-
- -
-Module ListTest.
- -
-(* let l = cons 5 (cons 6 (nil Nat)) in
-   lcase l of
-     nil => 0
-   | x::y => x*x *)
- -
-Definition test :=
-  tlet l
-    (tcons (tnat 5) (tcons (tnat 6) (tnil TNat)))
-    (tlcase (tvar l)
-       (tnat 0)
-       x y (tmult (tvar x) (tvar x))).
- -
-(* 
-Example typechecks :
-  (@empty ty) |- test ∈ TNat.
-Proof. unfold test. eauto 20. Qed.
-
-Example reduces :
-  test ==>* (tnat 25).
-Proof. unfold test. normalize. Qed.
-*)
- -
-End ListTest.
- -
-
- -
-

fix

- -
-
- -
-Module FixTest1.
- -
-(* fact := fix
-             (\f:nat->nat.
-                \a:nat. 
-                   if a=0 then 1 else a * (f (pred a))) *)
-Definition fact :=
-  tfix
-    (tabs f (TArrow TNat TNat)
-      (tabs a TNat
-        (tif0
-           (tvar a)
-           (tnat 1)
-           (tmult
-              (tvar a)
-              (tapp (tvar f) (tpred (tvar a))))))).
- -
-
- -
-(Warning: you may be able to typecheck fact but still have some - rules wrong!) -
-
- -
-(* 
-Example fact_typechecks :
-  (@empty ty) |- fact ∈ (TArrow TNat TNat).
-Proof. unfold fact. auto 10. 
-Qed.
-*)
- -
-(* 
-Example fact_example: 
-  (tapp fact (tnat 4)) ==>* (tnat 24).
-Proof. unfold fact. normalize. Qed.
-*)
- -
-End FixTest1.
- -
-Module FixTest2.
- -
-(* map :=
-     \g:nat->nat.
-       fix
-         (\f:nat->nat.
-            \l:nat. 
-               case l of
-               |  -> 
-               | x::l -> (g x)::(f l)) *)
-Definition map :=
-  tabs g (TArrow TNat TNat)
-    (tfix
-      (tabs f (TArrow (TList TNat) (TList TNat))
-        (tabs l (TList TNat)
-          (tlcase (tvar l)
-            (tnil TNat)
-            a l (tcons (tapp (tvar g) (tvar a))
-                         (tapp (tvar f) (tvar l))))))).
- -
-(* 
-(* Make sure you've uncommented the last Hint Extern above... *)
-Example map_typechecks :
-  empty |- map ∈ 
-    (TArrow (TArrow TNat TNat)
-      (TArrow (TList TNat) 
-        (TList TNat))).
-Proof. unfold map. auto 10. Qed.
-
-Example map_example :
-  tapp (tapp map (tabs a TNat (tsucc (tvar a))))
-         (tcons (tnat 1) (tcons (tnat 2) (tnil TNat)))
-  ==>* (tcons (tnat 2) (tcons (tnat 3) (tnil TNat))).
-Proof. unfold map. normalize. Qed.
-*)
- -
-End FixTest2.
- -
-Module FixTest3.
- -
-(* equal = 
-      fix 
-        (\eq:Nat->Nat->Bool.
-           \m:Nat. \n:Nat.
-             if0 m then (if0 n then 1 else 0) 
-             else if0 n then 0
-             else eq (pred m) (pred n))   *)
- -
-Definition equal :=
-  tfix
-    (tabs eq (TArrow TNat (TArrow TNat TNat))
-      (tabs m TNat
-        (tabs n TNat
-          (tif0 (tvar m)
-            (tif0 (tvar n) (tnat 1) (tnat 0))
-            (tif0 (tvar n)
-              (tnat 0)
-              (tapp (tapp (tvar eq)
-                              (tpred (tvar m)))
-                      (tpred (tvar n)))))))).
- -
-(* 
-Example equal_typechecks :
-  (@empty ty) |- equal ∈ (TArrow TNat (TArrow TNat TNat)).
-Proof. unfold equal. auto 10. 
-Qed.
-*)
- -
-(* 
-Example equal_example1: 
-  (tapp (tapp equal (tnat 4)) (tnat 4)) ==>* (tnat 1).
-Proof. unfold equal. normalize. Qed.
-*)
- -
-(* 
-Example equal_example2: 
-  (tapp (tapp equal (tnat 4)) (tnat 5)) ==>* (tnat 0).
-Proof. unfold equal. normalize. Qed.
-*)
- -
-End FixTest3.
- -
-Module FixTest4.
- -
-(* let evenodd = 
-         fix 
-           (\eo: (Nat->Nat * Nat->Nat).
-              let e = \n:Nat. if0 n then 1 else eo.snd (pred n) in
-              let o = \n:Nat. if0 n then 0 else eo.fst (pred n) in
-              (e,o)) in
-    let even = evenodd.fst in
-    let odd  = evenodd.snd in
-    (even 3, even 4)
-*)
- -
-Definition eotest :=
-  tlet evenodd
-    (tfix
-      (tabs eo (TProd (TArrow TNat TNat) (TArrow TNat TNat))
-        (tpair
-          (tabs n TNat
-            (tif0 (tvar n)
-              (tnat 1)
-              (tapp (tsnd (tvar eo)) (tpred (tvar n)))))
-          (tabs n TNat
-            (tif0 (tvar n)
-              (tnat 0)
-              (tapp (tfst (tvar eo)) (tpred (tvar n))))))))
-  (tlet even (tfst (tvar evenodd))
-  (tlet odd (tsnd (tvar evenodd))
-  (tpair
-    (tapp (tvar even) (tnat 3))
-    (tapp (tvar even) (tnat 4))))).
- -
-(* 
-Example eotest_typechecks :
-  (@empty ty) |- eotest ∈ (TProd TNat TNat).
-Proof. unfold eotest. eauto 30. 
-Qed.
-*)
- -
-(* 
-Example eotest_example1: 
-  eotest ==>* (tpair (tnat 0) (tnat 1)).
-Proof. unfold eotest. normalize. Qed.
-*)
- -
-End FixTest4.
- -
-End Examples.
- -
-
- -
-

Properties of Typing

- -
- - The proofs of progress and preservation for this system are - essentially the same (though of course somewhat longer) as for the - pure simply typed lambda-calculus. -
-
- -
-
- -
-

Progress

- -
-
- -
-Theorem progress : ∀t T,
-     empty ⊢ t ∈ T →
-     value t ∨ ∃t', t ⇒ t'.
-Proof with eauto.
-  (* Theorem: Suppose empty |- t : T.  Then either
-       1. t is a value, or
-       2. t ==> t' for some t'.
-     Proof: By induction on the given typing derivation. *)
-  intros t T Ht.
-  remember (@empty ty) as Γ.
-  generalize dependent HeqGamma.
-  has_type_cases (induction Ht) Case; intros HeqGamma; subst.
-  Case "T_Var".
-    (* The final rule in the given typing derivation cannot be T_Var,
-       since it can never be the case that empty ⊢ x : T (since the
-       context is empty). *)
-    inversion H.
-  Case "T_Abs".
-    (* If the T_Abs rule was the last used, then t = tabs x T11 t12,
-       which is a value. *)
-    left...
-  Case "T_App".
-    (* If the last rule applied was T_App, then t = t1 t2, and we know 
-       from the form of the rule that
-         empty ⊢ t1 : T1 → T2
-         empty ⊢ t2 : T1
-       By the induction hypothesis, each of t1 and t2 either is a value 
-       or can take a step. *)
-    right.
-    destruct IHHt1; subst...
-    SCase "t1 is a value".
-      destruct IHHt2; subst...
-      SSCase "t2 is a value".
-      (* If both t1 and t2 are values, then we know that 
-         t1 = tabs x T11 t12, since abstractions are the only values
-         that can have an arrow type.  But 
-         (tabs x T11 t12) t2 ⇒ [x:=t2]t12 by ST_AppAbs. *)
-        inversion H; subst; try (solve by inversion).
-        ∃(subst x t2 t12)...
-      SSCase "t2 steps".
-        (* If t1 is a value and t2 ⇒ t2', then t1 t2 ⇒ t1 t2' 
-           by ST_App2. *)
-        inversion H0 as [t2' Hstp]. ∃(tapp t1 t2')...
-    SCase "t1 steps".
-      (* Finally, If t1 ⇒ t1', then t1 t2 ⇒ t1' t2 by ST_App1. *)
-      inversion H as [t1' Hstp]. ∃(tapp t1' t2)...
-  Case "T_Nat".
-    left...
-  Case "T_Succ".
-    right.
-    destruct IHHt...
-    SCase "t1 is a value".
-      inversion H; subst; try solve by inversion.
-      ∃(tnat (S n1))...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp].
-      ∃(tsucc t1')...
-  Case "T_Pred".
-    right.
-    destruct IHHt...
-    SCase "t1 is a value".
-      inversion H; subst; try solve by inversion.
-      ∃(tnat (pred n1))...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp].
-      ∃(tpred t1')...
-  Case "T_Mult".
-    right.
-    destruct IHHt1...
-    SCase "t1 is a value".
-      destruct IHHt2...
-      SSCase "t2 is a value".
-        inversion H; subst; try solve by inversion.
-        inversion H0; subst; try solve by inversion.
-        ∃(tnat (mult n1 n0))...
-      SSCase "t2 steps".
-        inversion H0 as [t2' Hstp].
-        ∃(tmult t1 t2')...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp].
-      ∃(tmult t1' t2)...
-  Case "T_If0".
-    right.
-    destruct IHHt1...
-    SCase "t1 is a value".
-      inversion H; subst; try solve by inversion.
-      destruct n1 as [|n1'].
-      SSCase "n1=0".
-        ∃t2...
-      SSCase "n1≠0".
-        ∃t3...
-    SCase "t1 steps".
-      inversion H as [t1' H0].
-      ∃(tif0 t1' t2 t3)...
-  Case "T_Pair".
-    destruct IHHt1...
-    SCase "t1 is a value".
-      destruct IHHt2...
-      SSCase "t2 steps".
-        right. inversion H0 as [t2' Hstp].
-        ∃(tpair t1 t2')...
-    SCase "t1 steps".
-      right. inversion H as [t1' Hstp].
-      ∃(tpair t1' t2)...
-  Case "T_Fst".
-    right.
-    destruct IHHt...
-    SCase "t1 is a value".
-      inversion H; subst; try solve by inversion.
-      ∃v1...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp].
-      ∃(tfst t1')...
-  Case "T_Snd".
-    right.
-    destruct IHHt...
-    SCase "t1 is a value".
-      inversion H; subst; try solve by inversion.
-      ∃v2...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp].
-      ∃(tsnd t1')...
-  Case "T_Unit".
-    left...
-(* let *)
-(* FILL IN HERE *)
-  Case "T_Inl".
-    destruct IHHt...
-    SCase "t1 steps".
-      right. inversion H as [t1' Hstp]...
-      (* exists (tinl _ t1')... *)
-  Case "T_Inr".
-    destruct IHHt...
-    SCase "t1 steps".
-      right. inversion H as [t1' Hstp]...
-      (* exists (tinr _ t1')... *)
-  Case "T_Case".
-    right.
-    destruct IHHt1...
-    SCase "t0 is a value".
-      inversion H; subst; try solve by inversion.
-      SSCase "t0 is inl".
-        ∃([x1:=v]t1)...
-      SSCase "t0 is inr".
-        ∃([x2:=v]t2)...
-    SCase "t0 steps".
-      inversion H as [t0' Hstp].
-      ∃(tcase t0' x1 t1 x2 t2)...
-  Case "T_Nil".
-    left...
-  Case "T_Cons".
-    destruct IHHt1...
-    SCase "head is a value".
-      destruct IHHt2...
-      SSCase "tail steps".
-        right. inversion H0 as [t2' Hstp].
-        ∃(tcons t1 t2')...
-    SCase "head steps".
-      right. inversion H as [t1' Hstp].
-      ∃(tcons t1' t2)...
-  Case "T_Lcase".
-    right.
-    destruct IHHt1...
-    SCase "t1 is a value".
-      inversion H; subst; try solve by inversion.
-      SSCase "t1=tnil".
-        ∃t2...
-      SSCase "t1=tcons v1 vl".
-        ∃([x2:=vl]([x1:=v1]t3))...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp].
-      ∃(tlcase t1' t2 x1 x2 t3)...
-(* fix *)
-(* FILL IN HERE *)
-Qed.
- -
-
- -
-

Context Invariance

- -
-
- -
-Inductive appears_free_in : id → tm → Prop :=
-  | afi_var : ∀x,
-      appears_free_in x (tvar x)
-  | afi_app1 : ∀x t1 t2,
-      appears_free_in x t1 → appears_free_in x (tapp t1 t2)
-  | afi_app2 : ∀x t1 t2,
-      appears_free_in x t2 → appears_free_in x (tapp t1 t2)
-  | afi_abs : ∀x y T11 t12,
-        y ≠ x →
-        appears_free_in x t12 →
-        appears_free_in x (tabs y T11 t12)
-  (* nats *)
-  | afi_succ : ∀x t,
-     appears_free_in x t →
-     appears_free_in x (tsucc t)
-  | afi_pred : ∀x t,
-     appears_free_in x t →
-     appears_free_in x (tpred t)
-  | afi_mult1 : ∀x t1 t2,
-     appears_free_in x t1 →
-     appears_free_in x (tmult t1 t2)
-  | afi_mult2 : ∀x t1 t2,
-     appears_free_in x t2 →
-     appears_free_in x (tmult t1 t2)
-  | afi_if01 : ∀x t1 t2 t3,
-     appears_free_in x t1 →
-     appears_free_in x (tif0 t1 t2 t3)
-  | afi_if02 : ∀x t1 t2 t3,
-     appears_free_in x t2 →
-     appears_free_in x (tif0 t1 t2 t3)
-  | afi_if03 : ∀x t1 t2 t3,
-     appears_free_in x t3 →
-     appears_free_in x (tif0 t1 t2 t3)
-  (* pairs *)
-  | afi_pair1 : ∀x t1 t2,
-      appears_free_in x t1 →
-      appears_free_in x (tpair t1 t2)
-  | afi_pair2 : ∀x t1 t2,
-      appears_free_in x t2 →
-      appears_free_in x (tpair t1 t2)
-  | afi_fst : ∀x t,
-      appears_free_in x t →
-      appears_free_in x (tfst t)
-  | afi_snd : ∀x t,
-      appears_free_in x t →
-      appears_free_in x (tsnd t)
-  (* let *)
-(* FILL IN HERE *)
-  (* sums *)
-  | afi_inl : ∀x t T,
-      appears_free_in x t →
-      appears_free_in x (tinl T t)
-  | afi_inr : ∀x t T,
-      appears_free_in x t →
-      appears_free_in x (tinr T t)
-  | afi_case0 : ∀x t0 x1 t1 x2 t2,
-      appears_free_in x t0 →
-      appears_free_in x (tcase t0 x1 t1 x2 t2)
-  | afi_case1 : ∀x t0 x1 t1 x2 t2,
-      x1 ≠ x →
-      appears_free_in x t1 →
-      appears_free_in x (tcase t0 x1 t1 x2 t2)
-  | afi_case2 : ∀x t0 x1 t1 x2 t2,
-      x2 ≠ x →
-      appears_free_in x t2 →
-      appears_free_in x (tcase t0 x1 t1 x2 t2)
-  (* lists *)
-  | afi_cons1 : ∀x t1 t2,
-     appears_free_in x t1 →
-     appears_free_in x (tcons t1 t2)
-  | afi_cons2 : ∀x t1 t2,
-     appears_free_in x t2 →
-     appears_free_in x (tcons t1 t2)
-  | afi_lcase1 : ∀x t1 t2 y1 y2 t3,
-     appears_free_in x t1 →
-     appears_free_in x (tlcase t1 t2 y1 y2 t3)
-  | afi_lcase2 : ∀x t1 t2 y1 y2 t3,
-     appears_free_in x t2 →
-     appears_free_in x (tlcase t1 t2 y1 y2 t3)
-  | afi_lcase3 : ∀x t1 t2 y1 y2 t3,
-     y1 ≠ x →
-     y2 ≠ x →
-     appears_free_in x t3 →
-     appears_free_in x (tlcase t1 t2 y1 y2 t3)
-  (* fix *)
-(* FILL IN HERE *)
-  .
- -
-Hint Constructors appears_free_in.
- -
-Lemma context_invariance : ∀Γ Γ' t S,
-     Γ ⊢ t ∈ S →
-     (∀x, appears_free_in x t → Γ x = Γ' x) →
-     Γ' ⊢ t ∈ S.
-Proof with eauto.
-  intros. generalize dependent Γ'.
-  has_type_cases (induction H) Case;
-    intros Γ' Heqv...
-  Case "T_Var".
-    apply T_Var... rewrite ← Heqv...
-  Case "T_Abs".
-    apply T_Abs... apply IHhas_type. intros y Hafi.
-    unfold extend.
-    destruct (eq_id_dec x y)...
-  Case "T_Mult".
-    apply T_Mult...
-  Case "T_If0".
-    apply T_If0...
-  Case "T_Pair".
-    apply T_Pair...
-(* let *)
-(* FILL IN HERE *)
-  Case "T_Case".
-    eapply T_Case...
-     apply IHhas_type2. intros y Hafi.
-       unfold extend.
-       destruct (eq_id_dec x1 y)...
-     apply IHhas_type3. intros y Hafi.
-       unfold extend.
-       destruct (eq_id_dec x2 y)...
-  Case "T_Cons".
-    apply T_Cons...
-  Case "T_Lcase".
-    eapply T_Lcase... apply IHhas_type3. intros y Hafi.
-    unfold extend.
-    destruct (eq_id_dec x1 y)...
-    destruct (eq_id_dec x2 y)...
-Qed.
- -
-Lemma free_in_context : ∀x t T Γ,
-   appears_free_in x t →
-   Γ ⊢ t ∈ T →
-   ∃T', Γ x = Some T'.
-Proof with eauto.
-  intros x t T Γ Hafi Htyp.
-  has_type_cases (induction Htyp) Case; inversion Hafi; subst...
-  Case "T_Abs".
-    destruct IHHtyp as [T' Hctx]... ∃T'.
-    unfold extend in Hctx.
-    rewrite neq_id in Hctx...
-(* let *)
-(* FILL IN HERE *)
-  Case "T_Case".
-    SCase "left".
-      destruct IHHtyp2 as [T' Hctx]... ∃T'.
-      unfold extend in Hctx.
-      rewrite neq_id in Hctx...
-    SCase "right".
-      destruct IHHtyp3 as [T' Hctx]... ∃T'.
-      unfold extend in Hctx.
-      rewrite neq_id in Hctx...
-  Case "T_Lcase".
-    clear Htyp1 IHHtyp1 Htyp2 IHHtyp2.
-    destruct IHHtyp3 as [T' Hctx]... ∃T'.
-    unfold extend in Hctx.
-    rewrite neq_id in Hctx... rewrite neq_id in Hctx...
-Qed.
- -
-
- -
-

Substitution

- -
-
- -
-Lemma substitution_preserves_typing : ∀Γ x U v t S,
-     (extend Γ x U) ⊢ t ∈ S →
-     empty ⊢ v ∈ U →
-     Γ ⊢ ([x:=v]t) ∈ S.
-Proof with eauto.
-  (* Theorem: If Gamma,x:U |- t : S and empty |- v : U, then 
-     Gamma |- x:=vt : S. *)
-  intros Γ x U v t S Htypt Htypv.
-  generalize dependent Γ. generalize dependent S.
-  (* Proof: By induction on the term t.  Most cases follow directly
-     from the IH, with the exception of tvar and tabs.
-     The former aren't automatic because we must reason about how the
-     variables interact. *)
-  t_cases (induction t) Case;
-    intros S Γ Htypt; simpl; inversion Htypt; subst...
-  Case "tvar".
-    simpl. rename i into y.
-    (* If t = y, we know that
-         empty ⊢ v : U and
-         Γ,x:U ⊢ y : S
-       and, by inversion, extend Γ x U y = Some S.  We want to
-       show that Γ ⊢ [x:=v]y : S.
-
-       There are two cases to consider: either x=y or x≠y. *)
-    destruct (eq_id_dec x y).
-    SCase "x=y".
-    (* If x = y, then we know that U = S, and that [x:=v]y = v.
-       So what we really must show is that if empty ⊢ v : U then
-       Γ ⊢ v : U.  We have already proven a more general version
-       of this theorem, called context invariance. *)
-      subst.
-      unfold extend in H1. rewrite eq_id in H1.
-      inversion H1; subst. clear H1.
-      eapply context_invariance...
-      intros x Hcontra.
-      destruct (free_in_context _ _ S empty Hcontra) as [T' HT']...
-      inversion HT'.
-    SCase "x≠y".
-    (* If x ≠ y, then Γ y = Some S and the substitution has no
-       effect.  We can show that Γ ⊢ y : S by T_Var. *)
-      apply T_Var... unfold extend in H1. rewrite neq_id in H1...
-  Case "tabs".
-    rename i into y. rename t into T11.
-    (* If t = tabs y T11 t0, then we know that
-         Γ,x:U ⊢ tabs y T11 t0 : T11→T12
-         Γ,x:U,y:T11 ⊢ t0 : T12
-         empty ⊢ v : U
-       As our IH, we know that forall S Gamma, 
-         Γ,x:U ⊢ t0 : S → Γ ⊢ [x:=v]t0 : S.
-    
-       We can calculate that 
-         x:=vt = tabs y T11 (if beq_id x y then t0 else x:=vt0)
-       And we must show that Γ ⊢ [x:=v]t : T11→T12.  We know
-       we will do so using T_Abs, so it remains to be shown that:
-         Γ,y:T11 ⊢ if beq_id x y then t0 else [x:=v]t0 : T12
-       We consider two cases: x = y and x ≠ y.
-    *)
-    apply T_Abs...
-    destruct (eq_id_dec x y).
-    SCase "x=y".
-    (* If x = y, then the substitution has no effect.  Context
-       invariance shows that Γ,y:U,y:T11 and Γ,y:T11 are
-       equivalent.  Since the former context shows that t0 : T12, so
-       does the latter. *)
-      eapply context_invariance...
-      subst.
-      intros x Hafi. unfold extend.
-      destruct (eq_id_dec y x)...
-    SCase "x≠y".
-    (* If x ≠ y, then the IH and context invariance allow us to show that
-         Γ,x:U,y:T11 ⊢ t0 : T12       =>
-         Γ,y:T11,x:U ⊢ t0 : T12       =>
-         Γ,y:T11 ⊢ [x:=v]t0 : T12 *)
-      apply IHt. eapply context_invariance...
-      intros z Hafi. unfold extend.
-      destruct (eq_id_dec y z)...
-      subst. rewrite neq_id...
-(* let *)
-(* FILL IN HERE *)
-  Case "tcase".
-    rename i into x1. rename i0 into x2.
-    eapply T_Case...
-      SCase "left arm".
-       destruct (eq_id_dec x x1).
-       SSCase "x = x1".
-        eapply context_invariance...
-        subst.
-        intros z Hafi. unfold extend.
-        destruct (eq_id_dec x1 z)...
-       SSCase "x ≠ x1".
-         apply IHt2. eapply context_invariance...
-         intros z Hafi. unfold extend.
-         destruct (eq_id_dec x1 z)...
-           subst. rewrite neq_id...
-      SCase "right arm".
-       destruct (eq_id_dec x x2).
-       SSCase "x = x2".
-        eapply context_invariance...
-        subst.
-        intros z Hafi. unfold extend.
-        destruct (eq_id_dec x2 z)...
-       SSCase "x ≠ x2".
-         apply IHt3. eapply context_invariance...
-         intros z Hafi. unfold extend.
-         destruct (eq_id_dec x2 z)...
-           subst. rewrite neq_id...
-  Case "tlcase".
-    rename i into y1. rename i0 into y2.
-    eapply T_Lcase...
-    destruct (eq_id_dec x y1).
-    SCase "x=y1".
-      simpl.
-      eapply context_invariance...
-      subst.
-      intros z Hafi. unfold extend.
-      destruct (eq_id_dec y1 z)...
-    SCase "x≠y1".
-      destruct (eq_id_dec x y2).
-      SSCase "x=y2".
-        eapply context_invariance...
-        subst.
-        intros z Hafi. unfold extend.
-        destruct (eq_id_dec y2 z)...
-      SSCase "x≠y2".
-        apply IHt3. eapply context_invariance...
-        intros z Hafi. unfold extend.
-        destruct (eq_id_dec y1 z)...
-        subst. rewrite neq_id...
-        destruct (eq_id_dec y2 z)...
-        subst. rewrite neq_id...
-Qed.
- -
-
- -
-

Preservation

- -
-
- -
-Theorem preservation : ∀t t' T,
-     empty ⊢ t ∈ T →
-     t ⇒ t' →
-     empty ⊢ t' ∈ T.
-Proof with eauto.
-  intros t t' T HT.
-  (* Theorem: If empty ⊢ t : T and t ⇒ t', then empty ⊢ t' : T. *)
-  remember (@empty ty) as Γ. generalize dependent HeqGamma.
-  generalize dependent t'.
-  (* Proof: By induction on the given typing derivation.  Many cases are
-     contradictory (T_Var, T_Abs).  We show just the interesting ones. *)
-  has_type_cases (induction HT) Case;
-    intros t' HeqGamma HE; subst; inversion HE; subst...
-  Case "T_App".
-    (* If the last rule used was T_App, then t = t1 t2, and three rules
-       could have been used to show t ⇒ t': ST_App1, ST_App2, and 
-       ST_AppAbs. In the first two cases, the result follows directly from 
-       the IH. *)
-    inversion HE; subst...
-    SCase "ST_AppAbs".
-      (* For the third case, suppose 
-           t1 = tabs x T11 t12
-         and
-           t2 = v2.  
-         We must show that empty ⊢ [x:=v2]t12 : T2. 
-         We know by assumption that
-             empty ⊢ tabs x T11 t12 : T1→T2
-         and by inversion
-             x:T1 ⊢ t12 : T2
-         We have already proven that substitution_preserves_typing and 
-             empty ⊢ v2 : T1
-         by assumption, so we are done. *)
-      apply substitution_preserves_typing with T1...
-      inversion HT1...
-  Case "T_Fst".
-    inversion HT...
-  Case "T_Snd".
-    inversion HT...
-(* let *)
-(* FILL IN HERE *)
-  Case "T_Case".
-    SCase "ST_CaseInl".
-      inversion HT1; subst.
-      eapply substitution_preserves_typing...
-    SCase "ST_CaseInr".
-      inversion HT1; subst.
-      eapply substitution_preserves_typing...
-  Case "T_Lcase".
-    SCase "ST_LcaseCons".
-      inversion HT1; subst.
-      apply substitution_preserves_typing with (TList T1)...
-      apply substitution_preserves_typing with T1...
-(* fix *)
-(* FILL IN HERE *)
-Qed.
-
- -
-☐ -
-
- -
-End STLCExtended.
- -
-(* $Date: 2013-12-03 07:45:41 -0500 (Tue, 03 Dec 2013) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/MoreStlc.v b/MoreStlc.v deleted file mode 100644 index e739dbd..0000000 --- a/MoreStlc.v +++ /dev/null @@ -1,2234 +0,0 @@ -(** * MoreStlc: More on the Simply Typed Lambda-Calculus *) - -Require Export Stlc. - -(* ###################################################################### *) -(** * Simple Extensions to STLC *) - -(** The simply typed lambda-calculus has enough structure to make its - theoretical properties interesting, but it is not much of a - programming language. In this chapter, we begin to close the gap - with real-world languages by introducing a number of familiar - features that have straightforward treatments at the level of - typing. *) - -(** ** Numbers *) - -(** Adding types, constants, and primitive operations for numbers is - easy -- just a matter of combining the [Types] and [Stlc] - chapters. *) - -(** ** [let]-bindings *) - -(** When writing a complex expression, it is often useful to give - names to some of its subexpressions: this avoids repetition and - often increases readability. Most languages provide one or more - ways of doing this. In OCaml (and Coq), for example, we can write - [let x=t1 in t2] to mean ``evaluate the expression [t1] and bind - the name [x] to the resulting value while evaluating [t2].'' - - Our [let]-binder follows OCaml's in choosing a call-by-value - evaluation order, where the [let]-bound term must be fully - evaluated before evaluation of the [let]-body can begin. The - typing rule [T_Let] tells us that the type of a [let] can be - calculated by calculating the type of the [let]-bound term, - extending the context with a binding with this type, and in this - enriched context calculating the type of the body, which is then - the type of the whole [let] expression. - - At this point in the course, it's probably easier simply to look - at the rules defining this new feature as to wade through a lot of - english text conveying the same information. Here they are: *) - - -(** Syntax: -<< - t ::= Terms - | ... (other terms same as before) - | let x=t in t let-binding ->> -*) - -(** - Reduction: - t1 ==> t1' - ---------------------------------- (ST_Let1) - let x=t1 in t2 ==> let x=t1' in t2 - - ---------------------------- (ST_LetValue) - let x=v1 in t2 ==> [x:=v1]t2 - Typing: - Gamma |- t1 : T1 Gamma , x:T1 |- t2 : T2 - -------------------------------------------- (T_Let) - Gamma |- let x=t1 in t2 : T2 - *) - -(** ** Pairs *) - -(** Our functional programming examples in Coq have made - frequent use of _pairs_ of values. The type of such pairs is - called a _product type_. - - The formalization of pairs is almost too simple to be worth - discussing. However, let's look briefly at the various parts of - the definition to emphasize the common pattern. *) - -(** In Coq, the primitive way of extracting the components of a pair - is _pattern matching_. An alternative style is to take [fst] and - [snd] -- the first- and second-projection operators -- as - primitives. Just for fun, let's do our products this way. For - example, here's how we'd write a function that takes a pair of - numbers and returns the pair of their sum and difference: -<< - \x:Nat*Nat. - let sum = x.fst + x.snd in - let diff = x.fst - x.snd in - (sum,diff) ->> -*) - -(** Adding pairs to the simply typed lambda-calculus, then, involves - adding two new forms of term -- pairing, written [(t1,t2)], and - projection, written [t.fst] for the first projection from [t] and - [t.snd] for the second projection -- plus one new type constructor, - [T1*T2], called the _product_ of [T1] and [T2]. *) - -(** Syntax: -<< - t ::= Terms - | ... - | (t,t) pair - | t.fst first projection - | t.snd second projection - - v ::= Values - | ... - | (v,v) pair value - - T ::= Types - | ... - | T * T product type ->> -*) - -(** For evaluation, we need several new rules specifying how pairs and - projection behave. - t1 ==> t1' - -------------------- (ST_Pair1) - (t1,t2) ==> (t1',t2) - - t2 ==> t2' - -------------------- (ST_Pair2) - (v1,t2) ==> (v1,t2') - - t1 ==> t1' - ------------------ (ST_Fst1) - t1.fst ==> t1'.fst - - ------------------ (ST_FstPair) - (v1,v2).fst ==> v1 - - t1 ==> t1' - ------------------ (ST_Snd1) - t1.snd ==> t1'.snd - - ------------------ (ST_SndPair) - (v1,v2).snd ==> v2 -*) - -(** - Rules [ST_FstPair] and [ST_SndPair] specify that, when a fully - evaluated pair meets a first or second projection, the result is - the appropriate component. The congruence rules [ST_Fst1] and - [ST_Snd1] allow reduction to proceed under projections, when the - term being projected from has not yet been fully evaluated. - [ST_Pair1] and [ST_Pair2] evaluate the parts of pairs: first the - left part, and then -- when a value appears on the left -- the right - part. The ordering arising from the use of the metavariables [v] - and [t] in these rules enforces a left-to-right evaluation - strategy for pairs. (Note the implicit convention that - metavariables like [v] and [v1] can only denote values.) We've - also added a clause to the definition of values, above, specifying - that [(v1,v2)] is a value. The fact that the components of a pair - value must themselves be values ensures that a pair passed as an - argument to a function will be fully evaluated before the function - body starts executing. *) - -(** The typing rules for pairs and projections are straightforward. - Gamma |- t1 : T1 Gamma |- t2 : T2 - --------------------------------------- (T_Pair) - Gamma |- (t1,t2) : T1*T2 - - Gamma |- t1 : T11*T12 - --------------------- (T_Fst) - Gamma |- t1.fst : T11 - - Gamma |- t1 : T11*T12 - --------------------- (T_Snd) - Gamma |- t1.snd : T12 -*) - -(** The rule [T_Pair] says that [(t1,t2)] has type [T1*T2] if [t1] has - type [T1] and [t2] has type [T2]. Conversely, the rules [T_Fst] - and [T_Snd] tell us that, if [t1] has a product type - [T11*T12] (i.e., if it will evaluate to a pair), then the types of - the projections from this pair are [T11] and [T12]. *) - -(** ** Unit *) - -(** Another handy base type, found especially in languages in - the ML family, is the singleton type [Unit]. *) -(** It has a single element -- the term constant [unit] (with a small - [u]) -- and a typing rule making [unit] an element of [Unit]. We - also add [unit] to the set of possible result values of - computations -- indeed, [unit] is the _only_ possible result of - evaluating an expression of type [Unit]. *) - -(** Syntax: -<< - t ::= Terms - | ... - | unit unit value - - v ::= Values - | ... - | unit unit - - T ::= Types - | ... - | Unit Unit type ->> - Typing: - -------------------- (T_Unit) - Gamma |- unit : Unit -*) - -(** It may seem a little strange to bother defining a type that - has just one element -- after all, wouldn't every computation - living in such a type be trivial? - - This is a fair question, and indeed in the STLC the [Unit] type is - not especially critical (though we'll see two uses for it below). - Where [Unit] really comes in handy is in richer languages with - various sorts of _side effects_ -- e.g., assignment statements - that mutate variables or pointers, exceptions and other sorts of - nonlocal control structures, etc. In such languages, it is - convenient to have a type for the (trivial) result of an - expression that is evaluated only for its effect. *) - -(** ** Sums *) - -(** Many programs need to deal with values that can take two distinct - forms. For example, we might identify employees in an accounting - application using using _either_ their name _or_ their id number. - A search function might return _either_ a matching value _or_ an - error code. - - These are specific examples of a binary _sum type_, - which describes a set of values drawn from exactly two given types, e.g. -<< - Nat + Bool ->> -*) - - - -(** We create elements of these types by _tagging_ elements of - the component types. For example, if [n] is a [Nat] then [inl v] - is an element of [Nat+Bool]; similarly, if [b] is a [Bool] then - [inr b] is a [Nat+Bool]. The names of the tags [inl] and [inr] - arise from thinking of them as functions - -<< - inl : Nat -> Nat + Bool - inr : Bool -> Nat + Bool ->> - - that "inject" elements of [Nat] or [Bool] into the left and right - components of the sum type [Nat+Bool]. (But note that we don't - actually treat them as functions in the way we formalize them: - [inl] and [inr] are keywords, and [inl t] and [inr t] are primitive - syntactic forms, not function applications. This allows us to give - them their own special typing rules.) *) - -(** In general, the elements of a type [T1 + T2] consist of the - elements of [T1] tagged with the token [inl], plus the elements of - [T2] tagged with [inr]. *) - -(** One important usage of sums is signaling errors: -<< - div : Nat -> Nat -> (Nat + Unit) = - div = - \x:Nat. \y:Nat. - if iszero y then - inr unit - else - inl ... ->> - The type [Nat + Unit] above is in fact isomorphic to [option nat] - in Coq, and we've already seen how to signal errors with options. *) - -(** To _use_ elements of sum types, we introduce a [case] - construct (a very simplified form of Coq's [match]) to destruct - them. For example, the following procedure converts a [Nat+Bool] - into a [Nat]: *) - -(** -<< - getNat = - \x:Nat+Bool. - case x of - inl n => n - | inr b => if b then 1 else 0 ->> -*) - -(** More formally... *) - -(** Syntax: -<< - t ::= Terms - | ... - | inl T t tagging (left) - | inr T t tagging (right) - | case t of case - inl x => t - | inr x => t - - v ::= Values - | ... - | inl T v tagged value (left) - | inr T v tagged value (right) - - T ::= Types - | ... - | T + T sum type ->> -*) - -(** Evaluation: - - t1 ==> t1' - ---------------------- (ST_Inl) - inl T t1 ==> inl T t1' - - t1 ==> t1' - ---------------------- (ST_Inr) - inr T t1 ==> inr T t1' - - t0 ==> t0' - ------------------------------------------- (ST_Case) - case t0 of inl x1 => t1 | inr x2 => t2 ==> - case t0' of inl x1 => t1 | inr x2 => t2 - - ---------------------------------------------- (ST_CaseInl) - case (inl T v0) of inl x1 => t1 | inr x2 => t2 - ==> [x1:=v0]t1 - - ---------------------------------------------- (ST_CaseInr) - case (inr T v0) of inl x1 => t1 | inr x2 => t2 - ==> [x2:=v0]t2 -*) - -(** Typing: - Gamma |- t1 : T1 - ---------------------------- (T_Inl) - Gamma |- inl T2 t1 : T1 + T2 - - Gamma |- t1 : T2 - ---------------------------- (T_Inr) - Gamma |- inr T1 t1 : T1 + T2 - - Gamma |- t0 : T1+T2 - Gamma , x1:T1 |- t1 : T - Gamma , x2:T2 |- t2 : T - --------------------------------------------------- (T_Case) - Gamma |- case t0 of inl x1 => t1 | inr x2 => t2 : T - - We use the type annotation in [inl] and [inr] to make the typing - simpler, similarly to what we did for functions. *) -(** Without this extra - information, the typing rule [T_Inl], for example, would have to - say that, once we have shown that [t1] is an element of type [T1], - we can derive that [inl t1] is an element of [T1 + T2] for _any_ - type T2. For example, we could derive both [inl 5 : Nat + Nat] - and [inl 5 : Nat + Bool] (and infinitely many other types). - This failure of uniqueness of types would mean that we cannot - build a typechecking algorithm simply by "reading the rules from - bottom to top" as we could for all the other features seen so far. - - There are various ways to deal with this difficulty. One simple - one -- which we've adopted here -- forces the programmer to - explicitly annotate the "other side" of a sum type when performing - an injection. This is rather heavyweight for programmers (and so - real languages adopt other solutions), but it is easy to - understand and formalize. *) - - - -(** ** Lists *) - -(** The typing features we have seen can be classified into _base - types_ like [Bool], and _type constructors_ like [->] and [*] that - build new types from old ones. Another useful type constructor is - [List]. For every type [T], the type [List T] describes - finite-length lists whose elements are drawn from [T]. - - In principle, we could encode lists using pairs, sums and - _recursive_ types. But giving semantics to recursive types is - non-trivial. Instead, we'll just discuss the special case of lists - directly. - - Below we give the syntax, semantics, and typing rules for lists. - Except for the fact that explicit type annotations are mandatory - on [nil] and cannot appear on [cons], these lists are essentially - identical to those we built in Coq. We use [lcase] to destruct - lists, to avoid dealing with questions like "what is the [head] of - the empty list?" *) - -(** For example, here is a function that calculates the sum of - the first two elements of a list of numbers: -<< - \x:List Nat. - lcase x of nil -> 0 - | a::x' -> lcase x' of nil -> a - | b::x'' -> a+b ->> -*) - -(** - Syntax: -<< - t ::= Terms - | ... - | nil T - | cons t t - | lcase t of nil -> t | x::x -> t - - v ::= Values - | ... - | nil T nil value - | cons v v cons value - - T ::= Types - | ... - | List T list of Ts ->> -*) - -(** Reduction: - t1 ==> t1' - -------------------------- (ST_Cons1) - cons t1 t2 ==> cons t1' t2 - - t2 ==> t2' - -------------------------- (ST_Cons2) - cons v1 t2 ==> cons v1 t2' - - t1 ==> t1' - ---------------------------------------- (ST_Lcase1) - (lcase t1 of nil -> t2 | xh::xt -> t3) ==> - (lcase t1' of nil -> t2 | xh::xt -> t3) - - ----------------------------------------- (ST_LcaseNil) - (lcase nil T of nil -> t2 | xh::xt -> t3) - ==> t2 - - ----------------------------------------------- (ST_LcaseCons) - (lcase (cons vh vt) of nil -> t2 | xh::xt -> t3) - ==> [xh:=vh,xt:=vt]t3 -*) - -(** Typing: - ----------------------- (T_Nil) - Gamma |- nil T : List T - - Gamma |- t1 : T Gamma |- t2 : List T - ----------------------------------------- (T_Cons) - Gamma |- cons t1 t2: List T - - Gamma |- t1 : List T1 - Gamma |- t2 : T - Gamma , h:T1, t:List T1 |- t3 : T - ------------------------------------------------- (T_Lcase) - Gamma |- (lcase t1 of nil -> t2 | h::t -> t3) : T -*) - - -(** ** General Recursion *) - -(** Another facility found in most programming languages (including - Coq) is the ability to define recursive functions. For example, - we might like to be able to define the factorial function like - this: -<< - fact = \x:Nat. - if x=0 then 1 else x * (fact (pred x))) ->> - But this would require quite a bit of work to formalize: we'd have - to introduce a notion of "function definitions" and carry around an - "environment" of such definitions in the definition of the [step] - relation. *) - -(** Here is another way that is straightforward to formalize: instead - of writing recursive definitions where the right-hand side can - contain the identifier being defined, we can define a _fixed-point - operator_ that performs the "unfolding" of the recursive definition - in the right-hand side lazily during reduction. -<< - fact = - fix - (\f:Nat->Nat. - \x:Nat. - if x=0 then 1 else x * (f (pred x))) ->> -*) - - -(** The intuition is that the higher-order function [f] passed - to [fix] is a _generator_ for the [fact] function: if [fact] is - applied to a function that approximates the desired behavior of - [fact] up to some number [n] (that is, a function that returns - correct results on inputs less than or equal to [n]), then it - returns a better approximation to [fact] -- a function that returns - correct results for inputs up to [n+1]. Applying [fix] to this - generator returns its _fixed point_ -- a function that gives the - desired behavior for all inputs [n]. - - (The term "fixed point" has exactly the same sense as in ordinary - mathematics, where a fixed point of a function [f] is an input [x] - such that [f(x) = x]. Here, a fixed point of a function [F] of - type (say) [(Nat->Nat)->(Nat->Nat)] is a function [f] such that [F - f] is behaviorally equivalent to [f].) *) - -(** Syntax: -<< - t ::= Terms - | ... - | fix t fixed-point operator ->> - Reduction: - t1 ==> t1' - ------------------ (ST_Fix1) - fix t1 ==> fix t1' - - F = \xf:T1.t2 - ----------------------- (ST_FixAbs) - fix F ==> [xf:=fix F]t2 - Typing: - Gamma |- t1 : T1->T1 - -------------------- (T_Fix) - Gamma |- fix t1 : T1 - *) - -(** Let's see how [ST_FixAbs] works by reducing [fact 3 = fix F 3], - where [F = (\f. \x. if x=0 then 1 else x * (f (pred x)))] (we are - omitting type annotations for brevity here). -<< -fix F 3 ->> -[==>] [ST_FixAbs] -<< -(\x. if x=0 then 1 else x * (fix F (pred x))) 3 ->> -[==>] [ST_AppAbs] -<< -if 3=0 then 1 else 3 * (fix F (pred 3)) ->> -[==>] [ST_If0_Nonzero] -<< -3 * (fix F (pred 3)) ->> -[==>] [ST_FixAbs + ST_Mult2] -<< -3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 3)) ->> -[==>] [ST_PredNat + ST_Mult2 + ST_App2] -<< -3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 2) ->> -[==>] [ST_AppAbs + ST_Mult2] -<< -3 * (if 2=0 then 1 else 2 * (fix F (pred 2))) ->> -[==>] [ST_If0_Nonzero + ST_Mult2] -<< -3 * (2 * (fix F (pred 2))) ->> -[==>] [ST_FixAbs + 2 x ST_Mult2] -<< -3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 2))) ->> -[==>] [ST_PredNat + 2 x ST_Mult2 + ST_App2] -<< -3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 1)) ->> -[==>] [ST_AppAbs + 2 x ST_Mult2] -<< -3 * (2 * (if 1=0 then 1 else 1 * (fix F (pred 1)))) ->> -[==>] [ST_If0_Nonzero + 2 x ST_Mult2] -<< -3 * (2 * (1 * (fix F (pred 1)))) ->> -[==>] [ST_FixAbs + 3 x ST_Mult2] -<< -3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 1)))) ->> -[==>] [ST_PredNat + 3 x ST_Mult2 + ST_App2] -<< -3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 0))) ->> -[==>] [ST_AppAbs + 3 x ST_Mult2] -<< -3 * (2 * (1 * (if 0=0 then 1 else 0 * (fix F (pred 0))))) ->> -[==>] [ST_If0Zero + 3 x ST_Mult2] -<< -3 * (2 * (1 * 1)) ->> -[==>] [ST_MultNats + 2 x ST_Mult2] -<< -3 * (2 * 1) ->> -[==>] [ST_MultNats + ST_Mult2] -<< -3 * 2 ->> -[==>] [ST_MultNats] -<< -6 ->> -*) - - -(** **** Exercise: 1 star (halve_fix) *) -(** Translate this informal recursive definition into one using [fix]: -<< - halve = - \x:Nat. - if x=0 then 0 - else if (pred x)=0 then 0 - else 1 + (halve (pred (pred x)))) ->> -(* FILL IN HERE *) -[] -*) - -(** **** Exercise: 1 star (fact_steps) *) -(** Write down the sequence of steps that the term [fact 1] goes - through to reduce to a normal form (assuming the usual reduction - rules for arithmetic operations). - - (* FILL IN HERE *) -[] -*) - -(** The ability to form the fixed point of a function of type [T->T] - for any [T] has some surprising consequences. In particular, it - implies that _every_ type is inhabited by some term. To see this, - observe that, for every type [T], we can define the term - fix (\x:T.x) - By [T_Fix] and [T_Abs], this term has type [T]. By [ST_FixAbs] - it reduces to itself, over and over again. Thus it is an - _undefined element_ of [T]. - - More usefully, here's an example using [fix] to define a - two-argument recursive function: -<< - equal = - fix - (\eq:Nat->Nat->Bool. - \m:Nat. \n:Nat. - if m=0 then iszero n - else if n=0 then false - else eq (pred m) (pred n)) ->> - - And finally, here is an example where [fix] is used to define a - _pair_ of recursive functions (illustrating the fact that the type - [T1] in the rule [T_Fix] need not be a function type): -<< - evenodd = - fix - (\eo: (Nat->Bool * Nat->Bool). - let e = \n:Nat. if n=0 then true else eo.snd (pred n) in - let o = \n:Nat. if n=0 then false else eo.fst (pred n) in - (e,o)) - - even = evenodd.fst - odd = evenodd.snd ->> -*) - -(* ###################################################################### *) -(** ** Records *) - -(** As a final example of a basic extension of the STLC, let's - look briefly at how to define _records_ and their types. - Intuitively, records can be obtained from pairs by two kinds of - generalization: they are n-ary products (rather than just binary) - and their fields are accessed by _label_ (rather than position). - - Conceptually, this extension is a straightforward generalization - of pairs and product types, but notationally it becomes a little - heavier; for this reason, we postpone its formal treatment to a - separate chapter ([Records]). *) - -(** Records are not included in the extended exercise below, but - they will be useful to motivate the [Sub] chapter. *) - -(** Syntax: -<< - t ::= Terms - | ... - | {i1=t1, ..., in=tn} record - | t.i projection - - v ::= Values - | ... - | {i1=v1, ..., in=vn} record value - - T ::= Types - | ... - | {i1:T1, ..., in:Tn} record type ->> - Intuitively, the generalization is pretty obvious. But it's worth - noticing that what we've actually written is rather informal: in - particular, we've written "[...]" in several places to mean "any - number of these," and we've omitted explicit mention of the usual - side-condition that the labels of a record should not contain - repetitions. *) -(* It is possible to devise informal notations that are - more precise, but these tend to be quite heavy and to obscure the - main points of the definitions. So we'll leave these a bit loose - here (they are informal anyway, after all) and do the work of - tightening things up elsewhere (in chapter [Records]). *) - -(** - Reduction: - ti ==> ti' - ------------------------------------ (ST_Rcd) - {i1=v1, ..., im=vm, in=ti, ...} - ==> {i1=v1, ..., im=vm, in=ti', ...} - - t1 ==> t1' - -------------- (ST_Proj1) - t1.i ==> t1'.i - - ------------------------- (ST_ProjRcd) - {..., i=vi, ...}.i ==> vi - Again, these rules are a bit informal. For example, the first rule - is intended to be read "if [ti] is the leftmost field that is not a - value and if [ti] steps to [ti'], then the whole record steps..." - In the last rule, the intention is that there should only be one - field called i, and that all the other fields must contain values. *) - -(** - Typing: - Gamma |- t1 : T1 ... Gamma |- tn : Tn - -------------------------------------------------- (T_Rcd) - Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn} - - Gamma |- t : {..., i:Ti, ...} - ----------------------------- (T_Proj) - Gamma |- t.i : Ti - -*) - -(* ###################################################################### *) -(** *** Encoding Records (Optional) *) - -(** There are several ways to make the above definitions precise. - - - We can directly formalize the syntactic forms and inference - rules, staying as close as possible to the form we've given - them above. This is conceptually straightforward, and it's - probably what we'd want to do if we were building a real - compiler -- in particular, it will allow is to print error - messages in the form that programmers will find easy to - understand. But the formal versions of the rules will not be - pretty at all! - - - We could look for a smoother way of presenting records -- for - example, a binary presentation with one constructor for the - empty record and another constructor for adding a single field - to an existing record, instead of a single monolithic - constructor that builds a whole record at once. This is the - right way to go if we are primarily interested in studying the - metatheory of the calculi with records, since it leads to - clean and elegant definitions and proofs. Chapter [Records] - shows how this can be done. - - - Alternatively, if we like, we can avoid formalizing records - altogether, by stipulating that record notations are just - informal shorthands for more complex expressions involving - pairs and product types. We sketch this approach here. - - First, observe that we can encode arbitrary-size tuples using - nested pairs and the [unit] value. To avoid overloading the pair - notation [(t1,t2)], we'll use curly braces without labels to write - down tuples, so [{}] is the empty tuple, [{5}] is a singleton - tuple, [{5,6}] is a 2-tuple (morally the same as a pair), - [{5,6,7}] is a triple, etc. -<< - {} ----> unit - {t1, t2, ..., tn} ----> (t1, trest) - where {t2, ..., tn} ----> trest ->> - Similarly, we can encode tuple types using nested product types: -<< - {} ----> Unit - {T1, T2, ..., Tn} ----> T1 * TRest - where {T2, ..., Tn} ----> TRest ->> - The operation of projecting a field from a tuple can be encoded - using a sequence of second projections followed by a first projection: -<< - t.0 ----> t.fst - t.(n+1) ----> (t.snd).n ->> - - Next, suppose that there is some total ordering on record labels, - so that we can associate each label with a unique natural number. - This number is called the _position_ of the label. For example, - we might assign positions like this: -<< - LABEL POSITION - a 0 - b 1 - c 2 - ... ... - foo 1004 - ... ... - bar 10562 - ... ... ->> - - We use these positions to encode record values as tuples (i.e., as - nested pairs) by sorting the fields according to their positions. - For example: -<< - {a=5, b=6} ----> {5,6} - {a=5, c=7} ----> {5,unit,7} - {c=7, a=5} ----> {5,unit,7} - {c=5, b=3} ----> {unit,3,5} - {f=8,c=5,a=7} ----> {7,unit,5,unit,unit,8} - {f=8,c=5} ----> {unit,unit,5,unit,unit,8} ->> - Note that each field appears in the position associated with its - label, that the size of the tuple is determined by the label with - the highest position, and that we fill in unused positions with - [unit]. - - We do exactly the same thing with record types: -<< - {a:Nat, b:Nat} ----> {Nat,Nat} - {c:Nat, a:Nat} ----> {Nat,Unit,Nat} - {f:Nat,c:Nat} ----> {Unit,Unit,Nat,Unit,Unit,Nat} ->> - - Finally, record projection is encoded as a tuple projection from - the appropriate position: -<< - t.l ----> t.(position of l) ->> - - It is not hard to check that all the typing rules for the original - "direct" presentation of records are validated by this - encoding. (The reduction rules are "almost validated" -- not - quite, because the encoding reorders fields.) *) - -(** Of course, this encoding will not be very efficient if we - happen to use a record with label [bar]! But things are not - actually as bad as they might seem: for example, if we assume that - our compiler can see the whole program at the same time, we can - _choose_ the numbering of labels so that we assign small positions - to the most frequently used labels. Indeed, there are industrial - compilers that essentially do this! *) - -(** *** Variants (Optional Reading) *) - -(** Just as products can be generalized to records, sums can be - generalized to n-ary labeled types called _variants_. Instead of - [T1+T2], we can write something like [] - where [l1],[l2],... are field labels which are used both to build - instances and as case arm labels. - - These n-ary variants give us almost enough mechanism to build - arbitrary inductive data types like lists and trees from - scratch -- the only thing missing is a way to allow _recursion_ in - type definitions. We won't cover this here, but detailed - treatments can be found in many textbooks -- e.g., Types and - Programming Languages. *) - -(* ###################################################################### *) -(** * Exercise: Formalizing the Extensions *) - -(** **** Exercise: 4 stars, advanced (STLC_extensions) *) -(** In this problem you will formalize a couple of the extensions - described above. We've provided the necessary additions to the - syntax of terms and types, and we've included a few examples that - you can test your definitions with to make sure they are working - as expected. You'll fill in the rest of the definitions and - extend all the proofs accordingly. - - To get you started, we've provided implementations for: - - numbers - - pairs and units - - sums - - lists - - You need to complete the implementations for: - - let (which involves binding) - - [fix] - - A good strategy is to work on the extensions one at a time, in - multiple passes, rather than trying to work through the file from - start to finish in a single pass. For each definition or proof, - begin by reading carefully through the parts that are provided for - you, referring to the text in the [Stlc] chapter for high-level - intuitions and the embedded comments for detailed mechanics. -*) - -Module STLCExtended. - -(* ###################################################################### *) -(** *** Syntax and Operational Semantics *) - -Inductive ty : Type := - | TArrow : ty -> ty -> ty - | TNat : ty - | TUnit : ty - | TProd : ty -> ty -> ty - | TSum : ty -> ty -> ty - | TList : ty -> ty. - -Tactic Notation "T_cases" tactic(first) ident(c) := - first; - [ Case_aux c "TArrow" | Case_aux c "TNat" - | Case_aux c "TProd" | Case_aux c "TUnit" - | Case_aux c "TSum" | Case_aux c "TList" ]. - -Inductive tm : Type := - (* pure STLC *) - | tvar : id -> tm - | tapp : tm -> tm -> tm - | tabs : id -> ty -> tm -> tm - (* numbers *) - | tnat : nat -> tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tmult : tm -> tm -> tm - | tif0 : tm -> tm -> tm -> tm - (* pairs *) - | tpair : tm -> tm -> tm - | tfst : tm -> tm - | tsnd : tm -> tm - (* units *) - | tunit : tm - (* let *) - | tlet : id -> tm -> tm -> tm - (* i.e., [let x = t1 in t2] *) - (* sums *) - | tinl : ty -> tm -> tm - | tinr : ty -> tm -> tm - | tcase : tm -> id -> tm -> id -> tm -> tm - (* i.e., [case t0 of inl x1 => t1 | inr x2 => t2] *) - (* lists *) - | tnil : ty -> tm - | tcons : tm -> tm -> tm - | tlcase : tm -> tm -> id -> id -> tm -> tm - (* i.e., [lcase t1 of | nil -> t2 | x::y -> t3] *) - (* fix *) - | tfix : tm -> tm. - -(** Note that, for brevity, we've omitted booleans and instead - provided a single [if0] form combining a zero test and a - conditional. That is, instead of writing -<< - if x = 0 then ... else ... ->> - we'll write this: -<< - if0 x then ... else ... ->> -*) - -Tactic Notation "t_cases" tactic(first) ident(c) := - first; - [ Case_aux c "tvar" | Case_aux c "tapp" | Case_aux c "tabs" - | Case_aux c "tnat" | Case_aux c "tsucc" | Case_aux c "tpred" - | Case_aux c "tmult" | Case_aux c "tif0" - | Case_aux c "tpair" | Case_aux c "tfst" | Case_aux c "tsnd" - | Case_aux c "tunit" | Case_aux c "tlet" - | Case_aux c "tinl" | Case_aux c "tinr" | Case_aux c "tcase" - | Case_aux c "tnil" | Case_aux c "tcons" | Case_aux c "tlcase" - | Case_aux c "tfix" ]. - -(* ###################################################################### *) -(** *** Substitution *) - -Fixpoint subst (x:id) (s:tm) (t:tm) : tm := - match t with - | tvar y => - if eq_id_dec x y then s else t - | tabs y T t1 => - tabs y T (if eq_id_dec x y then t1 else (subst x s t1)) - | tapp t1 t2 => - tapp (subst x s t1) (subst x s t2) - | tnat n => - tnat n - | tsucc t1 => - tsucc (subst x s t1) - | tpred t1 => - tpred (subst x s t1) - | tmult t1 t2 => - tmult (subst x s t1) (subst x s t2) - | tif0 t1 t2 t3 => - tif0 (subst x s t1) (subst x s t2) (subst x s t3) - | tpair t1 t2 => - tpair (subst x s t1) (subst x s t2) - | tfst t1 => - tfst (subst x s t1) - | tsnd t1 => - tsnd (subst x s t1) - | tunit => tunit - (* FILL IN HERE *) - | tinl T t1 => - tinl T (subst x s t1) - | tinr T t1 => - tinr T (subst x s t1) - | tcase t0 y1 t1 y2 t2 => - tcase (subst x s t0) - y1 (if eq_id_dec x y1 then t1 else (subst x s t1)) - y2 (if eq_id_dec x y2 then t2 else (subst x s t2)) - | tnil T => - tnil T - | tcons t1 t2 => - tcons (subst x s t1) (subst x s t2) - | tlcase t1 t2 y1 y2 t3 => - tlcase (subst x s t1) (subst x s t2) y1 y2 - (if eq_id_dec x y1 then - t3 - else if eq_id_dec x y2 then t3 - else (subst x s t3)) -(* FILL IN HERE *) - | _ => t (* ... and delete this line *) - end. - -Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). - - -(* ###################################################################### *) -(** *** Reduction *) - -(** Next we define the values of our language. *) - -Inductive value : tm -> Prop := - | v_abs : forall x T11 t12, - value (tabs x T11 t12) - (* Numbers are values: *) - | v_nat : forall n1, - value (tnat n1) - (* A pair is a value if both components are: *) - | v_pair : forall v1 v2, - value v1 -> - value v2 -> - value (tpair v1 v2) - (* A unit is always a value *) - | v_unit : value tunit - (* A tagged value is a value: *) - | v_inl : forall v T, - value v -> - value (tinl T v) - | v_inr : forall v T, - value v -> - value (tinr T v) - (* A list is a value iff its head and tail are values: *) - | v_lnil : forall T, value (tnil T) - | v_lcons : forall v1 vl, - value v1 -> - value vl -> - value (tcons v1 vl) - . - -Hint Constructors value. - -Reserved Notation "t1 '==>' t2" (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_AppAbs : forall x T11 t12 v2, - value v2 -> - (tapp (tabs x T11 t12) v2) ==> [x:=v2]t12 - | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) - | ST_App2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - (tapp v1 t2) ==> (tapp v1 t2') - (* nats *) - | ST_Succ1 : forall t1 t1', - t1 ==> t1' -> - (tsucc t1) ==> (tsucc t1') - | ST_SuccNat : forall n1, - (tsucc (tnat n1)) ==> (tnat (S n1)) - | ST_Pred : forall t1 t1', - t1 ==> t1' -> - (tpred t1) ==> (tpred t1') - | ST_PredNat : forall n1, - (tpred (tnat n1)) ==> (tnat (pred n1)) - | ST_Mult1 : forall t1 t1' t2, - t1 ==> t1' -> - (tmult t1 t2) ==> (tmult t1' t2) - | ST_Mult2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - (tmult v1 t2) ==> (tmult v1 t2') - | ST_MultNats : forall n1 n2, - (tmult (tnat n1) (tnat n2)) ==> (tnat (mult n1 n2)) - | ST_If01 : forall t1 t1' t2 t3, - t1 ==> t1' -> - (tif0 t1 t2 t3) ==> (tif0 t1' t2 t3) - | ST_If0Zero : forall t2 t3, - (tif0 (tnat 0) t2 t3) ==> t2 - | ST_If0Nonzero : forall n t2 t3, - (tif0 (tnat (S n)) t2 t3) ==> t3 - (* pairs *) - | ST_Pair1 : forall t1 t1' t2, - t1 ==> t1' -> - (tpair t1 t2) ==> (tpair t1' t2) - | ST_Pair2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - (tpair v1 t2) ==> (tpair v1 t2') - | ST_Fst1 : forall t1 t1', - t1 ==> t1' -> - (tfst t1) ==> (tfst t1') - | ST_FstPair : forall v1 v2, - value v1 -> - value v2 -> - (tfst (tpair v1 v2)) ==> v1 - | ST_Snd1 : forall t1 t1', - t1 ==> t1' -> - (tsnd t1) ==> (tsnd t1') - | ST_SndPair : forall v1 v2, - value v1 -> - value v2 -> - (tsnd (tpair v1 v2)) ==> v2 - (* let *) - (* FILL IN HERE *) - (* sums *) - | ST_Inl : forall t1 t1' T, - t1 ==> t1' -> - (tinl T t1) ==> (tinl T t1') - | ST_Inr : forall t1 t1' T, - t1 ==> t1' -> - (tinr T t1) ==> (tinr T t1') - | ST_Case : forall t0 t0' x1 t1 x2 t2, - t0 ==> t0' -> - (tcase t0 x1 t1 x2 t2) ==> (tcase t0' x1 t1 x2 t2) - | ST_CaseInl : forall v0 x1 t1 x2 t2 T, - value v0 -> - (tcase (tinl T v0) x1 t1 x2 t2) ==> [x1:=v0]t1 - | ST_CaseInr : forall v0 x1 t1 x2 t2 T, - value v0 -> - (tcase (tinr T v0) x1 t1 x2 t2) ==> [x2:=v0]t2 - (* lists *) - | ST_Cons1 : forall t1 t1' t2, - t1 ==> t1' -> - (tcons t1 t2) ==> (tcons t1' t2) - | ST_Cons2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - (tcons v1 t2) ==> (tcons v1 t2') - | ST_Lcase1 : forall t1 t1' t2 x1 x2 t3, - t1 ==> t1' -> - (tlcase t1 t2 x1 x2 t3) ==> (tlcase t1' t2 x1 x2 t3) - | ST_LcaseNil : forall T t2 x1 x2 t3, - (tlcase (tnil T) t2 x1 x2 t3) ==> t2 - | ST_LcaseCons : forall v1 vl t2 x1 x2 t3, - value v1 -> - value vl -> - (tlcase (tcons v1 vl) t2 x1 x2 t3) ==> (subst x2 vl (subst x1 v1 t3)) - (* fix *) -(* FILL IN HERE *) - -where "t1 '==>' t2" := (step t1 t2). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2" - | Case_aux c "ST_Succ1" | Case_aux c "ST_SuccNat" - | Case_aux c "ST_Pred1" | Case_aux c "ST_PredNat" - | Case_aux c "ST_Mult1" | Case_aux c "ST_Mult2" - | Case_aux c "ST_MultNats" | Case_aux c "ST_If01" - | Case_aux c "ST_If0Zero" | Case_aux c "ST_If0Nonzero" - | Case_aux c "ST_Pair1" | Case_aux c "ST_Pair2" - | Case_aux c "ST_Fst1" | Case_aux c "ST_FstPair" - | Case_aux c "ST_Snd1" | Case_aux c "ST_SndPair" - (* FILL IN HERE *) - | Case_aux c "ST_Inl" | Case_aux c "ST_Inr" | Case_aux c "ST_Case" - | Case_aux c "ST_CaseInl" | Case_aux c "ST_CaseInr" - | Case_aux c "ST_Cons1" | Case_aux c "ST_Cons2" | Case_aux c "ST_Lcase1" - | Case_aux c "ST_LcaseNil" | Case_aux c "ST_LcaseCons" -(* FILL IN HERE *) - ]. - -Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). - -Hint Constructors step. - -(* ###################################################################### *) -(** *** Typing *) - -Definition context := partial_map ty. - -(** Next we define the typing rules. These are nearly direct - transcriptions of the inference rules shown above. *) - -Reserved Notation "Gamma '|-' t '\in' T" (at level 40). - -Inductive has_type : context -> tm -> ty -> Prop := - (* Typing rules for proper terms *) - | T_Var : forall Gamma x T, - Gamma x = Some T -> - Gamma |- (tvar x) \in T - | T_Abs : forall Gamma x T11 T12 t12, - (extend Gamma x T11) |- t12 \in T12 -> - Gamma |- (tabs x T11 t12) \in (TArrow T11 T12) - | T_App : forall T1 T2 Gamma t1 t2, - Gamma |- t1 \in (TArrow T1 T2) -> - Gamma |- t2 \in T1 -> - Gamma |- (tapp t1 t2) \in T2 - (* nats *) - | T_Nat : forall Gamma n1, - Gamma |- (tnat n1) \in TNat - | T_Succ : forall Gamma t1, - Gamma |- t1 \in TNat -> - Gamma |- (tsucc t1) \in TNat - | T_Pred : forall Gamma t1, - Gamma |- t1 \in TNat -> - Gamma |- (tpred t1) \in TNat - | T_Mult : forall Gamma t1 t2, - Gamma |- t1 \in TNat -> - Gamma |- t2 \in TNat -> - Gamma |- (tmult t1 t2) \in TNat - | T_If0 : forall Gamma t1 t2 t3 T1, - Gamma |- t1 \in TNat -> - Gamma |- t2 \in T1 -> - Gamma |- t3 \in T1 -> - Gamma |- (tif0 t1 t2 t3) \in T1 - (* pairs *) - | T_Pair : forall Gamma t1 t2 T1 T2, - Gamma |- t1 \in T1 -> - Gamma |- t2 \in T2 -> - Gamma |- (tpair t1 t2) \in (TProd T1 T2) - | T_Fst : forall Gamma t T1 T2, - Gamma |- t \in (TProd T1 T2) -> - Gamma |- (tfst t) \in T1 - | T_Snd : forall Gamma t T1 T2, - Gamma |- t \in (TProd T1 T2) -> - Gamma |- (tsnd t) \in T2 - (* unit *) - | T_Unit : forall Gamma, - Gamma |- tunit \in TUnit - (* let *) -(* FILL IN HERE *) - (* sums *) - | T_Inl : forall Gamma t1 T1 T2, - Gamma |- t1 \in T1 -> - Gamma |- (tinl T2 t1) \in (TSum T1 T2) - | T_Inr : forall Gamma t2 T1 T2, - Gamma |- t2 \in T2 -> - Gamma |- (tinr T1 t2) \in (TSum T1 T2) - | T_Case : forall Gamma t0 x1 T1 t1 x2 T2 t2 T, - Gamma |- t0 \in (TSum T1 T2) -> - (extend Gamma x1 T1) |- t1 \in T -> - (extend Gamma x2 T2) |- t2 \in T -> - Gamma |- (tcase t0 x1 t1 x2 t2) \in T - (* lists *) - | T_Nil : forall Gamma T, - Gamma |- (tnil T) \in (TList T) - | T_Cons : forall Gamma t1 t2 T1, - Gamma |- t1 \in T1 -> - Gamma |- t2 \in (TList T1) -> - Gamma |- (tcons t1 t2) \in (TList T1) - | T_Lcase : forall Gamma t1 T1 t2 x1 x2 t3 T2, - Gamma |- t1 \in (TList T1) -> - Gamma |- t2 \in T2 -> - (extend (extend Gamma x2 (TList T1)) x1 T1) |- t3 \in T2 -> - Gamma |- (tlcase t1 t2 x1 x2 t3) \in T2 - (* fix *) -(* FILL IN HERE *) - -where "Gamma '|-' t '\in' T" := (has_type Gamma t T). - -Hint Constructors has_type. - -Tactic Notation "has_type_cases" tactic(first) ident(c) := - first; - [ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App" - | Case_aux c "T_Nat" | Case_aux c "T_Succ" | Case_aux c "T_Pred" - | Case_aux c "T_Mult" | Case_aux c "T_If0" - | Case_aux c "T_Pair" | Case_aux c "T_Fst" | Case_aux c "T_Snd" - | Case_aux c "T_Unit" -(* let *) -(* FILL IN HERE *) - | Case_aux c "T_Inl" | Case_aux c "T_Inr" | Case_aux c "T_Case" - | Case_aux c "T_Nil" | Case_aux c "T_Cons" | Case_aux c "T_Lcase" -(* fix *) -(* FILL IN HERE *) -]. - -(* ###################################################################### *) -(** ** Examples *) - -(** This section presents formalized versions of the examples from - above (plus several more). The ones at the beginning focus on - specific features; you can use these to make sure your definition - of a given feature is reasonable before moving on to extending the - proofs later in the file with the cases relating to this feature. - The later examples require all the features together, so you'll - need to come back to these when you've got all the definitions - filled in. *) - -Module Examples. - -(** *** Preliminaries *) - -(** First, let's define a few variable names: *) - -Notation a := (Id 0). -Notation f := (Id 1). -Notation g := (Id 2). -Notation l := (Id 3). -Notation k := (Id 6). -Notation i1 := (Id 7). -Notation i2 := (Id 8). -Notation x := (Id 9). -Notation y := (Id 10). -Notation processSum := (Id 11). -Notation n := (Id 12). -Notation eq := (Id 13). -Notation m := (Id 14). -Notation evenodd := (Id 15). -Notation even := (Id 16). -Notation odd := (Id 17). -Notation eo := (Id 18). - -(** Next, a bit of Coq hackery to automate searching for typing - derivations. You don't need to understand this bit in detail -- - just have a look over it so that you'll know what to look for if - you ever find yourself needing to make custom extensions to - [auto]. - - The following [Hint] declarations say that, whenever [auto] - arrives at a goal of the form [(Gamma |- (tapp e1 e1) \in T)], it - should consider [eapply T_App], leaving an existential variable - for the middle type T1, and similar for [lcase]. That variable - will then be filled in during the search for type derivations for - [e1] and [e2]. We also include a hint to "try harder" when - solving equality goals; this is useful to automate uses of - [T_Var] (which includes an equality as a precondition). *) - -Hint Extern 2 (has_type _ (tapp _ _) _) => - eapply T_App; auto. -(* You'll want to uncomment the following line once - you've defined the [T_Lcase] constructor for the typing - relation: *) -(* -Hint Extern 2 (has_type _ (tlcase _ _ _ _ _) _) => - eapply T_Lcase; auto. -*) -Hint Extern 2 (_ = _) => compute; reflexivity. - -(** *** Numbers *) - -Module Numtest. - -(* if0 (pred (succ (pred (2 * 0))) then 5 else 6 *) -Definition test := - tif0 - (tpred - (tsucc - (tpred - (tmult - (tnat 2) - (tnat 0))))) - (tnat 5) - (tnat 6). - -(** Remove the comment braces once you've implemented enough of the - definitions that you think this should work. *) - -(* -Example typechecks : - (@empty ty) |- test \in TNat. -Proof. - unfold test. - (* This typing derivation is quite deep, so we need to increase the - max search depth of [auto] from the default 5 to 10. *) - auto 10. -Qed. - -Example numtest_reduces : - test ==>* tnat 5. -Proof. - unfold test. normalize. -Qed. -*) - -End Numtest. - -(** *** Products *) - -Module Prodtest. - -(* ((5,6),7).fst.snd *) -Definition test := - tsnd - (tfst - (tpair - (tpair - (tnat 5) - (tnat 6)) - (tnat 7))). - -(* -Example typechecks : - (@empty ty) |- test \in TNat. -Proof. unfold test. eauto 15. Qed. - -Example reduces : - test ==>* tnat 6. -Proof. unfold test. normalize. Qed. -*) - -End Prodtest. - -(** *** [let] *) - -Module LetTest. - -(* let x = pred 6 in succ x *) -Definition test := - tlet - x - (tpred (tnat 6)) - (tsucc (tvar x)). - -(* -Example typechecks : - (@empty ty) |- test \in TNat. -Proof. unfold test. eauto 15. Qed. - -Example reduces : - test ==>* tnat 6. -Proof. unfold test. normalize. Qed. -*) - -End LetTest. - -(** *** Sums *) - -Module Sumtest1. - -(* case (inl Nat 5) of - inl x => x - | inr y => y *) - -Definition test := - tcase (tinl TNat (tnat 5)) - x (tvar x) - y (tvar y). - -(* -Example typechecks : - (@empty ty) |- test \in TNat. -Proof. unfold test. eauto 15. Qed. - -Example reduces : - test ==>* (tnat 5). -Proof. unfold test. normalize. Qed. -*) - -End Sumtest1. - -Module Sumtest2. - -(* let processSum = - \x:Nat+Nat. - case x of - inl n => n - inr n => if0 n then 1 else 0 in - (processSum (inl Nat 5), processSum (inr Nat 5)) *) - -Definition test := - tlet - processSum - (tabs x (TSum TNat TNat) - (tcase (tvar x) - n (tvar n) - n (tif0 (tvar n) (tnat 1) (tnat 0)))) - (tpair - (tapp (tvar processSum) (tinl TNat (tnat 5))) - (tapp (tvar processSum) (tinr TNat (tnat 5)))). - -(* -Example typechecks : - (@empty ty) |- test \in (TProd TNat TNat). -Proof. unfold test. eauto 15. Qed. - -Example reduces : - test ==>* (tpair (tnat 5) (tnat 0)). -Proof. unfold test. normalize. Qed. -*) - -End Sumtest2. - -(** *** Lists *) - -Module ListTest. - -(* let l = cons 5 (cons 6 (nil Nat)) in - lcase l of - nil => 0 - | x::y => x*x *) - -Definition test := - tlet l - (tcons (tnat 5) (tcons (tnat 6) (tnil TNat))) - (tlcase (tvar l) - (tnat 0) - x y (tmult (tvar x) (tvar x))). - -(* -Example typechecks : - (@empty ty) |- test \in TNat. -Proof. unfold test. eauto 20. Qed. - -Example reduces : - test ==>* (tnat 25). -Proof. unfold test. normalize. Qed. -*) - -End ListTest. - -(** *** [fix] *) - -Module FixTest1. - -(* fact := fix - (\f:nat->nat. - \a:nat. - if a=0 then 1 else a * (f (pred a))) *) -Definition fact := - tfix - (tabs f (TArrow TNat TNat) - (tabs a TNat - (tif0 - (tvar a) - (tnat 1) - (tmult - (tvar a) - (tapp (tvar f) (tpred (tvar a))))))). - -(** (Warning: you may be able to typecheck [fact] but still have some - rules wrong!) *) - -(* -Example fact_typechecks : - (@empty ty) |- fact \in (TArrow TNat TNat). -Proof. unfold fact. auto 10. -Qed. -*) - -(* -Example fact_example: - (tapp fact (tnat 4)) ==>* (tnat 24). -Proof. unfold fact. normalize. Qed. -*) - -End FixTest1. - -Module FixTest2. - -(* map := - \g:nat->nat. - fix - (\f:[nat]->[nat]. - \l:[nat]. - case l of - | [] -> [] - | x::l -> (g x)::(f l)) *) -Definition map := - tabs g (TArrow TNat TNat) - (tfix - (tabs f (TArrow (TList TNat) (TList TNat)) - (tabs l (TList TNat) - (tlcase (tvar l) - (tnil TNat) - a l (tcons (tapp (tvar g) (tvar a)) - (tapp (tvar f) (tvar l))))))). - -(* -(* Make sure you've uncommented the last [Hint Extern] above... *) -Example map_typechecks : - empty |- map \in - (TArrow (TArrow TNat TNat) - (TArrow (TList TNat) - (TList TNat))). -Proof. unfold map. auto 10. Qed. - -Example map_example : - tapp (tapp map (tabs a TNat (tsucc (tvar a)))) - (tcons (tnat 1) (tcons (tnat 2) (tnil TNat))) - ==>* (tcons (tnat 2) (tcons (tnat 3) (tnil TNat))). -Proof. unfold map. normalize. Qed. -*) - -End FixTest2. - -Module FixTest3. - -(* equal = - fix - (\eq:Nat->Nat->Bool. - \m:Nat. \n:Nat. - if0 m then (if0 n then 1 else 0) - else if0 n then 0 - else eq (pred m) (pred n)) *) - -Definition equal := - tfix - (tabs eq (TArrow TNat (TArrow TNat TNat)) - (tabs m TNat - (tabs n TNat - (tif0 (tvar m) - (tif0 (tvar n) (tnat 1) (tnat 0)) - (tif0 (tvar n) - (tnat 0) - (tapp (tapp (tvar eq) - (tpred (tvar m))) - (tpred (tvar n)))))))). - -(* -Example equal_typechecks : - (@empty ty) |- equal \in (TArrow TNat (TArrow TNat TNat)). -Proof. unfold equal. auto 10. -Qed. -*) - -(* -Example equal_example1: - (tapp (tapp equal (tnat 4)) (tnat 4)) ==>* (tnat 1). -Proof. unfold equal. normalize. Qed. -*) - -(* -Example equal_example2: - (tapp (tapp equal (tnat 4)) (tnat 5)) ==>* (tnat 0). -Proof. unfold equal. normalize. Qed. -*) - -End FixTest3. - -Module FixTest4. - -(* let evenodd = - fix - (\eo: (Nat->Nat * Nat->Nat). - let e = \n:Nat. if0 n then 1 else eo.snd (pred n) in - let o = \n:Nat. if0 n then 0 else eo.fst (pred n) in - (e,o)) in - let even = evenodd.fst in - let odd = evenodd.snd in - (even 3, even 4) -*) - -Definition eotest := - tlet evenodd - (tfix - (tabs eo (TProd (TArrow TNat TNat) (TArrow TNat TNat)) - (tpair - (tabs n TNat - (tif0 (tvar n) - (tnat 1) - (tapp (tsnd (tvar eo)) (tpred (tvar n))))) - (tabs n TNat - (tif0 (tvar n) - (tnat 0) - (tapp (tfst (tvar eo)) (tpred (tvar n)))))))) - (tlet even (tfst (tvar evenodd)) - (tlet odd (tsnd (tvar evenodd)) - (tpair - (tapp (tvar even) (tnat 3)) - (tapp (tvar even) (tnat 4))))). - -(* -Example eotest_typechecks : - (@empty ty) |- eotest \in (TProd TNat TNat). -Proof. unfold eotest. eauto 30. -Qed. -*) - -(* -Example eotest_example1: - eotest ==>* (tpair (tnat 0) (tnat 1)). -Proof. unfold eotest. normalize. Qed. -*) - -End FixTest4. - -End Examples. - -(* ###################################################################### *) -(** ** Properties of Typing *) - -(** The proofs of progress and preservation for this system are - essentially the same (though of course somewhat longer) as for the - pure simply typed lambda-calculus. *) - -(* ###################################################################### *) -(** *** Progress *) - -Theorem progress : forall t T, - empty |- t \in T -> - value t \/ exists t', t ==> t'. -Proof with eauto. - (* Theorem: Suppose empty |- t : T. Then either - 1. t is a value, or - 2. t ==> t' for some t'. - Proof: By induction on the given typing derivation. *) - intros t T Ht. - remember (@empty ty) as Gamma. - generalize dependent HeqGamma. - has_type_cases (induction Ht) Case; intros HeqGamma; subst. - Case "T_Var". - (* The final rule in the given typing derivation cannot be [T_Var], - since it can never be the case that [empty |- x : T] (since the - context is empty). *) - inversion H. - Case "T_Abs". - (* If the [T_Abs] rule was the last used, then [t = tabs x T11 t12], - which is a value. *) - left... - Case "T_App". - (* If the last rule applied was T_App, then [t = t1 t2], and we know - from the form of the rule that - [empty |- t1 : T1 -> T2] - [empty |- t2 : T1] - By the induction hypothesis, each of t1 and t2 either is a value - or can take a step. *) - right. - destruct IHHt1; subst... - SCase "t1 is a value". - destruct IHHt2; subst... - SSCase "t2 is a value". - (* If both [t1] and [t2] are values, then we know that - [t1 = tabs x T11 t12], since abstractions are the only values - that can have an arrow type. But - [(tabs x T11 t12) t2 ==> [x:=t2]t12] by [ST_AppAbs]. *) - inversion H; subst; try (solve by inversion). - exists (subst x t2 t12)... - SSCase "t2 steps". - (* If [t1] is a value and [t2 ==> t2'], then [t1 t2 ==> t1 t2'] - by [ST_App2]. *) - inversion H0 as [t2' Hstp]. exists (tapp t1 t2')... - SCase "t1 steps". - (* Finally, If [t1 ==> t1'], then [t1 t2 ==> t1' t2] by [ST_App1]. *) - inversion H as [t1' Hstp]. exists (tapp t1' t2)... - Case "T_Nat". - left... - Case "T_Succ". - right. - destruct IHHt... - SCase "t1 is a value". - inversion H; subst; try solve by inversion. - exists (tnat (S n1))... - SCase "t1 steps". - inversion H as [t1' Hstp]. - exists (tsucc t1')... - Case "T_Pred". - right. - destruct IHHt... - SCase "t1 is a value". - inversion H; subst; try solve by inversion. - exists (tnat (pred n1))... - SCase "t1 steps". - inversion H as [t1' Hstp]. - exists (tpred t1')... - Case "T_Mult". - right. - destruct IHHt1... - SCase "t1 is a value". - destruct IHHt2... - SSCase "t2 is a value". - inversion H; subst; try solve by inversion. - inversion H0; subst; try solve by inversion. - exists (tnat (mult n1 n0))... - SSCase "t2 steps". - inversion H0 as [t2' Hstp]. - exists (tmult t1 t2')... - SCase "t1 steps". - inversion H as [t1' Hstp]. - exists (tmult t1' t2)... - Case "T_If0". - right. - destruct IHHt1... - SCase "t1 is a value". - inversion H; subst; try solve by inversion. - destruct n1 as [|n1']. - SSCase "n1=0". - exists t2... - SSCase "n1<>0". - exists t3... - SCase "t1 steps". - inversion H as [t1' H0]. - exists (tif0 t1' t2 t3)... - Case "T_Pair". - destruct IHHt1... - SCase "t1 is a value". - destruct IHHt2... - SSCase "t2 steps". - right. inversion H0 as [t2' Hstp]. - exists (tpair t1 t2')... - SCase "t1 steps". - right. inversion H as [t1' Hstp]. - exists (tpair t1' t2)... - Case "T_Fst". - right. - destruct IHHt... - SCase "t1 is a value". - inversion H; subst; try solve by inversion. - exists v1... - SCase "t1 steps". - inversion H as [t1' Hstp]. - exists (tfst t1')... - Case "T_Snd". - right. - destruct IHHt... - SCase "t1 is a value". - inversion H; subst; try solve by inversion. - exists v2... - SCase "t1 steps". - inversion H as [t1' Hstp]. - exists (tsnd t1')... - Case "T_Unit". - left... -(* let *) -(* FILL IN HERE *) - Case "T_Inl". - destruct IHHt... - SCase "t1 steps". - right. inversion H as [t1' Hstp]... - (* exists (tinl _ t1')... *) - Case "T_Inr". - destruct IHHt... - SCase "t1 steps". - right. inversion H as [t1' Hstp]... - (* exists (tinr _ t1')... *) - Case "T_Case". - right. - destruct IHHt1... - SCase "t0 is a value". - inversion H; subst; try solve by inversion. - SSCase "t0 is inl". - exists ([x1:=v]t1)... - SSCase "t0 is inr". - exists ([x2:=v]t2)... - SCase "t0 steps". - inversion H as [t0' Hstp]. - exists (tcase t0' x1 t1 x2 t2)... - Case "T_Nil". - left... - Case "T_Cons". - destruct IHHt1... - SCase "head is a value". - destruct IHHt2... - SSCase "tail steps". - right. inversion H0 as [t2' Hstp]. - exists (tcons t1 t2')... - SCase "head steps". - right. inversion H as [t1' Hstp]. - exists (tcons t1' t2)... - Case "T_Lcase". - right. - destruct IHHt1... - SCase "t1 is a value". - inversion H; subst; try solve by inversion. - SSCase "t1=tnil". - exists t2... - SSCase "t1=tcons v1 vl". - exists ([x2:=vl]([x1:=v1]t3))... - SCase "t1 steps". - inversion H as [t1' Hstp]. - exists (tlcase t1' t2 x1 x2 t3)... -(* fix *) -(* FILL IN HERE *) -Qed. - -(* ###################################################################### *) -(** *** Context Invariance *) - -Inductive appears_free_in : id -> tm -> Prop := - | afi_var : forall x, - appears_free_in x (tvar x) - | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) - | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) - | afi_abs : forall x y T11 t12, - y <> x -> - appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) - (* nats *) - | afi_succ : forall x t, - appears_free_in x t -> - appears_free_in x (tsucc t) - | afi_pred : forall x t, - appears_free_in x t -> - appears_free_in x (tpred t) - | afi_mult1 : forall x t1 t2, - appears_free_in x t1 -> - appears_free_in x (tmult t1 t2) - | afi_mult2 : forall x t1 t2, - appears_free_in x t2 -> - appears_free_in x (tmult t1 t2) - | afi_if01 : forall x t1 t2 t3, - appears_free_in x t1 -> - appears_free_in x (tif0 t1 t2 t3) - | afi_if02 : forall x t1 t2 t3, - appears_free_in x t2 -> - appears_free_in x (tif0 t1 t2 t3) - | afi_if03 : forall x t1 t2 t3, - appears_free_in x t3 -> - appears_free_in x (tif0 t1 t2 t3) - (* pairs *) - | afi_pair1 : forall x t1 t2, - appears_free_in x t1 -> - appears_free_in x (tpair t1 t2) - | afi_pair2 : forall x t1 t2, - appears_free_in x t2 -> - appears_free_in x (tpair t1 t2) - | afi_fst : forall x t, - appears_free_in x t -> - appears_free_in x (tfst t) - | afi_snd : forall x t, - appears_free_in x t -> - appears_free_in x (tsnd t) - (* let *) -(* FILL IN HERE *) - (* sums *) - | afi_inl : forall x t T, - appears_free_in x t -> - appears_free_in x (tinl T t) - | afi_inr : forall x t T, - appears_free_in x t -> - appears_free_in x (tinr T t) - | afi_case0 : forall x t0 x1 t1 x2 t2, - appears_free_in x t0 -> - appears_free_in x (tcase t0 x1 t1 x2 t2) - | afi_case1 : forall x t0 x1 t1 x2 t2, - x1 <> x -> - appears_free_in x t1 -> - appears_free_in x (tcase t0 x1 t1 x2 t2) - | afi_case2 : forall x t0 x1 t1 x2 t2, - x2 <> x -> - appears_free_in x t2 -> - appears_free_in x (tcase t0 x1 t1 x2 t2) - (* lists *) - | afi_cons1 : forall x t1 t2, - appears_free_in x t1 -> - appears_free_in x (tcons t1 t2) - | afi_cons2 : forall x t1 t2, - appears_free_in x t2 -> - appears_free_in x (tcons t1 t2) - | afi_lcase1 : forall x t1 t2 y1 y2 t3, - appears_free_in x t1 -> - appears_free_in x (tlcase t1 t2 y1 y2 t3) - | afi_lcase2 : forall x t1 t2 y1 y2 t3, - appears_free_in x t2 -> - appears_free_in x (tlcase t1 t2 y1 y2 t3) - | afi_lcase3 : forall x t1 t2 y1 y2 t3, - y1 <> x -> - y2 <> x -> - appears_free_in x t3 -> - appears_free_in x (tlcase t1 t2 y1 y2 t3) - (* fix *) -(* FILL IN HERE *) - . - -Hint Constructors appears_free_in. - -Lemma context_invariance : forall Gamma Gamma' t S, - Gamma |- t \in S -> - (forall x, appears_free_in x t -> Gamma x = Gamma' x) -> - Gamma' |- t \in S. -Proof with eauto. - intros. generalize dependent Gamma'. - has_type_cases (induction H) Case; - intros Gamma' Heqv... - Case "T_Var". - apply T_Var... rewrite <- Heqv... - Case "T_Abs". - apply T_Abs... apply IHhas_type. intros y Hafi. - unfold extend. - destruct (eq_id_dec x y)... - Case "T_Mult". - apply T_Mult... - Case "T_If0". - apply T_If0... - Case "T_Pair". - apply T_Pair... -(* let *) -(* FILL IN HERE *) - Case "T_Case". - eapply T_Case... - apply IHhas_type2. intros y Hafi. - unfold extend. - destruct (eq_id_dec x1 y)... - apply IHhas_type3. intros y Hafi. - unfold extend. - destruct (eq_id_dec x2 y)... - Case "T_Cons". - apply T_Cons... - Case "T_Lcase". - eapply T_Lcase... apply IHhas_type3. intros y Hafi. - unfold extend. - destruct (eq_id_dec x1 y)... - destruct (eq_id_dec x2 y)... -Qed. - -Lemma free_in_context : forall x t T Gamma, - appears_free_in x t -> - Gamma |- t \in T -> - exists T', Gamma x = Some T'. -Proof with eauto. - intros x t T Gamma Hafi Htyp. - has_type_cases (induction Htyp) Case; inversion Hafi; subst... - Case "T_Abs". - destruct IHHtyp as [T' Hctx]... exists T'. - unfold extend in Hctx. - rewrite neq_id in Hctx... -(* let *) -(* FILL IN HERE *) - Case "T_Case". - SCase "left". - destruct IHHtyp2 as [T' Hctx]... exists T'. - unfold extend in Hctx. - rewrite neq_id in Hctx... - SCase "right". - destruct IHHtyp3 as [T' Hctx]... exists T'. - unfold extend in Hctx. - rewrite neq_id in Hctx... - Case "T_Lcase". - clear Htyp1 IHHtyp1 Htyp2 IHHtyp2. - destruct IHHtyp3 as [T' Hctx]... exists T'. - unfold extend in Hctx. - rewrite neq_id in Hctx... rewrite neq_id in Hctx... -Qed. - -(* ###################################################################### *) -(** *** Substitution *) - -Lemma substitution_preserves_typing : forall Gamma x U v t S, - (extend Gamma x U) |- t \in S -> - empty |- v \in U -> - Gamma |- ([x:=v]t) \in S. -Proof with eauto. - (* Theorem: If Gamma,x:U |- t : S and empty |- v : U, then - Gamma |- [x:=v]t : S. *) - intros Gamma x U v t S Htypt Htypv. - generalize dependent Gamma. generalize dependent S. - (* Proof: By induction on the term t. Most cases follow directly - from the IH, with the exception of tvar and tabs. - The former aren't automatic because we must reason about how the - variables interact. *) - t_cases (induction t) Case; - intros S Gamma Htypt; simpl; inversion Htypt; subst... - Case "tvar". - simpl. rename i into y. - (* If t = y, we know that - [empty |- v : U] and - [Gamma,x:U |- y : S] - and, by inversion, [extend Gamma x U y = Some S]. We want to - show that [Gamma |- [x:=v]y : S]. - - There are two cases to consider: either [x=y] or [x<>y]. *) - destruct (eq_id_dec x y). - SCase "x=y". - (* If [x = y], then we know that [U = S], and that [[x:=v]y = v]. - So what we really must show is that if [empty |- v : U] then - [Gamma |- v : U]. We have already proven a more general version - of this theorem, called context invariance. *) - subst. - unfold extend in H1. rewrite eq_id in H1. - inversion H1; subst. clear H1. - eapply context_invariance... - intros x Hcontra. - destruct (free_in_context _ _ S empty Hcontra) as [T' HT']... - inversion HT'. - SCase "x<>y". - (* If [x <> y], then [Gamma y = Some S] and the substitution has no - effect. We can show that [Gamma |- y : S] by [T_Var]. *) - apply T_Var... unfold extend in H1. rewrite neq_id in H1... - Case "tabs". - rename i into y. rename t into T11. - (* If [t = tabs y T11 t0], then we know that - [Gamma,x:U |- tabs y T11 t0 : T11->T12] - [Gamma,x:U,y:T11 |- t0 : T12] - [empty |- v : U] - As our IH, we know that forall S Gamma, - [Gamma,x:U |- t0 : S -> Gamma |- [x:=v]t0 : S]. - - We can calculate that - [x:=v]t = tabs y T11 (if beq_id x y then t0 else [x:=v]t0) - And we must show that [Gamma |- [x:=v]t : T11->T12]. We know - we will do so using [T_Abs], so it remains to be shown that: - [Gamma,y:T11 |- if beq_id x y then t0 else [x:=v]t0 : T12] - We consider two cases: [x = y] and [x <> y]. - *) - apply T_Abs... - destruct (eq_id_dec x y). - SCase "x=y". - (* If [x = y], then the substitution has no effect. Context - invariance shows that [Gamma,y:U,y:T11] and [Gamma,y:T11] are - equivalent. Since the former context shows that [t0 : T12], so - does the latter. *) - eapply context_invariance... - subst. - intros x Hafi. unfold extend. - destruct (eq_id_dec y x)... - SCase "x<>y". - (* If [x <> y], then the IH and context invariance allow us to show that - [Gamma,x:U,y:T11 |- t0 : T12] => - [Gamma,y:T11,x:U |- t0 : T12] => - [Gamma,y:T11 |- [x:=v]t0 : T12] *) - apply IHt. eapply context_invariance... - intros z Hafi. unfold extend. - destruct (eq_id_dec y z)... - subst. rewrite neq_id... -(* let *) -(* FILL IN HERE *) - Case "tcase". - rename i into x1. rename i0 into x2. - eapply T_Case... - SCase "left arm". - destruct (eq_id_dec x x1). - SSCase "x = x1". - eapply context_invariance... - subst. - intros z Hafi. unfold extend. - destruct (eq_id_dec x1 z)... - SSCase "x <> x1". - apply IHt2. eapply context_invariance... - intros z Hafi. unfold extend. - destruct (eq_id_dec x1 z)... - subst. rewrite neq_id... - SCase "right arm". - destruct (eq_id_dec x x2). - SSCase "x = x2". - eapply context_invariance... - subst. - intros z Hafi. unfold extend. - destruct (eq_id_dec x2 z)... - SSCase "x <> x2". - apply IHt3. eapply context_invariance... - intros z Hafi. unfold extend. - destruct (eq_id_dec x2 z)... - subst. rewrite neq_id... - Case "tlcase". - rename i into y1. rename i0 into y2. - eapply T_Lcase... - destruct (eq_id_dec x y1). - SCase "x=y1". - simpl. - eapply context_invariance... - subst. - intros z Hafi. unfold extend. - destruct (eq_id_dec y1 z)... - SCase "x<>y1". - destruct (eq_id_dec x y2). - SSCase "x=y2". - eapply context_invariance... - subst. - intros z Hafi. unfold extend. - destruct (eq_id_dec y2 z)... - SSCase "x<>y2". - apply IHt3. eapply context_invariance... - intros z Hafi. unfold extend. - destruct (eq_id_dec y1 z)... - subst. rewrite neq_id... - destruct (eq_id_dec y2 z)... - subst. rewrite neq_id... -Qed. - -(* ###################################################################### *) -(** *** Preservation *) - -Theorem preservation : forall t t' T, - empty |- t \in T -> - t ==> t' -> - empty |- t' \in T. -Proof with eauto. - intros t t' T HT. - (* Theorem: If [empty |- t : T] and [t ==> t'], then [empty |- t' : T]. *) - remember (@empty ty) as Gamma. generalize dependent HeqGamma. - generalize dependent t'. - (* Proof: By induction on the given typing derivation. Many cases are - contradictory ([T_Var], [T_Abs]). We show just the interesting ones. *) - has_type_cases (induction HT) Case; - intros t' HeqGamma HE; subst; inversion HE; subst... - Case "T_App". - (* If the last rule used was [T_App], then [t = t1 t2], and three rules - could have been used to show [t ==> t']: [ST_App1], [ST_App2], and - [ST_AppAbs]. In the first two cases, the result follows directly from - the IH. *) - inversion HE; subst... - SCase "ST_AppAbs". - (* For the third case, suppose - [t1 = tabs x T11 t12] - and - [t2 = v2]. - We must show that [empty |- [x:=v2]t12 : T2]. - We know by assumption that - [empty |- tabs x T11 t12 : T1->T2] - and by inversion - [x:T1 |- t12 : T2] - We have already proven that substitution_preserves_typing and - [empty |- v2 : T1] - by assumption, so we are done. *) - apply substitution_preserves_typing with T1... - inversion HT1... - Case "T_Fst". - inversion HT... - Case "T_Snd". - inversion HT... -(* let *) -(* FILL IN HERE *) - Case "T_Case". - SCase "ST_CaseInl". - inversion HT1; subst. - eapply substitution_preserves_typing... - SCase "ST_CaseInr". - inversion HT1; subst. - eapply substitution_preserves_typing... - Case "T_Lcase". - SCase "ST_LcaseCons". - inversion HT1; subst. - apply substitution_preserves_typing with (TList T1)... - apply substitution_preserves_typing with T1... -(* fix *) -(* FILL IN HERE *) -Qed. -(** [] *) - -End STLCExtended. - -(* $Date: 2013-12-03 07:45:41 -0500 (Tue, 03 Dec 2013) $ *) - - diff --git a/Poly.html b/Poly.html deleted file mode 100644 index 917d5dc..0000000 --- a/Poly.html +++ /dev/null @@ -1,1860 +0,0 @@ - - - - - -Poly: Polymorphism and Higher-Order Functions - - - - - - -
- - - -
- -

PolyPolymorphism and Higher-Order Functions

- -
-
- -
- -
- - In this chapter we continue our development of basic - concepts of functional programming. The critical new ideas are - polymorphism (abstracting functions over the types of the data - they manipulate) and higher-order functions (treating functions - as data). - -
-
- -
-Require Export Lists.
- -
-
- -
-

Polymorphism

- -
-
-
- -
-

Polymorphic Lists

- -
- - For the last couple of chapters, we've been working just - with lists of numbers. Obviously, interesting programs also need - to be able to manipulate lists with elements from other types — - lists of strings, lists of booleans, lists of lists, etc. We - could just define a new inductive datatype for each of these, - for example... -
-
- -
-Inductive boollist : Type :=
-  | bool_nil : boollist
-  | bool_cons : bool → boollist → boollist.
- -
-
- -
-... but this would quickly become tedious, partly because we - have to make up different constructor names for each datatype, but - mostly because we would also need to define new versions of all - our list manipulating functions (length, rev, etc.) for each - new datatype definition. -
- -

- -
- - To avoid all this repetition, Coq supports polymorphic - inductive type definitions. For example, here is a polymorphic - list datatype. -
-
- -
-Inductive list (X:Type) : Type :=
-  | nil : list X
-  | cons : X → list X → list X.
- -
-
- -
-This is exactly like the definition of natlist from the - previous chapter, except that the nat argument to the cons - constructor has been replaced by an arbitrary type X, a binding - for X has been added to the header, and the occurrences of - natlist in the types of the constructors have been replaced by - list X. (We can re-use the constructor names nil and cons - because the earlier definition of natlist was inside of a - Module definition that is now out of scope.) -
- - What sort of thing is list itself? One good way to think - about it is that list is a function from Types to - Inductive definitions; or, to put it another way, list is a - function from Types to Types. For any particular type X, - the type list X is an Inductively defined set of lists whose - elements are things of type X. -
- - With this definition, when we use the constructors nil and - cons to build lists, we need to tell Coq the type of the - elements in the lists we are building — that is, nil and cons - are now polymorphic constructors. Observe the types of these - constructors: -
-
- -
-Check nil.
-(* ===> nil : forall X : Type, list X *)
-Check cons.
-(* ===> cons : forall X : Type, X -> list X -> list X *)
- -
-
- -
-The "∀ X" in these types can be read as an additional - argument to the constructors that determines the expected types of - the arguments that follow. When nil and cons are used, these - arguments are supplied in the same way as the others. For - example, the list containing 2 and 1 is written like this: -
-
- -
-Check (cons nat 2 (cons nat 1 (nil nat))).
- -
-
- -
-(We've gone back to writing nil and cons explicitly here - because we haven't yet defined the [] and :: notations for - the new version of lists. We'll do that in a bit.) -
- - We can now go back and make polymorphic (or "generic") - versions of all the list-processing functions that we wrote - before. Here is length, for example: -
- -

- -
-
- -
-Fixpoint length (X:Type) (l:list X) : nat :=
-  match l with
-  | nil ⇒ 0
-  | cons h t ⇒ S (length X t)
-  end.
- -
-
- -
-Note that the uses of nil and cons in match patterns - do not require any type annotations: Coq already knows that the list - l contains elements of type X, so there's no reason to include - X in the pattern. (More precisely, the type X is a parameter - of the whole definition of list, not of the individual - constructors. We'll come back to this point later.) - -
- - As with nil and cons, we can use length by applying it first - to a type and then to its list argument: -
-
- -
-Example test_length1 :
-    length nat (cons nat 1 (cons nat 2 (nil nat))) = 2.
-Proof. reflexivity. Qed.
- -
-
- -
-To use our length with other kinds of lists, we simply - instantiate it with an appropriate type parameter: -
-
- -
-Example test_length2 :
-    length bool (cons bool true (nil bool)) = 1.
-Proof. reflexivity. Qed.
- -
-
- -
-

- Let's close this subsection by re-implementing a few other - standard list functions on our new polymorphic lists: -
-
- -
-Fixpoint app (X : Type) (l1 l2 : list X)
-                : (list X) :=
-  match l1 with
-  | nil ⇒ l2
-  | cons h t ⇒ cons X h (app X t l2)
-  end.
- -
-Fixpoint snoc (X:Type) (l:list X) (v:X) : (list X) :=
-  match l with
-  | nil ⇒ cons X v (nil X)
-  | cons h t ⇒ cons X h (snoc X t v)
-  end.
- -
-Fixpoint rev (X:Type) (l:list X) : list X :=
-  match l with
-  | nil ⇒ nil X
-  | cons h t ⇒ snoc X (rev X t) h
-  end.
- -
-Example test_rev1 :
-    rev nat (cons nat 1 (cons nat 2 (nil nat)))
-  = (cons nat 2 (cons nat 1 (nil nat))).
-Proof. reflexivity. Qed.
- -
-Example test_rev2:
-  rev bool (nil bool) = nil bool.
-Proof. reflexivity. Qed.
- -
-Module MumbleBaz.
-
- -
-

Exercise: 2 stars (mumble_grumble)

- Consider the following two inductively defined types. -
-
- -
-Inductive mumble : Type :=
-  | a : mumble
-  | b : mumble → nat → mumble
-  | c : mumble.
-Inductive grumble (X:Type) : Type :=
-  | d : mumble → grumble X
-  | e : X → grumble X.
- -
-
- -
-Which of the following are well-typed elements of grumble X for - some type X? - -
- -
    -
  • d (b a 5) - -
    • -
  • d mumble (b a 5) - -
    • -
  • d bool (b a 5) - -
    • -
  • e bool true - -
    • -
  • e mumble (b c 0) - -
    • -
  • e bool (b c 0) - -
    • -
  • c - -
    • -
-(* FILL IN HERE *)
-☐ -
- -

Exercise: 2 stars (baz_num_elts)

- Consider the following inductive definition: -
-
- -
-Inductive baz : Type :=
-   | x : baz → baz
-   | y : baz → bool → baz.
- -
-
- -
-How many elements does the type baz have? -(* FILL IN HERE *)
-☐ -
-
- -
-End MumbleBaz.
- -
-
- -
-

Type Annotation Inference

- -
- - Let's write the definition of app again, but this time we won't - specify the types of any of the arguments. Will Coq still accept - it? -
-
- -
-Fixpoint app' X l1 l2 : list X :=
-  match l1 with
-  | nil ⇒ l2
-  | cons h t ⇒ cons X h (app' X t l2)
-  end.
- -
-
- -
-Indeed it will. Let's see what type Coq has assigned to app': -
-
- -
-Check app'.
-(* ===> forall X : Type, list X -> list X -> list X *)
-Check app.
-(* ===> forall X : Type, list X -> list X -> list X *)
- -
-
- -
-It has exactly the same type type as app. Coq was able to - use a process called type inference to deduce what the types of - X, l1, and l2 must be, based on how they are used. For - example, since X is used as an argument to cons, it must be a - Type, since cons expects a Type as its first argument; - matching l1 with nil and cons means it must be a list; and - so on. - -
- - This powerful facility means we don't always have to write - explicit type annotations everywhere, although explicit type - annotations are still quite useful as documentation and sanity - checks. You should try to find a balance in your own code between - too many type annotations (so many that they clutter and distract) - and too few (which forces readers to perform type inference in - their heads in order to understand your code). -
-
- -
-
- -
-

Type Argument Synthesis

- -
- - Whenever we use a polymorphic function, we need to pass it - one or more types in addition to its other arguments. For - example, the recursive call in the body of the length function - above must pass along the type X. But just like providing - explicit type annotations everywhere, this is heavy and verbose. - Since the second argument to length is a list of Xs, it seems - entirely obvious that the first argument can only be X — why - should we have to write it explicitly? - -
- - Fortunately, Coq permits us to avoid this kind of redundancy. In - place of any type argument we can write the "implicit argument" - _, which can be read as "Please figure out for yourself what - type belongs here." More precisely, when Coq encounters a _, it - will attempt to unify all locally available information — the - type of the function being applied, the types of the other - arguments, and the type expected by the context in which the - application appears — to determine what concrete type should - replace the _. - -
- - This may sound similar to type annotation inference — and, - indeed, the two procedures rely on the same underlying mechanisms. - Instead of simply omitting the types of some arguments to a - function, like - -
- -
-      app' X l1 l2 : list X := -
- -
- we can also replace the types with _, like - -
- -
-      app' (X : _) (l1 l2 : _) : list X := -
- -
- which tells Coq to attempt to infer the missing information, just - as with argument synthesis. - -
- - Using implicit arguments, the length function can be written - like this: -
-
- -
-Fixpoint length' (X:Type) (l:list X) : nat :=
-  match l with
-  | nil ⇒ 0
-  | cons h t ⇒ S (length' _ t)
-  end.
- -
-
- -
-In this instance, we don't save much by writing _ instead of - X. But in many cases the difference can be significant. For - example, suppose we want to write down a list containing the - numbers 1, 2, and 3. Instead of writing this... -
-
- -
-Definition list123 :=
-  cons nat 1 (cons nat 2 (cons nat 3 (nil nat))).
- -
-
- -
-...we can use argument synthesis to write this: -
-
- -
-Definition list123' := cons _ 1 (cons _ 2 (cons _ 3 (nil _))).
- -
-
- -
-

Implicit Arguments

- -
- - If fact, we can go further. To avoid having to sprinkle _'s - throughout our programs, we can tell Coq always to infer the - type argument(s) of a given function. The Arguments directive - specifies the name of the function or constructor, and then lists - its argument names, with curly braces around any arguments to be - treated as implicit. - -
-
- -
-Arguments nil {X}.
-Arguments cons {X} _ _. (* use underscore for argument position that has no name *)
-Arguments length {X} l.
-Arguments app {X} l1 l2.
-Arguments rev {X} l.
-Arguments snoc {X} l v.
- -
-(* note: no _ arguments required... *)
-Definition list123'' := cons 1 (cons 2 (cons 3 nil)).
-Check (length list123'').
- -
-
- -
-

- -
- - Alternatively, we can declare an argument to be implicit while - defining the function itself, by surrounding the argument in curly - braces. For example: -
-
- -
-Fixpoint length'' {X:Type} (l:list X) : nat :=
-  match l with
-  | nil ⇒ 0
-  | cons h t ⇒ S (length'' t)
-  end.
- -
-
- -
-(Note that we didn't even have to provide a type argument to - the recursive call to length''; indeed, it is invalid to provide - one.) We will use this style whenever possible, although we will - continue to use use explicit Argument declarations for - Inductive constructors. -
- -

- -
- - One small problem with declaring arguments Implicit is - that, occasionally, Coq does not have enough local information to - determine a type argument; in such cases, we need to tell Coq that - we want to give the argument explicitly this time, even though - we've globally declared it to be Implicit. For example, suppose we - write this: -
-
- -
-(* Definition mynil := nil.  *)
- -
-
- -
-If we uncomment this definition, Coq will give us an error, - because it doesn't know what type argument to supply to nil. We - can help it by providing an explicit type declaration (so that Coq - has more information available when it gets to the "application" - of nil): -
-
- -
-Definition mynil : list nat := nil.
- -
-
- -
-Alternatively, we can force the implicit arguments to be explicit by - prefixing the function name with @. -
-
- -
-Check @nil.
- -
-Definition mynil' := @nil nat.
- -
-
- -
-

- Using argument synthesis and implicit arguments, we can - define convenient notation for lists, as before. Since we have - made the constructor type arguments implicit, Coq will know to - automatically infer these when we use the notations. -
-
- -
-Notation "x :: y" := (cons x y)
-                     (at level 60, right associativity).
-Notation "[ ]" := nil.
-Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
-Notation "x ++ y" := (app x y)
-                     (at level 60, right associativity).
- -
-
- -
-Now lists can be written just the way we'd hope: -
-
- -
-Definition list123''' := [1; 2; 3].
- -
-Check ([3 + 4] ++ nil).
- -
-
- -
-

Exercises: Polymorphic Lists

- -
- -

Exercise: 2 stars, optional (poly_exercises)

- Here are a few simple exercises, just like ones in the Lists - chapter, for practice with polymorphism. Fill in the definitions - and complete the proofs below. -
-
- -
-Fixpoint repeat {X : Type} (n : X) (count : nat) : list X :=
-  (* FILL IN HERE *) admit.
- -
-Example test_repeat1:
-  repeat true 2 = cons true (cons true nil).
- (* FILL IN HERE *) Admitted.
- -
-Theorem nil_app : ∀X:Type, ∀l:list X,
-  app [] l = l.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem rev_snoc : ∀X : Type,
-                     ∀v : X,
-                     ∀s : list X,
-  rev (snoc s v) = v :: (rev s).
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem rev_involutive : ∀X : Type, ∀l : list X,
-  rev (rev l) = l.
-Proof.
-(* FILL IN HERE *) Admitted.
- -
-Theorem snoc_with_append : ∀X : Type,
-                         ∀l1 l2 : list X,
-                         ∀v : X,
-  snoc (l1 ++ l2) v = l1 ++ (snoc l2 v).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Polymorphic Pairs

- -
- - Following the same pattern, the type definition we gave in - the last chapter for pairs of numbers can be generalized to - polymorphic pairs (or products): -
-
- -
-Inductive prod (X Y : Type) : Type :=
-  pair : X → Y → prod X Y.
- -
-Arguments pair {X} {Y} _ _.
- -
-
- -
-As with lists, we make the type arguments implicit and define the - familiar concrete notation. -
-
- -
-Notation "( x , y )" := (pair x y).
- -
-
- -
-We can also use the Notation mechanism to define the standard - notation for pair types: -
-
- -
-Notation "X × Y" := (prod X Y) : type_scope.
- -
-
- -
-(The annotation : type_scope tells Coq that this abbreviation - should be used when parsing types. This avoids a clash with the - multiplication symbol.) -
- -

- A note of caution: it is easy at first to get (x,y) and - X×Y confused. Remember that (x,y) is a value built from two - other values; X×Y is a type built from two other types. If - x has type X and y has type Y, then (x,y) has type - X×Y. -
- - The first and second projection functions now look pretty - much as they would in any functional programming language. -
-
- -
-Definition fst {X Y : Type} (p : X × Y) : X :=
-  match p with (x,y) ⇒ x end.
- -
-Definition snd {X Y : Type} (p : X × Y) : Y :=
-  match p with (x,y) ⇒ y end.
- -
-
- -
-The following function takes two lists and combines them - into a list of pairs. In many functional programming languages, - it is called zip. We call it combine for consistency with - Coq's standard library. Note that the pair notation can be used both in expressions and in - patterns... -
-
- -
-Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
-           : list (X×Y) :=
-  match (lx,ly) with
-  | ([],_) ⇒ []
-  | (_,[]) ⇒ []
-  | (x::tx, y::ty) ⇒ (x,y) :: (combine tx ty)
-  end.
- -
-
- -
-

Exercise: 1 star, optional (combine_checks)

- Try answering the following questions on paper and - checking your answers in coq: - -
- -
    -
  • What is the type of combine (i.e., what does Check - @combine print?) - -
    • -
  • What does - -
    - -
    -  Eval compute in (combine [1;2] [false;false;true;true]). -
    - -
    - print? ☐ - -
    • -
- -
- -

Exercise: 2 stars (split)

- The function split is the right inverse of combine: it takes a - list of pairs and returns a pair of lists. In many functional - programing languages, this function is called unzip. - -
- - Uncomment the material below and fill in the definition of - split. Make sure it passes the given unit tests. -
-
- -
-Fixpoint split
-           {X Y : Type} (l : list (X×Y))
-           : (list X) × (list Y) :=
-(* FILL IN HERE *) admit.
- -
-Example test_split:
-  split [(1,false);(2,false)] = ([1;2],[false;false]).
-Proof.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Polymorphic Options

- -
- - One last polymorphic type for now: polymorphic options. - The type declaration generalizes the one for natoption in the - previous chapter: -
-
- -
-Inductive option (X:Type) : Type :=
-  | Some : X → option X
-  | None : option X.
- -
-Arguments Some {X} _.
-Arguments None {X}.
- -
-
- -
-

- We can now rewrite the index function so that it works - with any type of lists. -
-
- -
-Fixpoint index {X : Type} (n : nat)
-               (l : list X) : option X :=
-  match l with
-  | [] ⇒ None
-  | a :: l' ⇒ if beq_nat n O then Some a else index (pred n) l'
-  end.
- -
-Example test_index1 : index 0 [4;5;6;7] = Some 4.
-Proof. reflexivity. Qed.
-Example test_index2 : index 1 [[1];[2]] = Some [2].
-Proof. reflexivity. Qed.
-Example test_index3 : index 2 [true] = None.
-Proof. reflexivity. Qed.
- -
-
- -
-

Exercise: 1 star, optional (hd_opt_poly)

- Complete the definition of a polymorphic version of the - hd_opt function from the last chapter. Be sure that it - passes the unit tests below. -
-
- -
-Definition hd_opt {X : Type} (l : list X) : option X :=
-  (* FILL IN HERE *) admit.
- -
-
- -
-Once again, to force the implicit arguments to be explicit, - we can use @ before the name of the function. -
-
- -
-Check @hd_opt.
- -
-Example test_hd_opt1 : hd_opt [1;2] = Some 1.
- (* FILL IN HERE *) Admitted.
-Example test_hd_opt2 : hd_opt [[1];[2]] = Some [1].
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Functions as Data

- -
-
-
- -
-

Higher-Order Functions

- -
- - Like many other modern programming languages — including - all functional languages (ML, Haskell, Scheme, etc.) — Coq - treats functions as first-class citizens, allowing functions to be - passed as arguments to other functions, returned as results, - stored in data structures, etc. - -
- - Functions that manipulate other functions are often called - higher-order functions. Here's a simple one: -
-
- -
-Definition doit3times {X:Type} (f:X→X) (n:X) : X :=
-  f (f (f n)).
- -
-
- -
-The argument f here is itself a function (from X to - X); the body of doit3times applies f three times to some - value n. -
-
- -
-Check @doit3times.
-(* ===> doit3times : forall X : Type, (X -> X) -> X -> X *)
- -
-Example test_doit3times: doit3times minustwo 9 = 3.
-Proof. reflexivity. Qed.
- -
-Example test_doit3times': doit3times negb true = false.
-Proof. reflexivity. Qed.
- -
-
- -
-

Partial Application

- -
- - In fact, the multiple-argument functions we have already - seen are also examples of passing functions as data. To see why, - recall the type of plus. -
-
- -
-Check plus.
-(* ==> nat -> nat -> nat *)
- -
-
- -
-Each → in this expression is actually a binary operator - on types. (This is the same as saying that Coq primitively - supports only one-argument functions — do you see why?) This - operator is right-associative, so the type of plus is really a - shorthand for nat → (nat → nat) — i.e., it can be read as - saying that "plus is a one-argument function that takes a nat - and returns a one-argument function that takes another nat and - returns a nat." In the examples above, we have always applied - plus to both of its arguments at once, but if we like we can - supply just the first. This is called partial application. -
-
- -
-Definition plus3 := plus 3.
-Check plus3.
- -
-Example test_plus3 : plus3 4 = 7.
-Proof. reflexivity. Qed.
-Example test_plus3' : doit3times plus3 0 = 9.
-Proof. reflexivity. Qed.
-Example test_plus3'' : doit3times (plus 3) 0 = 9.
-Proof. reflexivity. Qed.
- -
-
- -
-

Digression: Currying

- -
- -

Exercise: 2 stars, advanced (currying)

- In Coq, a function f : A → B → C really has the type A - → (B → C). That is, if you give f a value of type A, it - will give you function f' : B → C. If you then give f' a - value of type B, it will return a value of type C. This - allows for partial application, as in plus3. Processing a list - of arguments with functions that return functions is called - currying, in honor of the logician Haskell Curry. - -
- - Conversely, we can reinterpret the type A → B → C as (A × - B) → C. This is called uncurrying. With an uncurried binary - function, both arguments must be given at once as a pair; there is - no partial application. -
- - We can define currying as follows: -
-
- -
-Definition prod_curry {X Y Z : Type}
-  (f : X × Y → Z) (x : X) (y : Y) : Z := f (x, y).
- -
-
- -
-As an exercise, define its inverse, prod_uncurry. Then prove - the theorems below to show that the two are inverses. -
-
- -
-Definition prod_uncurry {X Y Z : Type}
-  (f : X → Y → Z) (p : X × Y) : Z :=
-  (* FILL IN HERE *) admit.
- -
-
- -
-(Thought exercise: before running these commands, can you - calculate the types of prod_curry and prod_uncurry?) -
-
- -
-Check @prod_curry.
-Check @prod_uncurry.
- -
-Theorem uncurry_curry : ∀(X Y Z : Type) (f : X → Y → Z) x y,
-  prod_curry (prod_uncurry f) x y = f x y.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem curry_uncurry : ∀(X Y Z : Type)
-                               (f : (X × Y) → Z) (p : X × Y),
-  prod_uncurry (prod_curry f) p = f p.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Filter

- -
- - Here is a useful higher-order function, which takes a list - of Xs and a predicate on X (a function from X to bool) - and "filters" the list, returning a new list containing just those - elements for which the predicate returns true. -
-
- -
-Fixpoint filter {X:Type} (test: X→bool) (l:list X)
-                : (list X) :=
-  match l with
-  | [] ⇒ []
-  | h :: t ⇒ if test h then h :: (filter test t)
-                        else filter test t
-  end.
- -
-
- -
-For example, if we apply filter to the predicate evenb - and a list of numbers l, it returns a list containing just the - even members of l. -
-
- -
-Example test_filter1: filter evenb [1;2;3;4] = [2;4].
-Proof. reflexivity. Qed.
- -
-
- -
-

- -
-
-Definition length_is_1 {X : Type} (l : list X) : bool :=
-  beq_nat (length l) 1.
- -
-Example test_filter2:
-    filter length_is_1
-           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
-  = [ [3]; [4]; [8] ].
-Proof. reflexivity. Qed.
- -
-
- -
-

- -
- - We can use filter to give a concise version of the - countoddmembers function from the Lists chapter. -
-
- -
-Definition countoddmembers' (l:list nat) : nat :=
-  length (filter oddb l).
- -
-Example test_countoddmembers'1: countoddmembers' [1;0;3;1;4;5] = 4.
-Proof. reflexivity. Qed.
-Example test_countoddmembers'2: countoddmembers' [0;2;4] = 0.
-Proof. reflexivity. Qed.
-Example test_countoddmembers'3: countoddmembers' nil = 0.
-Proof. reflexivity. Qed.
- -
-
- -
-

Anonymous Functions

- -
- - It is a little annoying to be forced to define the function - length_is_1 and give it a name just to be able to pass it as an - argument to filter, since we will probably never use it again. - Moreover, this is not an isolated example. When using - higher-order functions, we often want to pass as arguments - "one-off" functions that we will never use again; having to give - each of these functions a name would be tedious. - -
- - Fortunately, there is a better way. It is also possible to - construct a function "on the fly" without declaring it at the top - level or giving it a name; this is analogous to the notation we've - been using for writing down constant lists, natural numbers, and - so on. -
-
- -
-Example test_anon_fun':
-  doit3times (fun n ⇒ n × n) 2 = 256.
-Proof. reflexivity. Qed.
- -
-
- -
-Here is the motivating example from before, rewritten to use - an anonymous function. -
-
- -
-Example test_filter2':
-    filter (fun l ⇒ beq_nat (length l) 1)
-           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
-  = [ [3]; [4]; [8] ].
-Proof. reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (filter_even_gt7)

- -
- - Use filter (instead of Fixpoint) to write a Coq function - filter_even_gt7 that takes a list of natural numbers as input - and returns a list of just those that are even and greater than - 7. -
-
- -
-Definition filter_even_gt7 (l : list nat) : list nat :=
-  (* FILL IN HERE *) admit.
- -
-Example test_filter_even_gt7_1 :
-  filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8].
- (* FILL IN HERE *) Admitted.
- -
-Example test_filter_even_gt7_2 :
-  filter_even_gt7 [5;2;6;19;129] = [].
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (partition)

- Use filter to write a Coq function partition: - -
- -
-  partition : ∀X : Type,
-              (X → bool) → list X → list X × list X -
- -
- Given a set X, a test function of type X → bool and a list - X, partition should return a pair of lists. The first member of - the pair is the sublist of the original list containing the - elements that satisfy the test, and the second is the sublist - containing those that fail the test. The order of elements in the - two sublists should be the same as their order in the original - list. - -
-
- -
-Definition partition {X : Type} (test : X → bool) (l : list X)
-                     : list X × list X :=
-(* FILL IN HERE *) admit.
- -
-Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]).
-(* FILL IN HERE *) Admitted.
-Example test_partition2: partition (fun x ⇒ false) [5;9;0] = ([], [5;9;0]).
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Map

- -
- - Another handy higher-order function is called map. -
-
- -
-Fixpoint map {X Y:Type} (f:X→Y) (l:list X)
-             : (list Y) :=
-  match l with
-  | [] ⇒ []
-  | h :: t ⇒ (f h) :: (map f t)
-  end.
- -
-
- -
-

- It takes a function f and a list l = [n1, n2, n3, ...] - and returns the list [f n1, f n2, f n3,...] , where f has - been applied to each element of l in turn. For example: -
-
- -
-Example test_map1: map (plus 3) [2;0;2] = [5;3;5].
-Proof. reflexivity. Qed.
- -
-
- -
-The element types of the input and output lists need not be - the same (map takes two type arguments, X and Y). This - version of map can thus be applied to a list of numbers and a - function from numbers to booleans to yield a list of booleans: -
-
- -
-Example test_map2: map oddb [2;1;2;5] = [false;true;false;true].
-Proof. reflexivity. Qed.
- -
-
- -
-It can even be applied to a list of numbers and - a function from numbers to lists of booleans to - yield a list of lists of booleans: -
-
- -
-Example test_map3:
-    map (fun n ⇒ [evenb n;oddb n]) [2;1;2;5]
-  = [[true;false];[false;true];[true;false];[false;true]].
-Proof. reflexivity. Qed.
- -
-
- -
-

Map for options

-

Exercise: 3 stars (map_rev)

- Show that map and rev commute. You may need to define an - auxiliary lemma. -
-
- -
-Theorem map_rev : ∀(X Y : Type) (f : X → Y) (l : list X),
-  map f (rev l) = rev (map f l).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (flat_map)

- The function map maps a list X to a list Y using a function - of type X → Y. We can define a similar function, flat_map, - which maps a list X to a list Y using a function f of type - X → list Y. Your definition should work by 'flattening' the - results of f, like so: - -
- -
-        flat_map (fun n ⇒ [n;n+1;n+2]) [1;5;10]
-      = [1; 2; 3; 5; 6; 7; 10; 11; 12]. -
- -
- -
-
- -
-Fixpoint flat_map {X Y:Type} (f:X → list Y) (l:list X)
-                   : (list Y) :=
-  (* FILL IN HERE *) admit.
- -
-Example test_flat_map1:
-  flat_map (fun n ⇒ [n;n;n]) [1;5;4]
-  = [1; 1; 1; 5; 5; 5; 4; 4; 4].
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Lists are not the only inductive type that we can write a - map function for. Here is the definition of map for the - option type: -
-
- -
-Definition option_map {X Y : Type} (f : X → Y) (xo : option X)
-                      : option Y :=
-  match xo with
-    | None ⇒ None
-    | Some x ⇒ Some (f x)
-  end.
- -
-
- -
-

Exercise: 2 stars, optional (implicit_args)

- The definitions and uses of filter and map use implicit - arguments in many places. Replace the curly braces around the - implicit arguments with parentheses, and then fill in explicit - type parameters where necessary and use Coq to check that you've - done so correctly. (This exercise is not to be turned in; it is - probably easiest to do it on a copy of this file that you can - throw away afterwards.) ☐ -
-
- -
-
- -
-

Fold

- -
- - An even more powerful higher-order function is called - fold. This function is the inspiration for the "reduce" - operation that lies at the heart of Google's map/reduce - distributed programming framework. -
-
- -
-Fixpoint fold {X Y:Type} (f: X→Y→Y) (l:list X) (b:Y) : Y :=
-  match l with
-  | nil ⇒ b
-  | h :: t ⇒ f h (fold f t b)
-  end.
- -
-
- -
-

- -
- - Intuitively, the behavior of the fold operation is to - insert a given binary operator f between every pair of elements - in a given list. For example, fold plus [1;2;3;4] intuitively - means 1+2+3+4. To make this precise, we also need a "starting - element" that serves as the initial second input to f. So, for - example, - -
- -
-   fold plus [1;2;3;4] 0 -
- -
- yields - -
- -
-   1 + (2 + (3 + (4 + 0))). -
- -
- Here are some more examples: - -
-
- -
-Check (fold andb).
-(* ===> fold andb : list bool -> bool -> bool *)
- -
-Example fold_example1 : fold mult [1;2;3;4] 1 = 24.
-Proof. reflexivity. Qed.
- -
-Example fold_example2 : fold andb [true;true;false;true] true = false.
-Proof. reflexivity. Qed.
- -
-Example fold_example3 : fold app [[1];[];[2;3];[4]] [] = [1;2;3;4].
-Proof. reflexivity. Qed.
- -
-
- -
-

Exercise: 1 star, advanced (fold_types_different)

- Observe that the type of fold is parameterized by two type - variables, X and Y, and the parameter f is a binary operator - that takes an X and a Y and returns a Y. Can you think of a - situation where it would be useful for X and Y to be - different? -
-
- -
-
- -
-

Functions For Constructing Functions

- -
- - Most of the higher-order functions we have talked about so - far take functions as arguments. Now let's look at some - examples involving returning functions as the results of other - functions. - -
- - To begin, here is a function that takes a value x (drawn from - some type X) and returns a function from nat to X that - yields x whenever it is called, ignoring its nat argument. -
-
- -
-Definition constfun {X: Type} (x: X) : nat→X :=
-  fun (k:nat) ⇒ x.
- -
-Definition ftrue := constfun true.
- -
-Example constfun_example1 : ftrue 0 = true.
-Proof. reflexivity. Qed.
- -
-Example constfun_example2 : (constfun 5) 99 = 5.
-Proof. reflexivity. Qed.
- -
-
- -
-

- Similarly, but a bit more interestingly, here is a function - that takes a function f from numbers to some type X, a number - k, and a value x, and constructs a function that behaves - exactly like f except that, when called with the argument k, - it returns x. -
-
- -
-Definition override {X: Type} (f: nat→X) (k:nat) (x:X) : nat→X:=
-  fun (k':nat) ⇒ if beq_nat k k' then x else f k'.
- -
-
- -
-For example, we can apply override twice to obtain a - function from numbers to booleans that returns false on 1 and - 3 and returns true on all other arguments. -
-
- -
-Definition fmostlytrue := override (override ftrue 1 false) 3 false.
- -
-
- -
-

- -
-
- -
-Example override_example1 : fmostlytrue 0 = true.
-Proof. reflexivity. Qed.
- -
-Example override_example2 : fmostlytrue 1 = false.
-Proof. reflexivity. Qed.
- -
-Example override_example3 : fmostlytrue 2 = true.
-Proof. reflexivity. Qed.
- -
-Example override_example4 : fmostlytrue 3 = false.
-Proof. reflexivity. Qed.
- -
-
- -
-

- -
- -

Exercise: 1 star (override_example)

- Before starting to work on the following proof, make sure you - understand exactly what the theorem is saying and can paraphrase - it in your own words. The proof itself is straightforward. -
-
- -
-Theorem override_example : ∀(b:bool),
-  (override (constfun b) 3 true) 2 = b.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - We'll use function overriding heavily in parts of the rest of the - course, and we will end up needing to know quite a bit about its - properties. To prove these properties, though, we need to know - about a few more of Coq's tactics; developing these is the main - topic of the next chapter. For now, though, let's introduce just - one very useful tactic that will also help us with proving - properties of some of the other functions we have introduced in - this chapter. -
-
- -
- -
-
- -
-

The unfold Tactic

- -
- - Sometimes, a proof will get stuck because Coq doesn't - automatically expand a function call into its definition. (This - is a feature, not a bug: if Coq automatically expanded everything - possible, our proof goals would quickly become enormous — hard to - read and slow for Coq to manipulate!) -
-
- -
-Theorem unfold_example_bad : ∀m n,
-  3 + n = m →
-  plus3 n + 1 = m + 1.
-Proof.
-  intros m n H.
-(* At this point, we'd like to do rewrite → H, since 
-     plus3 n is definitionally equal to 3 + n.  However, 
-     Coq doesn't automatically expand plus3 n to its 
-     definition. *)
-  Abort.
- -
-
- -
-The unfold tactic can be used to explicitly replace a - defined name by the right-hand side of its definition. -
-
- -
-Theorem unfold_example : ∀m n,
-  3 + n = m →
-  plus3 n + 1 = m + 1.
-Proof.
-  intros m n H.
-  unfold plus3.
-  rewrite → H.
-  reflexivity. Qed.
- -
-
- -
-Now we can prove a first property of override: If we - override a function at some argument k and then look up k, we - get back the overridden value. -
-
- -
-Theorem override_eq : ∀{X:Type} x k (f:nat→X),
-  (override f k x) k = x.
-Proof.
-  intros X x k f.
-  unfold override.
-  rewrite ← beq_nat_refl.
-  reflexivity. Qed.
- -
-
- -
-This proof was straightforward, but note that it requires - unfold to expand the definition of override. -
- -

Exercise: 2 stars (override_neq)

- -
-
-Theorem override_neq : ∀(X:Type) x1 x2 k1 k2 (f : nat→X),
-  f k1 = x1 →
-  beq_nat k2 k1 = false →
-  (override f k2 x2) k1 = x1.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - As the inverse of unfold, Coq also provides a tactic - fold, which can be used to "unexpand" a definition. It is used - much less often. -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 2 stars (fold_length)

- Many common functions on lists can be implemented in terms of - fold. For example, here is an alternative definition of length: -
-
- -
-Definition fold_length {X : Type} (l : list X) : nat :=
-  fold (fun _ n ⇒ S n) l 0.
- -
-Example test_fold_length1 : fold_length [4;7;0] = 3.
-Proof. reflexivity. Qed.
- -
-
- -
-Prove the correctness of fold_length. -
-
- -
-Theorem fold_length_correct : ∀X (l : list X),
-  fold_length l = length l.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (fold_map)

- We can also define map in terms of fold. Finish fold_map - below. -
-
- -
-Definition fold_map {X Y:Type} (f : X → Y) (l : list X) : list Y :=
-(* FILL IN HERE *) admit.
- -
-
- -
-Write down a theorem in Coq stating that fold_map is correct, - and prove it. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-(* $Date: 2013-09-26 14:40:26 -0400 (Thu, 26 Sep 2013) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Poly.v b/Poly.v deleted file mode 100644 index 426d534..0000000 --- a/Poly.v +++ /dev/null @@ -1,1082 +0,0 @@ -(** * Poly: Polymorphism and Higher-Order Functions *) - -(** In this chapter we continue our development of basic - concepts of functional programming. The critical new ideas are - _polymorphism_ (abstracting functions over the types of the data - they manipulate) and _higher-order functions_ (treating functions - as data). -*) - -Require Export Lists. - -(* ###################################################### *) -(** * Polymorphism *) -(* ###################################################### *) -(** ** Polymorphic Lists *) - -(** For the last couple of chapters, we've been working just - with lists of numbers. Obviously, interesting programs also need - to be able to manipulate lists with elements from other types -- - lists of strings, lists of booleans, lists of lists, etc. We - _could_ just define a new inductive datatype for each of these, - for example... *) - -Inductive boollist : Type := - | bool_nil : boollist - | bool_cons : bool -> boollist -> boollist. - -(** ... but this would quickly become tedious, partly because we - have to make up different constructor names for each datatype, but - mostly because we would also need to define new versions of all - our list manipulating functions ([length], [rev], etc.) for each - new datatype definition. *) - -(** *** *) - -(** To avoid all this repetition, Coq supports _polymorphic_ - inductive type definitions. For example, here is a _polymorphic - list_ datatype. *) - -Inductive list (X:Type) : Type := - | nil : list X - | cons : X -> list X -> list X. - - -(** This is exactly like the definition of [natlist] from the - previous chapter, except that the [nat] argument to the [cons] - constructor has been replaced by an arbitrary type [X], a binding - for [X] has been added to the header, and the occurrences of - [natlist] in the types of the constructors have been replaced by - [list X]. (We can re-use the constructor names [nil] and [cons] - because the earlier definition of [natlist] was inside of a - [Module] definition that is now out of scope.) *) - -(** What sort of thing is [list] itself? One good way to think - about it is that [list] is a _function_ from [Type]s to - [Inductive] definitions; or, to put it another way, [list] is a - function from [Type]s to [Type]s. For any particular type [X], - the type [list X] is an [Inductive]ly defined set of lists whose - elements are things of type [X]. *) - -(** With this definition, when we use the constructors [nil] and - [cons] to build lists, we need to tell Coq the type of the - elements in the lists we are building -- that is, [nil] and [cons] - are now _polymorphic constructors_. Observe the types of these - constructors: *) - -Check nil. -(* ===> nil : forall X : Type, list X *) -Check cons. -(* ===> cons : forall X : Type, X -> list X -> list X *) - -(** The "[forall X]" in these types can be read as an additional - argument to the constructors that determines the expected types of - the arguments that follow. When [nil] and [cons] are used, these - arguments are supplied in the same way as the others. For - example, the list containing [2] and [1] is written like this: *) - -Check (cons nat 2 (cons nat 1 (nil nat))). - -(** (We've gone back to writing [nil] and [cons] explicitly here - because we haven't yet defined the [ [] ] and [::] notations for - the new version of lists. We'll do that in a bit.) *) - -(** We can now go back and make polymorphic (or "generic") - versions of all the list-processing functions that we wrote - before. Here is [length], for example: *) - -(** *** *) - -Fixpoint length (X:Type) (l:list X) : nat := - match l with - | nil => 0 - | cons h t => S (length X t) - end. - -(** Note that the uses of [nil] and [cons] in [match] patterns - do not require any type annotations: Coq already knows that the list - [l] contains elements of type [X], so there's no reason to include - [X] in the pattern. (More precisely, the type [X] is a parameter - of the whole definition of [list], not of the individual - constructors. We'll come back to this point later.) - - As with [nil] and [cons], we can use [length] by applying it first - to a type and then to its list argument: *) - -Example test_length1 : - length nat (cons nat 1 (cons nat 2 (nil nat))) = 2. -Proof. reflexivity. Qed. - -(** To use our length with other kinds of lists, we simply - instantiate it with an appropriate type parameter: *) - -Example test_length2 : - length bool (cons bool true (nil bool)) = 1. -Proof. reflexivity. Qed. - - -(** *** *) -(** Let's close this subsection by re-implementing a few other - standard list functions on our new polymorphic lists: *) - -Fixpoint app (X : Type) (l1 l2 : list X) - : (list X) := - match l1 with - | nil => l2 - | cons h t => cons X h (app X t l2) - end. - -Fixpoint snoc (X:Type) (l:list X) (v:X) : (list X) := - match l with - | nil => cons X v (nil X) - | cons h t => cons X h (snoc X t v) - end. - -Fixpoint rev (X:Type) (l:list X) : list X := - match l with - | nil => nil X - | cons h t => snoc X (rev X t) h - end. - - - -Example test_rev1 : - rev nat (cons nat 1 (cons nat 2 (nil nat))) - = (cons nat 2 (cons nat 1 (nil nat))). -Proof. reflexivity. Qed. - -Example test_rev2: - rev bool (nil bool) = nil bool. -Proof. reflexivity. Qed. - -Module MumbleBaz. -(** **** Exercise: 2 stars (mumble_grumble) *) -(** Consider the following two inductively defined types. *) - -Inductive mumble : Type := - | a : mumble - | b : mumble -> nat -> mumble - | c : mumble. -Inductive grumble (X:Type) : Type := - | d : mumble -> grumble X - | e : X -> grumble X. - -(** Which of the following are well-typed elements of [grumble X] for - some type [X]? - - [d (b a 5)] - - [d mumble (b a 5)] - - [d bool (b a 5)] - - [e bool true] - - [e mumble (b c 0)] - - [e bool (b c 0)] - - [c] -(* FILL IN HERE *) -[] *) - - -(** **** Exercise: 2 stars (baz_num_elts) *) -(** Consider the following inductive definition: *) - -Inductive baz : Type := - | x : baz -> baz - | y : baz -> bool -> baz. - -(** How _many_ elements does the type [baz] have? -(* FILL IN HERE *) -[] *) - -End MumbleBaz. - -(* ###################################################### *) -(** *** Type Annotation Inference *) - -(** Let's write the definition of [app] again, but this time we won't - specify the types of any of the arguments. Will Coq still accept - it? *) - -Fixpoint app' X l1 l2 : list X := - match l1 with - | nil => l2 - | cons h t => cons X h (app' X t l2) - end. - -(** Indeed it will. Let's see what type Coq has assigned to [app']: *) - -Check app'. -(* ===> forall X : Type, list X -> list X -> list X *) -Check app. -(* ===> forall X : Type, list X -> list X -> list X *) - -(** It has exactly the same type type as [app]. Coq was able to - use a process called _type inference_ to deduce what the types of - [X], [l1], and [l2] must be, based on how they are used. For - example, since [X] is used as an argument to [cons], it must be a - [Type], since [cons] expects a [Type] as its first argument; - matching [l1] with [nil] and [cons] means it must be a [list]; and - so on. - - This powerful facility means we don't always have to write - explicit type annotations everywhere, although explicit type - annotations are still quite useful as documentation and sanity - checks. You should try to find a balance in your own code between - too many type annotations (so many that they clutter and distract) - and too few (which forces readers to perform type inference in - their heads in order to understand your code). *) - -(* ###################################################### *) -(** *** Type Argument Synthesis *) - -(** Whenever we use a polymorphic function, we need to pass it - one or more types in addition to its other arguments. For - example, the recursive call in the body of the [length] function - above must pass along the type [X]. But just like providing - explicit type annotations everywhere, this is heavy and verbose. - Since the second argument to [length] is a list of [X]s, it seems - entirely obvious that the first argument can only be [X] -- why - should we have to write it explicitly? - - Fortunately, Coq permits us to avoid this kind of redundancy. In - place of any type argument we can write the "implicit argument" - [_], which can be read as "Please figure out for yourself what - type belongs here." More precisely, when Coq encounters a [_], it - will attempt to _unify_ all locally available information -- the - type of the function being applied, the types of the other - arguments, and the type expected by the context in which the - application appears -- to determine what concrete type should - replace the [_]. - - This may sound similar to type annotation inference -- and, - indeed, the two procedures rely on the same underlying mechanisms. - Instead of simply omitting the types of some arguments to a - function, like - app' X l1 l2 : list X := - we can also replace the types with [_], like - app' (X : _) (l1 l2 : _) : list X := - which tells Coq to attempt to infer the missing information, just - as with argument synthesis. - - Using implicit arguments, the [length] function can be written - like this: *) - -Fixpoint length' (X:Type) (l:list X) : nat := - match l with - | nil => 0 - | cons h t => S (length' _ t) - end. - -(** In this instance, we don't save much by writing [_] instead of - [X]. But in many cases the difference can be significant. For - example, suppose we want to write down a list containing the - numbers [1], [2], and [3]. Instead of writing this... *) - -Definition list123 := - cons nat 1 (cons nat 2 (cons nat 3 (nil nat))). - -(** ...we can use argument synthesis to write this: *) - -Definition list123' := cons _ 1 (cons _ 2 (cons _ 3 (nil _))). - -(* ###################################################### *) -(** *** Implicit Arguments *) - -(** If fact, we can go further. To avoid having to sprinkle [_]'s - throughout our programs, we can tell Coq _always_ to infer the - type argument(s) of a given function. The [Arguments] directive - specifies the name of the function or constructor, and then lists - its argument names, with curly braces around any arguments to be - treated as implicit. - *) - -Arguments nil {X}. -Arguments cons {X} _ _. (* use underscore for argument position that has no name *) -Arguments length {X} l. -Arguments app {X} l1 l2. -Arguments rev {X} l. -Arguments snoc {X} l v. - -(* note: no _ arguments required... *) -Definition list123'' := cons 1 (cons 2 (cons 3 nil)). -Check (length list123''). - -(** *** *) - -(** Alternatively, we can declare an argument to be implicit while - defining the function itself, by surrounding the argument in curly - braces. For example: *) - -Fixpoint length'' {X:Type} (l:list X) : nat := - match l with - | nil => 0 - | cons h t => S (length'' t) - end. - -(** (Note that we didn't even have to provide a type argument to - the recursive call to [length'']; indeed, it is invalid to provide - one.) We will use this style whenever possible, although we will - continue to use use explicit [Argument] declarations for - [Inductive] constructors. *) - -(** *** *) - -(** One small problem with declaring arguments [Implicit] is - that, occasionally, Coq does not have enough local information to - determine a type argument; in such cases, we need to tell Coq that - we want to give the argument explicitly this time, even though - we've globally declared it to be [Implicit]. For example, suppose we - write this: *) - -(* Definition mynil := nil. *) - -(** If we uncomment this definition, Coq will give us an error, - because it doesn't know what type argument to supply to [nil]. We - can help it by providing an explicit type declaration (so that Coq - has more information available when it gets to the "application" - of [nil]): *) - -Definition mynil : list nat := nil. - -(** Alternatively, we can force the implicit arguments to be explicit by - prefixing the function name with [@]. *) - -Check @nil. - -Definition mynil' := @nil nat. - -(** *** *) -(** Using argument synthesis and implicit arguments, we can - define convenient notation for lists, as before. Since we have - made the constructor type arguments implicit, Coq will know to - automatically infer these when we use the notations. *) - -Notation "x :: y" := (cons x y) - (at level 60, right associativity). -Notation "[ ]" := nil. -Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..). -Notation "x ++ y" := (app x y) - (at level 60, right associativity). - -(** Now lists can be written just the way we'd hope: *) - -Definition list123''' := [1; 2; 3]. - -Check ([3 + 4] ++ nil). - - - - -(* ###################################################### *) -(** *** Exercises: Polymorphic Lists *) - -(** **** Exercise: 2 stars, optional (poly_exercises) *) -(** Here are a few simple exercises, just like ones in the [Lists] - chapter, for practice with polymorphism. Fill in the definitions - and complete the proofs below. *) - -Fixpoint repeat {X : Type} (n : X) (count : nat) : list X := - (* FILL IN HERE *) admit. - -Example test_repeat1: - repeat true 2 = cons true (cons true nil). - (* FILL IN HERE *) Admitted. - -Theorem nil_app : forall X:Type, forall l:list X, - app [] l = l. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem rev_snoc : forall X : Type, - forall v : X, - forall s : list X, - rev (snoc s v) = v :: (rev s). -Proof. - (* FILL IN HERE *) Admitted. - -Theorem rev_involutive : forall X : Type, forall l : list X, - rev (rev l) = l. -Proof. -(* FILL IN HERE *) Admitted. - -Theorem snoc_with_append : forall X : Type, - forall l1 l2 : list X, - forall v : X, - snoc (l1 ++ l2) v = l1 ++ (snoc l2 v). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** ** Polymorphic Pairs *) - -(** Following the same pattern, the type definition we gave in - the last chapter for pairs of numbers can be generalized to - _polymorphic pairs_ (or _products_): *) - -Inductive prod (X Y : Type) : Type := - pair : X -> Y -> prod X Y. - -Arguments pair {X} {Y} _ _. - -(** As with lists, we make the type arguments implicit and define the - familiar concrete notation. *) - -Notation "( x , y )" := (pair x y). - -(** We can also use the [Notation] mechanism to define the standard - notation for pair _types_: *) - -Notation "X * Y" := (prod X Y) : type_scope. - -(** (The annotation [: type_scope] tells Coq that this abbreviation - should be used when parsing types. This avoids a clash with the - multiplication symbol.) *) - -(** *** *) -(** A note of caution: it is easy at first to get [(x,y)] and - [X*Y] confused. Remember that [(x,y)] is a _value_ built from two - other values; [X*Y] is a _type_ built from two other types. If - [x] has type [X] and [y] has type [Y], then [(x,y)] has type - [X*Y]. *) - -(** The first and second projection functions now look pretty - much as they would in any functional programming language. *) - -Definition fst {X Y : Type} (p : X * Y) : X := - match p with (x,y) => x end. - -Definition snd {X Y : Type} (p : X * Y) : Y := - match p with (x,y) => y end. - -(** The following function takes two lists and combines them - into a list of pairs. In many functional programming languages, - it is called [zip]. We call it [combine] for consistency with - Coq's standard library. *) -(** Note that the pair notation can be used both in expressions and in - patterns... *) - -Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y) - : list (X*Y) := - match (lx,ly) with - | ([],_) => [] - | (_,[]) => [] - | (x::tx, y::ty) => (x,y) :: (combine tx ty) - end. - -(** **** Exercise: 1 star, optional (combine_checks) *) -(** Try answering the following questions on paper and - checking your answers in coq: - - What is the type of [combine] (i.e., what does [Check - @combine] print?) - - What does - Eval compute in (combine [1;2] [false;false;true;true]). - print? [] -*) - -(** **** Exercise: 2 stars (split) *) -(** The function [split] is the right inverse of combine: it takes a - list of pairs and returns a pair of lists. In many functional - programing languages, this function is called [unzip]. - - Uncomment the material below and fill in the definition of - [split]. Make sure it passes the given unit tests. *) - -Fixpoint split - {X Y : Type} (l : list (X*Y)) - : (list X) * (list Y) := -(* FILL IN HERE *) admit. - -Example test_split: - split [(1,false);(2,false)] = ([1;2],[false;false]). -Proof. -(* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** ** Polymorphic Options *) - -(** One last polymorphic type for now: _polymorphic options_. - The type declaration generalizes the one for [natoption] in the - previous chapter: *) - -Inductive option (X:Type) : Type := - | Some : X -> option X - | None : option X. - -Arguments Some {X} _. -Arguments None {X}. - -(** *** *) -(** We can now rewrite the [index] function so that it works - with any type of lists. *) - -Fixpoint index {X : Type} (n : nat) - (l : list X) : option X := - match l with - | [] => None - | a :: l' => if beq_nat n O then Some a else index (pred n) l' - end. - -Example test_index1 : index 0 [4;5;6;7] = Some 4. -Proof. reflexivity. Qed. -Example test_index2 : index 1 [[1];[2]] = Some [2]. -Proof. reflexivity. Qed. -Example test_index3 : index 2 [true] = None. -Proof. reflexivity. Qed. - -(** **** Exercise: 1 star, optional (hd_opt_poly) *) -(** Complete the definition of a polymorphic version of the - [hd_opt] function from the last chapter. Be sure that it - passes the unit tests below. *) - -Definition hd_opt {X : Type} (l : list X) : option X := - (* FILL IN HERE *) admit. - -(** Once again, to force the implicit arguments to be explicit, - we can use [@] before the name of the function. *) - -Check @hd_opt. - -Example test_hd_opt1 : hd_opt [1;2] = Some 1. - (* FILL IN HERE *) Admitted. -Example test_hd_opt2 : hd_opt [[1];[2]] = Some [1]. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** * Functions as Data *) -(* ###################################################### *) -(** ** Higher-Order Functions *) - -(** Like many other modern programming languages -- including - all _functional languages_ (ML, Haskell, Scheme, etc.) -- Coq - treats functions as first-class citizens, allowing functions to be - passed as arguments to other functions, returned as results, - stored in data structures, etc. - - Functions that manipulate other functions are often called - _higher-order_ functions. Here's a simple one: *) - -Definition doit3times {X:Type} (f:X->X) (n:X) : X := - f (f (f n)). - -(** The argument [f] here is itself a function (from [X] to - [X]); the body of [doit3times] applies [f] three times to some - value [n]. *) - -Check @doit3times. -(* ===> doit3times : forall X : Type, (X -> X) -> X -> X *) - -Example test_doit3times: doit3times minustwo 9 = 3. -Proof. reflexivity. Qed. - -Example test_doit3times': doit3times negb true = false. -Proof. reflexivity. Qed. - -(* ###################################################### *) -(** ** Partial Application *) - -(** In fact, the multiple-argument functions we have already - seen are also examples of passing functions as data. To see why, - recall the type of [plus]. *) - -Check plus. -(* ==> nat -> nat -> nat *) - -(** Each [->] in this expression is actually a _binary_ operator - on types. (This is the same as saying that Coq primitively - supports only one-argument functions -- do you see why?) This - operator is _right-associative_, so the type of [plus] is really a - shorthand for [nat -> (nat -> nat)] -- i.e., it can be read as - saying that "[plus] is a one-argument function that takes a [nat] - and returns a one-argument function that takes another [nat] and - returns a [nat]." In the examples above, we have always applied - [plus] to both of its arguments at once, but if we like we can - supply just the first. This is called _partial application_. *) - -Definition plus3 := plus 3. -Check plus3. - -Example test_plus3 : plus3 4 = 7. -Proof. reflexivity. Qed. -Example test_plus3' : doit3times plus3 0 = 9. -Proof. reflexivity. Qed. -Example test_plus3'' : doit3times (plus 3) 0 = 9. -Proof. reflexivity. Qed. - -(* ###################################################### *) -(** ** Digression: Currying *) - -(** **** Exercise: 2 stars, advanced (currying) *) -(** In Coq, a function [f : A -> B -> C] really has the type [A - -> (B -> C)]. That is, if you give [f] a value of type [A], it - will give you function [f' : B -> C]. If you then give [f'] a - value of type [B], it will return a value of type [C]. This - allows for partial application, as in [plus3]. Processing a list - of arguments with functions that return functions is called - _currying_, in honor of the logician Haskell Curry. - - Conversely, we can reinterpret the type [A -> B -> C] as [(A * - B) -> C]. This is called _uncurrying_. With an uncurried binary - function, both arguments must be given at once as a pair; there is - no partial application. *) - -(** We can define currying as follows: *) - -Definition prod_curry {X Y Z : Type} - (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y). - -(** As an exercise, define its inverse, [prod_uncurry]. Then prove - the theorems below to show that the two are inverses. *) - -Definition prod_uncurry {X Y Z : Type} - (f : X -> Y -> Z) (p : X * Y) : Z := - (* FILL IN HERE *) admit. - -(** (Thought exercise: before running these commands, can you - calculate the types of [prod_curry] and [prod_uncurry]?) *) - -Check @prod_curry. -Check @prod_uncurry. - -Theorem uncurry_curry : forall (X Y Z : Type) (f : X -> Y -> Z) x y, - prod_curry (prod_uncurry f) x y = f x y. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem curry_uncurry : forall (X Y Z : Type) - (f : (X * Y) -> Z) (p : X * Y), - prod_uncurry (prod_curry f) p = f p. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** ** Filter *) - -(** Here is a useful higher-order function, which takes a list - of [X]s and a _predicate_ on [X] (a function from [X] to [bool]) - and "filters" the list, returning a new list containing just those - elements for which the predicate returns [true]. *) - -Fixpoint filter {X:Type} (test: X->bool) (l:list X) - : (list X) := - match l with - | [] => [] - | h :: t => if test h then h :: (filter test t) - else filter test t - end. - -(** For example, if we apply [filter] to the predicate [evenb] - and a list of numbers [l], it returns a list containing just the - even members of [l]. *) - -Example test_filter1: filter evenb [1;2;3;4] = [2;4]. -Proof. reflexivity. Qed. - -(** *** *) -Definition length_is_1 {X : Type} (l : list X) : bool := - beq_nat (length l) 1. - -Example test_filter2: - filter length_is_1 - [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] - = [ [3]; [4]; [8] ]. -Proof. reflexivity. Qed. - -(** *** *) - -(** We can use [filter] to give a concise version of the - [countoddmembers] function from the [Lists] chapter. *) - -Definition countoddmembers' (l:list nat) : nat := - length (filter oddb l). - -Example test_countoddmembers'1: countoddmembers' [1;0;3;1;4;5] = 4. -Proof. reflexivity. Qed. -Example test_countoddmembers'2: countoddmembers' [0;2;4] = 0. -Proof. reflexivity. Qed. -Example test_countoddmembers'3: countoddmembers' nil = 0. -Proof. reflexivity. Qed. - -(* ###################################################### *) -(** ** Anonymous Functions *) - -(** It is a little annoying to be forced to define the function - [length_is_1] and give it a name just to be able to pass it as an - argument to [filter], since we will probably never use it again. - Moreover, this is not an isolated example. When using - higher-order functions, we often want to pass as arguments - "one-off" functions that we will never use again; having to give - each of these functions a name would be tedious. - - Fortunately, there is a better way. It is also possible to - construct a function "on the fly" without declaring it at the top - level or giving it a name; this is analogous to the notation we've - been using for writing down constant lists, natural numbers, and - so on. *) - -Example test_anon_fun': - doit3times (fun n => n * n) 2 = 256. -Proof. reflexivity. Qed. - -(** Here is the motivating example from before, rewritten to use - an anonymous function. *) - -Example test_filter2': - filter (fun l => beq_nat (length l) 1) - [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] - = [ [3]; [4]; [8] ]. -Proof. reflexivity. Qed. - -(** **** Exercise: 2 stars (filter_even_gt7) *) - -(** Use [filter] (instead of [Fixpoint]) to write a Coq function - [filter_even_gt7] that takes a list of natural numbers as input - and returns a list of just those that are even and greater than - 7. *) - -Definition filter_even_gt7 (l : list nat) : list nat := - (* FILL IN HERE *) admit. - -Example test_filter_even_gt7_1 : - filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8]. - (* FILL IN HERE *) Admitted. - -Example test_filter_even_gt7_2 : - filter_even_gt7 [5;2;6;19;129] = []. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (partition) *) -(** Use [filter] to write a Coq function [partition]: - partition : forall X : Type, - (X -> bool) -> list X -> list X * list X - Given a set [X], a test function of type [X -> bool] and a [list - X], [partition] should return a pair of lists. The first member of - the pair is the sublist of the original list containing the - elements that satisfy the test, and the second is the sublist - containing those that fail the test. The order of elements in the - two sublists should be the same as their order in the original - list. -*) - -Definition partition {X : Type} (test : X -> bool) (l : list X) - : list X * list X := -(* FILL IN HERE *) admit. - -Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]). -(* FILL IN HERE *) Admitted. -Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]). -(* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################### *) -(** ** Map *) - -(** Another handy higher-order function is called [map]. *) - -Fixpoint map {X Y:Type} (f:X->Y) (l:list X) - : (list Y) := - match l with - | [] => [] - | h :: t => (f h) :: (map f t) - end. - -(** *** *) -(** It takes a function [f] and a list [ l = [n1, n2, n3, ...] ] - and returns the list [ [f n1, f n2, f n3,...] ], where [f] has - been applied to each element of [l] in turn. For example: *) - -Example test_map1: map (plus 3) [2;0;2] = [5;3;5]. -Proof. reflexivity. Qed. - -(** The element types of the input and output lists need not be - the same ([map] takes _two_ type arguments, [X] and [Y]). This - version of [map] can thus be applied to a list of numbers and a - function from numbers to booleans to yield a list of booleans: *) - -Example test_map2: map oddb [2;1;2;5] = [false;true;false;true]. -Proof. reflexivity. Qed. - -(** It can even be applied to a list of numbers and - a function from numbers to _lists_ of booleans to - yield a list of lists of booleans: *) - -Example test_map3: - map (fun n => [evenb n;oddb n]) [2;1;2;5] - = [[true;false];[false;true];[true;false];[false;true]]. -Proof. reflexivity. Qed. - - - -(** ** Map for options *) -(** **** Exercise: 3 stars (map_rev) *) -(** Show that [map] and [rev] commute. You may need to define an - auxiliary lemma. *) - - -Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X), - map f (rev l) = rev (map f l). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (flat_map) *) -(** The function [map] maps a [list X] to a [list Y] using a function - of type [X -> Y]. We can define a similar function, [flat_map], - which maps a [list X] to a [list Y] using a function [f] of type - [X -> list Y]. Your definition should work by 'flattening' the - results of [f], like so: - flat_map (fun n => [n;n+1;n+2]) [1;5;10] - = [1; 2; 3; 5; 6; 7; 10; 11; 12]. -*) - -Fixpoint flat_map {X Y:Type} (f:X -> list Y) (l:list X) - : (list Y) := - (* FILL IN HERE *) admit. - -Example test_flat_map1: - flat_map (fun n => [n;n;n]) [1;5;4] - = [1; 1; 1; 5; 5; 5; 4; 4; 4]. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Lists are not the only inductive type that we can write a - [map] function for. Here is the definition of [map] for the - [option] type: *) - -Definition option_map {X Y : Type} (f : X -> Y) (xo : option X) - : option Y := - match xo with - | None => None - | Some x => Some (f x) - end. - -(** **** Exercise: 2 stars, optional (implicit_args) *) -(** The definitions and uses of [filter] and [map] use implicit - arguments in many places. Replace the curly braces around the - implicit arguments with parentheses, and then fill in explicit - type parameters where necessary and use Coq to check that you've - done so correctly. (This exercise is not to be turned in; it is - probably easiest to do it on a _copy_ of this file that you can - throw away afterwards.) [] *) - -(* ###################################################### *) -(** ** Fold *) - -(** An even more powerful higher-order function is called - [fold]. This function is the inspiration for the "[reduce]" - operation that lies at the heart of Google's map/reduce - distributed programming framework. *) - -Fixpoint fold {X Y:Type} (f: X->Y->Y) (l:list X) (b:Y) : Y := - match l with - | nil => b - | h :: t => f h (fold f t b) - end. - -(** *** *) - -(** Intuitively, the behavior of the [fold] operation is to - insert a given binary operator [f] between every pair of elements - in a given list. For example, [ fold plus [1;2;3;4] ] intuitively - means [1+2+3+4]. To make this precise, we also need a "starting - element" that serves as the initial second input to [f]. So, for - example, - fold plus [1;2;3;4] 0 - yields - 1 + (2 + (3 + (4 + 0))). - Here are some more examples: -*) - -Check (fold andb). -(* ===> fold andb : list bool -> bool -> bool *) - -Example fold_example1 : fold mult [1;2;3;4] 1 = 24. -Proof. reflexivity. Qed. - -Example fold_example2 : fold andb [true;true;false;true] true = false. -Proof. reflexivity. Qed. - -Example fold_example3 : fold app [[1];[];[2;3];[4]] [] = [1;2;3;4]. -Proof. reflexivity. Qed. - - -(** **** Exercise: 1 star, advanced (fold_types_different) *) -(** Observe that the type of [fold] is parameterized by _two_ type - variables, [X] and [Y], and the parameter [f] is a binary operator - that takes an [X] and a [Y] and returns a [Y]. Can you think of a - situation where it would be useful for [X] and [Y] to be - different? *) - -(* ###################################################### *) -(** ** Functions For Constructing Functions *) - -(** Most of the higher-order functions we have talked about so - far take functions as _arguments_. Now let's look at some - examples involving _returning_ functions as the results of other - functions. - - To begin, here is a function that takes a value [x] (drawn from - some type [X]) and returns a function from [nat] to [X] that - yields [x] whenever it is called, ignoring its [nat] argument. *) - -Definition constfun {X: Type} (x: X) : nat->X := - fun (k:nat) => x. - -Definition ftrue := constfun true. - -Example constfun_example1 : ftrue 0 = true. -Proof. reflexivity. Qed. - -Example constfun_example2 : (constfun 5) 99 = 5. -Proof. reflexivity. Qed. - -(** *** *) -(** Similarly, but a bit more interestingly, here is a function - that takes a function [f] from numbers to some type [X], a number - [k], and a value [x], and constructs a function that behaves - exactly like [f] except that, when called with the argument [k], - it returns [x]. *) - -Definition override {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:= - fun (k':nat) => if beq_nat k k' then x else f k'. - -(** For example, we can apply [override] twice to obtain a - function from numbers to booleans that returns [false] on [1] and - [3] and returns [true] on all other arguments. *) - -Definition fmostlytrue := override (override ftrue 1 false) 3 false. - -(** *** *) - -Example override_example1 : fmostlytrue 0 = true. -Proof. reflexivity. Qed. - -Example override_example2 : fmostlytrue 1 = false. -Proof. reflexivity. Qed. - -Example override_example3 : fmostlytrue 2 = true. -Proof. reflexivity. Qed. - -Example override_example4 : fmostlytrue 3 = false. -Proof. reflexivity. Qed. - -(** *** *) - -(** **** Exercise: 1 star (override_example) *) -(** Before starting to work on the following proof, make sure you - understand exactly what the theorem is saying and can paraphrase - it in your own words. The proof itself is straightforward. *) - -Theorem override_example : forall (b:bool), - (override (constfun b) 3 true) 2 = b. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** We'll use function overriding heavily in parts of the rest of the - course, and we will end up needing to know quite a bit about its - properties. To prove these properties, though, we need to know - about a few more of Coq's tactics; developing these is the main - topic of the next chapter. For now, though, let's introduce just - one very useful tactic that will also help us with proving - properties of some of the other functions we have introduced in - this chapter. *) - -(* ###################################################### *) - -(* ###################################################### *) -(** * The [unfold] Tactic *) - -(** Sometimes, a proof will get stuck because Coq doesn't - automatically expand a function call into its definition. (This - is a feature, not a bug: if Coq automatically expanded everything - possible, our proof goals would quickly become enormous -- hard to - read and slow for Coq to manipulate!) *) - -Theorem unfold_example_bad : forall m n, - 3 + n = m -> - plus3 n + 1 = m + 1. -Proof. - intros m n H. -(* At this point, we'd like to do [rewrite -> H], since - [plus3 n] is definitionally equal to [3 + n]. However, - Coq doesn't automatically expand [plus3 n] to its - definition. *) - Abort. - -(** The [unfold] tactic can be used to explicitly replace a - defined name by the right-hand side of its definition. *) - -Theorem unfold_example : forall m n, - 3 + n = m -> - plus3 n + 1 = m + 1. -Proof. - intros m n H. - unfold plus3. - rewrite -> H. - reflexivity. Qed. - -(** Now we can prove a first property of [override]: If we - override a function at some argument [k] and then look up [k], we - get back the overridden value. *) - -Theorem override_eq : forall {X:Type} x k (f:nat->X), - (override f k x) k = x. -Proof. - intros X x k f. - unfold override. - rewrite <- beq_nat_refl. - reflexivity. Qed. - -(** This proof was straightforward, but note that it requires - [unfold] to expand the definition of [override]. *) - -(** **** Exercise: 2 stars (override_neq) *) -Theorem override_neq : forall (X:Type) x1 x2 k1 k2 (f : nat->X), - f k1 = x1 -> - beq_nat k2 k1 = false -> - (override f k2 x2) k1 = x1. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** As the inverse of [unfold], Coq also provides a tactic - [fold], which can be used to "unexpand" a definition. It is used - much less often. *) - -(* ##################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 2 stars (fold_length) *) -(** Many common functions on lists can be implemented in terms of - [fold]. For example, here is an alternative definition of [length]: *) - -Definition fold_length {X : Type} (l : list X) : nat := - fold (fun _ n => S n) l 0. - -Example test_fold_length1 : fold_length [4;7;0] = 3. -Proof. reflexivity. Qed. - -(** Prove the correctness of [fold_length]. *) - -Theorem fold_length_correct : forall X (l : list X), - fold_length l = length l. -(* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (fold_map) *) -(** We can also define [map] in terms of [fold]. Finish [fold_map] - below. *) - -Definition fold_map {X Y:Type} (f : X -> Y) (l : list X) : list Y := -(* FILL IN HERE *) admit. - -(** Write down a theorem in Coq stating that [fold_map] is correct, - and prove it. *) - -(* FILL IN HERE *) -(** [] *) - -(* $Date: 2013-09-26 14:40:26 -0400 (Thu, 26 Sep 2013) $ *) - diff --git a/Preface.html b/Preface.html deleted file mode 100644 index 9ef2d13..0000000 --- a/Preface.html +++ /dev/null @@ -1,663 +0,0 @@ - - - - - -Preface - - - - - - -
- - - -
- -

Preface

- -
-
- -
- -
-
- -
-
- -
-

Welcome

- -
- - This electronic book is a course on Software Foundations, the - mathematical underpinnings of reliable software. Topics include - basic concepts of logic, computer-assisted theorem proving and the - Coq proof assistant, functional programming, operational - semantics, Hoare logic, and static type systems. The exposition - is intended for a broad range of readers, from advanced - undergraduates to PhD students and researchers. No specific - background in logic or programming languages is assumed, though a - degree of mathematical maturity will be helpful. - -
- - One novelty of the course is that it is one hundred per cent - formalized and machine-checked: the entire text is literally a - script for Coq. It is intended to be read alongside an - interactive session with Coq. All the details in the text are - fully formalized in Coq, and the exercises are designed to be - worked using Coq. - -
- - The files are organized into a sequence of core chapters, covering - about one semester's worth of material and organized into a - coherent linear narrative, plus a number of "appendices" covering - additional topics. All the core chapters are suitable for both - graduate and upper-level undergraduate students. -
-
- -
-
- -
-

Overview

- -
- - Building reliable software is hard. The scale and complexity of - modern software systems, the number of people involved in building - them, and the range of demands placed on them make it extremely - difficult to build software that works as intended, even most of - the time. At the same time, the increasing degree to which - software is woven into almost every aspect of our society - continually amplifies the cost of bugs and insecurities. - -
- - Computer science and software engineering have responded to these - challenges by developing a whole host of techniques for improving - software reliability, ranging from recommendations about managing - software projects and structuring programming teams (e.g., extreme - programming) to design philosophies for libraries (e.g., - model-view-controller, publish-subscribe, etc.) and programming - languages (e.g., object-oriented programming, aspect-oriented - programming, functional programming), to mathematical techniques - for specifying and reasoning about properties of software and - tools for helping validate these properties. - -
- - The present course is focused on this last set of techniques. The - text weaves together five conceptual threads: - -
- - (1) basic tools from logic for making and justifying precise - claims about programs; - -
- - (2) the use of proof assistants to construct rigorous logical - arguments; - -
- - (3) the idea of functional programming, both as a method of - programming and as a bridge between programming and logic; - -
- - (4) formal techniques for reasoning about the properties of - specific programs (e.g., that a loop terminates on all - inputs, or that a sorting function actually fulfills its - specification); and - -
- - (5) the use of type systems for establishing well-behavedness - guarantees for all programs in a given programming - language (e.g., the fact that well-typed Java programs cannot - be subverted at runtime). - -
- - Each of these topics is easily rich enough to fill a whole course - in its own right; taking all of them together naturally means that - much will be left unsaid. But we hope readers will agree that the - themes illuminate and amplify each other in useful ways, and that - bringing them together creates a foundation from which it will be - easy to dig into any of them more deeply. Some suggestions for - supplemental texts can be found in the Postscript chapter. -
- -

Logic

- -
- - Logic is the field of study whose subject matter is proofs — - unassailable arguments for the truth of particular propositions. - -
- - Volumes have been written about the central role of logic in - computer science. Manna and Waldinger called it "the calculus of - computer science," while Halpern et al.'s paper On the Unusual - Effectiveness of Logic in Computer Science catalogs scores of - ways in which logic offers critical tools and insights. - -
- - In particular, the fundamental notion of inductive proofs is - ubiquitous in all of computer science. You have surely seen them - before, in contexts from discrete math to analysis of algorithms, - but in this course we will examine them much more deeply than you - have probably done so far. -
- -

Proof Assistants

- -
- - The flow of ideas between logic and computer science has not gone - only one way: CS has made its own contributions to logic. One of - these has been the development of tools for constructing proofs of - logical propositions. These tools fall into two broad categories: - -
- -
    -
  • Automated theorem provers provide "push-button" operation: - you give them a proposition and they return either true, - false, or ran out of time. Although their capabilities - are limited to fairly specific sorts of reasoning, they have - matured enough to be useful now in a huge variety of - settings. Examples of such tools include SAT solvers, SMT - solvers, and model checkers. - -
    - - -
    • -
  • Proof assistants are hybrid tools that try to automate the - more routine aspects of building proofs while depending on - human guidance for more difficult aspects. Widely used proof - assistants include Isabelle, Agda, Twelf, ACL2, PVS, and Coq, - among many others. - -
    • -
- -
- - This course is based around Coq, a proof assistant that has been - under development since 1983 at a number of French research labs - and universities. Coq provides a rich environment for interactive - development of machine-checked formal reasoning. The kernel of - the Coq system is a simple proof-checker which guarantees that - only correct deduction steps are performed. On top of this - kernel, the Coq environment provides high-level facilities for - proof development, including powerful tactics for constructing - complex proofs semi-automatically, and a large library of common - definitions and lemmas. - -
- - Coq has been a critical enabler for a huge variety of work across - computer science and mathematics. - -
- -
    -
  • As a platform for the modeling of programming languages, it has - become a standard tool for researchers who need to describe and - reason about complex language definitions. It has been used, - for example, to check the security of the JavaCard platform, - obtaining the highest level of common criteria certification, - and for formal specifications of the x86 and LLVM instruction - sets. - -
    - - -
    • -
  • As an environment for the development of formally certified - programs, Coq has been used to build CompCert, a fully-verified - optimizing compiler for C, for proving the correctness of subtle - algorithms involving floating point numbers, and as the basis - for Certicrypt, an environment for reasoning about the security - of cryptographic algorithms. - -
    - - -
    • -
  • As a realistic environment for experiments with programming with - dependent types, it has inspired numerous innovations. For - example, the Ynot project at Harvard embeds "relational Hoare - reasoning" (an extension of the Hoare Logic we will see later - in this course) in Coq. - -
    - - -
    • -
  • As a proof assistant for higher-order logic, it has been used to - validate a number of important results in mathematics. For - example, its ability to include complex computations inside - proofs made it possible to develop the first formally verified - proof of the 4-color theorem. This proof had previously been - controversial among mathematicians because part of it included - checking a large number of configurations using a program. In - the Coq formalization, everything is checked, including the - correctness of the computational part. More recently, an even - more massive effort led to a Coq formalization of the - Feit-Thompson Theorem — the first major step in the - classification of finite simple groups. - -
    • -
- -
- - By the way, in case you're wondering about the name, here's what - the official Coq web site says: "Some French computer scientists - have a tradition of naming their software as animal species: Caml, - Elan, Foc or Phox are examples of this tacit convention. In French, - “coq” means rooster, and it sounds like the initials of the - Calculus of Constructions CoC on which it is based." The rooster - is also the national symbol of France, and "Coq" are the first - three letters of the name of Thierry Coquand, one of Coq's early - developers. -
- -

Functional Programming

- -
- - The term functional programming refers both to a collection of - programming idioms that can be used in almost any programming - language and to a particular family of programming languages that are - designed to emphasize these idioms, including Haskell, OCaml, - Standard ML, F#, Scala, Scheme, Racket, Common Lisp, Clojure, - Erlang, and Coq. - -
- - Functional programming has been developed by researchers over many - decades — indeed, its roots go back to Church's lambda-calculus, - developed in the 1930s before the era of the computer began! But - in the past two decades it has enjoyed a surge of interest among - industrial engineers and language designers, playing a key role in - high-value systems at companies like Jane St. Capital, Microsoft, - Facebook, and Ericsson. - -
- - The most basic tenet of functional programming is that, as much as - possible, computation should be pure: the only effect of running - a computation should be to produce a result; the computation - should be free from side effects such as I/O, assignments to - mutable variables, or redirecting pointers. For example, whereas - an imperative sorting function might take a list of numbers and - rearrange the pointers to put the list in order, a pure sorting - function would take the original list and return a new list - containing the same numbers in sorted order. - -
- - One significant benefit of this style of programming is that it - makes programs easier to understand and reason about. If every - operation on a data structure yields a new data structure, leaving - the old one intact, then there is no need to worry about where - else in the program the structure is being shared, whether a - change by one part of the program might break an invariant that - another part of the program thinks is being enforced. These - considerations are particularly critical in concurrent programs, - where any mutable state that is shared between threads is a - potential source of pernicious bugs. Indeed, a large part of the - recent interest in functional programming in industry is due to its - simple behavior in the presence of concurrency. - -
- - Another reason for the current excitement about functional - programming is related to this one: functional programs are often - much easier to parallelize than their imperative counterparts. If - running a computation has no effect other than producing a result, - then it can be run anywhere. If a data structure is never - modified in place, it can be copied freely, across cores or across - the network. Indeed, the MapReduce idiom that lies at the heart - of massively distributed query processors like Hadoop and is used - at Google to index the entire web is an instance of functional - programming. - -
- - For purposes of this course, functional programming has one other - significant attraction: it serves as a bridge between logic and - computer science. Indeed, Coq itself can be seen as a combination - of a small but extremely expressive functional programming - language, together with a set of tools for stating and proving - logical assertions. However, when we come to look more closely, - we will find that these two sides of Coq are actually aspects of - the very same underlying machinery — i.e., proofs are programs. -
- -

Program Verification

- -
- - The first third of the book is devoted to developing the - conceptual framework of logic and functional programming and to - gaining enough fluency with the essentials of Coq to use it for - modeling and reasoning about nontrivial artifacts. From this - point on, we will increasingly turn our attention to two broad - topics of critical importance to the enterprise of building - reliable software (and hardware!): techniques for proving specific - properties of particular programs and for proving general - properties of whole programming languages. - -
- - For both of these, the first thing we need is a way of - representing programs as mathematical objects (so we can talk - about them precisely) and of describing their behavior in terms of - mathematical functions or relations. Our tools for these tasks - will be abstract syntax and operational semantics, a method of - specifying the behavior of programs by writing abstract - interpreters. At the beginning, we will work with operational - semantics in the so-called "big-step" style, which leads to - somewhat simpler and more readable definitions, in those cases - where it is applicable. Later on, we will switch to a more - detailed "small-step" style, which helps make some useful - distinctions between different sorts of "nonterminating" program - behaviors and which can be applied to a broader range of language - features, including concurrency. - -
- - The first programming language we consider in detail is Imp, a - tiny toy language capturing the most fundamental features of - conventional imperative languages: variables, assignment, - conditionals, and loops. We study two different ways of reasoning - about the properties of Imp programs. - -
- - First, we consider what it means to say that two Imp programs are - equivalent in the sense that they give the same behaviors for - all initial memories. This notion of equivalence then becomes a - criterion for judging the correctness of metaprograms — - programs that manipulate other programs, such as compilers and - optimizers. We build a simple optimizer for Imp and prove that it - is correct. - -
- - Second, we develop a methodology for proving that Imp programs - satisfy some formal specification of their behavior. We introduce - the notion of Hoare triples — Imp programs annotated with pre- - and post-conditions describing what should be true about the - memory in which they are started and what they promise to make - true about the memory in which they terminate — and the reasoning - principles of Hoare Logic, a "domain-specific logic" specialized - for convenient compositional reasoning about imperative programs, - with concepts like "loop invariant" built in. - -
- - This part of the course will give you a taste of the key ideas and - mathematical tools used for a wide variety of real-world software - and hardware verification tasks. - -
- - -
- -

Type Systems

- -
- - Our final major topic, covering the last third of the course, is - type systems, a powerful set of tools for establishing - properties of all programs in a given language. - -
- - Type systems are the best established and most popular example of - a highly successful class of formal verification techniques known - as lightweight formal methods. These are reasoning techniques - of modest power — modest enough that automatic checkers can be - built into compilers, linkers, or program analyzers and thus be - applied even by programmers unfamiliar with the underlying - theories. (Other examples of lightweight formal methods include - hardware and software model checkers and run-time property - monitoring, a collection of techniques that allow a system to - detect, dynamically, when one of its components is not behaving - according to specification). - -
- - In a sense, this topic brings us full circle: the language whose - properties we study in this part, called the simply typed - lambda-calculus, is essentially a simplified model of the core of - Coq itself! - -
- - -
-
- -
-
- -
-

Practicalities

- -
-
- -
-
- -
-

System Requirements

- -
- - Coq runs on Windows, Linux, and OS X. You will need: - -
- -
    -
  • A current installation of Coq, available from the Coq home - page. Everything should work with version 8.4. - -
    - - -
    • -
  • An IDE for interacting with Coq. Currently, there are two - choices: - -
    - -
      -
    • Proof General is an Emacs-based IDE. It tends to be - preferred by users who are already comfortable with - Emacs. It requires a separate installation (google - "Proof General"). - -
      - - -
      • -
    • CoqIDE is a simpler stand-alone IDE. It is distributed - with Coq, but on some platforms compiling it involves - installing additional packages for GUI libraries and - such. -
      • -
    - -
    • -
- -
-
- -
-
- -
-

Exercises

- -
- - Each chapter includes numerous exercises. Each is marked with a - "star rating," which can be interpreted as follows: - -
- -
    -
  • One star: easy exercises that underscore points in the text - and that, for most readers, should take only a minute or two. - Get in the habit of working these as you reach them. - -
    - - -
    • -
  • Two stars: straightforward exercises (five or ten minutes). - -
    - - -
    • -
  • Three stars: exercises requiring a bit of thought (ten - minutes to half an hour). - -
    - - -
    • -
  • Four and five stars: more difficult exercises (half an hour - and up). - -
    • -
- -
- - Also, some exercises are marked "advanced", and some are marked - "optional." Doing just the non-optional, non-advanced exercises - should provide good coverage of the core material. "Advanced" - exercises are for readers who want an extra challenge (and, in - return, a deeper contact with the material). "Optional" exercises - provide a bit of extra practice with key concepts and introduce - secondary themes that may be of interest to some readers. -
-
- -
-
- -
-

Chapter Dependencies

- -
- - A diagram of the dependencies between chapters and some suggested - paths through the material can be found in the file deps.html. -
-
- -
-
- -
-

Downloading the Coq Files

- -
- - A tar file containing the full sources for the "release version" - of these notes (as a collection of Coq scripts and HTML files) is - available here: -
-        http://www.cis.upenn.edu/~bcpierce/sf   
-
- If you are using the notes as part of a class, you may be given - access to a locally extended version of the files, which you - should use instead of the release version. - -
-
- -
-
- -
-

Note for Instructors

- -
- - If you intend to use these materials in your own course, you will - undoubtedly find things you'd like to change, improve, or add. - Your contributions are welcome! - -
- - Please send an email to Benjamin Pierce, and we'll set you up with - read/write access to our subversion repository and developers' - mailing list; in the repository you'll find a README with further - instructions. -
-
- -
-
- -
-

Translations

- -
- - Thanks to the efforts of a team of volunteer translators, Software - Foundations can now be enjoyed in Japanese: - -
- -
    -
  • http://proofcafe.org/sf - -
    • -
- -
-
- -
-(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Preface.v b/Preface.v deleted file mode 100644 index 1eee244..0000000 --- a/Preface.v +++ /dev/null @@ -1,412 +0,0 @@ -(** * Preface *) - -(* ###################################################################### *) -(** * Welcome *) - -(** This electronic book is a course on _Software Foundations_, the - mathematical underpinnings of reliable software. Topics include - basic concepts of logic, computer-assisted theorem proving and the - Coq proof assistant, functional programming, operational - semantics, Hoare logic, and static type systems. The exposition - is intended for a broad range of readers, from advanced - undergraduates to PhD students and researchers. No specific - background in logic or programming languages is assumed, though a - degree of mathematical maturity will be helpful. - - One novelty of the course is that it is one hundred per cent - formalized and machine-checked: the entire text is literally a - script for Coq. It is intended to be read alongside an - interactive session with Coq. All the details in the text are - fully formalized in Coq, and the exercises are designed to be - worked using Coq. - - The files are organized into a sequence of core chapters, covering - about one semester's worth of material and organized into a - coherent linear narrative, plus a number of "appendices" covering - additional topics. All the core chapters are suitable for both - graduate and upper-level undergraduate students. *) - - -(* ###################################################################### *) -(** * Overview *) - -(** Building reliable software is hard. The scale and complexity of - modern software systems, the number of people involved in building - them, and the range of demands placed on them make it extremely - difficult to build software that works as intended, even most of - the time. At the same time, the increasing degree to which - software is woven into almost every aspect of our society - continually amplifies the cost of bugs and insecurities. - - Computer science and software engineering have responded to these - challenges by developing a whole host of techniques for improving - software reliability, ranging from recommendations about managing - software projects and structuring programming teams (e.g., extreme - programming) to design philosophies for libraries (e.g., - model-view-controller, publish-subscribe, etc.) and programming - languages (e.g., object-oriented programming, aspect-oriented - programming, functional programming), to mathematical techniques - for specifying and reasoning about properties of software and - tools for helping validate these properties. - - The present course is focused on this last set of techniques. The - text weaves together five conceptual threads: - - (1) basic tools from _logic_ for making and justifying precise - claims about programs; - - (2) the use of _proof assistants_ to construct rigorous logical - arguments; - - (3) the idea of _functional programming_, both as a method of - programming and as a bridge between programming and logic; - - (4) formal techniques for _reasoning about the properties of - specific programs_ (e.g., that a loop terminates on all - inputs, or that a sorting function actually fulfills its - specification); and - - (5) the use of _type systems_ for establishing well-behavedness - guarantees for _all_ programs in a given programming - language (e.g., the fact that well-typed Java programs cannot - be subverted at runtime). - - Each of these topics is easily rich enough to fill a whole course - in its own right; taking all of them together naturally means that - much will be left unsaid. But we hope readers will agree that the - themes illuminate and amplify each other in useful ways, and that - bringing them together creates a foundation from which it will be - easy to dig into any of them more deeply. Some suggestions for - supplemental texts can be found in the [Postscript] chapter. *) - -(** ** Logic *) - -(** Logic is the field of study whose subject matter is _proofs_ -- - unassailable arguments for the truth of particular propositions. - - Volumes have been written about the central role of logic in - computer science. Manna and Waldinger called it "the calculus of - computer science," while Halpern et al.'s paper _On the Unusual - Effectiveness of Logic in Computer Science_ catalogs scores of - ways in which logic offers critical tools and insights. - - In particular, the fundamental notion of inductive proofs is - ubiquitous in all of computer science. You have surely seen them - before, in contexts from discrete math to analysis of algorithms, - but in this course we will examine them much more deeply than you - have probably done so far. *) - -(** ** Proof Assistants *) - -(** The flow of ideas between logic and computer science has not gone - only one way: CS has made its own contributions to logic. One of - these has been the development of tools for constructing proofs of - logical propositions. These tools fall into two broad categories: - - - _Automated theorem provers_ provide "push-button" operation: - you give them a proposition and they return either _true_, - _false_, or _ran out of time_. Although their capabilities - are limited to fairly specific sorts of reasoning, they have - matured enough to be useful now in a huge variety of - settings. Examples of such tools include SAT solvers, SMT - solvers, and model checkers. - - - _Proof assistants_ are hybrid tools that try to automate the - more routine aspects of building proofs while depending on - human guidance for more difficult aspects. Widely used proof - assistants include Isabelle, Agda, Twelf, ACL2, PVS, and Coq, - among many others. - - This course is based around Coq, a proof assistant that has been - under development since 1983 at a number of French research labs - and universities. Coq provides a rich environment for interactive - development of machine-checked formal reasoning. The kernel of - the Coq system is a simple proof-checker which guarantees that - only correct deduction steps are performed. On top of this - kernel, the Coq environment provides high-level facilities for - proof development, including powerful tactics for constructing - complex proofs semi-automatically, and a large library of common - definitions and lemmas. - - Coq has been a critical enabler for a huge variety of work across - computer science and mathematics. - - - As a platform for the modeling of programming languages, it has - become a standard tool for researchers who need to describe and - reason about complex language definitions. It has been used, - for example, to check the security of the JavaCard platform, - obtaining the highest level of common criteria certification, - and for formal specifications of the x86 and LLVM instruction - sets. - - - As an environment for the development of formally certified - programs, Coq has been used to build CompCert, a fully-verified - optimizing compiler for C, for proving the correctness of subtle - algorithms involving floating point numbers, and as the basis - for Certicrypt, an environment for reasoning about the security - of cryptographic algorithms. - - - As a realistic environment for experiments with programming with - dependent types, it has inspired numerous innovations. For - example, the Ynot project at Harvard embeds "relational Hoare - reasoning" (an extension of the _Hoare Logic_ we will see later - in this course) in Coq. - - - As a proof assistant for higher-order logic, it has been used to - validate a number of important results in mathematics. For - example, its ability to include complex computations inside - proofs made it possible to develop the first formally verified - proof of the 4-color theorem. This proof had previously been - controversial among mathematicians because part of it included - checking a large number of configurations using a program. In - the Coq formalization, everything is checked, including the - correctness of the computational part. More recently, an even - more massive effort led to a Coq formalization of the - Feit-Thompson Theorem -- the first major step in the - classification of finite simple groups. - - By the way, in case you're wondering about the name, here's what - the official Coq web site says: "Some French computer scientists - have a tradition of naming their software as animal species: Caml, - Elan, Foc or Phox are examples of this tacit convention. In French, - “coq” means rooster, and it sounds like the initials of the - Calculus of Constructions CoC on which it is based." The rooster - is also the national symbol of France, and "Coq" are the first - three letters of the name of Thierry Coquand, one of Coq's early - developers. *) - -(** ** Functional Programming *) - -(** The term _functional programming_ refers both to a collection of - programming idioms that can be used in almost any programming - language and to a particular family of programming languages that are - designed to emphasize these idioms, including Haskell, OCaml, - Standard ML, F##, Scala, Scheme, Racket, Common Lisp, Clojure, - Erlang, and Coq. - - Functional programming has been developed by researchers over many - decades -- indeed, its roots go back to Church's lambda-calculus, - developed in the 1930s before the era of the computer began! But - in the past two decades it has enjoyed a surge of interest among - industrial engineers and language designers, playing a key role in - high-value systems at companies like Jane St. Capital, Microsoft, - Facebook, and Ericsson. - - The most basic tenet of functional programming is that, as much as - possible, computation should be _pure_: the only effect of running - a computation should be to produce a result; the computation - should be free from _side effects_ such as I/O, assignments to - mutable variables, or redirecting pointers. For example, whereas - an _imperative_ sorting function might take a list of numbers and - rearrange the pointers to put the list in order, a pure sorting - function would take the original list and return a _new_ list - containing the same numbers in sorted order. - - One significant benefit of this style of programming is that it - makes programs easier to understand and reason about. If every - operation on a data structure yields a new data structure, leaving - the old one intact, then there is no need to worry about where - else in the program the structure is being shared, whether a - change by one part of the program might break an invariant that - another part of the program thinks is being enforced. These - considerations are particularly critical in concurrent programs, - where any mutable state that is shared between threads is a - potential source of pernicious bugs. Indeed, a large part of the - recent interest in functional programming in industry is due to its - simple behavior in the presence of concurrency. - - Another reason for the current excitement about functional - programming is related to this one: functional programs are often - much easier to parallelize than their imperative counterparts. If - running a computation has no effect other than producing a result, - then it can be run anywhere. If a data structure is never - modified in place, it can be copied freely, across cores or across - the network. Indeed, the MapReduce idiom that lies at the heart - of massively distributed query processors like Hadoop and is used - at Google to index the entire web is an instance of functional - programming. - - For purposes of this course, functional programming has one other - significant attraction: it serves as a bridge between logic and - computer science. Indeed, Coq itself can be seen as a combination - of a small but extremely expressive functional programming - language, together with a set of tools for stating and proving - logical assertions. However, when we come to look more closely, - we will find that these two sides of Coq are actually aspects of - the very same underlying machinery -- i.e., _proofs are programs_. *) - -(** ** Program Verification *) - -(** The first third of the book is devoted to developing the - conceptual framework of logic and functional programming and to - gaining enough fluency with the essentials of Coq to use it for - modeling and reasoning about nontrivial artifacts. From this - point on, we will increasingly turn our attention to two broad - topics of critical importance to the enterprise of building - reliable software (and hardware!): techniques for proving specific - properties of particular _programs_ and for proving general - properties of whole programming _languages_. - - For both of these, the first thing we need is a way of - representing programs as mathematical objects (so we can talk - about them precisely) and of describing their behavior in terms of - mathematical functions or relations. Our tools for these tasks - will be _abstract syntax_ and _operational semantics_, a method of - specifying the behavior of programs by writing abstract - interpreters. At the beginning, we will work with operational - semantics in the so-called "big-step" style, which leads to - somewhat simpler and more readable definitions, in those cases - where it is applicable. Later on, we will switch to a more - detailed "small-step" style, which helps make some useful - distinctions between different sorts of "nonterminating" program - behaviors and which can be applied to a broader range of language - features, including concurrency. - - The first programming language we consider in detail is Imp, a - tiny toy language capturing the most fundamental features of - conventional imperative languages: variables, assignment, - conditionals, and loops. We study two different ways of reasoning - about the properties of Imp programs. - - First, we consider what it means to say that two Imp programs are - _equivalent_ in the sense that they give the same behaviors for - all initial memories. This notion of equivalence then becomes a - criterion for judging the correctness of _metaprograms_ -- - programs that manipulate other programs, such as compilers and - optimizers. We build a simple optimizer for Imp and prove that it - is correct. - - Second, we develop a methodology for proving that Imp programs - satisfy some formal specification of their behavior. We introduce - the notion of _Hoare triples_ -- Imp programs annotated with pre- - and post-conditions describing what should be true about the - memory in which they are started and what they promise to make - true about the memory in which they terminate -- and the reasoning - principles of _Hoare Logic_, a "domain-specific logic" specialized - for convenient compositional reasoning about imperative programs, - with concepts like "loop invariant" built in. - - This part of the course will give you a taste of the key ideas and - mathematical tools used for a wide variety of real-world software - and hardware verification tasks. - -*) - -(** ** Type Systems *) - -(** Our final major topic, covering the last third of the course, is - _type systems_, a powerful set of tools for establishing - properties of _all_ programs in a given language. - - Type systems are the best established and most popular example of - a highly successful class of formal verification techniques known - as _lightweight formal methods_. These are reasoning techniques - of modest power -- modest enough that automatic checkers can be - built into compilers, linkers, or program analyzers and thus be - applied even by programmers unfamiliar with the underlying - theories. (Other examples of lightweight formal methods include - hardware and software model checkers and run-time property - monitoring, a collection of techniques that allow a system to - detect, dynamically, when one of its components is not behaving - according to specification). - - In a sense, this topic brings us full circle: the language whose - properties we study in this part, called the _simply typed - lambda-calculus_, is essentially a simplified model of the core of - Coq itself! - -*) - -(* ###################################################################### *) -(** * Practicalities *) - -(* ###################################################################### *) -(** ** System Requirements *) - -(** Coq runs on Windows, Linux, and OS X. You will need: - - - A current installation of Coq, available from the Coq home - page. Everything should work with version 8.4. - - - An IDE for interacting with Coq. Currently, there are two - choices: - - - Proof General is an Emacs-based IDE. It tends to be - preferred by users who are already comfortable with - Emacs. It requires a separate installation (google - "Proof General"). - - - CoqIDE is a simpler stand-alone IDE. It is distributed - with Coq, but on some platforms compiling it involves - installing additional packages for GUI libraries and - such. *) - -(* ###################################################################### *) -(** ** Exercises *) - -(** Each chapter includes numerous exercises. Each is marked with a - "star rating," which can be interpreted as follows: - - - One star: easy exercises that underscore points in the text - and that, for most readers, should take only a minute or two. - Get in the habit of working these as you reach them. - - - Two stars: straightforward exercises (five or ten minutes). - - - Three stars: exercises requiring a bit of thought (ten - minutes to half an hour). - - - Four and five stars: more difficult exercises (half an hour - and up). - - Also, some exercises are marked "advanced", and some are marked - "optional." Doing just the non-optional, non-advanced exercises - should provide good coverage of the core material. "Advanced" - exercises are for readers who want an extra challenge (and, in - return, a deeper contact with the material). "Optional" exercises - provide a bit of extra practice with key concepts and introduce - secondary themes that may be of interest to some readers. *) - -(* ###################################################################### *) -(** ** Chapter Dependencies *) - -(** A diagram of the dependencies between chapters and some suggested - paths through the material can be found in the file [deps.html]. *) - -(* ###################################################################### *) -(** ** Downloading the Coq Files *) - -(** A tar file containing the full sources for the "release version" - of these notes (as a collection of Coq scripts and HTML files) is - available here: -<< - http://www.cis.upenn.edu/~bcpierce/sf ->> - If you are using the notes as part of a class, you may be given - access to a locally extended version of the files, which you - should use instead of the release version. -*) - -(* ###################################################################### *) -(** * Note for Instructors *) - -(** If you intend to use these materials in your own course, you will - undoubtedly find things you'd like to change, improve, or add. - Your contributions are welcome! - - Please send an email to Benjamin Pierce, and we'll set you up with - read/write access to our subversion repository and developers' - mailing list; in the repository you'll find a [README] with further - instructions. *) - -(* ###################################################################### *) -(** * Translations *) - -(** Thanks to the efforts of a team of volunteer translators, _Software - Foundations_ can now be enjoyed in Japanese: - - - http://proofcafe.org/sf -*) - -(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *) - diff --git a/ProofObjects.html b/ProofObjects.html deleted file mode 100644 index 4242a19..0000000 --- a/ProofObjects.html +++ /dev/null @@ -1,906 +0,0 @@ - - - - - -ProofObjects: Working with Explicit Evidence in Coq - - - - - - -
- - - -
- -

ProofObjectsWorking with Explicit Evidence in Coq

- -
-
- -
- -
-
- -
-Require Export MoreLogic.
- -
- -
-
- -
- We have seen that Coq has mechanisms both for programming, - using inductive data types (like nat or list) and functions - over these types, and for proving properties of these programs, - using inductive propositions (like ev or eq), implication, and - universal quantification. So far, we have treated these mechanisms - as if they were quite separate, and for many purposes this is - a good way to think. But we have also seen hints that Coq's programming and - proving facilities are closely related. For example, the - keyword Inductive is used to declare both data types and - propositions, and → is used both to describe the type of - functions on data and logical implication. This is not just a - syntactic accident! In fact, programs and proofs in Coq are almost - the same thing. In this chapter we will study how this works. - -
- - We have already seen the fundamental idea: provability in Coq is - represented by concrete evidence. When we construct the proof - of a basic proposition, we are actually building a tree of evidence, - which can be thought of as a data structure. If the proposition - is an implication like A → B, then its proof will be an - evidence transformer: a recipe for converting evidence for - A into evidence for B. So at a fundamental level, proofs are simply - programs that manipulate evidence. - -
- - Q. If evidence is data, what are propositions themselves? - -
- - A. They are types! - -
- - Look again at the formal definition of the beautiful property. -
-
- -
-Print beautiful.
-(* ==>
-  Inductive beautiful : nat -> Prop :=
-      b_0 : beautiful 0
-    | b_3 : beautiful 3
-    | b_5 : beautiful 5
-    | b_sum : forall n m : nat, beautiful n -> beautiful m -> beautiful (n + m)
-*)
- -
-
- -
-

- -
- - The trick is to introduce an alternative pronunciation of ":". - Instead of "has type," we can also say "is a proof of." For - example, the second line in the definition of beautiful declares - that b_0 : beautiful 0. Instead of "b_0 has type - beautiful 0," we can say that "b_0 is a proof of beautiful 0." - Similarly for b_3 and b_5. -
- -

- -
- - This pun between types and propositions (between : as "has type" - and : as "is a proof of" or "is evidence for") is called the - Curry-Howard correspondence. It proposes a deep connection - between the world of logic and the world of computation. -
-                 propositions  ~  types
-                 proofs        ~  data values
-
- Many useful insights follow from this connection. To begin with, it - gives us a natural interpretation of the type of b_sum constructor: -
-
- -
-Check b_sum.
-(* ===> b_sum : forall n m, 
-                  beautiful n -> 
-                  beautiful m -> 
-                  beautiful (n+m) *)
-
- -
-This can be read "b_sum is a constructor that takes four - arguments — two numbers, n and m, and two pieces of evidence, - for the propositions beautiful n and beautiful m, respectively — - and yields evidence for the proposition beautiful (n+m)." -
- - Now let's look again at a previous proof involving beautiful. -
-
- -
-Theorem eight_is_beautiful: beautiful 8.
-Proof.
-    apply b_sum with (n := 3) (m := 5).
-    apply b_3.
-    apply b_5. Qed.
- -
-
- -
-Just as with ordinary data values and functions, we can use the Print -command to see the proof object that results from this proof script. -
-
- -
-Print eight_is_beautiful.
-(* ===> eight_is_beautiful = b_sum 3 5 b_3 b_5  
-     : beautiful 8  *)
- -
-
- -
-In view of this, we might wonder whether we can write such - an expression ourselves. Indeed, we can: -
-
- -
-Check (b_sum 3 5 b_3 b_5).
-(* ===> beautiful (3 + 5) *)
- -
-
- -
-The expression b_sum 3 5 b_3 b_5 can be thought of as - instantiating the parameterized constructor b_sum with the - specific arguments 3 5 and the corresponding proof objects for - its premises beautiful 3 and beautiful 5 (Coq is smart enough - to figure out that 3+5=8). Alternatively, we can think of b_sum - as a primitive "evidence constructor" that, when applied to two - particular numbers, wants to be further applied to evidence that - those two numbers are beautiful; its type, - -
- -
-    ∀n m, beautiful n → beautiful m → beautiful (n+m), -
- -
- expresses this functionality, in the same way that the polymorphic - type ∀ X, list X in the previous chapter expressed the fact - that the constructor nil can be thought of as a function from - types to empty lists with elements of that type. -
- - This gives us an alternative way to write the proof that 8 is - beautiful: -
-
- -
-Theorem eight_is_beautiful': beautiful 8.
-Proof.
-   apply (b_sum 3 5 b_3 b_5).
-Qed.
- -
-
- -
-Notice that we're using apply here in a new way: instead of just - supplying the name of a hypothesis or previously proved theorem - whose type matches the current goal, we are supplying an - expression that directly builds evidence with the required - type. -
-
- -
-
- -
-

Proof Scripts and Proof Objects

- -
- - These proof objects lie at the core of how Coq operates. - -
- - When Coq is following a proof script, what is happening internally - is that it is gradually constructing a proof object — a term - whose type is the proposition being proved. The tactics between - the Proof command and the Qed instruct Coq how to build up a - term of the required type. To see this process in action, let's - use the Show Proof command to display the current state of the - proof tree at various points in the following tactic proof. -
-
- -
-Theorem eight_is_beautiful'': beautiful 8.
-Proof.
-   Show Proof.
-   apply b_sum with (n:=3) (m:=5).
-   Show Proof.
-   apply b_3.
-   Show Proof.
-   apply b_5.
-   Show Proof.
-Qed.
- -
-
- -
-At any given moment, Coq has constructed a term with some - "holes" (indicated by ?1, ?2, and so on), and it knows what - type of evidence is needed at each hole. -
- - -
- - Each of the holes corresponds to a subgoal, and the proof is - finished when there are no more subgoals. At this point, the - Theorem command gives a name to the evidence we've built and - stores it in the global context. -
- - Tactic proofs are useful and convenient, but they are not - essential: in principle, we can always construct the required - evidence by hand, as shown above. Then we can use Definition - (rather than Theorem) to give a global name directly to a - piece of evidence. -
-
- -
-Definition eight_is_beautiful''' : beautiful 8 :=
-  b_sum 3 5 b_3 b_5.
- -
-
- -
-All these different ways of building the proof lead to exactly the - same evidence being saved in the global environment. -
-
- -
-Print eight_is_beautiful.
-(* ===> eight_is_beautiful    = b_sum 3 5 b_3 b_5 : beautiful 8 *)
-Print eight_is_beautiful'.
-(* ===> eight_is_beautiful'   = b_sum 3 5 b_3 b_5 : beautiful 8 *)
-Print eight_is_beautiful''.
-(* ===> eight_is_beautiful''  = b_sum 3 5 b_3 b_5 : beautiful 8 *)
-Print eight_is_beautiful'''.
-(* ===> eight_is_beautiful''' = b_sum 3 5 b_3 b_5 : beautiful 8 *)
- -
-
- -
-

Exercise: 1 star (six_is_beautiful)

- Give a tactic proof and a proof object showing that 6 is beautiful. -
-
- -
-Theorem six_is_beautiful :
-  beautiful 6.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Definition six_is_beautiful' : beautiful 6 :=
-  (* FILL IN HERE *) admit.
-
- -
-☐ -
- -

Exercise: 1 star (nine_is_beautiful)

- Give a tactic proof and a proof object showing that 9 is beautiful. -
-
- -
-Theorem nine_is_beautiful :
-  beautiful 9.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Definition nine_is_beautiful' : beautiful 9 :=
-  (* FILL IN HERE *) admit.
-
- -
-☐ -
-
- -
-
- -
-

Quantification, Implications and Functions

- -
- - In Coq's computational universe (where we've mostly been living - until this chapter), there are two sorts of values with arrows in - their types: constructors introduced by Inductive-ly defined - data types, and functions. - -
- - Similarly, in Coq's logical universe, there are two ways of giving - evidence for an implication: constructors introduced by - Inductive-ly defined propositions, and... functions! - -
- - For example, consider this statement: -
-
- -
-Theorem b_plus3: ∀n, beautiful n → beautiful (3+n).
-Proof.
-   intros n H.
-   apply b_sum.
-   apply b_3.
-   apply H.
-Qed.
- -
-
- -
-What is the proof object corresponding to b_plus3? - -
- - We're looking for an expression whose type is ∀ n, - beautiful n → beautiful (3+n) — that is, a function that - takes two arguments (one number and a piece of evidence) and - returns a piece of evidence! Here it is: -
-
- -
-Definition b_plus3' : ∀n, beautiful n → beautiful (3+n) :=
-  fun (n : nat) ⇒ fun (H : beautiful n) ⇒
-    b_sum 3 n b_3 H.
- -
-Check b_plus3'.
-(* ===> b_plus3' : forall n : nat, beautiful n -> beautiful (3+n) *)
- -
-
- -
-Recall that fun n ⇒ blah means "the function that, given n, - yields blah." Another equivalent way to write this definition is: -
-
- -
-Definition b_plus3'' (n : nat) (H : beautiful n) : beautiful (3+n) :=
-  b_sum 3 n b_3 H.
- -
-Check b_plus3''.
-(* ===> b_plus3'' : forall n, beautiful n -> beautiful (3+n) *)
- -
-
- -
-When we view the proposition being proved by b_plus3 as a function type, - one aspect of it may seem a little unusual. The second argument's - type, beautiful n, mentions the value of the first argument, n. - While such dependent types are not commonly found in programming - languages, even functional ones like ML or Haskell, they can - be useful there too. - -
- - Notice that both implication (→) and quantification (∀) - correspond to functions on evidence. In fact, they are really the - same thing: → is just a shorthand for a degenerate use of - ∀ where there is no dependency, i.e., no need to give a name - to the type on the LHS of the arrow. -
- - For example, consider this proposition: -
-
- -
-Definition beautiful_plus3 : Prop :=
-  ∀n, ∀(E : beautiful n), beautiful (n+3).
- -
-
- -
-A proof term inhabiting this proposition would be a function - with two arguments: a number n and some evidence E that n is - beautiful. But the name E for this evidence is not used in the - rest of the statement of funny_prop1, so it's a bit silly to - bother making up a name for it. We could write it like this - instead, using the dummy identifier _ in place of a real - name: -
-
- -
-Definition beautiful_plus3' : Prop :=
-  ∀n, ∀(_ : beautiful n), beautiful (n+3).
- -
-
- -
-Or, equivalently, we can write it in more familiar notation: -
-
- -
-Definition beatiful_plus3'' : Prop :=
-  ∀n, beautiful n → beautiful (n+3).
- -
-
- -
-In general, "P → Q" is just syntactic sugar for - "∀ (_:P), Q". -
- -

Exercise: 2 stars b_times2

- -
- - Give a proof object corresponding to the theorem b_times2 from Prop.v -
-
- -
-Definition b_times2': ∀n, beautiful n → beautiful (2×n) :=
-  (* FILL IN HERE *) admit.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (gorgeous_plus13_po)

- Give a proof object corresponding to the theorem gorgeous_plus13 from Prop.v -
-
- -
-Definition gorgeous_plus13_po: ∀n, gorgeous n → gorgeous (13+n):=
-   (* FILL IN HERE *) admit.
-
- -
-☐ -
- - It is particularly revealing to look at proof objects involving the -logical connectives that we defined with inductive propositions in Logic.v. -
-
- -
-Theorem and_example :
-  (beautiful 0) ∧ (beautiful 3).
-Proof.
-  apply conj.
-   (* Case "left". *) apply b_0.
-   (* Case "right". *) apply b_3. Qed.
- -
-
- -
-Let's take a look at the proof object for the above theorem. -
-
- -
-Print and_example.
-(* ===>  conj (beautiful 0) (beautiful 3) b_0 b_3
-            : beautiful 0 /\ beautiful 3 *)
- -
-
- -
-Note that the proof is of the form - -
- -
-    conj (beautiful 0) (beautiful 3) 
-         (...pf of beautiful 3...) (...pf of beautiful 3...) -
- -
- as you'd expect, given the type of conj. -
- -

Exercise: 1 star, optional (case_proof_objects)

- The Case tactics were commented out in the proof of - and_example to avoid cluttering the proof object. What would - you guess the proof object will look like if we uncomment them? - Try it and see. ☐ -
-
- -
-Theorem and_commut : ∀P Q : Prop,
-  P ∧ Q → Q ∧ P.
-Proof.
-  intros P Q H.
-  inversion H as [HP HQ].
-  split.
-    (* Case "left". *) apply HQ.
-    (* Case "right". *) apply HP. Qed.
- -
-
- -
-Once again, we have commented out the Case tactics to make the - proof object for this theorem easier to understand. It is still - a little complicated, but after performing some simple reduction - steps, we can see that all that is really happening is taking apart - a record containing evidence for P and Q and rebuilding it in the - opposite order: -
-
- -
-Print and_commut.
-(* ===>
-    and_commut = 
-      fun (P Q : Prop) (H : P /\ Q) =>
-        (fun H0 : Q /\ P => H0)
-            match H with
-            | conj HP HQ => (fun (HP0 : P) (HQ0 : Q) => conj Q P HQ0 HP0) HP HQ
-            end
-      : forall P Q : Prop, P /\ Q -> Q /\ P *)
- -
-
- -
-After simplifying some direct application of fun expressions to arguments, -we get: -
-
- -
-(* ===> 
-   and_commut = 
-     fun (P Q : Prop) (H : P /\ Q) =>
-     match H with
-     | conj HP HQ => conj Q P HQ HP
-     end 
-     : forall P Q : Prop, P /\ Q -> Q /\ P *)
- -
-
- -
-

Exercise: 2 stars, optional (conj_fact)

- Construct a proof object demonstrating the following proposition. -
-
- -
-Definition conj_fact : ∀P Q R, P ∧ Q → Q ∧ R → P ∧ R :=
-  (* FILL IN HERE *) admit.
-
- -
-☐ -
- -

Exercise: 2 stars, advanced, optional (beautiful_iff_gorgeous)

- -
- - We have seen that the families of propositions beautiful and - gorgeous actually characterize the same set of numbers. - Prove that beautiful n ↔ gorgeous n for all n. Just for - fun, write your proof as an explicit proof object, rather than - using tactics. (Hint: if you make use of previously defined - theorems, you should only need a single line!) -
-
- -
-Definition beautiful_iff_gorgeous :
-  ∀n, beautiful n ↔ gorgeous n :=
-  (* FILL IN HERE *) admit.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (or_commut'')

- Try to write down an explicit proof object for or_commut (without - using Print to peek at the ones we already defined!). -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- - Recall that we model an existential for a property as a pair consisting of -a witness value and a proof that the witness obeys that property. -We can choose to construct the proof explicitly. - -
- -For example, consider this existentially quantified proposition: -
-
-Check ex.
- -
-Definition some_nat_is_even : Prop :=
-  ex _ ev.
- -
-
- -
-To prove this proposition, we need to choose a particular number - as witness — say, 4 — and give some evidence that that number is - even. -
-
- -
-Definition snie : some_nat_is_even :=
-  ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)).
- -
-
- -
-

Exercise: 2 stars, optional (ex_beautiful_Sn)

- Complete the definition of the following proof object: -
-
- -
-Definition p : ex _ (fun n ⇒ beautiful (S n)) :=
-(* FILL IN HERE *) admit.
-
- -
-☐ -
-
- -
-
- -
-

Giving Explicit Arguments to Lemmas and Hypotheses

- -
- - Even when we are using tactic-based proof, it can be very useful to -understand the underlying functional nature of implications and quantification. - -
- -For example, it is often convenient to apply or rewrite -using a lemma or hypothesis with one or more quantifiers or -assumptions already instantiated in order to direct what -happens. For example: -
-
- -
-Check plus_comm.
-(* ==> 
-    plus_comm
-     : forall n m : nat, n + m = m + n *)
- -
-Lemma plus_comm_r : ∀a b c, c + (b + a) = c + (a + b).
-Proof.
-   intros a b c.
-   (* rewrite plus_comm. *)
-      (* rewrites in the first possible spot; not what we want *)
-   rewrite (plus_comm b a). (* directs rewriting to the right spot *)
-   reflexivity. Qed.
- -
-
- -
-In this case, giving just one argument would be sufficient. -
-
- -
-Lemma plus_comm_r' : ∀a b c, c + (b + a) = c + (a + b).
-Proof.
-   intros a b c.
-   rewrite (plus_comm b).
-   reflexivity. Qed.
- -
-
- -
-Arguments must be given in order, but wildcards (_) -may be used to skip arguments that Coq can infer. -
-
- -
-Lemma plus_comm_r'' : ∀a b c, c + (b + a) = c + (a + b).
-Proof.
-  intros a b c.
-  rewrite (plus_comm _ a).
-  reflexivity. Qed.
- -
-
- -
-The author of a lemma can choose to declare easily inferable arguments -to be implicit, just as with functions and constructors. - -
- - The with clauses we've already seen is really just a way of - specifying selected arguments by name rather than position: -
-
- -
-Lemma plus_comm_r''' : ∀a b c, c + (b + a) = c + (a + b).
-Proof.
-  intros a b c.
-  rewrite plus_comm with (n := b).
-  reflexivity. Qed.
- -
-
- -
-

Exercise: 2 stars (trans_eq_example_redux)

- Redo the proof of the following theorem (from MoreCoq.v) using -an apply of trans_eq but not using a with clause. -
-
- -
-Example trans_eq_example' : ∀(a b c d e f : nat),
-     [a;b] = [c;d] →
-     [c;d] = [e;f] →
-     [a;b] = [e;f].
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Programming with Tactics (Optional)

- -
- - If we can build proofs with explicit terms rather than -tactics, you may be wondering if we can build programs using -tactics rather than explicit terms. Sure! -
-
- -
-Definition add1 : nat → nat.
-intro n.
-Show Proof.
-apply S.
-Show Proof.
-apply n. Defined.
- -
-Print add1.
-(* ==>
-    add1 = fun n : nat => S n
-         : nat -> nat
-*)
- -
-Eval compute in add1 2.
-(* ==> 3 : nat *)
- -
-
- -
-Notice that we terminate the Definition with a . rather than with -:= followed by a term. This tells Coq to enter proof scripting mode -to build an object of type nat → nat. Also, we terminate the proof -with Defined rather than Qed; this makes the definition transparent -so that it can be used in computation like a normally-defined function. - -
- -This feature is mainly useful for writing functions with dependent types, -which we won't explore much further in this book. -But it does illustrate the uniformity and orthogonality of the basic ideas in Coq. -
-
- -
-(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/ProofObjects.v b/ProofObjects.v deleted file mode 100644 index e6f1793..0000000 --- a/ProofObjects.v +++ /dev/null @@ -1,537 +0,0 @@ -(** * ProofObjects: Working with Explicit Evidence in Coq *) - -Require Export MoreLogic. - -(* ##################################################### *) - -(** We have seen that Coq has mechanisms both for _programming_, - using inductive data types (like [nat] or [list]) and functions - over these types, and for _proving_ properties of these programs, - using inductive propositions (like [ev] or [eq]), implication, and - universal quantification. So far, we have treated these mechanisms - as if they were quite separate, and for many purposes this is - a good way to think. But we have also seen hints that Coq's programming and - proving facilities are closely related. For example, the - keyword [Inductive] is used to declare both data types and - propositions, and [->] is used both to describe the type of - functions on data and logical implication. This is not just a - syntactic accident! In fact, programs and proofs in Coq are almost - the same thing. In this chapter we will study how this works. - - We have already seen the fundamental idea: provability in Coq is - represented by concrete _evidence_. When we construct the proof - of a basic proposition, we are actually building a tree of evidence, - which can be thought of as a data structure. If the proposition - is an implication like [A -> B], then its proof will be an - evidence _transformer_: a recipe for converting evidence for - A into evidence for B. So at a fundamental level, proofs are simply - programs that manipulate evidence. -*) -(** - Q. If evidence is data, what are propositions themselves? - - A. They are types! - - Look again at the formal definition of the [beautiful] property. *) - -Print beautiful. -(* ==> - Inductive beautiful : nat -> Prop := - b_0 : beautiful 0 - | b_3 : beautiful 3 - | b_5 : beautiful 5 - | b_sum : forall n m : nat, beautiful n -> beautiful m -> beautiful (n + m) -*) - -(** *** *) - -(** The trick is to introduce an alternative pronunciation of "[:]". - Instead of "has type," we can also say "is a proof of." For - example, the second line in the definition of [beautiful] declares - that [b_0 : beautiful 0]. Instead of "[b_0] has type - [beautiful 0]," we can say that "[b_0] is a proof of [beautiful 0]." - Similarly for [b_3] and [b_5]. *) - -(** *** *) - -(** This pun between types and propositions (between [:] as "has type" - and [:] as "is a proof of" or "is evidence for") is called the - _Curry-Howard correspondence_. It proposes a deep connection - between the world of logic and the world of computation. -<< - propositions ~ types - proofs ~ data values ->> - Many useful insights follow from this connection. To begin with, it - gives us a natural interpretation of the type of [b_sum] constructor: *) - -Check b_sum. -(* ===> b_sum : forall n m, - beautiful n -> - beautiful m -> - beautiful (n+m) *) -(** This can be read "[b_sum] is a constructor that takes four - arguments -- two numbers, [n] and [m], and two pieces of evidence, - for the propositions [beautiful n] and [beautiful m], respectively -- - and yields evidence for the proposition [beautiful (n+m)]." *) - -(** Now let's look again at a previous proof involving [beautiful]. *) - -Theorem eight_is_beautiful: beautiful 8. -Proof. - apply b_sum with (n := 3) (m := 5). - apply b_3. - apply b_5. Qed. - -(** Just as with ordinary data values and functions, we can use the [Print] -command to see the _proof object_ that results from this proof script. *) - -Print eight_is_beautiful. -(* ===> eight_is_beautiful = b_sum 3 5 b_3 b_5 - : beautiful 8 *) - -(** In view of this, we might wonder whether we can write such - an expression ourselves. Indeed, we can: *) - -Check (b_sum 3 5 b_3 b_5). -(* ===> beautiful (3 + 5) *) - -(** The expression [b_sum 3 5 b_3 b_5] can be thought of as - instantiating the parameterized constructor [b_sum] with the - specific arguments [3] [5] and the corresponding proof objects for - its premises [beautiful 3] and [beautiful 5] (Coq is smart enough - to figure out that 3+5=8). Alternatively, we can think of [b_sum] - as a primitive "evidence constructor" that, when applied to two - particular numbers, wants to be further applied to evidence that - those two numbers are beautiful; its type, - forall n m, beautiful n -> beautiful m -> beautiful (n+m), - expresses this functionality, in the same way that the polymorphic - type [forall X, list X] in the previous chapter expressed the fact - that the constructor [nil] can be thought of as a function from - types to empty lists with elements of that type. *) - -(** This gives us an alternative way to write the proof that [8] is - beautiful: *) - -Theorem eight_is_beautiful': beautiful 8. -Proof. - apply (b_sum 3 5 b_3 b_5). -Qed. - -(** Notice that we're using [apply] here in a new way: instead of just - supplying the _name_ of a hypothesis or previously proved theorem - whose type matches the current goal, we are supplying an - _expression_ that directly builds evidence with the required - type. *) - - -(* ##################################################### *) -(** ** Proof Scripts and Proof Objects *) - -(** These proof objects lie at the core of how Coq operates. - - When Coq is following a proof script, what is happening internally - is that it is gradually constructing a proof object -- a term - whose type is the proposition being proved. The tactics between - the [Proof] command and the [Qed] instruct Coq how to build up a - term of the required type. To see this process in action, let's - use the [Show Proof] command to display the current state of the - proof tree at various points in the following tactic proof. *) - -Theorem eight_is_beautiful'': beautiful 8. -Proof. - Show Proof. - apply b_sum with (n:=3) (m:=5). - Show Proof. - apply b_3. - Show Proof. - apply b_5. - Show Proof. -Qed. - -(** At any given moment, Coq has constructed a term with some - "holes" (indicated by [?1], [?2], and so on), and it knows what - type of evidence is needed at each hole. *) - -(** - Each of the holes corresponds to a subgoal, and the proof is - finished when there are no more subgoals. At this point, the - [Theorem] command gives a name to the evidence we've built and - stores it in the global context. *) - -(** Tactic proofs are useful and convenient, but they are not - essential: in principle, we can always construct the required - evidence by hand, as shown above. Then we can use [Definition] - (rather than [Theorem]) to give a global name directly to a - piece of evidence. *) - -Definition eight_is_beautiful''' : beautiful 8 := - b_sum 3 5 b_3 b_5. - -(** All these different ways of building the proof lead to exactly the - same evidence being saved in the global environment. *) - -Print eight_is_beautiful. -(* ===> eight_is_beautiful = b_sum 3 5 b_3 b_5 : beautiful 8 *) -Print eight_is_beautiful'. -(* ===> eight_is_beautiful' = b_sum 3 5 b_3 b_5 : beautiful 8 *) -Print eight_is_beautiful''. -(* ===> eight_is_beautiful'' = b_sum 3 5 b_3 b_5 : beautiful 8 *) -Print eight_is_beautiful'''. -(* ===> eight_is_beautiful''' = b_sum 3 5 b_3 b_5 : beautiful 8 *) - -(** **** Exercise: 1 star (six_is_beautiful) *) -(** Give a tactic proof and a proof object showing that [6] is [beautiful]. *) - -Theorem six_is_beautiful : - beautiful 6. -Proof. - (* FILL IN HERE *) Admitted. - -Definition six_is_beautiful' : beautiful 6 := - (* FILL IN HERE *) admit. -(** [] *) - -(** **** Exercise: 1 star (nine_is_beautiful) *) -(** Give a tactic proof and a proof object showing that [9] is [beautiful]. *) - -Theorem nine_is_beautiful : - beautiful 9. -Proof. - (* FILL IN HERE *) Admitted. - -Definition nine_is_beautiful' : beautiful 9 := - (* FILL IN HERE *) admit. -(** [] *) - -(* ##################################################### *) -(** ** Quantification, Implications and Functions *) - -(** In Coq's computational universe (where we've mostly been living - until this chapter), there are two sorts of values with arrows in - their types: _constructors_ introduced by [Inductive]-ly defined - data types, and _functions_. - - Similarly, in Coq's logical universe, there are two ways of giving - evidence for an implication: constructors introduced by - [Inductive]-ly defined propositions, and... functions! - - For example, consider this statement: *) - -Theorem b_plus3: forall n, beautiful n -> beautiful (3+n). -Proof. - intros n H. - apply b_sum. - apply b_3. - apply H. -Qed. - -(** What is the proof object corresponding to [b_plus3]? - - We're looking for an expression whose _type_ is [forall n, - beautiful n -> beautiful (3+n)] -- that is, a _function_ that - takes two arguments (one number and a piece of evidence) and - returns a piece of evidence! Here it is: *) - -Definition b_plus3' : forall n, beautiful n -> beautiful (3+n) := - fun (n : nat) => fun (H : beautiful n) => - b_sum 3 n b_3 H. - -Check b_plus3'. -(* ===> b_plus3' : forall n : nat, beautiful n -> beautiful (3+n) *) - -(** Recall that [fun n => blah] means "the function that, given [n], - yields [blah]." Another equivalent way to write this definition is: *) - -Definition b_plus3'' (n : nat) (H : beautiful n) : beautiful (3+n) := - b_sum 3 n b_3 H. - -Check b_plus3''. -(* ===> b_plus3'' : forall n, beautiful n -> beautiful (3+n) *) - -(** When we view the proposition being proved by [b_plus3] as a function type, - one aspect of it may seem a little unusual. The second argument's - type, [beautiful n], mentions the _value_ of the first argument, [n]. - While such _dependent types_ are not commonly found in programming - languages, even functional ones like ML or Haskell, they can - be useful there too. - - Notice that both implication ([->]) and quantification ([forall]) - correspond to functions on evidence. In fact, they are really the - same thing: [->] is just a shorthand for a degenerate use of - [forall] where there is no dependency, i.e., no need to give a name - to the type on the LHS of the arrow. *) - -(** For example, consider this proposition: *) - -Definition beautiful_plus3 : Prop := - forall n, forall (E : beautiful n), beautiful (n+3). - -(** A proof term inhabiting this proposition would be a function - with two arguments: a number [n] and some evidence [E] that [n] is - beautiful. But the name [E] for this evidence is not used in the - rest of the statement of [funny_prop1], so it's a bit silly to - bother making up a name for it. We could write it like this - instead, using the dummy identifier [_] in place of a real - name: *) - -Definition beautiful_plus3' : Prop := - forall n, forall (_ : beautiful n), beautiful (n+3). - -(** Or, equivalently, we can write it in more familiar notation: *) - -Definition beatiful_plus3'' : Prop := - forall n, beautiful n -> beautiful (n+3). - -(** In general, "[P -> Q]" is just syntactic sugar for - "[forall (_:P), Q]". *) - - -(** **** Exercise: 2 stars b_times2 *) - -(** Give a proof object corresponding to the theorem [b_times2] from Prop.v *) - -Definition b_times2': forall n, beautiful n -> beautiful (2*n) := - (* FILL IN HERE *) admit. -(** [] *) - - - -(** **** Exercise: 2 stars, optional (gorgeous_plus13_po) *) -(** Give a proof object corresponding to the theorem [gorgeous_plus13] from Prop.v *) - -Definition gorgeous_plus13_po: forall n, gorgeous n -> gorgeous (13+n):= - (* FILL IN HERE *) admit. -(** [] *) - - - - -(** It is particularly revealing to look at proof objects involving the -logical connectives that we defined with inductive propositions in Logic.v. *) - -Theorem and_example : - (beautiful 0) /\ (beautiful 3). -Proof. - apply conj. - (* Case "left". *) apply b_0. - (* Case "right". *) apply b_3. Qed. - -(** Let's take a look at the proof object for the above theorem. *) - -Print and_example. -(* ===> conj (beautiful 0) (beautiful 3) b_0 b_3 - : beautiful 0 /\ beautiful 3 *) - -(** Note that the proof is of the form - conj (beautiful 0) (beautiful 3) - (...pf of beautiful 3...) (...pf of beautiful 3...) - as you'd expect, given the type of [conj]. *) - -(** **** Exercise: 1 star, optional (case_proof_objects) *) -(** The [Case] tactics were commented out in the proof of - [and_example] to avoid cluttering the proof object. What would - you guess the proof object will look like if we uncomment them? - Try it and see. *) -(** [] *) - -Theorem and_commut : forall P Q : Prop, - P /\ Q -> Q /\ P. -Proof. - intros P Q H. - inversion H as [HP HQ]. - split. - (* Case "left". *) apply HQ. - (* Case "right". *) apply HP. Qed. - -(** Once again, we have commented out the [Case] tactics to make the - proof object for this theorem easier to understand. It is still - a little complicated, but after performing some simple reduction - steps, we can see that all that is really happening is taking apart - a record containing evidence for [P] and [Q] and rebuilding it in the - opposite order: *) - -Print and_commut. -(* ===> - and_commut = - fun (P Q : Prop) (H : P /\ Q) => - (fun H0 : Q /\ P => H0) - match H with - | conj HP HQ => (fun (HP0 : P) (HQ0 : Q) => conj Q P HQ0 HP0) HP HQ - end - : forall P Q : Prop, P /\ Q -> Q /\ P *) - -(** After simplifying some direct application of [fun] expressions to arguments, -we get: *) - -(* ===> - and_commut = - fun (P Q : Prop) (H : P /\ Q) => - match H with - | conj HP HQ => conj Q P HQ HP - end - : forall P Q : Prop, P /\ Q -> Q /\ P *) - - - -(** **** Exercise: 2 stars, optional (conj_fact) *) -(** Construct a proof object demonstrating the following proposition. *) - -Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R := - (* FILL IN HERE *) admit. -(** [] *) - - -(** **** Exercise: 2 stars, advanced, optional (beautiful_iff_gorgeous) *) - -(** We have seen that the families of propositions [beautiful] and - [gorgeous] actually characterize the same set of numbers. - Prove that [beautiful n <-> gorgeous n] for all [n]. Just for - fun, write your proof as an explicit proof object, rather than - using tactics. (_Hint_: if you make use of previously defined - theorems, you should only need a single line!) *) - -Definition beautiful_iff_gorgeous : - forall n, beautiful n <-> gorgeous n := - (* FILL IN HERE *) admit. -(** [] *) - - -(** **** Exercise: 2 stars, optional (or_commut'') *) -(** Try to write down an explicit proof object for [or_commut] (without - using [Print] to peek at the ones we already defined!). *) - -(* FILL IN HERE *) -(** [] *) - -(** Recall that we model an existential for a property as a pair consisting of -a witness value and a proof that the witness obeys that property. -We can choose to construct the proof explicitly. - -For example, consider this existentially quantified proposition: *) -Check ex. - -Definition some_nat_is_even : Prop := - ex _ ev. - -(** To prove this proposition, we need to choose a particular number - as witness -- say, 4 -- and give some evidence that that number is - even. *) - -Definition snie : some_nat_is_even := - ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)). - - -(** **** Exercise: 2 stars, optional (ex_beautiful_Sn) *) -(** Complete the definition of the following proof object: *) - -Definition p : ex _ (fun n => beautiful (S n)) := -(* FILL IN HERE *) admit. -(** [] *) - - - -(* ##################################################### *) -(** ** Giving Explicit Arguments to Lemmas and Hypotheses *) - -(** Even when we are using tactic-based proof, it can be very useful to -understand the underlying functional nature of implications and quantification. - -For example, it is often convenient to [apply] or [rewrite] -using a lemma or hypothesis with one or more quantifiers or -assumptions already instantiated in order to direct what -happens. For example: *) - -Check plus_comm. -(* ==> - plus_comm - : forall n m : nat, n + m = m + n *) - -Lemma plus_comm_r : forall a b c, c + (b + a) = c + (a + b). -Proof. - intros a b c. - (* rewrite plus_comm. *) - (* rewrites in the first possible spot; not what we want *) - rewrite (plus_comm b a). (* directs rewriting to the right spot *) - reflexivity. Qed. - - -(** In this case, giving just one argument would be sufficient. *) - -Lemma plus_comm_r' : forall a b c, c + (b + a) = c + (a + b). -Proof. - intros a b c. - rewrite (plus_comm b). - reflexivity. Qed. - -(** Arguments must be given in order, but wildcards (_) -may be used to skip arguments that Coq can infer. *) - -Lemma plus_comm_r'' : forall a b c, c + (b + a) = c + (a + b). -Proof. - intros a b c. - rewrite (plus_comm _ a). - reflexivity. Qed. - -(** The author of a lemma can choose to declare easily inferable arguments -to be implicit, just as with functions and constructors. - - The [with] clauses we've already seen is really just a way of - specifying selected arguments by name rather than position: *) - -Lemma plus_comm_r''' : forall a b c, c + (b + a) = c + (a + b). -Proof. - intros a b c. - rewrite plus_comm with (n := b). - reflexivity. Qed. - - -(** **** Exercise: 2 stars (trans_eq_example_redux) *) -(** Redo the proof of the following theorem (from MoreCoq.v) using -an [apply] of [trans_eq] but _not_ using a [with] clause. *) - -Example trans_eq_example' : forall (a b c d e f : nat), - [a;b] = [c;d] -> - [c;d] = [e;f] -> - [a;b] = [e;f]. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - -(* ##################################################### *) -(** ** Programming with Tactics (Optional) *) - -(** If we can build proofs with explicit terms rather than -tactics, you may be wondering if we can build programs using -tactics rather than explicit terms. Sure! *) - -Definition add1 : nat -> nat. -intro n. -Show Proof. -apply S. -Show Proof. -apply n. Defined. - -Print add1. -(* ==> - add1 = fun n : nat => S n - : nat -> nat -*) - -Eval compute in add1 2. -(* ==> 3 : nat *) - -(** Notice that we terminate the [Definition] with a [.] rather than with -[:=] followed by a term. This tells Coq to enter proof scripting mode -to build an object of type [nat -> nat]. Also, we terminate the proof -with [Defined] rather than [Qed]; this makes the definition _transparent_ -so that it can be used in computation like a normally-defined function. - -This feature is mainly useful for writing functions with dependent types, -which we won't explore much further in this book. -But it does illustrate the uniformity and orthogonality of the basic ideas in Coq. *) - -(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *) - diff --git a/Prop.html b/Prop.html deleted file mode 100644 index 4d1eabf..0000000 --- a/Prop.html +++ /dev/null @@ -1,1754 +0,0 @@ - - - - - -Prop: Propositions and Evidence - - - - - - -
- - - -
- -

PropPropositions and Evidence

- -
-
- -
- -
-
- -
-Require Export Logic.
- -
-
- -
-

From Boolean Functions to Propositions

- -
- - In chapter Basics we defined a function evenb that tests a - number for evenness, yielding true if so. We can use this - function to define the proposition that some number n is - even: -
-
- -
-Definition even (n:nat) : Prop :=
-  evenb n = true.
- -
-
- -
-That is, we can define "n is even" to mean "the function evenb - returns true when applied to n." - -
- - Note that here we have given a name - to a proposition using a Definition, just as we have - given names to expressions of other sorts. This isn't a fundamentally - new kind of proposition; it is still just an equality. -
- - Another alternative is to define the concept of evenness - directly. Instead of going via the evenb function ("a number is - even if a certain computation yields true"), we can say what the - concept of evenness means by giving two different ways of - presenting evidence that a number is even. -
- -

Inductively Defined Propositions

- -
-
- -
-Inductive ev : nat → Prop :=
-  | ev_0 : ev O
-  | ev_SS : ∀n:nat, ev n → ev (S (S n)).
- -
-
- -
-This definition says that there are two ways to give - evidence that a number m is even. First, 0 is even, and - ev_0 is evidence for this. Second, if m = S (S n) for some - n and we can give evidence e that n is even, then m is - also even, and ev_SS n e is the evidence. -
- -

Exercise: 1 star (double_even)

- -
-
- -
-Theorem double_even : ∀n,
-  ev (double n).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Discussion: Computational vs. Inductive Definitions

- -
- - We have seen that the proposition "n is even" can be - phrased in two different ways — indirectly, via a boolean testing - function evenb, or directly, by inductively describing what - constitutes evidence for evenness. These two ways of defining - evenness are about equally easy to state and work with. Which we - choose is basically a question of taste. - -
- - However, for many other properties of interest, the direct - inductive definition is preferable, since writing a testing - function may be awkward or even impossible. - -
- - One such property is beautiful. This is a perfectly sensible - definition of a set of numbers, but we cannot translate its - definition directly into a Coq Fixpoint (or into a recursive - function in any other common programming language). We might be - able to find a clever way of testing this property using a - Fixpoint (indeed, it is not too hard to find one in this case), - but in general this could require arbitrarily deep thinking. In - fact, if the property we are interested in is uncomputable, then - we cannot define it as a Fixpoint no matter how hard we try, - because Coq requires that all Fixpoints correspond to - terminating computations. - -
- - On the other hand, writing an inductive definition of what it - means to give evidence for the property beautiful is - straightforward. -
- -

Exercise: 1 star (ev__even)

- Here is a proof that the inductive definition of evenness implies - the computational one. -
-
- -
-Theorem ev__even : ∀n,
-  ev n → even n.
-Proof.
-  intros n E. induction E as [| n' E'].
-  Case "E = ev_0".
-    unfold even. reflexivity.
-  Case "E = ev_SS n' E'".
-    unfold even. apply IHE'.
-Qed.
- -
-
- -
-Could this proof also be carried out by induction on n instead - of E? If not, why not? -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- - The induction principle for inductively defined propositions does - not follow quite the same form as that of inductively defined - sets. For now, you can take the intuitive view that induction on - evidence ev n is similar to induction on n, but restricts our - attention to only those numbers for which evidence ev n could be - generated. We'll look at the induction principle of ev in more - depth below, to explain what's really going on. -
- -

Exercise: 1 star (l_fails)

- The following proof attempt will not succeed. - -
- -
-     Theorem l : ∀n,
-       ev n.
-     Proof.
-       intros n. induction n.
-         Case "O". simpl. apply ev_0.
-         Case "S".
-           ... -
- -
- Intuitively, we expect the proof to fail because not every - number is even. However, what exactly causes the proof to fail? - -
- -(* FILL IN HERE *)
- ☐ -
- -

Exercise: 2 stars (ev_sum)

- Here's another exercise requiring induction. -
-
- -
-Theorem ev_sum : ∀n m,
-   ev n → ev m → ev (n+m).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Inductively Defined Propositions

- -
- - As a running example, let's - define a simple property of natural numbers — we'll call it - "beautiful." -
- - Informally, a number is beautiful if it is 0, 3, 5, or the - sum of two beautiful numbers. - -
- - More pedantically, we can define beautiful numbers by giving four - rules: - -
- -
    -
  • Rule b_0: The number 0 is beautiful. - -
    • -
  • Rule b_3: The number 3 is beautiful. - -
    • -
  • Rule b_5: The number 5 is beautiful. - -
    • -
  • Rule b_sum: If n and m are both beautiful, then so is - their sum. -
    • -
-

Inference Rules

- We will see many definitions like this one during the rest - of the course, and for purposes of informal discussions, it is - helpful to have a lightweight notation that makes them easy to - read and write. Inference rules are one such notation: -
- -
- - - - - - - - - - -
   - (b_0)   -
beautiful 0
- - - - - - - - - - -
   - (b_3)   -
beautiful 3
- - - - - - - - - - -
   - (b_5)   -
beautiful 5
- - - - - - - - - - -
beautiful n     beautiful m - (b_sum)   -
beautiful (n+m)
-
- -

- Each of the textual rules above is reformatted here as an - inference rule; the intended reading is that, if the premises - above the line all hold, then the conclusion below the line - follows. For example, the rule b_sum says that, if n and m - are both beautiful numbers, then it follows that n+m is - beautiful too. If a rule has no premises above the line, then - its conclusion holds unconditionally. - -
- - These rules define the property beautiful. That is, if we - want to convince someone that some particular number is beautiful, - our argument must be based on these rules. For a simple example, - suppose we claim that the number 5 is beautiful. To support - this claim, we just need to point out that rule b_5 says so. - Or, if we want to claim that 8 is beautiful, we can support our - claim by first observing that 3 and 5 are both beautiful (by - rules b_3 and b_5) and then pointing out that their sum, 8, - is therefore beautiful by rule b_sum. This argument can be - expressed graphically with the following proof tree: -
- - -
- -
-         ----------- (b_3)   ----------- (b_5)
-         beautiful 3         beautiful 5
-         ------------------------------- (b_sum)
-                   beautiful 8    -
- -
-

- -
- - Of course, there are other ways of using these rules to argue that - 8 is beautiful, for instance: - -
- -
-         ----------- (b_5)   ----------- (b_3)
-         beautiful 5         beautiful 3
-         ------------------------------- (b_sum)
-                   beautiful 8    -
- -
- -
- -

Exercise: 1 star (varieties_of_beauty)

- How many different ways are there to show that 8 is beautiful? -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

- In Coq, we can express the definition of beautiful as - follows: -
-
- -
-Inductive beautiful : nat → Prop :=
-  b_0 : beautiful 0
-| b_3 : beautiful 3
-| b_5 : beautiful 5
-| b_sum : ∀n m, beautiful n → beautiful m → beautiful (n+m).
- -
-
- -
-The first line declares that beautiful is a proposition — or, - more formally, a family of propositions "indexed by" natural - numbers. (That is, for each number n, the claim that "n is - beautiful" is a proposition.) Such a family of propositions is - often called a property of numbers. Each of the remaining lines - embodies one of the rules for beautiful numbers. -

- -
- - The rules introduced this way have the same status as proven - theorems; that is, they are true axiomatically. - So we can use Coq's apply tactic with the rule names to prove - that particular numbers are beautiful. -
-
- -
-Theorem three_is_beautiful: beautiful 3.
-Proof.
-   (* This simply follows from the rule b_3. *)
-   apply b_3.
-Qed.
- -
-Theorem eight_is_beautiful: beautiful 8.
-Proof.
-   (* First we use the rule b_sum, telling Coq how to
-      instantiate n and m. *)
-   apply b_sum with (n:=3) (m:=5).
-   (* To solve the subgoals generated by b_sum, we must provide
-      evidence of beautiful 3 and beautiful 5. Fortunately we
-      have rules for both. *)
-   apply b_3.
-   apply b_5.
-Qed.
- -
-
- -
-

- As you would expect, we can also prove theorems that have -hypotheses about beautiful. -
-
- -
-Theorem beautiful_plus_eight: ∀n, beautiful n → beautiful (8+n).
-Proof.
-  intros n B.
-  apply b_sum with (n:=8) (m:=n).
-  apply eight_is_beautiful.
-  apply B.
-Qed.
- -
-
- -
-

Exercise: 2 stars (b_times2)

- -
-
-Theorem b_times2: ∀n, beautiful n → beautiful (2×n).
-Proof.
-    (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (b_timesm)

- -
-
-Theorem b_timesm: ∀n m, beautiful n → beautiful (m×n).
-Proof.
-   (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Induction Over Evidence

- -
- - Besides constructing evidence that numbers are beautiful, we can - also reason about such evidence. -
- - The fact that we introduced beautiful with an Inductive - declaration tells Coq not only that the constructors b_0, b_3, - b_5 and b_sum are ways to build evidence, but also that these - four constructors are the only ways to build evidence that - numbers are beautiful. -
- - In other words, if someone gives us evidence E for the assertion - beautiful n, then we know that E must have one of four shapes: - -
- -
    -
  • E is b_0 (and n is O), - -
    • -
  • E is b_3 (and n is 3), - -
    • -
  • E is b_5 (and n is 5), or - -
    • -
  • E is b_sum n1 n2 E1 E2 (and n is n1+n2, where E1 is - evidence that n1 is beautiful and E2 is evidence that n2 - is beautiful). -
    • -
- -
- -

- This permits us to analyze any hypothesis of the form beautiful - n to see how it was constructed, using the tactics we already - know. In particular, we can use the induction tactic that we - have already seen for reasoning about inductively defined data - to reason about inductively defined evidence. - -
- - To illustrate this, let's define another property of numbers: -
-
- -
-Inductive gorgeous : nat → Prop :=
-  g_0 : gorgeous 0
-| g_plus3 : ∀n, gorgeous n → gorgeous (3+n)
-| g_plus5 : ∀n, gorgeous n → gorgeous (5+n).
- -
-
- -
-

Exercise: 1 star (gorgeous_tree)

- Write out the definition of gorgeous numbers using inference rule - notation. - -
- -(* FILL IN HERE *)
-☐ - -
- -

Exercise: 1 star (gorgeous_plus13)

- -
-
-Theorem gorgeous_plus13: ∀n,
-  gorgeous n → gorgeous (13+n).
-Proof.
-   (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

- It seems intuitively obvious that, although gorgeous and - beautiful are presented using slightly different rules, they are - actually the same property in the sense that they are true of the - same numbers. Indeed, we can prove this. -
-
- -
-Theorem gorgeous__beautiful : ∀n,
-  gorgeous n → beautiful n.
-Proof.
-   intros n H.
-   induction H as [|n'|n'].
-   Case "g_0".
-       apply b_0.
-   Case "g_plus3".
-       apply b_sum. apply b_3.
-       apply IHgorgeous.
-   Case "g_plus5".
-       apply b_sum. apply b_5. apply IHgorgeous.
-Qed.
- -
-
- -
-Notice that the argument proceeds by induction on the evidence H! -
- - Let's see what happens if we try to prove this by induction on n - instead of induction on the evidence H. -
-
- -
-Theorem gorgeous__beautiful_FAILED : ∀n,
-  gorgeous n → beautiful n.
-Proof.
-   intros. induction n as [| n'].
-   Case "n = 0". apply b_0.
-   Case "n = S n'". (* We are stuck! *)
-Abort.
- -
-
- -
-The problem here is that doing induction on n doesn't yield a - useful induction hypothesis. Knowing how the property we are - interested in behaves on the predecessor of n doesn't help us - prove that it holds for n. Instead, we would like to be able to - have induction hypotheses that mention other numbers, such as n - - 3 and n - 5. This is given precisely by the shape of the - constructors for gorgeous. -
- -

Exercise: 2 stars (gorgeous_sum)

- -
-
-Theorem gorgeous_sum : ∀n m,
-  gorgeous n → gorgeous m → gorgeous (n + m).
-Proof.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (beautiful__gorgeous)

- -
-
-Theorem beautiful__gorgeous : ∀n, beautiful n → gorgeous n.
-Proof.
- (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (g_times2)

- Prove the g_times2 theorem below without using gorgeous__beautiful. - You might find the following helper lemma useful. -
-
- -
-Lemma helper_g_times2 : ∀x y z, x + (z + y)= z + x + y.
-Proof.
-   (* FILL IN HERE *) Admitted.
- -
-Theorem g_times2: ∀n, gorgeous n → gorgeous (2×n).
-Proof.
-   intros n H. simpl.
-   induction H.
-   (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Inversion on Evidence

- -
- - Another situation where we want to analyze evidence for evenness - is when proving that, if n is even, then pred (pred n) is - too. In this case, we don't need to do an inductive proof. The - right tactic turns out to be inversion. -
-
- -
-Theorem ev_minus2: ∀n,
-  ev n → ev (pred (pred n)).
-Proof.
-  intros n E.
-  inversion E as [| n' E'].
-  Case "E = ev_0". simpl. apply ev_0.
-  Case "E = ev_SS n' E'". simpl. apply E'. Qed.
- -
-
- -
-

Exercise: 1 star, optional (ev_minus2_n)

- What happens if we try to use destruct on n instead of inversion on E? -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

- Another example, in which inversion helps narrow down to -the relevant cases. -
-
- -
-Theorem SSev__even : ∀n,
-  ev (S (S n)) → ev n.
-Proof.
-  intros n E.
-  inversion E as [| n' E'].
-  apply E'. Qed.
- -
-
- -
-

inversion revisited

- -
- - These uses of inversion may seem a bit mysterious at first. - Until now, we've only used inversion on equality - propositions, to utilize injectivity of constructors or to - discriminate between different constructors. But we see here - that inversion can also be applied to analyzing evidence - for inductively defined propositions. - -
- - (You might also expect that destruct would be a more suitable - tactic to use here. Indeed, it is possible to use destruct, but - it often throws away useful information, and the eqn: qualifier - doesn't help much in this case.) - -
- - Here's how inversion works in general. Suppose the name - I refers to an assumption P in the current context, where - P has been defined by an Inductive declaration. Then, - for each of the constructors of P, inversion I generates - a subgoal in which I has been replaced by the exact, - specific conditions under which this constructor could have - been used to prove P. Some of these subgoals will be - self-contradictory; inversion throws these away. The ones - that are left represent the cases that must be proved to - establish the original goal. - -
- - In this particular case, the inversion analyzed the construction - ev (S (S n)), determined that this could only have been - constructed using ev_SS, and generated a new subgoal with the - arguments of that constructor as new hypotheses. (It also - produced an auxiliary equality, which happens to be useless here.) - We'll begin exploring this more general behavior of inversion in - what follows. -
- -

Exercise: 1 star (inversion_practice)

- -
-
-Theorem SSSSev__even : ∀n,
-  ev (S (S (S (S n)))) → ev n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-The inversion tactic can also be used to derive goals by showing - the absurdity of a hypothesis. -
-
- -
-Theorem even5_nonsense :
-  ev 5 → 2 + 2 = 9.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (ev_ev__ev)

- Finding the appropriate thing to do induction on is a - bit tricky here: -
-
- -
-Theorem ev_ev__ev : ∀n m,
-  ev (n+m) → ev n → ev m.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (ev_plus_plus)

- Here's an exercise that just requires applying existing lemmas. No - induction or even case analysis is needed, but some of the rewriting - may be tedious. -
-
- -
-Theorem ev_plus_plus : ∀n m p,
-  ev (n+m) → ev (n+p) → ev (m+p).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 4 stars (palindromes)

- A palindrome is a sequence that reads the same backwards as - forwards. - -
- -
    -
  • Define an inductive proposition pal on list X that - captures what it means to be a palindrome. (Hint: You'll need - three cases. Your definition should be based on the structure - of the list; just having a single constructor - -
    - -
    -c : ∀l, l = rev l → pal l -
    - -
    - may seem obvious, but will not work very well.) - -
    - - -
    • -
  • Prove that - -
    - -
    - ∀l, pal (l ++ rev l). -
    - -
    - -
    • -
  • Prove that - -
    - -
    - ∀l, pal l → l = rev l. -
    - -
    - -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 5 stars, optional (palindrome_converse)

- Using your definition of pal from the previous exercise, prove - that - -
- -
-     ∀l, l = rev l → pal l. -
- -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 4 stars, advanced (subsequence)

- A list is a subsequence of another list if all of the elements - in the first list occur in the same order in the second list, - possibly with some extra elements in between. For example, - -
- -
-    [1,2,3] -
- -
- is a subsequence of each of the lists - -
- -
-    [1,2,3]
-    [1,1,1,2,2,3]
-    [1,2,7,3]
-    [5,6,1,9,9,2,7,3,8] -
- -
- but it is not a subsequence of any of the lists - -
- -
-    [1,2]
-    [1,3]
-    [5,6,2,1,7,3,8] -
- -
- -
- -
    -
  • Define an inductive proposition subseq on list nat that - captures what it means to be a subsequence. (Hint: You'll need - three cases.) - -
    - - -
    • -
  • Prove that subsequence is reflexive, that is, any list is a - subsequence of itself. - -
    - - -
    • -
  • Prove that for any lists l1, l2, and l3, if l1 is a - subsequence of l2, then l1 is also a subsequence of l2 ++ - l3. - -
    - - -
    • -
  • (Optional, harder) Prove that subsequence is transitive — that - is, if l1 is a subsequence of l2 and l2 is a subsequence - of l3, then l1 is a subsequence of l3. Hint: choose your - induction carefully! - -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 2 stars, optional (R_provability)

- Suppose we give Coq the following definition: - -
- -
-    Inductive R : nat → list nat → Prop :=
-      | c1 : R 0 []
-      | c2 : ∀n l, R n l → R (S n) (n :: l)
-      | c3 : ∀n l, R (S n) l → R n l. -
- -
- Which of the following propositions are provable? - -
- -
    -
  • R 2 [1,0] - -
    • -
  • R 1 [1,2,1,0] - -
    • -
  • R 6 [3,2,1,0] - -
    • -
- -
- - ☐ -
-
- -
-
- -
-

Relations

- -
- - A proposition parameterized by a number (such as ev or - beautiful) can be thought of as a property — i.e., it defines - a subset of nat, namely those numbers for which the proposition - is provable. In the same way, a two-argument proposition can be - thought of as a relation — i.e., it defines a set of pairs for - which the proposition is provable. -
-
- -
- -
-
- -
-One useful example is the "less than or equal to" - relation on numbers. -
- - The following definition should be fairly intuitive. It - says that there are two ways to give evidence that one number is - less than or equal to another: either observe that they are the - same number, or give evidence that the first is less than or equal - to the predecessor of the second. -
-
- -
-Inductive le : nat → nat → Prop :=
-  | le_n : ∀n, le n n
-  | le_S : ∀n m, (le n m) → (le n (S m)).
- -
-Notation "m ≤ n" := (le m n).
- -
-
- -
-Proofs of facts about ≤ using the constructors le_n and - le_S follow the same patterns as proofs about properties, like - ev in chapter Prop. We can apply the constructors to prove ≤ - goals (e.g., to show that 3≤3 or 3≤6), and we can use - tactics like inversion to extract information from ≤ - hypotheses in the context (e.g., to prove that (2 ≤ 1) → 2+2=5.) -
- -

- Here are some sanity checks on the definition. (Notice that, - although these are the same kind of simple "unit tests" as we gave - for the testing functions we wrote in the first few lectures, we - must construct their proofs explicitly — simpl and - reflexivity don't do the job, because the proofs aren't just a - matter of simplifying computations.) -
-
- -
-Theorem test_le1 :
-  3 ≤ 3.
-Proof.
-  (* WORKED IN CLASS *)
-  apply le_n. Qed.
- -
-Theorem test_le2 :
-  3 ≤ 6.
-Proof.
-  (* WORKED IN CLASS *)
-  apply le_S. apply le_S. apply le_S. apply le_n. Qed.
- -
-Theorem test_le3 :
-  (2 ≤ 1) → 2 + 2 = 5.
-Proof.
-  (* WORKED IN CLASS *)
-  intros H. inversion H. inversion H2. Qed.
- -
-
- -
-

- The "strictly less than" relation n < m can now be defined - in terms of le. -
-
- -
-Definition lt (n m:nat) := le (S n) m.
- -
-Notation "m < n" := (lt m n).
- -
-
- -
-Here are a few more simple relations on numbers: -
-
- -
-Inductive square_of : nat → nat → Prop :=
-  sq : ∀n:nat, square_of n (n × n).
- -
-Inductive next_nat (n:nat) : nat → Prop :=
-  | nn : next_nat n (S n).
- -
-Inductive next_even (n:nat) : nat → Prop :=
-  | ne_1 : ev (S n) → next_even n (S n)
-  | ne_2 : ev (S (S n)) → next_even n (S (S n)).
- -
-
- -
-

Exercise: 2 stars (total_relation)

- Define an inductive binary relation total_relation that holds - between every pair of natural numbers. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 2 stars (empty_relation)

- Define an inductive binary relation empty_relation (on numbers) - that never holds. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 2 stars, optional (le_exercises)

- Here are a number of facts about the ≤ and < relations that - we are going to need later in the course. The proofs make good - practice exercises. -
-
- -
-Lemma le_trans : ∀m n o, m ≤ n → n ≤ o → m ≤ o.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem O_le_n : ∀n,
-  0 ≤ n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem n_le_m__Sn_le_Sm : ∀n m,
-  n ≤ m → S n ≤ S m.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem Sn_le_Sm__n_le_m : ∀n m,
-  S n ≤ S m → n ≤ m.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem le_plus_l : ∀a b,
-  a ≤ a + b.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem plus_lt : ∀n1 n2 m,
-  n1 + n2 < m →
-  n1 < m ∧ n2 < m.
-Proof.
- unfold lt.
- (* FILL IN HERE *) Admitted.
- -
-Theorem lt_S : ∀n m,
-  n < m →
-  n < S m.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem ble_nat_true : ∀n m,
-  ble_nat n m = true → n ≤ m.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem le_ble_nat : ∀n m,
-  n ≤ m →
-  ble_nat n m = true.
-Proof.
-  (* Hint: This may be easiest to prove by induction on m. *)
-  (* FILL IN HERE *) Admitted.
- -
-Theorem ble_nat_true_trans : ∀n m o,
-  ble_nat n m = true → ble_nat m o = true → ble_nat n o = true.
-Proof.
-  (* Hint: This theorem can be easily proved without using induction. *)
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 2 stars, optional (ble_nat_false)

- -
-
-Theorem ble_nat_false : ∀n m,
-  ble_nat n m = false → ~(n ≤ m).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars (R_provability)

- -
-
-Module R.
-
- -
-We can define three-place relations, four-place relations, - etc., in just the same way as binary relations. For example, - consider the following three-place relation on numbers: -
-
- -
-Inductive R : nat → nat → nat → Prop :=
-   | c1 : R 0 0 0
-   | c2 : ∀m n o, R m n o → R (S m) n (S o)
-   | c3 : ∀m n o, R m n o → R m (S n) (S o)
-   | c4 : ∀m n o, R (S m) (S n) (S (S o)) → R m n o
-   | c5 : ∀m n o, R m n o → R n m o.
- -
-
- -
- -
- -
    -
  • Which of the following propositions are provable? -
      -
    • R 1 1 2 - -
      • -
    • R 2 2 6 - -
      - - -
      - - -
      • -
    - -
    • -
  • If we dropped constructor c5 from the definition of R, - would the set of provable propositions change? Briefly (1 - sentence) explain your answer. - -
    - - -
    • -
  • If we dropped constructor c4 from the definition of R, - would the set of provable propositions change? Briefly (1 - sentence) explain your answer. - -
    • -
- -
- -(* FILL IN HERE *)
-☐ - -
- -

Exercise: 3 stars, optional (R_fact)

- Relation R actually encodes a familiar function. State and prove two - theorems that formally connects the relation and the function. - That is, if R m n o is true, what can we say about m, - n, and o, and vice versa? - -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-End R.
- -
-
- -
-

Programming with Propositions Revisited

- -
- - As we have seen, a proposition is a statement expressing a factual claim, - like "two plus two equals four." In Coq, propositions are written - as expressions of type Prop. . -
-
- -
-Check (2 + 2 = 4).
-(* ===> 2 + 2 = 4 : Prop *)
- -
-Check (ble_nat 3 2 = false).
-(* ===> ble_nat 3 2 = false : Prop *)
- -
-Check (beautiful 8).
-(* ===> beautiful 8 : Prop *)
- -
-
- -
-

- Both provable and unprovable claims are perfectly good - propositions. Simply being a proposition is one thing; being - provable is something else! -
-
- -
-Check (2 + 2 = 5).
-(* ===> 2 + 2 = 5 : Prop *)
- -
-Check (beautiful 4).
-(* ===> beautiful 4 : Prop *)
- -
-
- -
-Both 2 + 2 = 4 and 2 + 2 = 5 are legal expressions - of type Prop. -
- -

- We've mainly seen one place that propositions can appear in Coq: in - Theorem (and Lemma and Example) declarations. -
-
- -
-Theorem plus_2_2_is_4 :
-  2 + 2 = 4.
-Proof. reflexivity. Qed.
- -
-
- -
-But they can be used in many other ways. For example, we have also seen that - we can give a name to a proposition using a Definition, just as we have - given names to expressions of other sorts. -
-
- -
-Definition plus_fact : Prop := 2 + 2 = 4.
-Check plus_fact.
-(* ===> plus_fact : Prop *)
- -
-
- -
-We can later use this name in any situation where a proposition is - expected — for example, as the claim in a Theorem declaration. -
-
- -
-Theorem plus_fact_is_true :
-  plus_fact.
-Proof. reflexivity. Qed.
- -
-
- -
-

- We've seen several ways of constructing propositions. - -
- -
    -
  • We can define a new proposition primitively using Inductive. - -
    - - -
    • -
  • Given two expressions e1 and e2 of the same type, we can - form the proposition e1 = e2, which states that their - values are equal. - -
    - - -
    • -
  • We can combine propositions using implication and - quantification. -
    • -
-

- We have also seen parameterized propositions, such as even and - beautiful. -
-
- -
-Check (even 4).
-(* ===> even 4 : Prop *)
-Check (even 3).
-(* ===> even 3 : Prop *)
-Check even.
-(* ===> even : nat -> Prop *)
- -
-
- -
-

- The type of even, i.e., nat→Prop, can be pronounced in - three equivalent ways: (1) "even is a function from numbers to - propositions," (2) "even is a family of propositions, indexed - by a number n," or (3) "even is a property of numbers." -
- - Propositions — including parameterized propositions — are - first-class citizens in Coq. For example, we can define functions - from numbers to propositions... -
-
- -
-Definition between (n m o: nat) : Prop :=
-  andb (ble_nat n o) (ble_nat o m) = true.
- -
-
- -
-... and then partially apply them: -
-
- -
-Definition teen : nat→Prop := between 13 19.
- -
-
- -
-We can even pass propositions — including parameterized - propositions — as arguments to functions: -
-
- -
-Definition true_for_zero (P:nat→Prop) : Prop :=
-  P 0.
- -
-
- -
-

- Here are two more examples of passing parameterized propositions - as arguments to a function. - -
- - The first function, true_for_all_numbers, takes a proposition - P as argument and builds the proposition that P is true for - all natural numbers. -
-
- -
-Definition true_for_all_numbers (P:nat→Prop) : Prop :=
-  ∀n, P n.
- -
-
- -
-The second, preserved_by_S, takes P and builds the proposition - that, if P is true for some natural number n', then it is also - true by the successor of n' — i.e. that P is preserved by - successor: -
-
- -
-Definition preserved_by_S (P:nat→Prop) : Prop :=
-  ∀n', P n' → P (S n').
- -
-
- -
-

- Finally, we can put these ingredients together to define -a proposition stating that induction is valid for natural numbers: -
-
- -
-Definition natural_number_induction_valid : Prop :=
-  ∀(P:nat→Prop),
-    true_for_zero P →
-    preserved_by_S P →
-    true_for_all_numbers P.
- -
-
- -
-

Exercise: 3 stars (combine_odd_even)

- Complete the definition of the combine_odd_even function - below. It takes as arguments two properties of numbers Podd and - Peven. As its result, it should return a new property P such - that P n is equivalent to Podd n when n is odd, and - equivalent to Peven n otherwise. -
-
- -
-Definition combine_odd_even (Podd Peven : nat → Prop) : nat → Prop :=
-  (* FILL IN HERE *) admit.
- -
-
- -
-To test your definition, see whether you can prove the following - facts: -
-
- -
-Theorem combine_odd_even_intro :
-  ∀(Podd Peven : nat → Prop) (n : nat),
-    (oddb n = true → Podd n) →
-    (oddb n = false → Peven n) →
-    combine_odd_even Podd Peven n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem combine_odd_even_elim_odd :
-  ∀(Podd Peven : nat → Prop) (n : nat),
-    combine_odd_even Podd Peven n →
-    oddb n = true →
-    Podd n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Theorem combine_odd_even_elim_even :
-  ∀(Podd Peven : nat → Prop) (n : nat),
-    combine_odd_even Podd Peven n →
-    oddb n = false →
-    Peven n.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-☐ -
-
- -
-
- -
-One more quick digression, for adventurous souls: if we can define - parameterized propositions using Definition, then can we also - define them using Fixpoint? Of course we can! However, this - kind of "recursive parameterization" doesn't correspond to - anything very familiar from everyday mathematics. The following - exercise gives a slightly contrived example. -
- -

Exercise: 4 stars, optional (true_upto_n__true_everywhere)

- Define a recursive function - true_upto_n__true_everywhere that makes - true_upto_n_example work. -
-
- -
-(* 
-Fixpoint true_upto_n__true_everywhere
-(* FILL IN HERE *)
-
-Example true_upto_n_example :
-    (true_upto_n__true_everywhere 3 (fun n => even n))
-  = (even 3 -> even 2 -> even 1 -> forall m : nat, even m).
-Proof. reflexivity.  Qed.
-*)
-
- -
-☐ -
-
- -
-(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Prop.v b/Prop.v deleted file mode 100644 index 493ae12..0000000 --- a/Prop.v +++ /dev/null @@ -1,1012 +0,0 @@ -(** * Prop: Propositions and Evidence *) - -Require Export Logic. - - - -(* ####################################################### *) -(** ** From Boolean Functions to Propositions *) - -(** In chapter [Basics] we defined a _function_ [evenb] that tests a - number for evenness, yielding [true] if so. We can use this - function to define the _proposition_ that some number [n] is - even: *) - -Definition even (n:nat) : Prop := - evenb n = true. - -(** That is, we can define "[n] is even" to mean "the function [evenb] - returns [true] when applied to [n]." - - Note that here we have given a name - to a proposition using a [Definition], just as we have - given names to expressions of other sorts. This isn't a fundamentally - new kind of proposition; it is still just an equality. *) - -(** Another alternative is to define the concept of evenness - directly. Instead of going via the [evenb] function ("a number is - even if a certain computation yields [true]"), we can say what the - concept of evenness means by giving two different ways of - presenting _evidence_ that a number is even. *) - -(** ** Inductively Defined Propositions *) - -Inductive ev : nat -> Prop := - | ev_0 : ev O - | ev_SS : forall n:nat, ev n -> ev (S (S n)). - -(** This definition says that there are two ways to give - evidence that a number [m] is even. First, [0] is even, and - [ev_0] is evidence for this. Second, if [m = S (S n)] for some - [n] and we can give evidence [e] that [n] is even, then [m] is - also even, and [ev_SS n e] is the evidence. *) - - -(** **** Exercise: 1 star (double_even) *) - -Theorem double_even : forall n, - ev (double n). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(** *** Discussion: Computational vs. Inductive Definitions *) - -(** We have seen that the proposition "[n] is even" can be - phrased in two different ways -- indirectly, via a boolean testing - function [evenb], or directly, by inductively describing what - constitutes evidence for evenness. These two ways of defining - evenness are about equally easy to state and work with. Which we - choose is basically a question of taste. - - However, for many other properties of interest, the direct - inductive definition is preferable, since writing a testing - function may be awkward or even impossible. - - One such property is [beautiful]. This is a perfectly sensible - definition of a set of numbers, but we cannot translate its - definition directly into a Coq Fixpoint (or into a recursive - function in any other common programming language). We might be - able to find a clever way of testing this property using a - [Fixpoint] (indeed, it is not too hard to find one in this case), - but in general this could require arbitrarily deep thinking. In - fact, if the property we are interested in is uncomputable, then - we cannot define it as a [Fixpoint] no matter how hard we try, - because Coq requires that all [Fixpoint]s correspond to - terminating computations. - - On the other hand, writing an inductive definition of what it - means to give evidence for the property [beautiful] is - straightforward. *) - - - -(** **** Exercise: 1 star (ev__even) *) -(** Here is a proof that the inductive definition of evenness implies - the computational one. *) - -Theorem ev__even : forall n, - ev n -> even n. -Proof. - intros n E. induction E as [| n' E']. - Case "E = ev_0". - unfold even. reflexivity. - Case "E = ev_SS n' E'". - unfold even. apply IHE'. -Qed. - -(** Could this proof also be carried out by induction on [n] instead - of [E]? If not, why not? *) - -(* FILL IN HERE *) -(** [] *) - -(** The induction principle for inductively defined propositions does - not follow quite the same form as that of inductively defined - sets. For now, you can take the intuitive view that induction on - evidence [ev n] is similar to induction on [n], but restricts our - attention to only those numbers for which evidence [ev n] could be - generated. We'll look at the induction principle of [ev] in more - depth below, to explain what's really going on. *) - -(** **** Exercise: 1 star (l_fails) *) -(** The following proof attempt will not succeed. - Theorem l : forall n, - ev n. - Proof. - intros n. induction n. - Case "O". simpl. apply ev_0. - Case "S". - ... - Intuitively, we expect the proof to fail because not every - number is even. However, what exactly causes the proof to fail? - -(* FILL IN HERE *) -*) -(** [] *) - -(** **** Exercise: 2 stars (ev_sum) *) -(** Here's another exercise requiring induction. *) - -Theorem ev_sum : forall n m, - ev n -> ev m -> ev (n+m). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ##################################################### *) -(** * Inductively Defined Propositions *) - -(** As a running example, let's - define a simple property of natural numbers -- we'll call it - "[beautiful]." *) - -(** Informally, a number is [beautiful] if it is [0], [3], [5], or the - sum of two [beautiful] numbers. - - More pedantically, we can define [beautiful] numbers by giving four - rules: - - - Rule [b_0]: The number [0] is [beautiful]. - - Rule [b_3]: The number [3] is [beautiful]. - - Rule [b_5]: The number [5] is [beautiful]. - - Rule [b_sum]: If [n] and [m] are both [beautiful], then so is - their sum. *) -(** ** Inference Rules *) -(** We will see many definitions like this one during the rest - of the course, and for purposes of informal discussions, it is - helpful to have a lightweight notation that makes them easy to - read and write. _Inference rules_ are one such notation: *) -(** - ----------- (b_0) - beautiful 0 - - ------------ (b_3) - beautiful 3 - - ------------ (b_5) - beautiful 5 - - beautiful n beautiful m - --------------------------- (b_sum) - beautiful (n+m) -*) - -(** *** *) -(** Each of the textual rules above is reformatted here as an - inference rule; the intended reading is that, if the _premises_ - above the line all hold, then the _conclusion_ below the line - follows. For example, the rule [b_sum] says that, if [n] and [m] - are both [beautiful] numbers, then it follows that [n+m] is - [beautiful] too. If a rule has no premises above the line, then - its conclusion holds unconditionally. - - These rules _define_ the property [beautiful]. That is, if we - want to convince someone that some particular number is [beautiful], - our argument must be based on these rules. For a simple example, - suppose we claim that the number [5] is [beautiful]. To support - this claim, we just need to point out that rule [b_5] says so. - Or, if we want to claim that [8] is [beautiful], we can support our - claim by first observing that [3] and [5] are both [beautiful] (by - rules [b_3] and [b_5]) and then pointing out that their sum, [8], - is therefore [beautiful] by rule [b_sum]. This argument can be - expressed graphically with the following _proof tree_: *) -(** - ----------- (b_3) ----------- (b_5) - beautiful 3 beautiful 5 - ------------------------------- (b_sum) - beautiful 8 -*) -(** *** *) -(** - Of course, there are other ways of using these rules to argue that - [8] is [beautiful], for instance: - ----------- (b_5) ----------- (b_3) - beautiful 5 beautiful 3 - ------------------------------- (b_sum) - beautiful 8 -*) - -(** **** Exercise: 1 star (varieties_of_beauty) *) -(** How many different ways are there to show that [8] is [beautiful]? *) - -(* FILL IN HERE *) -(** [] *) - -(** *** *) -(** In Coq, we can express the definition of [beautiful] as - follows: *) - -Inductive beautiful : nat -> Prop := - b_0 : beautiful 0 -| b_3 : beautiful 3 -| b_5 : beautiful 5 -| b_sum : forall n m, beautiful n -> beautiful m -> beautiful (n+m). - - -(** The first line declares that [beautiful] is a proposition -- or, - more formally, a family of propositions "indexed by" natural - numbers. (That is, for each number [n], the claim that "[n] is - [beautiful]" is a proposition.) Such a family of propositions is - often called a _property_ of numbers. Each of the remaining lines - embodies one of the rules for [beautiful] numbers. -*) -(** *** *) -(** - The rules introduced this way have the same status as proven - theorems; that is, they are true axiomatically. - So we can use Coq's [apply] tactic with the rule names to prove - that particular numbers are [beautiful]. *) - -Theorem three_is_beautiful: beautiful 3. -Proof. - (* This simply follows from the rule [b_3]. *) - apply b_3. -Qed. - -Theorem eight_is_beautiful: beautiful 8. -Proof. - (* First we use the rule [b_sum], telling Coq how to - instantiate [n] and [m]. *) - apply b_sum with (n:=3) (m:=5). - (* To solve the subgoals generated by [b_sum], we must provide - evidence of [beautiful 3] and [beautiful 5]. Fortunately we - have rules for both. *) - apply b_3. - apply b_5. -Qed. - -(** *** *) -(** As you would expect, we can also prove theorems that have -hypotheses about [beautiful]. *) - -Theorem beautiful_plus_eight: forall n, beautiful n -> beautiful (8+n). -Proof. - intros n B. - apply b_sum with (n:=8) (m:=n). - apply eight_is_beautiful. - apply B. -Qed. - -(** **** Exercise: 2 stars (b_times2) *) -Theorem b_times2: forall n, beautiful n -> beautiful (2*n). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars (b_timesm) *) -Theorem b_timesm: forall n m, beautiful n -> beautiful (m*n). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ####################################################### *) -(** ** Induction Over Evidence *) - -(** Besides _constructing_ evidence that numbers are beautiful, we can - also _reason about_ such evidence. *) - -(** The fact that we introduced [beautiful] with an [Inductive] - declaration tells Coq not only that the constructors [b_0], [b_3], - [b_5] and [b_sum] are ways to build evidence, but also that these - four constructors are the _only_ ways to build evidence that - numbers are beautiful. *) - -(** In other words, if someone gives us evidence [E] for the assertion - [beautiful n], then we know that [E] must have one of four shapes: - - - [E] is [b_0] (and [n] is [O]), - - [E] is [b_3] (and [n] is [3]), - - [E] is [b_5] (and [n] is [5]), or - - [E] is [b_sum n1 n2 E1 E2] (and [n] is [n1+n2], where [E1] is - evidence that [n1] is beautiful and [E2] is evidence that [n2] - is beautiful). *) - -(** *** *) -(** This permits us to _analyze_ any hypothesis of the form [beautiful - n] to see how it was constructed, using the tactics we already - know. In particular, we can use the [induction] tactic that we - have already seen for reasoning about inductively defined _data_ - to reason about inductively defined _evidence_. - - To illustrate this, let's define another property of numbers: *) - -Inductive gorgeous : nat -> Prop := - g_0 : gorgeous 0 -| g_plus3 : forall n, gorgeous n -> gorgeous (3+n) -| g_plus5 : forall n, gorgeous n -> gorgeous (5+n). - -(** **** Exercise: 1 star (gorgeous_tree) *) -(** Write out the definition of [gorgeous] numbers using inference rule - notation. - -(* FILL IN HERE *) -[] -*) - - -(** **** Exercise: 1 star (gorgeous_plus13) *) -Theorem gorgeous_plus13: forall n, - gorgeous n -> gorgeous (13+n). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** *** *) -(** It seems intuitively obvious that, although [gorgeous] and - [beautiful] are presented using slightly different rules, they are - actually the same property in the sense that they are true of the - same numbers. Indeed, we can prove this. *) - -Theorem gorgeous__beautiful : forall n, - gorgeous n -> beautiful n. -Proof. - intros n H. - induction H as [|n'|n']. - Case "g_0". - apply b_0. - Case "g_plus3". - apply b_sum. apply b_3. - apply IHgorgeous. - Case "g_plus5". - apply b_sum. apply b_5. apply IHgorgeous. -Qed. - -(** Notice that the argument proceeds by induction on the _evidence_ [H]! *) - -(** Let's see what happens if we try to prove this by induction on [n] - instead of induction on the evidence [H]. *) - -Theorem gorgeous__beautiful_FAILED : forall n, - gorgeous n -> beautiful n. -Proof. - intros. induction n as [| n']. - Case "n = 0". apply b_0. - Case "n = S n'". (* We are stuck! *) -Abort. - -(** The problem here is that doing induction on [n] doesn't yield a - useful induction hypothesis. Knowing how the property we are - interested in behaves on the predecessor of [n] doesn't help us - prove that it holds for [n]. Instead, we would like to be able to - have induction hypotheses that mention other numbers, such as [n - - 3] and [n - 5]. This is given precisely by the shape of the - constructors for [gorgeous]. *) - - - - -(** **** Exercise: 2 stars (gorgeous_sum) *) -Theorem gorgeous_sum : forall n m, - gorgeous n -> gorgeous m -> gorgeous (n + m). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (beautiful__gorgeous) *) -Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (g_times2) *) -(** Prove the [g_times2] theorem below without using [gorgeous__beautiful]. - You might find the following helper lemma useful. *) - -Lemma helper_g_times2 : forall x y z, x + (z + y)= z + x + y. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem g_times2: forall n, gorgeous n -> gorgeous (2*n). -Proof. - intros n H. simpl. - induction H. - (* FILL IN HERE *) Admitted. -(** [] *) - - - - -(* ####################################################### *) -(** ** [Inversion] on Evidence *) - -(** Another situation where we want to analyze evidence for evenness - is when proving that, if [n] is even, then [pred (pred n)] is - too. In this case, we don't need to do an inductive proof. The - right tactic turns out to be [inversion]. *) - -Theorem ev_minus2: forall n, - ev n -> ev (pred (pred n)). -Proof. - intros n E. - inversion E as [| n' E']. - Case "E = ev_0". simpl. apply ev_0. - Case "E = ev_SS n' E'". simpl. apply E'. Qed. - -(** **** Exercise: 1 star, optional (ev_minus2_n) *) -(** What happens if we try to use [destruct] on [n] instead of [inversion] on [E]? *) - -(* FILL IN HERE *) -(** [] *) - -(** *** *) -(** Another example, in which [inversion] helps narrow down to -the relevant cases. *) - -Theorem SSev__even : forall n, - ev (S (S n)) -> ev n. -Proof. - intros n E. - inversion E as [| n' E']. - apply E'. Qed. - -(** ** [inversion] revisited *) - -(** These uses of [inversion] may seem a bit mysterious at first. - Until now, we've only used [inversion] on equality - propositions, to utilize injectivity of constructors or to - discriminate between different constructors. But we see here - that [inversion] can also be applied to analyzing evidence - for inductively defined propositions. - - (You might also expect that [destruct] would be a more suitable - tactic to use here. Indeed, it is possible to use [destruct], but - it often throws away useful information, and the [eqn:] qualifier - doesn't help much in this case.) - - Here's how [inversion] works in general. Suppose the name - [I] refers to an assumption [P] in the current context, where - [P] has been defined by an [Inductive] declaration. Then, - for each of the constructors of [P], [inversion I] generates - a subgoal in which [I] has been replaced by the exact, - specific conditions under which this constructor could have - been used to prove [P]. Some of these subgoals will be - self-contradictory; [inversion] throws these away. The ones - that are left represent the cases that must be proved to - establish the original goal. - - In this particular case, the [inversion] analyzed the construction - [ev (S (S n))], determined that this could only have been - constructed using [ev_SS], and generated a new subgoal with the - arguments of that constructor as new hypotheses. (It also - produced an auxiliary equality, which happens to be useless here.) - We'll begin exploring this more general behavior of inversion in - what follows. *) - - -(** **** Exercise: 1 star (inversion_practice) *) -Theorem SSSSev__even : forall n, - ev (S (S (S (S n)))) -> ev n. -Proof. - (* FILL IN HERE *) Admitted. - -(** The [inversion] tactic can also be used to derive goals by showing - the absurdity of a hypothesis. *) - -Theorem even5_nonsense : - ev 5 -> 2 + 2 = 9. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (ev_ev__ev) *) -(** Finding the appropriate thing to do induction on is a - bit tricky here: *) - -Theorem ev_ev__ev : forall n m, - ev (n+m) -> ev n -> ev m. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (ev_plus_plus) *) -(** Here's an exercise that just requires applying existing lemmas. No - induction or even case analysis is needed, but some of the rewriting - may be tedious. *) - -Theorem ev_plus_plus : forall n m p, - ev (n+m) -> ev (n+p) -> ev (m+p). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - - - -(* ####################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 4 stars (palindromes) *) -(** A palindrome is a sequence that reads the same backwards as - forwards. - - - Define an inductive proposition [pal] on [list X] that - captures what it means to be a palindrome. (Hint: You'll need - three cases. Your definition should be based on the structure - of the list; just having a single constructor - c : forall l, l = rev l -> pal l - may seem obvious, but will not work very well.) - - - Prove that - forall l, pal (l ++ rev l). - - Prove that - forall l, pal l -> l = rev l. -*) - - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 5 stars, optional (palindrome_converse) *) -(** Using your definition of [pal] from the previous exercise, prove - that - forall l, l = rev l -> pal l. -*) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 4 stars, advanced (subsequence) *) -(** A list is a _subsequence_ of another list if all of the elements - in the first list occur in the same order in the second list, - possibly with some extra elements in between. For example, - [1,2,3] - is a subsequence of each of the lists - [1,2,3] - [1,1,1,2,2,3] - [1,2,7,3] - [5,6,1,9,9,2,7,3,8] - but it is _not_ a subsequence of any of the lists - [1,2] - [1,3] - [5,6,2,1,7,3,8] - - - Define an inductive proposition [subseq] on [list nat] that - captures what it means to be a subsequence. (Hint: You'll need - three cases.) - - - Prove that subsequence is reflexive, that is, any list is a - subsequence of itself. - - - Prove that for any lists [l1], [l2], and [l3], if [l1] is a - subsequence of [l2], then [l1] is also a subsequence of [l2 ++ - l3]. - - - (Optional, harder) Prove that subsequence is transitive -- that - is, if [l1] is a subsequence of [l2] and [l2] is a subsequence - of [l3], then [l1] is a subsequence of [l3]. Hint: choose your - induction carefully! -*) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 2 stars, optional (R_provability) *) -(** Suppose we give Coq the following definition: - Inductive R : nat -> list nat -> Prop := - | c1 : R 0 [] - | c2 : forall n l, R n l -> R (S n) (n :: l) - | c3 : forall n l, R (S n) l -> R n l. - Which of the following propositions are provable? - - - [R 2 [1,0]] - - [R 1 [1,2,1,0]] - - [R 6 [3,2,1,0]] -*) - -(** [] *) - - - -(* ####################################################### *) -(** * Relations *) - -(** A proposition parameterized by a number (such as [ev] or - [beautiful]) can be thought of as a _property_ -- i.e., it defines - a subset of [nat], namely those numbers for which the proposition - is provable. In the same way, a two-argument proposition can be - thought of as a _relation_ -- i.e., it defines a set of pairs for - which the proposition is provable. *) - -Module LeModule. - - -(** One useful example is the "less than or equal to" - relation on numbers. *) - -(** The following definition should be fairly intuitive. It - says that there are two ways to give evidence that one number is - less than or equal to another: either observe that they are the - same number, or give evidence that the first is less than or equal - to the predecessor of the second. *) - -Inductive le : nat -> nat -> Prop := - | le_n : forall n, le n n - | le_S : forall n m, (le n m) -> (le n (S m)). - -Notation "m <= n" := (le m n). - - -(** Proofs of facts about [<=] using the constructors [le_n] and - [le_S] follow the same patterns as proofs about properties, like - [ev] in chapter [Prop]. We can [apply] the constructors to prove [<=] - goals (e.g., to show that [3<=3] or [3<=6]), and we can use - tactics like [inversion] to extract information from [<=] - hypotheses in the context (e.g., to prove that [(2 <= 1) -> 2+2=5].) *) - -(** *** *) -(** Here are some sanity checks on the definition. (Notice that, - although these are the same kind of simple "unit tests" as we gave - for the testing functions we wrote in the first few lectures, we - must construct their proofs explicitly -- [simpl] and - [reflexivity] don't do the job, because the proofs aren't just a - matter of simplifying computations.) *) - -Theorem test_le1 : - 3 <= 3. -Proof. - (* WORKED IN CLASS *) - apply le_n. Qed. - -Theorem test_le2 : - 3 <= 6. -Proof. - (* WORKED IN CLASS *) - apply le_S. apply le_S. apply le_S. apply le_n. Qed. - -Theorem test_le3 : - (2 <= 1) -> 2 + 2 = 5. -Proof. - (* WORKED IN CLASS *) - intros H. inversion H. inversion H2. Qed. - -(** *** *) -(** The "strictly less than" relation [n < m] can now be defined - in terms of [le]. *) - -End LeModule. - -Definition lt (n m:nat) := le (S n) m. - -Notation "m < n" := (lt m n). - -(** Here are a few more simple relations on numbers: *) - -Inductive square_of : nat -> nat -> Prop := - sq : forall n:nat, square_of n (n * n). - -Inductive next_nat (n:nat) : nat -> Prop := - | nn : next_nat n (S n). - -Inductive next_even (n:nat) : nat -> Prop := - | ne_1 : ev (S n) -> next_even n (S n) - | ne_2 : ev (S (S n)) -> next_even n (S (S n)). - -(** **** Exercise: 2 stars (total_relation) *) -(** Define an inductive binary relation [total_relation] that holds - between every pair of natural numbers. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 2 stars (empty_relation) *) -(** Define an inductive binary relation [empty_relation] (on numbers) - that never holds. *) - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 2 stars, optional (le_exercises) *) -(** Here are a number of facts about the [<=] and [<] relations that - we are going to need later in the course. The proofs make good - practice exercises. *) - -Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem O_le_n : forall n, - 0 <= n. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem n_le_m__Sn_le_Sm : forall n m, - n <= m -> S n <= S m. -Proof. - (* FILL IN HERE *) Admitted. - - -Theorem Sn_le_Sm__n_le_m : forall n m, - S n <= S m -> n <= m. -Proof. - (* FILL IN HERE *) Admitted. - - -Theorem le_plus_l : forall a b, - a <= a + b. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem plus_lt : forall n1 n2 m, - n1 + n2 < m -> - n1 < m /\ n2 < m. -Proof. - unfold lt. - (* FILL IN HERE *) Admitted. - -Theorem lt_S : forall n m, - n < m -> - n < S m. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem ble_nat_true : forall n m, - ble_nat n m = true -> n <= m. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem le_ble_nat : forall n m, - n <= m -> - ble_nat n m = true. -Proof. - (* Hint: This may be easiest to prove by induction on [m]. *) - (* FILL IN HERE *) Admitted. - -Theorem ble_nat_true_trans : forall n m o, - ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true. -Proof. - (* Hint: This theorem can be easily proved without using [induction]. *) - (* FILL IN HERE *) Admitted. - -(** **** Exercise: 2 stars, optional (ble_nat_false) *) -Theorem ble_nat_false : forall n m, - ble_nat n m = false -> ~(n <= m). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(** **** Exercise: 3 stars (R_provability) *) -Module R. -(** We can define three-place relations, four-place relations, - etc., in just the same way as binary relations. For example, - consider the following three-place relation on numbers: *) - -Inductive R : nat -> nat -> nat -> Prop := - | c1 : R 0 0 0 - | c2 : forall m n o, R m n o -> R (S m) n (S o) - | c3 : forall m n o, R m n o -> R m (S n) (S o) - | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o - | c5 : forall m n o, R m n o -> R n m o. - -(** - Which of the following propositions are provable? - - [R 1 1 2] - - [R 2 2 6] - - - If we dropped constructor [c5] from the definition of [R], - would the set of provable propositions change? Briefly (1 - sentence) explain your answer. - - - If we dropped constructor [c4] from the definition of [R], - would the set of provable propositions change? Briefly (1 - sentence) explain your answer. - -(* FILL IN HERE *) -[] -*) - -(** **** Exercise: 3 stars, optional (R_fact) *) -(** Relation [R] actually encodes a familiar function. State and prove two - theorems that formally connects the relation and the function. - That is, if [R m n o] is true, what can we say about [m], - [n], and [o], and vice versa? -*) - -(* FILL IN HERE *) -(** [] *) - -End R. - - -(* ##################################################### *) -(** * Programming with Propositions Revisited *) - -(** As we have seen, a _proposition_ is a statement expressing a factual claim, - like "two plus two equals four." In Coq, propositions are written - as expressions of type [Prop]. . *) - -Check (2 + 2 = 4). -(* ===> 2 + 2 = 4 : Prop *) - -Check (ble_nat 3 2 = false). -(* ===> ble_nat 3 2 = false : Prop *) - -Check (beautiful 8). -(* ===> beautiful 8 : Prop *) - -(** *** *) -(** Both provable and unprovable claims are perfectly good - propositions. Simply _being_ a proposition is one thing; being - _provable_ is something else! *) - -Check (2 + 2 = 5). -(* ===> 2 + 2 = 5 : Prop *) - -Check (beautiful 4). -(* ===> beautiful 4 : Prop *) - -(** Both [2 + 2 = 4] and [2 + 2 = 5] are legal expressions - of type [Prop]. *) - -(** *** *) -(** We've mainly seen one place that propositions can appear in Coq: in - [Theorem] (and [Lemma] and [Example]) declarations. *) - -Theorem plus_2_2_is_4 : - 2 + 2 = 4. -Proof. reflexivity. Qed. - -(** But they can be used in many other ways. For example, we have also seen that - we can give a name to a proposition using a [Definition], just as we have - given names to expressions of other sorts. *) - -Definition plus_fact : Prop := 2 + 2 = 4. -Check plus_fact. -(* ===> plus_fact : Prop *) - -(** We can later use this name in any situation where a proposition is - expected -- for example, as the claim in a [Theorem] declaration. *) - -Theorem plus_fact_is_true : - plus_fact. -Proof. reflexivity. Qed. - -(** *** *) -(** We've seen several ways of constructing propositions. - - - We can define a new proposition primitively using [Inductive]. - - - Given two expressions [e1] and [e2] of the same type, we can - form the proposition [e1 = e2], which states that their - values are equal. - - - We can combine propositions using implication and - quantification. *) -(** *** *) -(** We have also seen _parameterized propositions_, such as [even] and - [beautiful]. *) - -Check (even 4). -(* ===> even 4 : Prop *) -Check (even 3). -(* ===> even 3 : Prop *) -Check even. -(* ===> even : nat -> Prop *) - -(** *** *) -(** The type of [even], i.e., [nat->Prop], can be pronounced in - three equivalent ways: (1) "[even] is a _function_ from numbers to - propositions," (2) "[even] is a _family_ of propositions, indexed - by a number [n]," or (3) "[even] is a _property_ of numbers." *) - -(** Propositions -- including parameterized propositions -- are - first-class citizens in Coq. For example, we can define functions - from numbers to propositions... *) - -Definition between (n m o: nat) : Prop := - andb (ble_nat n o) (ble_nat o m) = true. - -(** ... and then partially apply them: *) - -Definition teen : nat->Prop := between 13 19. - -(** We can even pass propositions -- including parameterized - propositions -- as arguments to functions: *) - -Definition true_for_zero (P:nat->Prop) : Prop := - P 0. - -(** *** *) -(** Here are two more examples of passing parameterized propositions - as arguments to a function. - - The first function, [true_for_all_numbers], takes a proposition - [P] as argument and builds the proposition that [P] is true for - all natural numbers. *) - -Definition true_for_all_numbers (P:nat->Prop) : Prop := - forall n, P n. - -(** The second, [preserved_by_S], takes [P] and builds the proposition - that, if [P] is true for some natural number [n'], then it is also - true by the successor of [n'] -- i.e. that [P] is _preserved by - successor_: *) - -Definition preserved_by_S (P:nat->Prop) : Prop := - forall n', P n' -> P (S n'). - -(** *** *) -(** Finally, we can put these ingredients together to define -a proposition stating that induction is valid for natural numbers: *) - -Definition natural_number_induction_valid : Prop := - forall (P:nat->Prop), - true_for_zero P -> - preserved_by_S P -> - true_for_all_numbers P. - - - - - -(** **** Exercise: 3 stars (combine_odd_even) *) -(** Complete the definition of the [combine_odd_even] function - below. It takes as arguments two properties of numbers [Podd] and - [Peven]. As its result, it should return a new property [P] such - that [P n] is equivalent to [Podd n] when [n] is odd, and - equivalent to [Peven n] otherwise. *) - -Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop := - (* FILL IN HERE *) admit. - -(** To test your definition, see whether you can prove the following - facts: *) - -Theorem combine_odd_even_intro : - forall (Podd Peven : nat -> Prop) (n : nat), - (oddb n = true -> Podd n) -> - (oddb n = false -> Peven n) -> - combine_odd_even Podd Peven n. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem combine_odd_even_elim_odd : - forall (Podd Peven : nat -> Prop) (n : nat), - combine_odd_even Podd Peven n -> - oddb n = true -> - Podd n. -Proof. - (* FILL IN HERE *) Admitted. - -Theorem combine_odd_even_elim_even : - forall (Podd Peven : nat -> Prop) (n : nat), - combine_odd_even Podd Peven n -> - oddb n = false -> - Peven n. -Proof. - (* FILL IN HERE *) Admitted. - -(** [] *) - -(* ##################################################### *) -(** One more quick digression, for adventurous souls: if we can define - parameterized propositions using [Definition], then can we also - define them using [Fixpoint]? Of course we can! However, this - kind of "recursive parameterization" doesn't correspond to - anything very familiar from everyday mathematics. The following - exercise gives a slightly contrived example. *) - -(** **** Exercise: 4 stars, optional (true_upto_n__true_everywhere) *) -(** Define a recursive function - [true_upto_n__true_everywhere] that makes - [true_upto_n_example] work. *) - -(* -Fixpoint true_upto_n__true_everywhere -(* FILL IN HERE *) - -Example true_upto_n_example : - (true_upto_n__true_everywhere 3 (fun n => even n)) - = (even 3 -> even 2 -> even 1 -> forall m : nat, even m). -Proof. reflexivity. Qed. -*) -(** [] *) - - -(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *) - - diff --git a/Review1.html b/Review1.html deleted file mode 100644 index 28ed967..0000000 --- a/Review1.html +++ /dev/null @@ -1,232 +0,0 @@ - - - - - -Review1: Review Session for First Midterm - - - - - - -
- - - -
- -

Review1Review Session for First Midterm

- -
-
- -
- -
-
- -
- -
-
- -
-

General Notes

- -
- -

Standard vs. Advanced Exams

- -
- - -
- -
    -
  • Unlike the homework assignments, we will make up two completely - separate versions of the exam — a "standard exam" and an - "advanced exam." They will share some problems, but there will - be problems on each that are not on the other. - -
    - - You can choose to take whichever one you want at the beginning - of the exam period. - -
    • -
- -
- -

Grading

- -
- - -
- -
    -
  • Meaning of grades: -
      -
    • A = mastery of all or almost all of the material - -
      • -
    • B = good understanding of most of the material, perhaps with - a few gaps - -
      • -
    • C = some understanding of most of the material, with - substantial gaps - -
      • -
    • D = major gaps - -
      • -
    • F = didn't show up / try - -
      - - -
      - - -
      • -
    - -
    • -
  • There is no pre-determined curve. We'd be perfectly delighted - to give everyone an A (for the exam, and for the course). -
      -
    • Except: A+ grades will be given only for completing the - advanced track. - -
      - - -
      • -
    - -
    • -
  • Standard and advanced exams will be graded relative to different - expectations (i.e., "the material" is different) - -
    • -
- -
- -

Hints

- -
- - -
- -
    -
  • On each version of the exam, will be at least one problem taken - more or less verbatim from a homework assignment. - -
    - - -
    • -
  • On the advanced version, there will be an informal proof. - -
    • -
- -
-
- -
-
- -
-

Expressions and Their Types

- -
- - Thinking about well-typed expressions and their types is a great - way of reviewing many aspects of how Coq works... - -
- - -
- - (Discussion of Coq's view of the universe...)






-
-
- -
-
- -
-

Inductive Definitions

- -
-
- -
-
- -
-

Tactics

- -
-
- -
-
- -
-

Proof Objects

- -
-
- -
-
- -
-

Functional Programming

- -
-
- -
-
- -
-

Judging Propositions

- -
-
- -
-
- -
-

More Type Checking

- -
- - Good luck on the exam! -
-
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Review1.v b/Review1.v deleted file mode 100644 index 411971d..0000000 --- a/Review1.v +++ /dev/null @@ -1,121 +0,0 @@ -(** * Review1: Review Session for First Midterm *) - -Require Export MoreInd. - -(* ###################################################################### *) -(** * General Notes *) - -(** *** Standard vs. Advanced Exams *) - -(** - Unlike the homework assignments, we will make up two completely - separate versions of the exam -- a "standard exam" and an - "advanced exam." They will share some problems, but there will - be problems on each that are not on the other. - - You can choose to take whichever one you want at the beginning - of the exam period. -*) - -(** *** Grading *) - -(** - Meaning of grades: - - A = mastery of all or almost all of the material - - B = good understanding of most of the material, perhaps with - a few gaps - - C = some understanding of most of the material, with - substantial gaps - - D = major gaps - - F = didn't show up / try - - - There is no pre-determined curve. We'd be perfectly delighted - to give everyone an A (for the exam, and for the course). - - Except: A+ grades will be given only for completing the - advanced track. - - - Standard and advanced exams will be graded relative to different - expectations (i.e., "the material" is different) -*) - -(** *** Hints *) - -(** - - On each version of the exam, will be at least one problem taken - more or less verbatim from a homework assignment. - - - On the advanced version, there will be an informal proof. -*) - - -(* ###################################################################### *) -(** * Expressions and Their Types *) - -(** Thinking about well-typed expressions and their types is a great - way of reviewing many aspects of how Coq works... - -*) - - - - - - - - - - - - -(** (Discussion of Coq's view of the universe...) #






# *) - - - - - - - - - -(* ###################################################################### *) -(** * Inductive Definitions *) - -(* ###################################################################### *) -(** * Tactics *) - - - - - - -(* ###################################################################### *) -(** * Proof Objects*) - - - - - - - - -(* ###################################################################### *) -(** * Functional Programming *) - - - - -(* ###################################################################### *) -(** * Judging Propositions *) - - - - -(* ###################################################################### *) -(** * More Type Checking*) - - - - - - -(** Good luck on the exam! *) - -(* $Date: 2013-09-26 14:40:26 -0400 (Thu, 26 Sep 2013) $ *) diff --git a/Review2.html b/Review2.html deleted file mode 100644 index eda6e39..0000000 --- a/Review2.html +++ /dev/null @@ -1,120 +0,0 @@ - - - - - -Review2: Review Session for Second Midterm - - - - - - -
- - - -
- -

Review2Review Session for Second Midterm

- -
-
- -
- -
-
- -
- -
-
- -
-

General Notes

- -
- -

Hints

- -
- - -
- -
    -
  • On each version of the exam, there will be at least one problem - taken more or less verbatim from a homework assignment. - -
    - - -
    • -
  • Both versions will include one or more decorated programs. - -
    - - -
    • -
  • On the advanced version, there will be an informal proof. - -
    - - -
    • -
  • This set of review questions is biased toward ones that can be - discussed in class / using clickers, so it doesn't fully - represent the range of questions that might show up on the exam. - -
    - - Make sure to have a look at some prior exams to get a sense of - some other sorts of questions you might see. - -
    • -
- -
-
- -
-
- -
-

Definitions

- -
-
- -
-
- -
-

IMP Program Equivalence

- -
- -

Hoare triples

- -
- -

Decorated programs

- -
-
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Review2.v b/Review2.v deleted file mode 100644 index f513c16..0000000 --- a/Review2.v +++ /dev/null @@ -1,69 +0,0 @@ -(** * Review2: Review Session for Second Midterm *) - -Require Export Hoare2. - -(* ###################################################################### *) -(** * General Notes *) - -(** *** Hints *) - -(** - - On each version of the exam, there will be at least one problem - taken more or less verbatim from a homework assignment. - - - Both versions will include one or more decorated programs. - - - On the advanced version, there will be an informal proof. - - - This set of review questions is biased toward ones that can be - discussed in class / using clickers, so it doesn't fully - represent the range of questions that might show up on the exam. - - Make sure to have a look at some prior exams to get a sense of - some other sorts of questions you might see. -*) - - -(* ###################################################################### *) -(** * Definitions *) - - - -(* ###################################################################### *) -(** * IMP Program Equivalence *) - - - - - - - - - - - - - - - - - -(** * Hoare triples *) - - - - - - - - -(** * Decorated programs *) - - - - - - - - -(* $Date: 2013-11-20 13:03:49 -0500 (Wed, 20 Nov 2013) $ *) diff --git a/SfLib.html b/SfLib.html deleted file mode 100644 index 044898d..0000000 --- a/SfLib.html +++ /dev/null @@ -1,382 +0,0 @@ - - - - - -SfLib: Software Foundations Library - - - - - - -
- - - -
- -

SfLibSoftware Foundations Library

- -
-
- -
- -
-
- -
-(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)
- -
-
- -
-Here we collect together several useful definitions and theorems - from Basics.v, List.v, Poly.v, Ind.v, and Logic.v that are not - already in the Coq standard library. From now on we can Import - or Export this file, instead of cluttering our environment with - all the examples and false starts in those files. -
- -

From the Coq Standard Library

- -
-
- -
-Require Omega. (* needed for using the omega tactic *)
-Require Export Bool.
-Require Export List.
-Export ListNotations.
-Require Export Arith.
-Require Export Arith.EqNat. (* Contains beq_nat, among other things *)
- -
-
- -
-

From Basics.v

- -
-
- -
-Definition admit {T: Type} : T. Admitted.
- -
-Require String. Open Scope string_scope.
- -
-Ltac move_to_top x :=
-  match reverse goal with
-  | H : _ ⊢ _ ⇒ try move x after H
-  end.
- -
-Tactic Notation "assert_eq" ident(x) constr(v) :=
-  let H := fresh in
-  assert (x = v) as H by reflexivity;
-  clear H.
- -
-Tactic Notation "Case_aux" ident(x) constr(name) :=
-  first [
-    set (x := name); move_to_top x
-  | assert_eq x name; move_to_top x
-  | fail 1 "because we are working on a different case" ].
- -
-Tactic Notation "Case" constr(name) := Case_aux Case name.
-Tactic Notation "SCase" constr(name) := Case_aux SCase name.
-Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
-Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
-Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
-Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
-Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
-Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.
- -
-Fixpoint ble_nat (n m : nat) : bool :=
-  match n with
-  | O ⇒ true
-  | S n' ⇒
-      match m with
-      | O ⇒ false
-      | S m' ⇒ ble_nat n' m'
-      end
-  end.
- -
-Theorem andb_true_elim1 : ∀b c,
-  andb b c = true → b = true.
-Proof.
-  intros b c H.
-  destruct b.
-  Case "b = true".
-    reflexivity.
-  Case "b = false".
-    rewrite ← H. reflexivity. Qed.
- -
-Theorem andb_true_elim2 : ∀b c,
-  andb b c = true → c = true.
-Proof.
-(* An exercise in Basics.v *)
-Admitted.
- -
-Theorem beq_nat_sym : ∀(n m : nat),
-  beq_nat n m = beq_nat m n.
-(* An exercise in Lists.v *)
-Admitted.
- -
-
- -
-

From Props.v

- -
-
- -
-Inductive ev : nat → Prop :=
-  | ev_0 : ev O
-  | ev_SS : ∀n:nat, ev n → ev (S (S n)).
- -
-
- -
-

From Logic.v

- -
-
- -
-Theorem andb_true : ∀b c,
-  andb b c = true → b = true ∧ c = true.
-Proof.
-  intros b c H.
-  destruct b.
-    destruct c.
-      apply conj. reflexivity. reflexivity.
-      inversion H.
-    inversion H. Qed.
- -
-Theorem false_beq_nat: ∀n n' : nat,
-     n ≠ n' →
-     beq_nat n n' = false.
-Proof.
-(* An exercise in Logic.v *)
-Admitted.
- -
-Theorem ex_falso_quodlibet : ∀(P:Prop),
-  False → P.
-Proof.
-  intros P contra.
-  inversion contra. Qed.
- -
-Theorem ev_not_ev_S : ∀n,
-  ev n → ¬ ev (S n).
-Proof.
-(* An exercise in Logic.v *)
-Admitted.
- -
-Theorem ble_nat_true : ∀n m,
-  ble_nat n m = true → n ≤ m.
-(* An exercise in Logic.v *)
-Admitted.
- -
-Theorem ble_nat_false : ∀n m,
-  ble_nat n m = false → ~(n ≤ m).
-(* An exercise in Logic.v *)
-Admitted.
- -
-Inductive appears_in (n : nat) : list nat → Prop :=
-| ai_here : ∀l, appears_in n (n::l)
-| ai_later : ∀m l, appears_in n l → appears_in n (m::l).
- -
-Inductive next_nat (n:nat) : nat → Prop :=
-  | nn : next_nat n (S n).
- -
-Inductive total_relation : nat → nat → Prop :=
-  tot : ∀n m : nat, total_relation n m.
- -
-Inductive empty_relation : nat → nat → Prop := .
- -
-
- -
-

From Later Files

- -
-
- -
-Definition relation (X:Type) := X → X → Prop.
- -
-Definition deterministic {X: Type} (R: relation X) :=
-  ∀x y1 y2 : X, R x y1 → R x y2 → y1 = y2.
- -
-Inductive multi (X:Type) (R: relation X)
-                            : X → X → Prop :=
-  | multi_refl : ∀(x : X),
-                 multi X R x x
-  | multi_step : ∀(x y z : X),
-                    R x y →
-                    multi X R y z →
-                    multi X R x z.
-Implicit Arguments multi [[X]].
- -
-Tactic Notation "multi_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "multi_refl" | Case_aux c "multi_step" ].
- -
-Theorem multi_R : ∀(X:Type) (R:relation X) (x y : X),
-       R x y → multi R x y.
-Proof.
-  intros X R x y r.
-  apply multi_step with y. apply r. apply multi_refl. Qed.
- -
-Theorem multi_trans :
-  ∀(X:Type) (R: relation X) (x y z : X),
-      multi R x y →
-      multi R y z →
-      multi R x z.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
- Identifiers and polymorphic partial maps. -
-
- -
-Inductive id : Type :=
-  Id : nat → id.
- -
-Theorem eq_id_dec : ∀id1 id2 : id, {id1 = id2} + {id1 ≠ id2}.
-Proof.
-   intros id1 id2.
-   destruct id1 as [n1]. destruct id2 as [n2].
-   destruct (eq_nat_dec n1 n2) as [Heq | Hneq].
-   Case "n1 = n2".
-     left. rewrite Heq. reflexivity.
-   Case "n1 ≠ n2".
-     right. intros contra. inversion contra. apply Hneq. apply H0.
-Defined.
- -
-Lemma eq_id : ∀(T:Type) x (p q:T),
-              (if eq_id_dec x x then p else q) = p.
-Proof.
-  intros.
-  destruct (eq_id_dec x x); try reflexivity.
-  apply ex_falso_quodlibet; auto.
-Qed.
- -
-Lemma neq_id : ∀(T:Type) x y (p q:T), x ≠ y →
-               (if eq_id_dec x y then p else q) = q.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-Definition partial_map (A:Type) := id → option A.
- -
-Definition empty {A:Type} : partial_map A := (fun _ ⇒ None).
- -
-Notation "'\empty'" := empty.
- -
-Definition extend {A:Type} (Γ : partial_map A) (x:id) (T : A) :=
-  fun x' ⇒ if eq_id_dec x x' then Some T else Γ x'.
- -
-Lemma extend_eq : ∀A (ctxt: partial_map A) x T,
-  (extend ctxt x T) x = Some T.
-Proof.
-  intros. unfold extend. rewrite eq_id; auto.
-Qed.
- -
-Lemma extend_neq : ∀A (ctxt: partial_map A) x1 T x2,
-  x2 ≠ x1 →
-  (extend ctxt x2 T) x1 = ctxt x1.
-Proof.
-  intros. unfold extend. rewrite neq_id; auto.
-Qed.
- -
-Lemma extend_shadow : ∀A (ctxt: partial_map A) t1 t2 x1 x2,
-  extend (extend ctxt x2 t1) x2 t2 x1 = extend ctxt x2 t2 x1.
-Proof with auto.
-  intros. unfold extend. destruct (eq_id_dec x2 x1)...
-Qed.
- -
-
- -
-
- -
- -

Some useful tactics

- -
-
- -
-Tactic Notation "solve_by_inversion_step" tactic(t) :=
-  match goal with
-  | H : _ ⊢ _ ⇒ solve [ inversion H; subst; t ]
-  end
-  ⇓ fail "because the goal is not solvable by inversion.".
- -
-Tactic Notation "solve" "by" "inversion" "1" :=
-  solve_by_inversion_step idtac.
-Tactic Notation "solve" "by" "inversion" "2" :=
-  solve_by_inversion_step (solve by inversion 1).
-Tactic Notation "solve" "by" "inversion" "3" :=
-  solve_by_inversion_step (solve by inversion 2).
-Tactic Notation "solve" "by" "inversion" :=
-  solve by inversion 1.
-
-
- - - -
- - - \ No newline at end of file diff --git a/SfLib.v b/SfLib.v deleted file mode 100644 index 5178d5b..0000000 --- a/SfLib.v +++ /dev/null @@ -1,250 +0,0 @@ -(** * SfLib: Software Foundations Library *) - -(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *) - -(** Here we collect together several useful definitions and theorems - from Basics.v, List.v, Poly.v, Ind.v, and Logic.v that are not - already in the Coq standard library. From now on we can [Import] - or [Export] this file, instead of cluttering our environment with - all the examples and false starts in those files. *) - -(** * From the Coq Standard Library *) - -Require Omega. (* needed for using the [omega] tactic *) -Require Export Bool. -Require Export List. -Export ListNotations. -Require Export Arith. -Require Export Arith.EqNat. (* Contains [beq_nat], among other things *) - -(** * From Basics.v *) - -Definition admit {T: Type} : T. Admitted. - -Require String. Open Scope string_scope. - -Ltac move_to_top x := - match reverse goal with - | H : _ |- _ => try move x after H - end. - -Tactic Notation "assert_eq" ident(x) constr(v) := - let H := fresh in - assert (x = v) as H by reflexivity; - clear H. - -Tactic Notation "Case_aux" ident(x) constr(name) := - first [ - set (x := name); move_to_top x - | assert_eq x name; move_to_top x - | fail 1 "because we are working on a different case" ]. - -Tactic Notation "Case" constr(name) := Case_aux Case name. -Tactic Notation "SCase" constr(name) := Case_aux SCase name. -Tactic Notation "SSCase" constr(name) := Case_aux SSCase name. -Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name. -Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name. -Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name. -Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name. -Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name. - -Fixpoint ble_nat (n m : nat) : bool := - match n with - | O => true - | S n' => - match m with - | O => false - | S m' => ble_nat n' m' - end - end. - -Theorem andb_true_elim1 : forall b c, - andb b c = true -> b = true. -Proof. - intros b c H. - destruct b. - Case "b = true". - reflexivity. - Case "b = false". - rewrite <- H. reflexivity. Qed. - -Theorem andb_true_elim2 : forall b c, - andb b c = true -> c = true. -Proof. -(* An exercise in Basics.v *) -Admitted. - -Theorem beq_nat_sym : forall (n m : nat), - beq_nat n m = beq_nat m n. -(* An exercise in Lists.v *) -Admitted. - -(** * From Props.v *) - -Inductive ev : nat -> Prop := - | ev_0 : ev O - | ev_SS : forall n:nat, ev n -> ev (S (S n)). - -(** * From Logic.v *) - -Theorem andb_true : forall b c, - andb b c = true -> b = true /\ c = true. -Proof. - intros b c H. - destruct b. - destruct c. - apply conj. reflexivity. reflexivity. - inversion H. - inversion H. Qed. - -Theorem false_beq_nat: forall n n' : nat, - n <> n' -> - beq_nat n n' = false. -Proof. -(* An exercise in Logic.v *) -Admitted. - -Theorem ex_falso_quodlibet : forall (P:Prop), - False -> P. -Proof. - intros P contra. - inversion contra. Qed. - -Theorem ev_not_ev_S : forall n, - ev n -> ~ ev (S n). -Proof. -(* An exercise in Logic.v *) -Admitted. - -Theorem ble_nat_true : forall n m, - ble_nat n m = true -> n <= m. -(* An exercise in Logic.v *) -Admitted. - -Theorem ble_nat_false : forall n m, - ble_nat n m = false -> ~(n <= m). -(* An exercise in Logic.v *) -Admitted. - -Inductive appears_in (n : nat) : list nat -> Prop := -| ai_here : forall l, appears_in n (n::l) -| ai_later : forall m l, appears_in n l -> appears_in n (m::l). - -Inductive next_nat (n:nat) : nat -> Prop := - | nn : next_nat n (S n). - -Inductive total_relation : nat -> nat -> Prop := - tot : forall n m : nat, total_relation n m. - -Inductive empty_relation : nat -> nat -> Prop := . - -(** * From Later Files *) - -Definition relation (X:Type) := X -> X -> Prop. - -Definition deterministic {X: Type} (R: relation X) := - forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. - -Inductive multi (X:Type) (R: relation X) - : X -> X -> Prop := - | multi_refl : forall (x : X), - multi X R x x - | multi_step : forall (x y z : X), - R x y -> - multi X R y z -> - multi X R x z. -Implicit Arguments multi [[X]]. - -Tactic Notation "multi_cases" tactic(first) ident(c) := - first; - [ Case_aux c "multi_refl" | Case_aux c "multi_step" ]. - -Theorem multi_R : forall (X:Type) (R:relation X) (x y : X), - R x y -> multi R x y. -Proof. - intros X R x y r. - apply multi_step with y. apply r. apply multi_refl. Qed. - -Theorem multi_trans : - forall (X:Type) (R: relation X) (x y z : X), - multi R x y -> - multi R y z -> - multi R x z. -Proof. - (* FILL IN HERE *) Admitted. - -(** Identifiers and polymorphic partial maps. *) - -Inductive id : Type := - Id : nat -> id. - -Theorem eq_id_dec : forall id1 id2 : id, {id1 = id2} + {id1 <> id2}. -Proof. - intros id1 id2. - destruct id1 as [n1]. destruct id2 as [n2]. - destruct (eq_nat_dec n1 n2) as [Heq | Hneq]. - Case "n1 = n2". - left. rewrite Heq. reflexivity. - Case "n1 <> n2". - right. intros contra. inversion contra. apply Hneq. apply H0. -Defined. - -Lemma eq_id : forall (T:Type) x (p q:T), - (if eq_id_dec x x then p else q) = p. -Proof. - intros. - destruct (eq_id_dec x x); try reflexivity. - apply ex_falso_quodlibet; auto. -Qed. - -Lemma neq_id : forall (T:Type) x y (p q:T), x <> y -> - (if eq_id_dec x y then p else q) = q. -Proof. - (* FILL IN HERE *) Admitted. - -Definition partial_map (A:Type) := id -> option A. - -Definition empty {A:Type} : partial_map A := (fun _ => None). - -Notation "'\empty'" := empty. - -Definition extend {A:Type} (Gamma : partial_map A) (x:id) (T : A) := - fun x' => if eq_id_dec x x' then Some T else Gamma x'. - -Lemma extend_eq : forall A (ctxt: partial_map A) x T, - (extend ctxt x T) x = Some T. -Proof. - intros. unfold extend. rewrite eq_id; auto. -Qed. - -Lemma extend_neq : forall A (ctxt: partial_map A) x1 T x2, - x2 <> x1 -> - (extend ctxt x2 T) x1 = ctxt x1. -Proof. - intros. unfold extend. rewrite neq_id; auto. -Qed. - -Lemma extend_shadow : forall A (ctxt: partial_map A) t1 t2 x1 x2, - extend (extend ctxt x2 t1) x2 t2 x1 = extend ctxt x2 t2 x1. -Proof with auto. - intros. unfold extend. destruct (eq_id_dec x2 x1)... -Qed. - -(** -------------------- *) - -(** * Some useful tactics *) - -Tactic Notation "solve_by_inversion_step" tactic(t) := - match goal with - | H : _ |- _ => solve [ inversion H; subst; t ] - end - || fail "because the goal is not solvable by inversion.". - -Tactic Notation "solve" "by" "inversion" "1" := - solve_by_inversion_step idtac. -Tactic Notation "solve" "by" "inversion" "2" := - solve_by_inversion_step (solve by inversion 1). -Tactic Notation "solve" "by" "inversion" "3" := - solve_by_inversion_step (solve by inversion 2). -Tactic Notation "solve" "by" "inversion" := - solve by inversion 1. diff --git a/Smallstep.html b/Smallstep.html deleted file mode 100644 index 99f4bad..0000000 --- a/Smallstep.html +++ /dev/null @@ -1,2712 +0,0 @@ - - - - - -Smallstep: Small-step Operational Semantics - - - - - - -
- - - -
- -

SmallstepSmall-step Operational Semantics

- -
-
- -
- -
-
- -
-Require Export Imp.
- -
-
- -
-The evaluators we have seen so far (e.g., the ones for - aexps, bexps, and commands) have been formulated in a - "big-step" style — they specify how a given expression can be - evaluated to its final value (or a command plus a store to a final - store) "all in one big step." - -
- - This style is simple and natural for many purposes — indeed, - Gilles Kahn, who popularized its use, called it natural - semantics. But there are some things it does not do well. In - particular, it does not give us a natural way of talking about - concurrent programming languages, where the "semantics" of a - program — i.e., the essence of how it behaves — is not just - which input states get mapped to which output states, but also - includes the intermediate states that it passes through along the - way, since these states can also be observed by concurrently - executing code. - -
- - Another shortcoming of the big-step style is more technical, but - critical in some situations. To see the issue, suppose we wanted - to define a variant of Imp where variables could hold either - numbers or lists of numbers (see the HoareList chapter for - details). In the syntax of this extended language, it will be - possible to write strange expressions like 2 + nil, and our - semantics for arithmetic expressions will then need to say - something about how such expressions behave. One - possibility (explored in the HoareList chapter) is to maintain - the convention that every arithmetic expressions evaluates to some - number by choosing some way of viewing a list as a number — e.g., - by specifying that a list should be interpreted as 0 when it - occurs in a context expecting a number. But this is really a bit - of a hack. - -
- - A much more natural approach is simply to say that the behavior of - an expression like 2+nil is undefined — it doesn't evaluate - to any result at all. And we can easily do this: we just have to - formulate aeval and beval as Inductive propositions rather - than Fixpoints, so that we can make them partial functions instead - of total ones. - -
- - However, now we encounter a serious deficiency. In this language, - a command might fail to map a given starting state to any ending - state for two quite different reasons: either because the - execution gets into an infinite loop or because, at some point, - the program tries to do an operation that makes no sense, such as - adding a number to a list, and none of the evaluation rules can be - applied. - -
- - These two outcomes — nontermination vs. getting stuck in an - erroneous configuration — are quite different. In particular, we - want to allow the first (permitting the possibility of infinite - loops is the price we pay for the convenience of programming with - general looping constructs like while) but prevent the - second (which is just wrong), for example by adding some form of - typechecking to the language. Indeed, this will be a major - topic for the rest of the course. As a first step, we need a - different way of presenting the semantics that allows us to - distinguish nontermination from erroneous "stuck states." - -
- - So, for lots of reasons, we'd like to have a finer-grained way of - defining and reasoning about program behaviors. This is the topic - of the present chapter. We replace the "big-step" eval relation - with a "small-step" relation that specifies, for a given program, - how the "atomic steps" of computation are performed. -
-
- -
-
- -
-

A Toy Language

- -
- - To save space in the discussion, let's go back to an - incredibly simple language containing just constants and - addition. (We use single letters — C and P — for the - constructor names, for brevity.) At the end of the chapter, we'll - see how to apply the same techniques to the full Imp language. -
-
- -
-Inductive tm : Type :=
-  | C : nat → tm (* Constant *)
-  | P : tm → tm → tm. (* Plus *)
- -
-Tactic Notation "tm_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "C" | Case_aux c "P" ].
- -
-
- -
-Here is a standard evaluator for this language, written in the - same (big-step) style as we've been using up to this point. -
-
- -
-Fixpoint evalF (t : tm) : nat :=
-  match t with
-  | C n ⇒ n
-  | P a1 a2 ⇒ evalF a1 + evalF a2
-  end.
- -
-
- -
-Now, here is the same evaluator, written in exactly the same - style, but formulated as an inductively defined relation. Again, - we use the notation t ⇓ n for "t evaluates to n." -
- -
- - - - - - - - - - -
   - (E_Const)   -
C n ⇓ n
- - - - - - - - - - - - - - -
t1 ⇓ n1
t2 ⇓ n2 - (E_Plus)   -
P t1 t2 ⇓ C (n1 + n2)
-
-
- -
-Reserved Notation " t '⇓' n " (at level 50, left associativity).
- -
-Inductive eval : tm → nat → Prop :=
-
-
-  | E_Const : ∀n,
-      C n ⇓ n
-  | E_Plus : ∀t1 t2 n1 n2,
-      t1 ⇓ n1 →
-      t2 ⇓ n2 →
-      P t1 t2 ⇓ (n1 + n2)
-
-  where " t '⇓' n " := (eval t n).
- -
-Tactic Notation "eval_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "E_Const" | Case_aux c "E_Plus" ].
-
- -
- -
-
- -
-Now, here is a small-step version. -
- -
- - - - - - - - - - -
   - (ST_PlusConstConst)   -
P (C n1) (C n2) ⇒ C (n1 + n2)
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Plus1)   -
P t1 t2 ⇒ P t1' t2
- - - - - - - - - - -
t2 ⇒ t2' - (ST_Plus2)   -
P (C n1) t2 ⇒ P (C n1) t2'
-
-
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_PlusConstConst : ∀n1 n2,
-      P (C n1) (C n2) ⇒ C (n1 + n2)
-  | ST_Plus1 : ∀t1 t1' t2,
-      t1 ⇒ t1' →
-      P t1 t2 ⇒ P t1' t2
-  | ST_Plus2 : ∀n1 t2 t2',
-      t2 ⇒ t2' →
-      P (C n1) t2 ⇒ P (C n1) t2'
-
-  where " t '⇒' t' " := (step t t').
- -
-
-
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_PlusConstConst"
-  | Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2" ].
-
- -
-
- -
-Things to notice: - -
- -
    -
  • We are defining just a single reduction step, in which - one P node is replaced by its value. - -
    - - -
    • -
  • Each step finds the leftmost P node that is ready to - go (both of its operands are constants) and rewrites it in - place. The first rule tells how to rewrite this P node - itself; the other two rules tell how to find it. - -
    - - -
    • -
  • A term that is just a constant cannot take a step. -
    • -
- -
- - Let's pause and check a couple of examples of reasoning with - the step relation... -
- - If t1 can take a step to t1', then P t1 t2 steps - to P t1' t2: -
-
- -
-Example test_step_1 :
-      P
-        (P (C 0) (C 3))
-        (P (C 2) (C 4))
-      ⇒
-      P
-        (C (0 + 3))
-        (P (C 2) (C 4)).
-
-
-Proof.
-  apply ST_Plus1. apply ST_PlusConstConst. Qed.
-
- -
-
- -
-

Exercise: 1 star (test_step_2)

- Right-hand sides of sums can take a step only when the - left-hand side is finished: if t2 can take a step to t2', - then P (C n) t2 steps to P (C n) - t2': -
-
- -
-Example test_step_2 :
-      P
-        (C 0)
-        (P
-          (C 2)
-          (P (C 0) (C 3)))
-      ⇒
-      P
-        (C 0)
-        (P
-          (C 2)
-          (C (0 + 3))).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Relations

- -
- - We will be using several different step relations, so it is - helpful to generalize a bit... -
- - A (binary) relation on a set X is a family of propositions - parameterized by two elements of X — i.e., a proposition about - pairs of elements of X. -
-
- -
-Definition relation (X: Type) := X→X→Prop.
- -
-
- -
-Our main examples of such relations in this chapter will be - the single-step and multi-step reduction relations on terms, ⇒ - and ⇒*, but there are many other examples — some that come to - mind are the "equals," "less than," "less than or equal to," and - "is the square of" relations on numbers, and the "prefix of" - relation on lists and strings. -
- - One simple property of the ⇒ relation is that, like the - evaluation relation for our language of Imp programs, it is - deterministic. - -
- - Theorem: For each t, there is at most one t' such that t - steps to t' (t ⇒ t' is provable). Formally, this is the - same as saying that ⇒ is deterministic. -
- - Proof sketch: We show that if x steps to both y1 and y2 - then y1 and y2 are equal, by induction on a derivation of - step x y1. There are several cases to consider, depending on - the last rule used in this derivation and in the given derivation - of step x y2. - -
- -
    -
  • If both are ST_PlusConstConst, the result is immediate. - -
    - - -
    • -
  • The cases when both derivations end with ST_Plus1 or - ST_Plus2 follow by the induction hypothesis. - -
    - - -
    • -
  • It cannot happen that one is ST_PlusConstConst and the other - is ST_Plus1 or ST_Plus2, since this would imply that x has - the form P t1 t2 where both t1 and t2 are - constants (by ST_PlusConstConst) and one of t1 or t2 has - the form P .... - -
    - - -
    • -
  • Similarly, it cannot happen that one is ST_Plus1 and the other - is ST_Plus2, since this would imply that x has the form - P t1 t2 where t1 has both the form P t1 t2 and - the form C n. ☐ -
    • -
- -
-
- -
-Definition deterministic {X: Type} (R: relation X) :=
-  ∀x y1 y2 : X, R x y1 → R x y2 → y1 = y2.
- -
-Theorem step_deterministic:
-  deterministic step.
-
-
-Proof.
-  unfold deterministic. intros x y1 y2 Hy1 Hy2.
-  generalize dependent y2.
-  step_cases (induction Hy1) Case; intros y2 Hy2.
-    Case "ST_PlusConstConst". step_cases (inversion Hy2) SCase.
-      SCase "ST_PlusConstConst". reflexivity.
-      SCase "ST_Plus1". inversion H2.
-      SCase "ST_Plus2". inversion H2.
-    Case "ST_Plus1". step_cases (inversion Hy2) SCase.
-      SCase "ST_PlusConstConst". rewrite ← H0 in Hy1. inversion Hy1.
-      SCase "ST_Plus1".
-        rewrite ← (IHHy1 t1'0).
-        reflexivity. assumption.
-      SCase "ST_Plus2". rewrite ← H in Hy1. inversion Hy1.
-    Case "ST_Plus2". step_cases (inversion Hy2) SCase.
-      SCase "ST_PlusConstConst". rewrite ← H1 in Hy1. inversion Hy1.
-      SCase "ST_Plus1". inversion H2.
-      SCase "ST_Plus2".
-        rewrite ← (IHHy1 t2'0).
-        reflexivity. assumption. Qed.
-
- -
-End SimpleArith1.
- -
-
- -
-

Values

- -
- - Let's take a moment to slightly generalize the way we state the - definition of single-step reduction. -
- - It is useful to think of the ⇒ relation as defining an - abstract machine: - -
- -
    -
  • At any moment, the state of the machine is a term. - -
    - - -
    • -
  • A step of the machine is an atomic unit of computation — - here, a single "add" operation. - -
    - - -
    • -
  • The halting states of the machine are ones where there is no - more computation to be done. - -
    • -
- -
- - We can then execute a term t as follows: - -
- -
    -
  • Take t as the starting state of the machine. - -
    - - -
    • -
  • Repeatedly use the ⇒ relation to find a sequence of - machine states, starting with t, where each state steps to - the next. - -
    - - -
    • -
  • When no more reduction is possible, "read out" the final state - of the machine as the result of execution. -
    • -
- -
- - Intuitively, it is clear that the final states of the - machine are always terms of the form C n for some n. - We call such terms values. -
-
- -
-Inductive value : tm → Prop :=
-  v_const : ∀n, value (C n).
- -
-
- -
-Having introduced the idea of values, we can use it in the - definition of the ⇒ relation to write ST_Plus2 rule in a - slightly more elegant way: -
- - -
- -
- - - - - - - - - - -
   - (ST_PlusConstConst)   -
P (C n1) (C n2) ⇒ C (n1 + n2)
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Plus1)   -
P t1 t2 ⇒ P t1' t2
- - - - - - - - - - - - - - -
value v1
t2 ⇒ t2' - (ST_Plus2)   -
P v1 t2 ⇒ P v1 t2'
Again, the variable names here carry important information: - by convention, v1 ranges only over values, while t1 and t2 - range over arbitrary terms. (Given this convention, the explicit - value hypothesis is arguably redundant. We'll keep it for now, - to maintain a close correspondence between the informal and Coq - versions of the rules, but later on we'll drop it in informal - rules, for the sake of brevity.) -
- - Here are the formal rules: -
-
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_PlusConstConst : ∀n1 n2,
-          P (C n1) (C n2)
-      ⇒ C (n1 + n2)
-  | ST_Plus1 : ∀t1 t1' t2,
-        t1 ⇒ t1' →
-        P t1 t2 ⇒ P t1' t2
-  | ST_Plus2 : ∀v1 t2 t2',
-        value v1 → (* <----- n.b. *)
-        t2 ⇒ t2' →
-        P v1 t2 ⇒ P v1 t2'
-
-  where " t '⇒' t' " := (step t t').
- -
-
-
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_PlusConstConst"
-  | Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2" ].
-
- -
-
- -
-

Exercise: 3 stars (redo_determinism)

- As a sanity check on this change, let's re-verify determinism - -
- - Proof sketch: We must show that if x steps to both y1 and y2 - then y1 and y2 are equal. Consider the final rules used in - the derivations of step x y1 and step x y2. - -
- -
    -
  • If both are ST_PlusConstConst, the result is immediate. - -
    - - -
    • -
  • It cannot happen that one is ST_PlusConstConst and the other - is ST_Plus1 or ST_Plus2, since this would imply that x has - the form P t1 t2 where both t1 and t2 are - constants (by ST_PlusConstConst) AND one of t1 or t2 has - the form P .... - -
    - - -
    • -
  • Similarly, it cannot happen that one is ST_Plus1 and the other - is ST_Plus2, since this would imply that x has the form - P t1 t2 where t1 both has the form P t1 t2 and - is a value (hence has the form C n). - -
    - - -
    • -
  • The cases when both derivations end with ST_Plus1 or - ST_Plus2 follow by the induction hypothesis. ☐ -
    • -
- -
- - Most of this proof is the same as the one above. But to get - maximum benefit from the exercise you should try to write it from - scratch and just use the earlier one if you get stuck. -
-
- -
-Theorem step_deterministic :
-  deterministic step.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Strong Progress and Normal Forms

- -
- - The definition of single-step reduction for our toy language is - fairly simple, but for a larger language it would be pretty easy - to forget one of the rules and create a situation where some term - cannot take a step even though it has not been completely reduced - to a value. The following theorem shows that we did not, in fact, - make such a mistake here. -
- - Theorem (Strong Progress): If t is a term, then either t - is a value, or there exists a term t' such that t ⇒ t'. -
- - Proof: By induction on t. - -
- -
    -
  • Suppose t = C n. Then t is a value. - -
    - - -
    • -
  • Suppose t = P t1 t2, where (by the IH) t1 is either a - value or can step to some t1', and where t2 is either a - value or can step to some t2'. We must show P t1 t2 is - either a value or steps to some t'. - -
    - -
      -
    • If t1 and t2 are both values, then t can take a step, by - ST_PlusConstConst. - -
      - - -
      • -
    • If t1 is a value and t2 can take a step, then so can t, - by ST_Plus2. - -
      - - -
      • -
    • If t1 can take a step, then so can t, by ST_Plus1. ☐ -
      • -
    - -
    • -
- -
-
- -
-Theorem strong_progress : ∀t,
-  value t ∨ (∃t', t ⇒ t').
-
-
-Proof.
-  tm_cases (induction t) Case.
-    Case "C". left. apply v_const.
-    Case "P". right. inversion IHt1.
-      SCase "l". inversion IHt2.
-        SSCase "l". inversion H. inversion H0.
-          ∃(C (n + n0)).
-          apply ST_PlusConstConst.
-        SSCase "r". inversion H0 as [t' H1].
-          ∃(P t1 t').
-          apply ST_Plus2. apply H. apply H1.
-      SCase "r". inversion H as [t' H0].
-          ∃(P t' t2).
-          apply ST_Plus1. apply H0. Qed.
-
- -
-
- -
-This important property is called strong progress, because - every term either is a value or can "make progress" by stepping to - some other term. (The qualifier "strong" distinguishes it from a - more refined version that we'll see in later chapters, called - simply "progress.") -
- - The idea of "making progress" can be extended to tell us something - interesting about values: in this language values are exactly - the terms that cannot make progress in this sense. - -
- - To state this observation formally, let's begin by giving a name - to terms that cannot make progress. We'll call them normal - forms. -
-
- -
-Definition normal_form {X:Type} (R:relation X) (t:X) : Prop :=
-  ¬ ∃t', R t t'.
- -
-
- -
-This definition actually specifies what it is to be a normal form - for an arbitrary relation R over an arbitrary set X, not - just for the particular single-step reduction relation over terms - that we are interested in at the moment. We'll re-use the same - terminology for talking about other relations later in the - course. -
- - We can use this terminology to generalize the observation we made - in the strong progress theorem: in this language, normal forms and - values are actually the same thing. -
-
- -
-Lemma value_is_nf : ∀v,
-  value v → normal_form step v.
-
-
-Proof.
-  unfold normal_form. intros v H. inversion H.
-  intros contra. inversion contra. inversion H1.
-Qed.
-
- -
-Lemma nf_is_value : ∀t,
-  normal_form step t → value t.
-
-
-Proof. (* a corollary of strong_progress... *)
-  unfold normal_form. intros t H.
-  assert (G : value t ∨ ∃t', t ⇒ t').
-    SCase "Proof of assertion". apply strong_progress.
-  inversion G.
-    SCase "l". apply H0.
-    SCase "r". apply ex_falso_quodlibet. apply H. assumption. Qed.
-
- -
-Corollary nf_same_as_value : ∀t,
-  normal_form step t ↔ value t.
-
-
-Proof.
-  split. apply nf_is_value. apply value_is_nf. Qed.
-
- -
-
- -
-Why is this interesting? - -
- - Because value is a syntactic concept — it is defined by looking - at the form of a term — while normal_form is a semantic one — - it is defined by looking at how the term steps. It is not obvious - that these concepts should coincide! - -
- - Indeed, we could easily have written the definitions so that they - would not coincide... -
-
- -
- -
-
- -
-We might, for example, mistakenly define value so that it - includes some terms that are not finished reducing. -
-
- -
-Module Temp1.
-(* Open an inner module so we can redefine value and step. *)
- -
-Inductive value : tm → Prop :=
-| v_const : ∀n, value (C n)
-| v_funny : ∀t1 n2, (* <---- *)
-              value (P t1 (C n2)).
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_PlusConstConst : ∀n1 n2,
-      P (C n1) (C n2) ⇒ C (n1 + n2)
-  | ST_Plus1 : ∀t1 t1' t2,
-      t1 ⇒ t1' →
-      P t1 t2 ⇒ P t1' t2
-  | ST_Plus2 : ∀v1 t2 t2',
-      value v1 →
-      t2 ⇒ t2' →
-      P v1 t2 ⇒ P v1 t2'
-
-  where " t '⇒' t' " := (step t t').
- -
-
- -
-

Exercise: 3 stars, advanced (value_not_same_as_normal_form)

- -
-
-Lemma value_not_same_as_normal_form :
-  ∃v, value v ∧ ¬ normal_form step v.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-Alternatively, we might mistakenly define step so that it - permits something designated as a value to reduce further. -
-
- -
-Module Temp2.
- -
-Inductive value : tm → Prop :=
-| v_const : ∀n, value (C n).
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_Funny : ∀n, (* <---- *)
-      C n ⇒ P (C n) (C 0)
-  | ST_PlusConstConst : ∀n1 n2,
-      P (C n1) (C n2) ⇒ C (n1 + n2)
-  | ST_Plus1 : ∀t1 t1' t2,
-      t1 ⇒ t1' →
-      P t1 t2 ⇒ P t1' t2
-  | ST_Plus2 : ∀v1 t2 t2',
-      value v1 →
-      t2 ⇒ t2' →
-      P v1 t2 ⇒ P v1 t2'
-
-  where " t '⇒' t' " := (step t t').
- -
-
- -
-

Exercise: 2 stars, advanced (value_not_same_as_normal_form)

- -
-
-Lemma value_not_same_as_normal_form :
-  ∃v, value v ∧ ¬ normal_form step v.
-
-
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
-
- -
-☐ -
-
- -
-
- -
-Finally, we might define value and step so that there is some - term that is not a value but that cannot take a step in the step - relation. Such terms are said to be stuck. In this case this is - caused by a mistake in the semantics, but we will also see - situations where, even in a correct language definition, it makes - sense to allow some terms to be stuck. -
-
- -
-Module Temp3.
- -
-Inductive value : tm → Prop :=
-  | v_const : ∀n, value (C n).
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_PlusConstConst : ∀n1 n2,
-      P (C n1) (C n2) ⇒ C (n1 + n2)
-  | ST_Plus1 : ∀t1 t1' t2,
-      t1 ⇒ t1' →
-      P t1 t2 ⇒ P t1' t2
-
-  where " t '⇒' t' " := (step t t').
- -
-
- -
-(Note that ST_Plus2 is missing.) -
- -

Exercise: 3 stars, advanced (value_not_same_as_normal_form')

- -
-
-Lemma value_not_same_as_normal_form :
-  ∃t, ¬ value t ∧ normal_form step t.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-End Temp3.
- -
-
- -
-

Additional Exercises

- -
-
- -
-Module Temp4.
- -
-
- -
-Here is another very simple language whose terms, instead of being - just plus and numbers, are just the booleans true and false and a - conditional expression... -
-
- -
-Inductive tm : Type :=
-  | ttrue : tm
-  | tfalse : tm
-  | tif : tm → tm → tm → tm.
- -
-Inductive value : tm → Prop :=
-  | v_true : value ttrue
-  | v_false : value tfalse.
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_IfTrue : ∀t1 t2,
-      tif ttrue t1 t2 ⇒ t1
-  | ST_IfFalse : ∀t1 t2,
-      tif tfalse t1 t2 ⇒ t2
-  | ST_If : ∀t1 t1' t2 t3,
-      t1 ⇒ t1' →
-      tif t1 t2 t3 ⇒ tif t1' t2 t3
-
-  where " t '⇒' t' " := (step t t').
- -
-
- -
-

Exercise: 1 star (smallstep_bools)

- Which of the following propositions are provable? (This is just a - thought exercise, but for an extra challenge feel free to prove - your answers in Coq.) -
-
- -
-Definition bool_step_prop1 :=
-  tfalse ⇒ tfalse.
- -
-(* FILL IN HERE *)
- -
-Definition bool_step_prop2 :=
-     tif
-       ttrue
-       (tif ttrue ttrue ttrue)
-       (tif tfalse tfalse tfalse)
-  ⇒
-     ttrue.
- -
-(* FILL IN HERE *)
- -
-Definition bool_step_prop3 :=
-     tif
-       (tif ttrue ttrue ttrue)
-       (tif ttrue ttrue ttrue)
-       tfalse
-   ⇒
-     tif
-       ttrue
-       (tif ttrue ttrue ttrue)
-       tfalse.
- -
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 3 stars, optional (progress_bool)

- Just as we proved a progress theorem for plus expressions, we can - do so for boolean expressions, as well. -
-
- -
-Theorem strong_progress : ∀t,
-  value t ∨ (∃t', t ⇒ t').
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars, optional (step_deterministic)

- -
-
-Theorem step_deterministic :
-  deterministic step.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-Module Temp5.
- -
-
- -
-

Exercise: 2 stars (smallstep_bool_shortcut)

- Suppose we want to add a "short circuit" to the step relation for - boolean expressions, so that it can recognize when the then and - else branches of a conditional are the same value (either - ttrue or tfalse) and reduce the whole conditional to this - value in a single step, even if the guard has not yet been reduced - to a value. For example, we would like this proposition to be - provable: - -
- -
-         tif
-            (tif ttrue ttrue ttrue)
-            tfalse
-            tfalse
-     ⇒ 
-         tfalse. -
- -
- -
- - Write an extra clause for the step relation that achieves this - effect and prove bool_step_prop4. -
-
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_IfTrue : ∀t1 t2,
-      tif ttrue t1 t2 ⇒ t1
-  | ST_IfFalse : ∀t1 t2,
-      tif tfalse t1 t2 ⇒ t2
-  | ST_If : ∀t1 t1' t2 t3,
-      t1 ⇒ t1' →
-      tif t1 t2 t3 ⇒ tif t1' t2 t3
-(* FILL IN HERE *)
-
-  where " t '⇒' t' " := (step t t').
-
- -
-☐ -
-
- -
-Definition bool_step_prop4 :=
-         tif
-            (tif ttrue ttrue ttrue)
-            tfalse
-            tfalse
-     ⇒
-         tfalse.
- -
-Example bool_step_prop4_holds :
-  bool_step_prop4.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional (properties_of_altered_step)

- It can be shown that the determinism and strong progress theorems - for the step relation in the lecture notes also hold for the - definition of step given above. After we add the clause - ST_ShortCircuit... - -
- -
    -
  • Is the step relation still deterministic? Write yes or no and - briefly (1 sentence) explain your answer. - -
    - - Optional: prove your answer correct in Coq. - -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
- -
- -
    -
  • Does a strong progress theorem hold? Write yes or no and - briefly (1 sentence) explain your answer. - -
    - - Optional: prove your answer correct in Coq. - -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
- -
- -
    -
  • In general, is there any way we could cause strong progress to - fail if we took away one or more constructors from the original - step relation? Write yes or no and briefly (1 sentence) explain - your answer. - -
    • -
- -
- -(* FILL IN HERE *)
- ☐ -
-
- -
-End Temp5.
-End Temp4.
- -
-
- -
-

Multi-Step Reduction

- -
- - Until now, we've been working with the single-step reduction - relation ⇒, which formalizes the individual steps of an - abstract machine for executing programs. - -
- - We can also use this machine to reduce programs to completion — - to find out what final result they yield. This can be formalized - as follows: - -
- -
    -
  • First, we define a multi-step reduction relation ⇒*, which - relates terms t and t' if t can reach t' by any number - of single reduction steps (including zero steps!). - -
    - - -
    • -
  • Then we define a "result" of a term t as a normal form that - t can reach by multi-step reduction. -
    • -
- -
-
- -
- -
-
- -
-Since we'll want to reuse the idea of multi-step reduction many - times in this and future chapters, let's take a little extra - trouble here and define it generically. - -
- - Given a relation R, we define a relation multi R, called the - multi-step closure of R as follows: -
-
- -
-Inductive multi {X:Type} (R: relation X) : relation X :=
-  | multi_refl : ∀(x : X), multi R x x
-  | multi_step : ∀(x y z : X),
-                    R x y →
-                    multi R y z →
-                    multi R x z.
- -
-
- -
-The effect of this definition is that multi R relates two - elements x and y if either - -
- -
    -
  • x = y, or else - -
    • -
  • there is some sequence z1, z2, ..., zn - such that - -
    - -
    -  R x z1
    -  R z1 z2
    -  ...
    -  R zn y. -
    - -
    - -
    • -
- -
- - Thus, if R describes a single-step of computation, z1, - ... zn is the sequence of intermediate steps of computation - between x and y. - -
-
- -
-Tactic Notation "multi_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "multi_refl" | Case_aux c "multi_step" ].
- -
-
- -
-We write ⇒* for the multi step relation — i.e., the - relation that relates two terms t and t' if we can get from - t to t' using the step relation zero or more times. -
-
- -
-Definition multistep := multi step.
-Notation " t '⇒*' t' " := (multistep t t') (at level 40).
- -
-
- -
-The relation multi R has several crucial properties. - -
- - First, it is obviously reflexive (that is, ∀ x, multi R x - x). In the case of the ⇒* (i.e. multi step) relation, the - intuition is that a term can execute to itself by taking zero - steps of execution. - -
- - Second, it contains R — that is, single-step executions are a - particular case of multi-step executions. (It is this fact that - justifies the word "closure" in the term "multi-step closure of - R.") -
-
- -
-Theorem multi_R : ∀(X:Type) (R:relation X) (x y : X),
-       R x y → (multi R) x y.
-Proof.
-  intros X R x y H.
-  apply multi_step with y. apply H. apply multi_refl. Qed.
- -
-
- -
-Third, multi R is transitive. -
-
- -
-Theorem multi_trans :
-  ∀(X:Type) (R: relation X) (x y z : X),
-      multi R x y →
-      multi R y z →
-      multi R x z.
-
-
-Proof.
-  intros X R x y z G H.
-  multi_cases (induction G) Case.
-    Case "multi_refl". assumption.
-    Case "multi_step".
-      apply multi_step with y. assumption.
-      apply IHG. assumption. Qed.
-
- -
-
- -
-That is, if t1⇒*t2 and t2⇒*t3, then t1⇒*t3. -
-
- -
-
- -
-

Examples

- -
-
- -
-Lemma test_multistep_1:
-      P
-        (P (C 0) (C 3))
-        (P (C 2) (C 4))
-   ⇒*
-      C ((0 + 3) + (2 + 4)).
-
-
-Proof.
-  apply multi_step with
-            (P
-                (C (0 + 3))
-                (P (C 2) (C 4))).
-  apply ST_Plus1. apply ST_PlusConstConst.
-  apply multi_step with
-            (P
-                (C (0 + 3))
-                (C (2 + 4))).
-  apply ST_Plus2. apply v_const.
-  apply ST_PlusConstConst.
-  apply multi_R.
-  apply ST_PlusConstConst. Qed.
-
- -
-
- -
-Here's an alternate proof that uses eapply to avoid explicitly - constructing all the intermediate terms. -
-
- -
-Lemma test_multistep_1':
-      P
-        (P (C 0) (C 3))
-        (P (C 2) (C 4))
-  ⇒*
-      C ((0 + 3) + (2 + 4)).
-
-
-Proof.
-  eapply multi_step. apply ST_Plus1. apply ST_PlusConstConst.
-  eapply multi_step. apply ST_Plus2. apply v_const.
-  apply ST_PlusConstConst.
-  eapply multi_step. apply ST_PlusConstConst.
-  apply multi_refl. Qed.
-
- -
-
- -
-

Exercise: 1 star, optional (test_multistep_2)

- -
-
-Lemma test_multistep_2:
-  C 3 ⇒* C 3.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (test_multistep_3)

- -
-
-Lemma test_multistep_3:
-      P (C 0) (C 3)
-   ⇒*
-      P (C 0) (C 3).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (test_multistep_4)

- -
-
-Lemma test_multistep_4:
-      P
-        (C 0)
-        (P
-          (C 2)
-          (P (C 0) (C 3)))
-  ⇒*
-      P
-        (C 0)
-        (C (2 + (0 + 3))).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Normal Forms Again

- -
- - If t reduces to t' in zero or more steps and t' is a - normal form, we say that "t' is a normal form of t." -
-
- -
-Definition step_normal_form := normal_form step.
- -
-Definition normal_form_of (t t' : tm) :=
-  (t ⇒* t' ∧ step_normal_form t').
- -
-
- -
-We have already seen that, for our language, single-step reduction is - deterministic — i.e., a given term can take a single step in - at most one way. It follows from this that, if t can reach - a normal form, then this normal form is unique. In other words, we - can actually pronounce normal_form t t' as "t' is the - normal form of t." -
- -

Exercise: 3 stars, optional (normal_forms_unique)

- -
-
-Theorem normal_forms_unique:
-  deterministic normal_form_of.
-Proof.
-  unfold deterministic. unfold normal_form_of. intros x y1 y2 P1 P2.
-  inversion P1 as [P11 P12]; clear P1. inversion P2 as [P21 P22]; clear P2.
-  generalize dependent y2.
-  (* We recommend using this initial setup as-is! *)
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Indeed, something stronger is true for this language (though not - for all languages): the reduction of any term t will - eventually reach a normal form — i.e., normal_form_of is a - total function. Formally, we say the step relation is - normalizing. -
-
- -
-Definition normalizing {X:Type} (R:relation X) :=
-  ∀t, ∃t',
-    (multi R) t t' ∧ normal_form R t'.
- -
-
- -
-To prove that step is normalizing, we need a couple of lemmas. - -
- - First, we observe that, if t reduces to t' in many steps, then - the same sequence of reduction steps within t is also possible - when t appears as the left-hand child of a P node, and - similarly when t appears as the right-hand child of a P - node whose left-hand child is a value. -
-
- -
-Lemma multistep_congr_1 : ∀t1 t1' t2,
-     t1 ⇒* t1' →
-     P t1 t2 ⇒* P t1' t2.
-
-
-Proof.
-  intros t1 t1' t2 H. multi_cases (induction H) Case.
-    Case "multi_refl". apply multi_refl.
-    Case "multi_step". apply multi_step with (P y t2).
-        apply ST_Plus1. apply H.
-        apply IHmulti. Qed.
-
- -
-
- -
-

Exercise: 2 stars (multistep_congr_2)

- -
-
-Lemma multistep_congr_2 : ∀t1 t2 t2',
-     value t1 →
-     t2 ⇒* t2' →
-     P t1 t2 ⇒* P t1 t2'.
-
-
-Proof.
-  (* FILL IN HERE *) Admitted.
-
-
- -
-☐ -
- - Theorem: The step function is normalizing — i.e., for every - t there exists some t' such that t steps to t' and t' is - a normal form. - -
- - Proof sketch: By induction on terms. There are two cases to - consider: - -
- -
    -
  • t = C n for some n. Here t doesn't take a step, - and we have t' = t. We can derive the left-hand side by - reflexivity and the right-hand side by observing (a) that values - are normal forms (by nf_same_as_value) and (b) that t is a - value (by v_const). - -
    - - -
    • -
  • t = P t1 t2 for some t1 and t2. By the IH, t1 and - t2 have normal forms t1' and t2'. Recall that normal - forms are values (by nf_same_as_value); we know that t1' = - C n1 and t2' = C n2, for some n1 and n2. - We can combine the ⇒* derivations for t1 and t2 to prove - that P t1 t2 reduces in many steps to C (n1 + n2). - -
    - - It is clear that our choice of t' = C (n1 + n2) is a - value, which is in turn a normal form. ☐ -
    • -
- -
-
- -
-Theorem step_normalizing :
-  normalizing step.
-
-
-Proof.
-  unfold normalizing.
-  tm_cases (induction t) Case.
-    Case "C".
-      ∃(C n).
-      split.
-      SCase "l". apply multi_refl.
-      SCase "r".
-        (* We can use rewrite with "iff" statements, not
-           just equalities: *)
-        rewrite nf_same_as_value. apply v_const.
-    Case "P".
-      inversion IHt1 as [t1' H1]; clear IHt1. inversion IHt2 as [t2' H2]; clear IHt2.
-      inversion H1 as [H11 H12]; clear H1. inversion H2 as [H21 H22]; clear H2.
-      rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22.
-      inversion H12 as [n1]. inversion H22 as [n2].
-      rewrite ← H in H11.
-      rewrite ← H0 in H21.
-      ∃(C (n1 + n2)).
-      split.
-        SCase "l".
-          apply multi_trans with (P (C n1) t2).
-          apply multistep_congr_1. apply H11.
-          apply multi_trans with
-             (P (C n1) (C n2)).
-          apply multistep_congr_2. apply v_const. apply H21.
-          apply multi_R. apply ST_PlusConstConst.
-        SCase "r".
-          rewrite nf_same_as_value. apply v_const. Qed.
-
- -
-
- -
-

Equivalence of Big-Step and Small-Step Reduction

- -
- - Having defined the operational semantics of our tiny programming - language in two different styles, it makes sense to ask whether - these definitions actually define the same thing! They do, though - it takes a little work to show it. (The details are left as an - exercise). -
- -

Exercise: 3 stars (eval__multistep)

- -
-
-Theorem eval__multistep : ∀t n,
-  t ⇓ n → t ⇒* C n.
- -
-
- -
-The key idea behind the proof comes from the following picture: - -
- -
-       P t1 t2 ⇒            (by ST_Plus1) 
-       P t1' t2 ⇒           (by ST_Plus1)  
-       P t1'' t2 ⇒          (by ST_Plus1) 
-       ...
-       P (C n1) t2 ⇒        (by ST_Plus2)
-       P (C n1) t2' ⇒       (by ST_Plus2)
-       P (C n1) t2'' ⇒      (by ST_Plus2)
-       ...
-       P (C n1) (C n2) ⇒    (by ST_PlusConstConst)
-       C (n1 + n2)               -
- -
- That is, the multistep reduction of a term of the form P t1 t2 - proceeds in three phases: - -
- -
    -
  • First, we use ST_Plus1 some number of times to reduce t1 - to a normal form, which must (by nf_same_as_value) be a - term of the form C n1 for some n1. - -
    • -
  • Next, we use ST_Plus2 some number of times to reduce t2 - to a normal form, which must again be a term of the form C - n2 for some n2. - -
    • -
  • Finally, we use ST_PlusConstConst one time to reduce P (C - n1) (C n2) to C (n1 + n2). -
    • -
- -
- - To formalize this intuition, you'll need to use the congruence - lemmas from above (you might want to review them now, so that - you'll be able to recognize when they are useful), plus some basic - properties of ⇒*: that it is reflexive, transitive, and - includes ⇒. -
-
- -
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (eval__multistep_inf)

- Write a detailed informal version of the proof of eval__multistep. - -
- -(* FILL IN HERE *)
-☐ - For the other direction, we need one lemma, which establishes a - relation between single-step reduction and big-step evaluation. -
- -

Exercise: 3 stars (step__eval)

- -
-
-Lemma step__eval : ∀t t' n,
-     t ⇒ t' →
-     t' ⇓ n →
-     t ⇓ n.
-Proof.
-  intros t t' n Hs. generalize dependent n.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - The fact that small-step reduction implies big-step is now - straightforward to prove, once it is stated correctly. - -
- - The proof proceeds by induction on the multi-step reduction - sequence that is buried in the hypothesis normal_form_of t t'. Make sure you understand the statement before you start to - work on the proof. -
- -

Exercise: 3 stars (multistep__eval)

- -
-
-Theorem multistep__eval : ∀t t',
-  normal_form_of t t' → ∃n, t' = C n ∧ t ⇓ n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 3 stars, optional (interp_tm)

- Remember that we also defined big-step evaluation of tms as a - function evalF. Prove that it is equivalent to the existing - semantics. - -
- - Hint: we just proved that eval and multistep are - equivalent, so logically it doesn't matter which you choose. - One will be easier than the other, though! -
-
- -
-Theorem evalF_eval : ∀t n,
-  evalF t = n ↔ t ⇓ n.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 4 stars (combined_properties)

- We've considered the arithmetic and conditional expressions - separately. This exercise explores how the two interact. -
-
- -
-Module Combined.
- -
-Inductive tm : Type :=
-  | C : nat → tm
-  | P : tm → tm → tm
-  | ttrue : tm
-  | tfalse : tm
-  | tif : tm → tm → tm → tm.
-
-
- -
-Tactic Notation "tm_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "C" | Case_aux c "P"
-  | Case_aux c "ttrue" | Case_aux c "tfalse" | Case_aux c "tif" ].
-
- -
-Inductive value : tm → Prop :=
-  | v_const : ∀n, value (C n)
-  | v_true : value ttrue
-  | v_false : value tfalse.
- -
-Reserved Notation " t '⇒' t' " (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_PlusConstConst : ∀n1 n2,
-      P (C n1) (C n2) ⇒ C (n1 + n2)
-  | ST_Plus1 : ∀t1 t1' t2,
-      t1 ⇒ t1' →
-      P t1 t2 ⇒ P t1' t2
-  | ST_Plus2 : ∀v1 t2 t2',
-      value v1 →
-      t2 ⇒ t2' →
-      P v1 t2 ⇒ P v1 t2'
-  | ST_IfTrue : ∀t1 t2,
-      tif ttrue t1 t2 ⇒ t1
-  | ST_IfFalse : ∀t1 t2,
-      tif tfalse t1 t2 ⇒ t2
-  | ST_If : ∀t1 t1' t2 t3,
-      t1 ⇒ t1' →
-      tif t1 t2 t3 ⇒ tif t1' t2 t3
-
-  where " t '⇒' t' " := (step t t').
-
-
- -
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_PlusConstConst"
-  | Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2"
-  | Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ].
-
- -
-
- -
-Earlier, we separately proved for both plus- and if-expressions... - -
- -
    -
  • that the step relation was deterministic, and - -
    - - -
    • -
  • a strong progress lemma, stating that every term is either a - value or can take a step. - -
    • -
- Prove or disprove these two properties for the combined language. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-End Combined.
- -
-
- -
-

Small-Step Imp

- -
- - For a more serious example, here is the small-step version of the - Imp operational semantics. -
- - The small-step evaluation relations for arithmetic and boolean - expressions are straightforward extensions of the tiny language - we've been working up to now. To make them easier to read, we - introduce the symbolic notations ⇒a and ⇒b, respectively, - for the arithmetic and boolean step relations. -
-
- -
-Inductive aval : aexp → Prop :=
-  av_num : ∀n, aval (ANum n).
- -
-
- -
-We are not actually going to bother to define boolean - values, since they aren't needed in the definition of ⇒b - below (why?), though they might be if our language were a bit - larger (why?). -
-
- -
-Reserved Notation " t '/' st '⇒a' t' " (at level 40, st at level 39).
- -
-Inductive astep : state → aexp → aexp → Prop :=
-  | AS_Id : ∀st i,
-      AId i / st ⇒a ANum (st i)
-  | AS_Plus : ∀st n1 n2,
-      APlus (ANum n1) (ANum n2) / st ⇒a ANum (n1 + n2)
-  | AS_Plus1 : ∀st a1 a1' a2,
-      a1 / st ⇒a a1' →
-      (APlus a1 a2) / st ⇒a (APlus a1' a2)
-  | AS_Plus2 : ∀st v1 a2 a2',
-      aval v1 →
-      a2 / st ⇒a a2' →
-      (APlus v1 a2) / st ⇒a (APlus v1 a2')
-  | AS_Minus : ∀st n1 n2,
-      (AMinus (ANum n1) (ANum n2)) / st ⇒a (ANum (minus n1 n2))
-  | AS_Minus1 : ∀st a1 a1' a2,
-      a1 / st ⇒a a1' →
-      (AMinus a1 a2) / st ⇒a (AMinus a1' a2)
-  | AS_Minus2 : ∀st v1 a2 a2',
-      aval v1 →
-      a2 / st ⇒a a2' →
-      (AMinus v1 a2) / st ⇒a (AMinus v1 a2')
-  | AS_Mult : ∀st n1 n2,
-      (AMult (ANum n1) (ANum n2)) / st ⇒a (ANum (mult n1 n2))
-  | AS_Mult1 : ∀st a1 a1' a2,
-      a1 / st ⇒a a1' →
-      (AMult (a1) (a2)) / st ⇒a (AMult (a1') (a2))
-  | AS_Mult2 : ∀st v1 a2 a2',
-      aval v1 →
-      a2 / st ⇒a a2' →
-      (AMult v1 a2) / st ⇒a (AMult v1 a2')
-
-    where " t '/' st '⇒a' t' " := (astep st t t').
- -
-  Reserved Notation " t '/' st '⇒b' t' " (at level 40, st at level 39).
- -
-  Inductive bstep : state → bexp → bexp → Prop :=
-  | BS_Eq : ∀st n1 n2,
-      (BEq (ANum n1) (ANum n2)) / st ⇒b
-      (if (beq_nat n1 n2) then BTrue else BFalse)
-  | BS_Eq1 : ∀st a1 a1' a2,
-      a1 / st ⇒a a1' →
-      (BEq a1 a2) / st ⇒b (BEq a1' a2)
-  | BS_Eq2 : ∀st v1 a2 a2',
-      aval v1 →
-      a2 / st ⇒a a2' →
-      (BEq v1 a2) / st ⇒b (BEq v1 a2')
-  | BS_LtEq : ∀st n1 n2,
-      (BLe (ANum n1) (ANum n2)) / st ⇒b
-               (if (ble_nat n1 n2) then BTrue else BFalse)
-  | BS_LtEq1 : ∀st a1 a1' a2,
-      a1 / st ⇒a a1' →
-      (BLe a1 a2) / st ⇒b (BLe a1' a2)
-  | BS_LtEq2 : ∀st v1 a2 a2',
-      aval v1 →
-      a2 / st ⇒a a2' →
-      (BLe v1 a2) / st ⇒b (BLe v1 (a2'))
-  | BS_NotTrue : ∀st,
-      (BNot BTrue) / st ⇒b BFalse
-  | BS_NotFalse : ∀st,
-      (BNot BFalse) / st ⇒b BTrue
-  | BS_NotStep : ∀st b1 b1',
-      b1 / st ⇒b b1' →
-      (BNot b1) / st ⇒b (BNot b1')
-  | BS_AndTrueTrue : ∀st,
-      (BAnd BTrue BTrue) / st ⇒b BTrue
-  | BS_AndTrueFalse : ∀st,
-      (BAnd BTrue BFalse) / st ⇒b BFalse
-  | BS_AndFalse : ∀st b2,
-      (BAnd BFalse b2) / st ⇒b BFalse
-  | BS_AndTrueStep : ∀st b2 b2',
-      b2 / st ⇒b b2' →
-      (BAnd BTrue b2) / st ⇒b (BAnd BTrue b2')
-  | BS_AndStep : ∀st b1 b1' b2,
-      b1 / st ⇒b b1' →
-      (BAnd b1 b2) / st ⇒b (BAnd b1' b2)
-
-  where " t '/' st '⇒b' t' " := (bstep st t t').
- -
-
- -
-The semantics of commands is the interesting part. We need two - small tricks to make it work: - -
- -
    -
  • We use SKIP as a "command value" — i.e., a command that - has reached a normal form. - -
    - -
      -
    • An assignment command reduces to SKIP (and an updated - state). - -
      - - -
      • -
    • The sequencing command waits until its left-hand - subcommand has reduced to SKIP, then throws it away so - that reduction can continue with the right-hand - subcommand. - -
      - - -
      • -
    - -
    • -
  • We reduce a WHILE command by transforming it into a - conditional followed by the same WHILE. -
    • -
- -
- - (There are other ways of achieving the effect of the latter - trick, but they all share the feature that the original WHILE - command needs to be saved somewhere while a single copy of the loop - body is being evaluated.) -
-
- -
-Reserved Notation " t '/' st '⇒' t' '/' st' "
-                  (at level 40, st at level 39, t' at level 39).
- -
-Inductive cstep : (com × state) → (com × state) → Prop :=
-  | CS_AssStep : ∀st i a a',
-      a / st ⇒a a' →
-      (i ::= a) / st ⇒ (i ::= a') / st
-  | CS_Ass : ∀st i n,
-      (i ::= (ANum n)) / st ⇒ SKIP / (update st i n)
-  | CS_SeqStep : ∀st c1 c1' st' c2,
-      c1 / st ⇒ c1' / st' →
-      (c1 ;; c2) / st ⇒ (c1' ;; c2) / st'
-  | CS_SeqFinish : ∀st c2,
-      (SKIP ;; c2) / st ⇒ c2 / st
-  | CS_IfTrue : ∀st c1 c2,
-      IFB BTrue THEN c1 ELSE c2 FI / st ⇒ c1 / st
-  | CS_IfFalse : ∀st c1 c2,
-      IFB BFalse THEN c1 ELSE c2 FI / st ⇒ c2 / st
-  | CS_IfStep : ∀st b b' c1 c2,
-      b / st ⇒b b' →
-      IFB b THEN c1 ELSE c2 FI / st ⇒ (IFB b' THEN c1 ELSE c2 FI) / st
-  | CS_While : ∀st b c1,
-          (WHILE b DO c1 END) / st
-      ⇒ (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st
-
-  where " t '/' st '⇒' t' '/' st' " := (cstep (t,st) (t',st')).
- -
-
- -
-

Concurrent Imp

- -
- - Finally, to show the power of this definitional style, let's - enrich Imp with a new form of command that runs two subcommands in - parallel and terminates when both have terminated. To reflect the - unpredictability of scheduling, the actions of the subcommands may - be interleaved in any order, but they share the same memory and - can communicate by reading and writing the same variables. -
-
- -
-Module CImp.
- -
-Inductive com : Type :=
-  | CSkip : com
-  | CAss : id → aexp → com
-  | CSeq : com → com → com
-  | CIf : bexp → com → com → com
-  | CWhile : bexp → com → com
-  (* New: *)
-  | CPar : com → com → com.
-
-
- -
-Tactic Notation "com_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
-  | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "PAR" ].
-
- -
-Notation "'SKIP'" :=
-  CSkip.
-Notation "x '::=' a" :=
-  (CAss x a) (at level 60).
-Notation "c1 ;; c2" :=
-  (CSeq c1 c2) (at level 80, right associativity).
-Notation "'WHILE' b 'DO' c 'END'" :=
-  (CWhile b c) (at level 80, right associativity).
-Notation "'IFB' b 'THEN' c1 'ELSE' c2 'FI'" :=
-  (CIf b c1 c2) (at level 80, right associativity).
-Notation "'PAR' c1 'WITH' c2 'END'" :=
-  (CPar c1 c2) (at level 80, right associativity).
- -
-Inductive cstep : (com × state) → (com × state) → Prop :=
-    (* Old part *)
-  | CS_AssStep : ∀st i a a',
-      a / st ⇒a a' →
-      (i ::= a) / st ⇒ (i ::= a') / st
-  | CS_Ass : ∀st i n,
-      (i ::= (ANum n)) / st ⇒ SKIP / (update st i n)
-  | CS_SeqStep : ∀st c1 c1' st' c2,
-      c1 / st ⇒ c1' / st' →
-      (c1 ;; c2) / st ⇒ (c1' ;; c2) / st'
-  | CS_SeqFinish : ∀st c2,
-      (SKIP ;; c2) / st ⇒ c2 / st
-  | CS_IfTrue : ∀st c1 c2,
-      (IFB BTrue THEN c1 ELSE c2 FI) / st ⇒ c1 / st
-  | CS_IfFalse : ∀st c1 c2,
-      (IFB BFalse THEN c1 ELSE c2 FI) / st ⇒ c2 / st
-  | CS_IfStep : ∀st b b' c1 c2,
-      b /st ⇒b b' →
-      (IFB b THEN c1 ELSE c2 FI) / st ⇒ (IFB b' THEN c1 ELSE c2 FI) / st
-  | CS_While : ∀st b c1,
-      (WHILE b DO c1 END) / st ⇒
-               (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st
-    (* New part: *)
-  | CS_Par1 : ∀st c1 c1' c2 st',
-      c1 / st ⇒ c1' / st' →
-      (PAR c1 WITH c2 END) / st ⇒ (PAR c1' WITH c2 END) / st'
-  | CS_Par2 : ∀st c1 c2 c2' st',
-      c2 / st ⇒ c2' / st' →
-      (PAR c1 WITH c2 END) / st ⇒ (PAR c1 WITH c2' END) / st'
-  | CS_ParDone : ∀st,
-      (PAR SKIP WITH SKIP END) / st ⇒ SKIP / st
-  where " t '/' st '⇒' t' '/' st' " := (cstep (t,st) (t',st')).
- -
-Definition cmultistep := multi cstep.
- -
-Notation " t '/' st '⇒*' t' '/' st' " :=
-   (multi cstep (t,st) (t',st'))
-   (at level 40, st at level 39, t' at level 39).
- -
-
- -
-Among the many interesting properties of this language is the fact - that the following program can terminate with the variable X set - to any value... -
-
- -
-Definition par_loop : com :=
-  PAR
-    Y ::= ANum 1
-  WITH
-    WHILE BEq (AId Y) (ANum 0) DO
-      X ::= APlus (AId X) (ANum 1)
-    END
-  END.
- -
-
- -
-In particular, it can terminate with X set to 0: -
-
- -
-Example par_loop_example_0:
-  ∃st',
-       par_loop / empty_state ⇒* SKIP / st'
-    ∧ st' X = 0.
-
-
-Proof.
-  eapply ex_intro. split.
-  unfold par_loop.
-  eapply multi_step. apply CS_Par1.
-    apply CS_Ass.
-  eapply multi_step. apply CS_Par2. apply CS_While.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq1. apply AS_Id.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq. simpl.
-  eapply multi_step. apply CS_Par2. apply CS_IfFalse.
-  eapply multi_step. apply CS_ParDone.
-  eapply multi_refl.
-  reflexivity. Qed.
-
- -
-
- -
-It can also terminate with X set to 2: -
-
- -
-Example par_loop_example_2:
-  ∃st',
-       par_loop / empty_state ⇒* SKIP / st'
-    ∧ st' X = 2.
-
-
-Proof.
-  eapply ex_intro. split.
-  eapply multi_step. apply CS_Par2. apply CS_While.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq1. apply AS_Id.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq. simpl.
-  eapply multi_step. apply CS_Par2. apply CS_IfTrue.
-  eapply multi_step. apply CS_Par2. apply CS_SeqStep.
-    apply CS_AssStep. apply AS_Plus1. apply AS_Id.
-  eapply multi_step. apply CS_Par2. apply CS_SeqStep.
-    apply CS_AssStep. apply AS_Plus.
-  eapply multi_step. apply CS_Par2. apply CS_SeqStep.
-    apply CS_Ass.
-  eapply multi_step. apply CS_Par2. apply CS_SeqFinish.
- -
-  eapply multi_step. apply CS_Par2. apply CS_While.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq1. apply AS_Id.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq. simpl.
-  eapply multi_step. apply CS_Par2. apply CS_IfTrue.
-  eapply multi_step. apply CS_Par2. apply CS_SeqStep.
-    apply CS_AssStep. apply AS_Plus1. apply AS_Id.
-  eapply multi_step. apply CS_Par2. apply CS_SeqStep.
-    apply CS_AssStep. apply AS_Plus.
-  eapply multi_step. apply CS_Par2. apply CS_SeqStep.
-    apply CS_Ass.
- -
-  eapply multi_step. apply CS_Par1. apply CS_Ass.
-  eapply multi_step. apply CS_Par2. apply CS_SeqFinish.
-  eapply multi_step. apply CS_Par2. apply CS_While.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq1. apply AS_Id.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq. simpl.
-  eapply multi_step. apply CS_Par2. apply CS_IfFalse.
-  eapply multi_step. apply CS_ParDone.
-  eapply multi_refl.
-  reflexivity. Qed.
-
- -
-
- -
-More generally... -
- -

Exercise: 3 stars, optional

- -
-
-Lemma par_body_n__Sn : ∀n st,
-  st X = n ∧ st Y = 0 →
-  par_loop / st ⇒* par_loop / (update st X (S n)).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 3 stars, optional

- -
-
-Lemma par_body_n : ∀n st,
-  st X = 0 ∧ st Y = 0 →
-  ∃st',
-    par_loop / st ⇒* par_loop / st' ∧ st' X = n ∧ st' Y = 0.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - ... the above loop can exit with X having any value - whatsoever. -
-
- -
-Theorem par_loop_any_X:
-  ∀n, ∃st',
-    par_loop / empty_state ⇒* SKIP / st'
-    ∧ st' X = n.
-
-
-Proof.
-  intros n.
-  destruct (par_body_n n empty_state).
-    split; unfold update; reflexivity.
- -
-  rename x into st.
-  inversion H as [H' [HX HY]]; clear H.
-  ∃(update st Y 1). split.
-  eapply multi_trans with (par_loop,st). apply H'.
-  eapply multi_step. apply CS_Par1. apply CS_Ass.
-  eapply multi_step. apply CS_Par2. apply CS_While.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq1. apply AS_Id. rewrite update_eq.
-  eapply multi_step. apply CS_Par2. apply CS_IfStep.
-    apply BS_Eq. simpl.
-  eapply multi_step. apply CS_Par2. apply CS_IfFalse.
-  eapply multi_step. apply CS_ParDone.
-  apply multi_refl.
- -
-  rewrite update_neq. assumption. intro X; inversion X.
-Qed.
-
- -
-End CImp.
- -
-
- -
-

A Small-Step Stack Machine

- -
- - Last example: a small-step semantics for the stack machine example - from Imp.v. -
-
- -
-Definition stack := list nat.
-Definition prog := list sinstr.
- -
-Inductive stack_step : state → prog × stack → prog × stack → Prop :=
-  | SS_Push : ∀st stk n p',
-    stack_step st (SPush n :: p', stk) (p', n :: stk)
-  | SS_Load : ∀st stk i p',
-    stack_step st (SLoad i :: p', stk) (p', st i :: stk)
-  | SS_Plus : ∀st stk n m p',
-    stack_step st (SPlus :: p', n::m::stk) (p', (m+n)::stk)
-  | SS_Minus : ∀st stk n m p',
-    stack_step st (SMinus :: p', n::m::stk) (p', (m-n)::stk)
-  | SS_Mult : ∀st stk n m p',
-    stack_step st (SMult :: p', n::m::stk) (p', (m×n)::stk).
- -
-Theorem stack_step_deterministic : ∀st,
-  deterministic (stack_step st).
-
-
-Proof.
-  unfold deterministic. intros st x y1 y2 H1 H2.
-  induction H1; inversion H2; reflexivity.
-Qed.
-
- -
-Definition stack_multistep st := multi (stack_step st).
- -
-
- -
-

Exercise: 3 stars, advanced (compiler_is_correct)

- Remember the definition of compile for aexp given in the - Imp chapter. We want now to prove compile correct with respect - to the stack machine. - -
- - State what it means for the compiler to be correct according to - the stack machine small step semantics and then prove it. -
-
- -
-Definition compiler_is_correct_statement : Prop :=
-(* FILL IN HERE *) admit.
- -
-Theorem compiler_is_correct : compiler_is_correct_statement.
-Proof.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-(* $Date: 2014-04-02 10:55:30 -0400 (Wed, 02 Apr 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Smallstep.v b/Smallstep.v deleted file mode 100644 index 490535d..0000000 --- a/Smallstep.v +++ /dev/null @@ -1,1661 +0,0 @@ -(** * Smallstep: Small-step Operational Semantics *) - -Require Export Imp. - - - -(** The evaluators we have seen so far (e.g., the ones for - [aexp]s, [bexp]s, and commands) have been formulated in a - "big-step" style -- they specify how a given expression can be - evaluated to its final value (or a command plus a store to a final - store) "all in one big step." - - This style is simple and natural for many purposes -- indeed, - Gilles Kahn, who popularized its use, called it _natural - semantics_. But there are some things it does not do well. In - particular, it does not give us a natural way of talking about - _concurrent_ programming languages, where the "semantics" of a - program -- i.e., the essence of how it behaves -- is not just - which input states get mapped to which output states, but also - includes the intermediate states that it passes through along the - way, since these states can also be observed by concurrently - executing code. - - Another shortcoming of the big-step style is more technical, but - critical in some situations. To see the issue, suppose we wanted - to define a variant of Imp where variables could hold _either_ - numbers _or_ lists of numbers (see the [HoareList] chapter for - details). In the syntax of this extended language, it will be - possible to write strange expressions like [2 + nil], and our - semantics for arithmetic expressions will then need to say - something about how such expressions behave. One - possibility (explored in the [HoareList] chapter) is to maintain - the convention that every arithmetic expressions evaluates to some - number by choosing some way of viewing a list as a number -- e.g., - by specifying that a list should be interpreted as [0] when it - occurs in a context expecting a number. But this is really a bit - of a hack. - - A much more natural approach is simply to say that the behavior of - an expression like [2+nil] is _undefined_ -- it doesn't evaluate - to any result at all. And we can easily do this: we just have to - formulate [aeval] and [beval] as [Inductive] propositions rather - than Fixpoints, so that we can make them partial functions instead - of total ones. - - However, now we encounter a serious deficiency. In this language, - a command might _fail_ to map a given starting state to any ending - state for two quite different reasons: either because the - execution gets into an infinite loop or because, at some point, - the program tries to do an operation that makes no sense, such as - adding a number to a list, and none of the evaluation rules can be - applied. - - These two outcomes -- nontermination vs. getting stuck in an - erroneous configuration -- are quite different. In particular, we - want to allow the first (permitting the possibility of infinite - loops is the price we pay for the convenience of programming with - general looping constructs like [while]) but prevent the - second (which is just wrong), for example by adding some form of - _typechecking_ to the language. Indeed, this will be a major - topic for the rest of the course. As a first step, we need a - different way of presenting the semantics that allows us to - distinguish nontermination from erroneous "stuck states." - - So, for lots of reasons, we'd like to have a finer-grained way of - defining and reasoning about program behaviors. This is the topic - of the present chapter. We replace the "big-step" [eval] relation - with a "small-step" relation that specifies, for a given program, - how the "atomic steps" of computation are performed. *) - - -(* ########################################################### *) -(** * A Toy Language *) - -(** To save space in the discussion, let's go back to an - incredibly simple language containing just constants and - addition. (We use single letters -- [C] and [P] -- for the - constructor names, for brevity.) At the end of the chapter, we'll - see how to apply the same techniques to the full Imp language. *) - -Inductive tm : Type := - | C : nat -> tm (* Constant *) - | P : tm -> tm -> tm. (* Plus *) - -Tactic Notation "tm_cases" tactic(first) ident(c) := - first; - [ Case_aux c "C" | Case_aux c "P" ]. - -(** Here is a standard evaluator for this language, written in the - same (big-step) style as we've been using up to this point. *) - -Fixpoint evalF (t : tm) : nat := - match t with - | C n => n - | P a1 a2 => evalF a1 + evalF a2 - end. - -(** Now, here is the same evaluator, written in exactly the same - style, but formulated as an inductively defined relation. Again, - we use the notation [t || n] for "[t] evaluates to [n]." *) -(** - -------- (E_Const) - C n || n - - t1 || n1 - t2 || n2 - ---------------------- (E_Plus) - P t1 t2 || C (n1 + n2) -*) - -Reserved Notation " t '||' n " (at level 50, left associativity). - -Inductive eval : tm -> nat -> Prop := - | E_Const : forall n, - C n || n - | E_Plus : forall t1 t2 n1 n2, - t1 || n1 -> - t2 || n2 -> - P t1 t2 || (n1 + n2) - - where " t '||' n " := (eval t n). - -Tactic Notation "eval_cases" tactic(first) ident(c) := - first; - [ Case_aux c "E_Const" | Case_aux c "E_Plus" ]. - -Module SimpleArith1. - -(** Now, here is a small-step version. *) -(** - ------------------------------- (ST_PlusConstConst) - P (C n1) (C n2) ==> C (n1 + n2) - - t1 ==> t1' - -------------------- (ST_Plus1) - P t1 t2 ==> P t1' t2 - - t2 ==> t2' - --------------------------- (ST_Plus2) - P (C n1) t2 ==> P (C n1) t2' -*) - - - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall n1 t2 t2', - t2 ==> t2' -> - P (C n1) t2 ==> P (C n1) t2' - - where " t '==>' t' " := (step t t'). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_PlusConstConst" - | Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2" ]. - -(** Things to notice: - - - We are defining just a single reduction step, in which - one [P] node is replaced by its value. - - - Each step finds the _leftmost_ [P] node that is ready to - go (both of its operands are constants) and rewrites it in - place. The first rule tells how to rewrite this [P] node - itself; the other two rules tell how to find it. - - - A term that is just a constant cannot take a step. *) - - -(** Let's pause and check a couple of examples of reasoning with - the [step] relation... *) - -(** If [t1] can take a step to [t1'], then [P t1 t2] steps - to [P t1' t2]: *) - -Example test_step_1 : - P - (P (C 0) (C 3)) - (P (C 2) (C 4)) - ==> - P - (C (0 + 3)) - (P (C 2) (C 4)). -Proof. - apply ST_Plus1. apply ST_PlusConstConst. Qed. - -(** **** Exercise: 1 star (test_step_2) *) -(** Right-hand sides of sums can take a step only when the - left-hand side is finished: if [t2] can take a step to [t2'], - then [P (C n) t2] steps to [P (C n) - t2']: *) - -Example test_step_2 : - P - (C 0) - (P - (C 2) - (P (C 0) (C 3))) - ==> - P - (C 0) - (P - (C 2) - (C (0 + 3))). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - - -(* ########################################################### *) -(** * Relations *) - -(** We will be using several different step relations, so it is - helpful to generalize a bit... *) - -(** A (binary) _relation_ on a set [X] is a family of propositions - parameterized by two elements of [X] -- i.e., a proposition about - pairs of elements of [X]. *) - -Definition relation (X: Type) := X->X->Prop. - - -(** Our main examples of such relations in this chapter will be - the single-step and multi-step reduction relations on terms, [==>] - and [==>*], but there are many other examples -- some that come to - mind are the "equals," "less than," "less than or equal to," and - "is the square of" relations on numbers, and the "prefix of" - relation on lists and strings. *) - - -(** One simple property of the [==>] relation is that, like the - evaluation relation for our language of Imp programs, it is - _deterministic_. - - _Theorem_: For each [t], there is at most one [t'] such that [t] - steps to [t'] ([t ==> t'] is provable). Formally, this is the - same as saying that [==>] is deterministic. *) - -(** _Proof sketch_: We show that if [x] steps to both [y1] and [y2] - then [y1] and [y2] are equal, by induction on a derivation of - [step x y1]. There are several cases to consider, depending on - the last rule used in this derivation and in the given derivation - of [step x y2]. - - - If both are [ST_PlusConstConst], the result is immediate. - - - The cases when both derivations end with [ST_Plus1] or - [ST_Plus2] follow by the induction hypothesis. - - - It cannot happen that one is [ST_PlusConstConst] and the other - is [ST_Plus1] or [ST_Plus2], since this would imply that [x] has - the form [P t1 t2] where both [t1] and [t2] are - constants (by [ST_PlusConstConst]) _and_ one of [t1] or [t2] has - the form [P ...]. - - - Similarly, it cannot happen that one is [ST_Plus1] and the other - is [ST_Plus2], since this would imply that [x] has the form - [P t1 t2] where [t1] has both the form [P t1 t2] and - the form [C n]. [] *) - -Definition deterministic {X: Type} (R: relation X) := - forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. - -Theorem step_deterministic: - deterministic step. -Proof. - unfold deterministic. intros x y1 y2 Hy1 Hy2. - generalize dependent y2. - step_cases (induction Hy1) Case; intros y2 Hy2. - Case "ST_PlusConstConst". step_cases (inversion Hy2) SCase. - SCase "ST_PlusConstConst". reflexivity. - SCase "ST_Plus1". inversion H2. - SCase "ST_Plus2". inversion H2. - Case "ST_Plus1". step_cases (inversion Hy2) SCase. - SCase "ST_PlusConstConst". rewrite <- H0 in Hy1. inversion Hy1. - SCase "ST_Plus1". - rewrite <- (IHHy1 t1'0). - reflexivity. assumption. - SCase "ST_Plus2". rewrite <- H in Hy1. inversion Hy1. - Case "ST_Plus2". step_cases (inversion Hy2) SCase. - SCase "ST_PlusConstConst". rewrite <- H1 in Hy1. inversion Hy1. - SCase "ST_Plus1". inversion H2. - SCase "ST_Plus2". - rewrite <- (IHHy1 t2'0). - reflexivity. assumption. Qed. - -End SimpleArith1. - -(* ########################################################### *) -(** ** Values *) - -(** Let's take a moment to slightly generalize the way we state the - definition of single-step reduction. *) - -(** It is useful to think of the [==>] relation as defining an - _abstract machine_: - - - At any moment, the _state_ of the machine is a term. - - - A _step_ of the machine is an atomic unit of computation -- - here, a single "add" operation. - - - The _halting states_ of the machine are ones where there is no - more computation to be done. -*) -(** - We can then execute a term [t] as follows: - - - Take [t] as the starting state of the machine. - - - Repeatedly use the [==>] relation to find a sequence of - machine states, starting with [t], where each state steps to - the next. - - - When no more reduction is possible, "read out" the final state - of the machine as the result of execution. *) - -(** Intuitively, it is clear that the final states of the - machine are always terms of the form [C n] for some [n]. - We call such terms _values_. *) - -Inductive value : tm -> Prop := - v_const : forall n, value (C n). - -(** Having introduced the idea of values, we can use it in the - definition of the [==>] relation to write [ST_Plus2] rule in a - slightly more elegant way: *) - -(** - ------------------------------- (ST_PlusConstConst) - P (C n1) (C n2) ==> C (n1 + n2) - - t1 ==> t1' - -------------------- (ST_Plus1) - P t1 t2 ==> P t1' t2 - - value v1 - t2 ==> t2' - -------------------- (ST_Plus2) - P v1 t2 ==> P v1 t2' -*) -(** Again, the variable names here carry important information: - by convention, [v1] ranges only over values, while [t1] and [t2] - range over arbitrary terms. (Given this convention, the explicit - [value] hypothesis is arguably redundant. We'll keep it for now, - to maintain a close correspondence between the informal and Coq - versions of the rules, but later on we'll drop it in informal - rules, for the sake of brevity.) *) - -(** Here are the formal rules: *) - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) - ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> (* <----- n.b. *) - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' - - where " t '==>' t' " := (step t t'). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_PlusConstConst" - | Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2" ]. - -(** **** Exercise: 3 stars (redo_determinism) *) -(** As a sanity check on this change, let's re-verify determinism - - Proof sketch: We must show that if [x] steps to both [y1] and [y2] - then [y1] and [y2] are equal. Consider the final rules used in - the derivations of [step x y1] and [step x y2]. - - - If both are [ST_PlusConstConst], the result is immediate. - - - It cannot happen that one is [ST_PlusConstConst] and the other - is [ST_Plus1] or [ST_Plus2], since this would imply that [x] has - the form [P t1 t2] where both [t1] and [t2] are - constants (by [ST_PlusConstConst]) AND one of [t1] or [t2] has - the form [P ...]. - - - Similarly, it cannot happen that one is [ST_Plus1] and the other - is [ST_Plus2], since this would imply that [x] has the form - [P t1 t2] where [t1] both has the form [P t1 t2] and - is a value (hence has the form [C n]). - - - The cases when both derivations end with [ST_Plus1] or - [ST_Plus2] follow by the induction hypothesis. [] *) - -(** Most of this proof is the same as the one above. But to get - maximum benefit from the exercise you should try to write it from - scratch and just use the earlier one if you get stuck. *) - -Theorem step_deterministic : - deterministic step. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ########################################################### *) -(** ** Strong Progress and Normal Forms *) - -(** The definition of single-step reduction for our toy language is - fairly simple, but for a larger language it would be pretty easy - to forget one of the rules and create a situation where some term - cannot take a step even though it has not been completely reduced - to a value. The following theorem shows that we did not, in fact, - make such a mistake here. *) - -(** _Theorem_ (_Strong Progress_): If [t] is a term, then either [t] - is a value, or there exists a term [t'] such that [t ==> t']. *) - -(** _Proof_: By induction on [t]. - - - Suppose [t = C n]. Then [t] is a [value]. - - - Suppose [t = P t1 t2], where (by the IH) [t1] is either a - value or can step to some [t1'], and where [t2] is either a - value or can step to some [t2']. We must show [P t1 t2] is - either a value or steps to some [t']. - - - If [t1] and [t2] are both values, then [t] can take a step, by - [ST_PlusConstConst]. - - - If [t1] is a value and [t2] can take a step, then so can [t], - by [ST_Plus2]. - - - If [t1] can take a step, then so can [t], by [ST_Plus1]. [] *) - -Theorem strong_progress : forall t, - value t \/ (exists t', t ==> t'). -Proof. - tm_cases (induction t) Case. - Case "C". left. apply v_const. - Case "P". right. inversion IHt1. - SCase "l". inversion IHt2. - SSCase "l". inversion H. inversion H0. - exists (C (n + n0)). - apply ST_PlusConstConst. - SSCase "r". inversion H0 as [t' H1]. - exists (P t1 t'). - apply ST_Plus2. apply H. apply H1. - SCase "r". inversion H as [t' H0]. - exists (P t' t2). - apply ST_Plus1. apply H0. Qed. - -(** This important property is called _strong progress_, because - every term either is a value or can "make progress" by stepping to - some other term. (The qualifier "strong" distinguishes it from a - more refined version that we'll see in later chapters, called - simply "progress.") *) - -(** The idea of "making progress" can be extended to tell us something - interesting about [value]s: in this language [value]s are exactly - the terms that _cannot_ make progress in this sense. - - To state this observation formally, let's begin by giving a name - to terms that cannot make progress. We'll call them _normal - forms_. *) - -Definition normal_form {X:Type} (R:relation X) (t:X) : Prop := - ~ exists t', R t t'. - -(** This definition actually specifies what it is to be a normal form - for an _arbitrary_ relation [R] over an arbitrary set [X], not - just for the particular single-step reduction relation over terms - that we are interested in at the moment. We'll re-use the same - terminology for talking about other relations later in the - course. *) - -(** We can use this terminology to generalize the observation we made - in the strong progress theorem: in this language, normal forms and - values are actually the same thing. *) - -Lemma value_is_nf : forall v, - value v -> normal_form step v. -Proof. - unfold normal_form. intros v H. inversion H. - intros contra. inversion contra. inversion H1. -Qed. - -Lemma nf_is_value : forall t, - normal_form step t -> value t. -Proof. (* a corollary of [strong_progress]... *) - unfold normal_form. intros t H. - assert (G : value t \/ exists t', t ==> t'). - SCase "Proof of assertion". apply strong_progress. - inversion G. - SCase "l". apply H0. - SCase "r". apply ex_falso_quodlibet. apply H. assumption. Qed. - -Corollary nf_same_as_value : forall t, - normal_form step t <-> value t. -Proof. - split. apply nf_is_value. apply value_is_nf. Qed. - -(** Why is this interesting? - - Because [value] is a syntactic concept -- it is defined by looking - at the form of a term -- while [normal_form] is a semantic one -- - it is defined by looking at how the term steps. It is not obvious - that these concepts should coincide! - - Indeed, we could easily have written the definitions so that they - would not coincide... *) - -(* ##################################################### *) - -(** We might, for example, mistakenly define [value] so that it - includes some terms that are not finished reducing. *) - -Module Temp1. -(* Open an inner module so we can redefine value and step. *) - -Inductive value : tm -> Prop := -| v_const : forall n, value (C n) -| v_funny : forall t1 n2, (* <---- *) - value (P t1 (C n2)). - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' - - where " t '==>' t' " := (step t t'). - - - -(** **** Exercise: 3 stars, advanced (value_not_same_as_normal_form) *) -Lemma value_not_same_as_normal_form : - exists v, value v /\ ~ normal_form step v. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) -End Temp1. - -(* ##################################################### *) -(** Alternatively, we might mistakenly define [step] so that it - permits something designated as a value to reduce further. *) - -Module Temp2. - -Inductive value : tm -> Prop := -| v_const : forall n, value (C n). - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_Funny : forall n, (* <---- *) - C n ==> P (C n) (C 0) - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' - - where " t '==>' t' " := (step t t'). - - -(** **** Exercise: 2 stars, advanced (value_not_same_as_normal_form) *) -Lemma value_not_same_as_normal_form : - exists v, value v /\ ~ normal_form step v. -Proof. - (* FILL IN HERE *) Admitted. - -(** [] *) -End Temp2. - -(* ########################################################### *) -(** Finally, we might define [value] and [step] so that there is some - term that is not a value but that cannot take a step in the [step] - relation. Such terms are said to be _stuck_. In this case this is - caused by a mistake in the semantics, but we will also see - situations where, even in a correct language definition, it makes - sense to allow some terms to be stuck. *) - -Module Temp3. - -Inductive value : tm -> Prop := - | v_const : forall n, value (C n). - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - - where " t '==>' t' " := (step t t'). - -(** (Note that [ST_Plus2] is missing.) *) - -(** **** Exercise: 3 stars, advanced (value_not_same_as_normal_form') *) -Lemma value_not_same_as_normal_form : - exists t, ~ value t /\ normal_form step t. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -End Temp3. - -(* ########################################################### *) -(** *** Additional Exercises *) - -Module Temp4. - -(** Here is another very simple language whose terms, instead of being - just plus and numbers, are just the booleans true and false and a - conditional expression... *) - -Inductive tm : Type := - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. - -Inductive value : tm -> Prop := - | v_true : value ttrue - | v_false : value tfalse. - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 - | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 - - where " t '==>' t' " := (step t t'). - -(** **** Exercise: 1 star (smallstep_bools) *) -(** Which of the following propositions are provable? (This is just a - thought exercise, but for an extra challenge feel free to prove - your answers in Coq.) *) - -Definition bool_step_prop1 := - tfalse ==> tfalse. - -(* FILL IN HERE *) - -Definition bool_step_prop2 := - tif - ttrue - (tif ttrue ttrue ttrue) - (tif tfalse tfalse tfalse) - ==> - ttrue. - -(* FILL IN HERE *) - -Definition bool_step_prop3 := - tif - (tif ttrue ttrue ttrue) - (tif ttrue ttrue ttrue) - tfalse - ==> - tif - ttrue - (tif ttrue ttrue ttrue) - tfalse. - -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 3 stars, optional (progress_bool) *) -(** Just as we proved a progress theorem for plus expressions, we can - do so for boolean expressions, as well. *) - -Theorem strong_progress : forall t, - value t \/ (exists t', t ==> t'). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars, optional (step_deterministic) *) -Theorem step_deterministic : - deterministic step. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -Module Temp5. - -(** **** Exercise: 2 stars (smallstep_bool_shortcut) *) -(** Suppose we want to add a "short circuit" to the step relation for - boolean expressions, so that it can recognize when the [then] and - [else] branches of a conditional are the same value (either - [ttrue] or [tfalse]) and reduce the whole conditional to this - value in a single step, even if the guard has not yet been reduced - to a value. For example, we would like this proposition to be - provable: - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse - ==> - tfalse. -*) - -(** Write an extra clause for the step relation that achieves this - effect and prove [bool_step_prop4]. *) - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 - | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 -(* FILL IN HERE *) - - where " t '==>' t' " := (step t t'). -(** [] *) - -Definition bool_step_prop4 := - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse - ==> - tfalse. - -Example bool_step_prop4_holds : - bool_step_prop4. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional (properties_of_altered_step) *) -(** It can be shown that the determinism and strong progress theorems - for the step relation in the lecture notes also hold for the - definition of step given above. After we add the clause - [ST_ShortCircuit]... - - - Is the [step] relation still deterministic? Write yes or no and - briefly (1 sentence) explain your answer. - - Optional: prove your answer correct in Coq. -*) - -(* FILL IN HERE *) -(** - - Does a strong progress theorem hold? Write yes or no and - briefly (1 sentence) explain your answer. - - Optional: prove your answer correct in Coq. -*) - -(* FILL IN HERE *) -(** - - In general, is there any way we could cause strong progress to - fail if we took away one or more constructors from the original - step relation? Write yes or no and briefly (1 sentence) explain - your answer. - -(* FILL IN HERE *) -*) -(** [] *) - -End Temp5. -End Temp4. - -(* ########################################################### *) -(** * Multi-Step Reduction *) - -(** Until now, we've been working with the _single-step reduction_ - relation [==>], which formalizes the individual steps of an - _abstract machine_ for executing programs. - - We can also use this machine to reduce programs to completion -- - to find out what final result they yield. This can be formalized - as follows: - - - First, we define a _multi-step reduction relation_ [==>*], which - relates terms [t] and [t'] if [t] can reach [t'] by any number - of single reduction steps (including zero steps!). - - - Then we define a "result" of a term [t] as a normal form that - [t] can reach by multi-step reduction. *) - -(* ########################################################### *) - -(** Since we'll want to reuse the idea of multi-step reduction many - times in this and future chapters, let's take a little extra - trouble here and define it generically. - - Given a relation [R], we define a relation [multi R], called the - _multi-step closure of [R]_ as follows: *) - -Inductive multi {X:Type} (R: relation X) : relation X := - | multi_refl : forall (x : X), multi R x x - | multi_step : forall (x y z : X), - R x y -> - multi R y z -> - multi R x z. - -(** The effect of this definition is that [multi R] relates two - elements [x] and [y] if either - - - [x = y], or else - - there is some sequence [z1], [z2], ..., [zn] - such that - R x z1 - R z1 z2 - ... - R zn y. - - Thus, if [R] describes a single-step of computation, [z1], - ... [zn] is the sequence of intermediate steps of computation - between [x] and [y]. -*) - -Tactic Notation "multi_cases" tactic(first) ident(c) := - first; - [ Case_aux c "multi_refl" | Case_aux c "multi_step" ]. - -(** We write [==>*] for the [multi step] relation -- i.e., the - relation that relates two terms [t] and [t'] if we can get from - [t] to [t'] using the [step] relation zero or more times. *) - -Definition multistep := multi step. -Notation " t '==>*' t' " := (multistep t t') (at level 40). - -(** The relation [multi R] has several crucial properties. - - First, it is obviously _reflexive_ (that is, [forall x, multi R x - x]). In the case of the [==>*] (i.e. [multi step]) relation, the - intuition is that a term can execute to itself by taking zero - steps of execution. - - Second, it contains [R] -- that is, single-step executions are a - particular case of multi-step executions. (It is this fact that - justifies the word "closure" in the term "multi-step closure of - [R].") *) - -Theorem multi_R : forall (X:Type) (R:relation X) (x y : X), - R x y -> (multi R) x y. -Proof. - intros X R x y H. - apply multi_step with y. apply H. apply multi_refl. Qed. - -(** Third, [multi R] is _transitive_. *) - -Theorem multi_trans : - forall (X:Type) (R: relation X) (x y z : X), - multi R x y -> - multi R y z -> - multi R x z. -Proof. - intros X R x y z G H. - multi_cases (induction G) Case. - Case "multi_refl". assumption. - Case "multi_step". - apply multi_step with y. assumption. - apply IHG. assumption. Qed. - -(** That is, if [t1==>*t2] and [t2==>*t3], then [t1==>*t3]. *) - -(* ########################################################### *) -(** ** Examples *) - -Lemma test_multistep_1: - P - (P (C 0) (C 3)) - (P (C 2) (C 4)) - ==>* - C ((0 + 3) + (2 + 4)). -Proof. - apply multi_step with - (P - (C (0 + 3)) - (P (C 2) (C 4))). - apply ST_Plus1. apply ST_PlusConstConst. - apply multi_step with - (P - (C (0 + 3)) - (C (2 + 4))). - apply ST_Plus2. apply v_const. - apply ST_PlusConstConst. - apply multi_R. - apply ST_PlusConstConst. Qed. - -(** Here's an alternate proof that uses [eapply] to avoid explicitly - constructing all the intermediate terms. *) - -Lemma test_multistep_1': - P - (P (C 0) (C 3)) - (P (C 2) (C 4)) - ==>* - C ((0 + 3) + (2 + 4)). -Proof. - eapply multi_step. apply ST_Plus1. apply ST_PlusConstConst. - eapply multi_step. apply ST_Plus2. apply v_const. - apply ST_PlusConstConst. - eapply multi_step. apply ST_PlusConstConst. - apply multi_refl. Qed. - -(** **** Exercise: 1 star, optional (test_multistep_2) *) -Lemma test_multistep_2: - C 3 ==>* C 3. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (test_multistep_3) *) -Lemma test_multistep_3: - P (C 0) (C 3) - ==>* - P (C 0) (C 3). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (test_multistep_4) *) -Lemma test_multistep_4: - P - (C 0) - (P - (C 2) - (P (C 0) (C 3))) - ==>* - P - (C 0) - (C (2 + (0 + 3))). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ########################################################### *) -(** ** Normal Forms Again *) - -(** If [t] reduces to [t'] in zero or more steps and [t'] is a - normal form, we say that "[t'] is a normal form of [t]." *) - -Definition step_normal_form := normal_form step. - -Definition normal_form_of (t t' : tm) := - (t ==>* t' /\ step_normal_form t'). - -(** We have already seen that, for our language, single-step reduction is - deterministic -- i.e., a given term can take a single step in - at most one way. It follows from this that, if [t] can reach - a normal form, then this normal form is unique. In other words, we - can actually pronounce [normal_form t t'] as "[t'] is _the_ - normal form of [t]." *) - -(** **** Exercise: 3 stars, optional (normal_forms_unique) *) -Theorem normal_forms_unique: - deterministic normal_form_of. -Proof. - unfold deterministic. unfold normal_form_of. intros x y1 y2 P1 P2. - inversion P1 as [P11 P12]; clear P1. inversion P2 as [P21 P22]; clear P2. - generalize dependent y2. - (* We recommend using this initial setup as-is! *) - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Indeed, something stronger is true for this language (though not - for all languages): the reduction of _any_ term [t] will - eventually reach a normal form -- i.e., [normal_form_of] is a - _total_ function. Formally, we say the [step] relation is - _normalizing_. *) - -Definition normalizing {X:Type} (R:relation X) := - forall t, exists t', - (multi R) t t' /\ normal_form R t'. - -(** To prove that [step] is normalizing, we need a couple of lemmas. - - First, we observe that, if [t] reduces to [t'] in many steps, then - the same sequence of reduction steps within [t] is also possible - when [t] appears as the left-hand child of a [P] node, and - similarly when [t] appears as the right-hand child of a [P] - node whose left-hand child is a value. *) - -Lemma multistep_congr_1 : forall t1 t1' t2, - t1 ==>* t1' -> - P t1 t2 ==>* P t1' t2. -Proof. - intros t1 t1' t2 H. multi_cases (induction H) Case. - Case "multi_refl". apply multi_refl. - Case "multi_step". apply multi_step with (P y t2). - apply ST_Plus1. apply H. - apply IHmulti. Qed. - -(** **** Exercise: 2 stars (multistep_congr_2) *) -Lemma multistep_congr_2 : forall t1 t2 t2', - value t1 -> - t2 ==>* t2' -> - P t1 t2 ==>* P t1 t2'. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** _Theorem_: The [step] function is normalizing -- i.e., for every - [t] there exists some [t'] such that [t] steps to [t'] and [t'] is - a normal form. - - _Proof sketch_: By induction on terms. There are two cases to - consider: - - - [t = C n] for some [n]. Here [t] doesn't take a step, - and we have [t' = t]. We can derive the left-hand side by - reflexivity and the right-hand side by observing (a) that values - are normal forms (by [nf_same_as_value]) and (b) that [t] is a - value (by [v_const]). - - - [t = P t1 t2] for some [t1] and [t2]. By the IH, [t1] and - [t2] have normal forms [t1'] and [t2']. Recall that normal - forms are values (by [nf_same_as_value]); we know that [t1' = - C n1] and [t2' = C n2], for some [n1] and [n2]. - We can combine the [==>*] derivations for [t1] and [t2] to prove - that [P t1 t2] reduces in many steps to [C (n1 + n2)]. - - It is clear that our choice of [t' = C (n1 + n2)] is a - value, which is in turn a normal form. [] *) - -Theorem step_normalizing : - normalizing step. -Proof. - unfold normalizing. - tm_cases (induction t) Case. - Case "C". - exists (C n). - split. - SCase "l". apply multi_refl. - SCase "r". - (* We can use [rewrite] with "iff" statements, not - just equalities: *) - rewrite nf_same_as_value. apply v_const. - Case "P". - inversion IHt1 as [t1' H1]; clear IHt1. inversion IHt2 as [t2' H2]; clear IHt2. - inversion H1 as [H11 H12]; clear H1. inversion H2 as [H21 H22]; clear H2. - rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22. - inversion H12 as [n1]. inversion H22 as [n2]. - rewrite <- H in H11. - rewrite <- H0 in H21. - exists (C (n1 + n2)). - split. - SCase "l". - apply multi_trans with (P (C n1) t2). - apply multistep_congr_1. apply H11. - apply multi_trans with - (P (C n1) (C n2)). - apply multistep_congr_2. apply v_const. apply H21. - apply multi_R. apply ST_PlusConstConst. - SCase "r". - rewrite nf_same_as_value. apply v_const. Qed. - -(* ########################################################### *) -(** ** Equivalence of Big-Step and Small-Step Reduction *) - -(** Having defined the operational semantics of our tiny programming - language in two different styles, it makes sense to ask whether - these definitions actually define the same thing! They do, though - it takes a little work to show it. (The details are left as an - exercise). *) - -(** **** Exercise: 3 stars (eval__multistep) *) -Theorem eval__multistep : forall t n, - t || n -> t ==>* C n. - -(** The key idea behind the proof comes from the following picture: - P t1 t2 ==> (by ST_Plus1) - P t1' t2 ==> (by ST_Plus1) - P t1'' t2 ==> (by ST_Plus1) - ... - P (C n1) t2 ==> (by ST_Plus2) - P (C n1) t2' ==> (by ST_Plus2) - P (C n1) t2'' ==> (by ST_Plus2) - ... - P (C n1) (C n2) ==> (by ST_PlusConstConst) - C (n1 + n2) - That is, the multistep reduction of a term of the form [P t1 t2] - proceeds in three phases: - - First, we use [ST_Plus1] some number of times to reduce [t1] - to a normal form, which must (by [nf_same_as_value]) be a - term of the form [C n1] for some [n1]. - - Next, we use [ST_Plus2] some number of times to reduce [t2] - to a normal form, which must again be a term of the form [C - n2] for some [n2]. - - Finally, we use [ST_PlusConstConst] one time to reduce [P (C - n1) (C n2)] to [C (n1 + n2)]. *) - -(** To formalize this intuition, you'll need to use the congruence - lemmas from above (you might want to review them now, so that - you'll be able to recognize when they are useful), plus some basic - properties of [==>*]: that it is reflexive, transitive, and - includes [==>]. *) - -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (eval__multistep_inf) *) -(** Write a detailed informal version of the proof of [eval__multistep]. - -(* FILL IN HERE *) -[] -*) -(** For the other direction, we need one lemma, which establishes a - relation between single-step reduction and big-step evaluation. *) - -(** **** Exercise: 3 stars (step__eval) *) -Lemma step__eval : forall t t' n, - t ==> t' -> - t' || n -> - t || n. -Proof. - intros t t' n Hs. generalize dependent n. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** The fact that small-step reduction implies big-step is now - straightforward to prove, once it is stated correctly. - - The proof proceeds by induction on the multi-step reduction - sequence that is buried in the hypothesis [normal_form_of t t']. *) -(** Make sure you understand the statement before you start to - work on the proof. *) - -(** **** Exercise: 3 stars (multistep__eval) *) -Theorem multistep__eval : forall t t', - normal_form_of t t' -> exists n, t' = C n /\ t || n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ########################################################### *) -(** ** Additional Exercises *) - -(** **** Exercise: 3 stars, optional (interp_tm) *) -(** Remember that we also defined big-step evaluation of [tm]s as a - function [evalF]. Prove that it is equivalent to the existing - semantics. - - Hint: we just proved that [eval] and [multistep] are - equivalent, so logically it doesn't matter which you choose. - One will be easier than the other, though! *) - -Theorem evalF_eval : forall t n, - evalF t = n <-> t || n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 4 stars (combined_properties) *) -(** We've considered the arithmetic and conditional expressions - separately. This exercise explores how the two interact. *) - -Module Combined. - -Inductive tm : Type := - | C : nat -> tm - | P : tm -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. - -Tactic Notation "tm_cases" tactic(first) ident(c) := - first; - [ Case_aux c "C" | Case_aux c "P" - | Case_aux c "ttrue" | Case_aux c "tfalse" | Case_aux c "tif" ]. - -Inductive value : tm -> Prop := - | v_const : forall n, value (C n) - | v_true : value ttrue - | v_false : value tfalse. - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' - | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 - | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 - - where " t '==>' t' " := (step t t'). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_PlusConstConst" - | Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2" - | Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ]. - -(** Earlier, we separately proved for both plus- and if-expressions... - - - that the step relation was deterministic, and - - - a strong progress lemma, stating that every term is either a - value or can take a step. - - Prove or disprove these two properties for the combined language. *) - -(* FILL IN HERE *) -(** [] *) - -End Combined. - - -(* ########################################################### *) -(** * Small-Step Imp *) - -(** For a more serious example, here is the small-step version of the - Imp operational semantics. *) - -(** The small-step evaluation relations for arithmetic and boolean - expressions are straightforward extensions of the tiny language - we've been working up to now. To make them easier to read, we - introduce the symbolic notations [==>a] and [==>b], respectively, - for the arithmetic and boolean step relations. *) - -Inductive aval : aexp -> Prop := - av_num : forall n, aval (ANum n). - -(** We are not actually going to bother to define boolean - values, since they aren't needed in the definition of [==>b] - below (why?), though they might be if our language were a bit - larger (why?). *) - -Reserved Notation " t '/' st '==>a' t' " (at level 40, st at level 39). - -Inductive astep : state -> aexp -> aexp -> Prop := - | AS_Id : forall st i, - AId i / st ==>a ANum (st i) - | AS_Plus : forall st n1 n2, - APlus (ANum n1) (ANum n2) / st ==>a ANum (n1 + n2) - | AS_Plus1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (APlus a1 a2) / st ==>a (APlus a1' a2) - | AS_Plus2 : forall st v1 a2 a2', - aval v1 -> - a2 / st ==>a a2' -> - (APlus v1 a2) / st ==>a (APlus v1 a2') - | AS_Minus : forall st n1 n2, - (AMinus (ANum n1) (ANum n2)) / st ==>a (ANum (minus n1 n2)) - | AS_Minus1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (AMinus a1 a2) / st ==>a (AMinus a1' a2) - | AS_Minus2 : forall st v1 a2 a2', - aval v1 -> - a2 / st ==>a a2' -> - (AMinus v1 a2) / st ==>a (AMinus v1 a2') - | AS_Mult : forall st n1 n2, - (AMult (ANum n1) (ANum n2)) / st ==>a (ANum (mult n1 n2)) - | AS_Mult1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (AMult (a1) (a2)) / st ==>a (AMult (a1') (a2)) - | AS_Mult2 : forall st v1 a2 a2', - aval v1 -> - a2 / st ==>a a2' -> - (AMult v1 a2) / st ==>a (AMult v1 a2') - - where " t '/' st '==>a' t' " := (astep st t t'). - - Reserved Notation " t '/' st '==>b' t' " (at level 40, st at level 39). - - Inductive bstep : state -> bexp -> bexp -> Prop := - | BS_Eq : forall st n1 n2, - (BEq (ANum n1) (ANum n2)) / st ==>b - (if (beq_nat n1 n2) then BTrue else BFalse) - | BS_Eq1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (BEq a1 a2) / st ==>b (BEq a1' a2) - | BS_Eq2 : forall st v1 a2 a2', - aval v1 -> - a2 / st ==>a a2' -> - (BEq v1 a2) / st ==>b (BEq v1 a2') - | BS_LtEq : forall st n1 n2, - (BLe (ANum n1) (ANum n2)) / st ==>b - (if (ble_nat n1 n2) then BTrue else BFalse) - | BS_LtEq1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (BLe a1 a2) / st ==>b (BLe a1' a2) - | BS_LtEq2 : forall st v1 a2 a2', - aval v1 -> - a2 / st ==>a a2' -> - (BLe v1 a2) / st ==>b (BLe v1 (a2')) - | BS_NotTrue : forall st, - (BNot BTrue) / st ==>b BFalse - | BS_NotFalse : forall st, - (BNot BFalse) / st ==>b BTrue - | BS_NotStep : forall st b1 b1', - b1 / st ==>b b1' -> - (BNot b1) / st ==>b (BNot b1') - | BS_AndTrueTrue : forall st, - (BAnd BTrue BTrue) / st ==>b BTrue - | BS_AndTrueFalse : forall st, - (BAnd BTrue BFalse) / st ==>b BFalse - | BS_AndFalse : forall st b2, - (BAnd BFalse b2) / st ==>b BFalse - | BS_AndTrueStep : forall st b2 b2', - b2 / st ==>b b2' -> - (BAnd BTrue b2) / st ==>b (BAnd BTrue b2') - | BS_AndStep : forall st b1 b1' b2, - b1 / st ==>b b1' -> - (BAnd b1 b2) / st ==>b (BAnd b1' b2) - - where " t '/' st '==>b' t' " := (bstep st t t'). - -(** The semantics of commands is the interesting part. We need two - small tricks to make it work: - - - We use [SKIP] as a "command value" -- i.e., a command that - has reached a normal form. - - - An assignment command reduces to [SKIP] (and an updated - state). - - - The sequencing command waits until its left-hand - subcommand has reduced to [SKIP], then throws it away so - that reduction can continue with the right-hand - subcommand. - - - We reduce a [WHILE] command by transforming it into a - conditional followed by the same [WHILE]. *) - -(** (There are other ways of achieving the effect of the latter - trick, but they all share the feature that the original [WHILE] - command needs to be saved somewhere while a single copy of the loop - body is being evaluated.) *) - -Reserved Notation " t '/' st '==>' t' '/' st' " - (at level 40, st at level 39, t' at level 39). - -Inductive cstep : (com * state) -> (com * state) -> Prop := - | CS_AssStep : forall st i a a', - a / st ==>a a' -> - (i ::= a) / st ==> (i ::= a') / st - | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ==> SKIP / (update st i n) - | CS_SeqStep : forall st c1 c1' st' c2, - c1 / st ==> c1' / st' -> - (c1 ;; c2) / st ==> (c1' ;; c2) / st' - | CS_SeqFinish : forall st c2, - (SKIP ;; c2) / st ==> c2 / st - | CS_IfTrue : forall st c1 c2, - IFB BTrue THEN c1 ELSE c2 FI / st ==> c1 / st - | CS_IfFalse : forall st c1 c2, - IFB BFalse THEN c1 ELSE c2 FI / st ==> c2 / st - | CS_IfStep : forall st b b' c1 c2, - b / st ==>b b' -> - IFB b THEN c1 ELSE c2 FI / st ==> (IFB b' THEN c1 ELSE c2 FI) / st - | CS_While : forall st b c1, - (WHILE b DO c1 END) / st - ==> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st - - where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). - - -(* ########################################################### *) -(** * Concurrent Imp *) - -(** Finally, to show the power of this definitional style, let's - enrich Imp with a new form of command that runs two subcommands in - parallel and terminates when both have terminated. To reflect the - unpredictability of scheduling, the actions of the subcommands may - be interleaved in any order, but they share the same memory and - can communicate by reading and writing the same variables. *) - -Module CImp. - -Inductive com : Type := - | CSkip : com - | CAss : id -> aexp -> com - | CSeq : com -> com -> com - | CIf : bexp -> com -> com -> com - | CWhile : bexp -> com -> com - (* New: *) - | CPar : com -> com -> com. - -Tactic Notation "com_cases" tactic(first) ident(c) := - first; - [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";" - | Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "PAR" ]. - -Notation "'SKIP'" := - CSkip. -Notation "x '::=' a" := - (CAss x a) (at level 60). -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' b 'THEN' c1 'ELSE' c2 'FI'" := - (CIf b c1 c2) (at level 80, right associativity). -Notation "'PAR' c1 'WITH' c2 'END'" := - (CPar c1 c2) (at level 80, right associativity). - -Inductive cstep : (com * state) -> (com * state) -> Prop := - (* Old part *) - | CS_AssStep : forall st i a a', - a / st ==>a a' -> - (i ::= a) / st ==> (i ::= a') / st - | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ==> SKIP / (update st i n) - | CS_SeqStep : forall st c1 c1' st' c2, - c1 / st ==> c1' / st' -> - (c1 ;; c2) / st ==> (c1' ;; c2) / st' - | CS_SeqFinish : forall st c2, - (SKIP ;; c2) / st ==> c2 / st - | CS_IfTrue : forall st c1 c2, - (IFB BTrue THEN c1 ELSE c2 FI) / st ==> c1 / st - | CS_IfFalse : forall st c1 c2, - (IFB BFalse THEN c1 ELSE c2 FI) / st ==> c2 / st - | CS_IfStep : forall st b b' c1 c2, - b /st ==>b b' -> - (IFB b THEN c1 ELSE c2 FI) / st ==> (IFB b' THEN c1 ELSE c2 FI) / st - | CS_While : forall st b c1, - (WHILE b DO c1 END) / st ==> - (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st - (* New part: *) - | CS_Par1 : forall st c1 c1' c2 st', - c1 / st ==> c1' / st' -> - (PAR c1 WITH c2 END) / st ==> (PAR c1' WITH c2 END) / st' - | CS_Par2 : forall st c1 c2 c2' st', - c2 / st ==> c2' / st' -> - (PAR c1 WITH c2 END) / st ==> (PAR c1 WITH c2' END) / st' - | CS_ParDone : forall st, - (PAR SKIP WITH SKIP END) / st ==> SKIP / st - where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). - - -Definition cmultistep := multi cstep. - -Notation " t '/' st '==>*' t' '/' st' " := - (multi cstep (t,st) (t',st')) - (at level 40, st at level 39, t' at level 39). - - - - - -(** Among the many interesting properties of this language is the fact - that the following program can terminate with the variable [X] set - to any value... *) - -Definition par_loop : com := - PAR - Y ::= ANum 1 - WITH - WHILE BEq (AId Y) (ANum 0) DO - X ::= APlus (AId X) (ANum 1) - END - END. - -(** In particular, it can terminate with [X] set to [0]: *) - -Example par_loop_example_0: - exists st', - par_loop / empty_state ==>* SKIP / st' - /\ st' X = 0. -Proof. - eapply ex_intro. split. - unfold par_loop. - eapply multi_step. apply CS_Par1. - apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfFalse. - eapply multi_step. apply CS_ParDone. - eapply multi_refl. - reflexivity. Qed. - -(** It can also terminate with [X] set to [2]: *) - -Example par_loop_example_2: - exists st', - par_loop / empty_state ==>* SKIP / st' - /\ st' X = 2. -Proof. - eapply ex_intro. split. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfTrue. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_SeqFinish. - - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfTrue. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_Ass. - - eapply multi_step. apply CS_Par1. apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_SeqFinish. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfFalse. - eapply multi_step. apply CS_ParDone. - eapply multi_refl. - reflexivity. Qed. - -(** More generally... *) - -(** **** Exercise: 3 stars, optional *) -Lemma par_body_n__Sn : forall n st, - st X = n /\ st Y = 0 -> - par_loop / st ==>* par_loop / (update st X (S n)). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, optional *) -Lemma par_body_n : forall n st, - st X = 0 /\ st Y = 0 -> - exists st', - par_loop / st ==>* par_loop / st' /\ st' X = n /\ st' Y = 0. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** ... the above loop can exit with [X] having any value - whatsoever. *) - -Theorem par_loop_any_X: - forall n, exists st', - par_loop / empty_state ==>* SKIP / st' - /\ st' X = n. -Proof. - intros n. - destruct (par_body_n n empty_state). - split; unfold update; reflexivity. - - rename x into st. - inversion H as [H' [HX HY]]; clear H. - exists (update st Y 1). split. - eapply multi_trans with (par_loop,st). apply H'. - eapply multi_step. apply CS_Par1. apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. rewrite update_eq. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfFalse. - eapply multi_step. apply CS_ParDone. - apply multi_refl. - - rewrite update_neq. assumption. intro X; inversion X. -Qed. - -End CImp. - -(* ########################################################### *) -(** * A Small-Step Stack Machine *) - -(** Last example: a small-step semantics for the stack machine example - from Imp.v. *) - -Definition stack := list nat. -Definition prog := list sinstr. - -Inductive stack_step : state -> prog * stack -> prog * stack -> Prop := - | SS_Push : forall st stk n p', - stack_step st (SPush n :: p', stk) (p', n :: stk) - | SS_Load : forall st stk i p', - stack_step st (SLoad i :: p', stk) (p', st i :: stk) - | SS_Plus : forall st stk n m p', - stack_step st (SPlus :: p', n::m::stk) (p', (m+n)::stk) - | SS_Minus : forall st stk n m p', - stack_step st (SMinus :: p', n::m::stk) (p', (m-n)::stk) - | SS_Mult : forall st stk n m p', - stack_step st (SMult :: p', n::m::stk) (p', (m*n)::stk). - -Theorem stack_step_deterministic : forall st, - deterministic (stack_step st). -Proof. - unfold deterministic. intros st x y1 y2 H1 H2. - induction H1; inversion H2; reflexivity. -Qed. - -Definition stack_multistep st := multi (stack_step st). - -(** **** Exercise: 3 stars, advanced (compiler_is_correct) *) -(** Remember the definition of [compile] for [aexp] given in the - [Imp] chapter. We want now to prove [compile] correct with respect - to the stack machine. - - State what it means for the compiler to be correct according to - the stack machine small step semantics and then prove it. *) - -Definition compiler_is_correct_statement : Prop := -(* FILL IN HERE *) admit. - - -Theorem compiler_is_correct : compiler_is_correct_statement. -Proof. -(* FILL IN HERE *) Admitted. -(** [] *) - -(* $Date: 2014-04-02 10:55:30 -0400 (Wed, 02 Apr 2014) $ *) - - diff --git a/Stlc.html b/Stlc.html deleted file mode 100644 index 7397e5a..0000000 --- a/Stlc.html +++ /dev/null @@ -1,1595 +0,0 @@ - - - - - -Stlc: The Simply Typed Lambda-Calculus - - - - - - -
- - - -
- -

StlcThe Simply Typed Lambda-Calculus

- -
-
- -
- -
-
- -
-Require Export Types.
- -
-
- -
-

The Simply Typed Lambda-Calculus

- -
- - The simply typed lambda-calculus (STLC) is a tiny core calculus - embodying the key concept of functional abstraction, which shows - up in pretty much every real-world programming language in some - form (functions, procedures, methods, etc.). - -
- - We will follow exactly the same pattern as in the previous - chapter when formalizing this calculus (syntax, small-step - semantics, typing rules) and its main properties (progress and - preservation). The new technical challenges (which will take some - work to deal with) all arise from the mechanisms of variable - binding and substitution. -
-
- -
-
- -
-

Overview

- -
- - The STLC is built on some collection of base types — booleans, - numbers, strings, etc. The exact choice of base types doesn't - matter — the construction of the language and its theoretical - properties work out pretty much the same — so for the sake of - brevity let's take just Bool for the moment. At the end of the - chapter we'll see how to add more base types, and in later - chapters we'll enrich the pure STLC with other useful constructs - like pairs, records, subtyping, and mutable state. - -
- - Starting from the booleans, we add three things: - -
- -
    -
  • variables - -
    • -
  • function abstractions - -
    • -
  • application - -
    • -
- -
- - This gives us the following collection of abstract syntax - constructors (written out here in informal BNF notation — we'll - formalize it below). - -
- - -
- - Informal concrete syntax: - -
- -
-       t ::= x                       variable
-           | \x:T1.t2                abstraction
-           | t1 t2                   application
-           | true                    constant true
-           | false                   constant false
-           | if t1 then t2 else t3   conditional -
- -
- -
- - The \ symbol (backslash, in ascii) in a function abstraction - \x:T1.t2 is generally written as a greek letter "lambda" (hence - the name of the calculus). The variable x is called the - parameter to the function; the term t1 is its body. The - annotation :T specifies the type of arguments that the function - can be applied to. -
- - Some examples: - -
- -
    -
  • \x:Bool. x - -
    - - The identity function for booleans. - -
    - - -
    • -
  • (\x:Bool. x) true - -
    - - The identity function for booleans, applied to the boolean true. - -
    - - -
    • -
  • \x:Bool. if x then false else true - -
    - - The boolean "not" function. - -
    - - -
    • -
  • \x:Bool. true - -
    - - The constant function that takes every (boolean) argument to - true. -
    • -
- -
- -
    -
  • \x:Bool. \y:Bool. x - -
    - - A two-argument function that takes two booleans and returns - the first one. (Note that, as in Coq, a two-argument function - is really a one-argument function whose body is also a - one-argument function.) - -
    - - -
    • -
  • (\x:Bool. \y:Bool. x) false true - -
    - - A two-argument function that takes two booleans and returns - the first one, applied to the booleans false and true. - -
    - - Note that, as in Coq, application associates to the left — - i.e., this expression is parsed as ((\x:Bool. \y:Bool. x) - false) true. - -
    - - -
    • -
  • \f:Bool→Bool. f (f true) - -
    - - A higher-order function that takes a function f (from - booleans to booleans) as an argument, applies f to true, - and applies f again to the result. - -
    - - -
    • -
  • (\f:Bool→Bool. f (f true)) (\x:Bool. false) - -
    - - The same higher-order function, applied to the constantly - false function. -
    • -
- -
- - As the last several examples show, the STLC is a language of - higher-order functions: we can write down functions that take - other functions as arguments and/or return other functions as - results. - -
- - Another point to note is that the STLC doesn't provide any - primitive syntax for defining named functions — all functions - are "anonymous." We'll see in chapter MoreStlc that it is easy - to add named functions to what we've got — indeed, the - fundamental naming and binding mechanisms are exactly the same. - -
- - The types of the STLC include Bool, which classifies the - boolean constants true and false as well as more complex - computations that yield booleans, plus arrow types that classify - functions. -
- - -
- -
-      T ::= Bool
-          | T1 → T2 -
- -
- For example: - -
- -
    -
  • \x:Bool. false has type Bool→Bool - -
    - - -
    • -
  • \x:Bool. x has type Bool→Bool - -
    - - -
    • -
  • (\x:Bool. x) true has type Bool - -
    - - -
    • -
  • \x:Bool. \y:Bool. x has type Bool→Bool→Bool (i.e. Bool → (Bool→Bool)) - -
    - - -
    • -
  • (\x:Bool. \y:Bool. x) false has type Bool→Bool - -
    - - -
    • -
  • (\x:Bool. \y:Bool. x) false true has type Bool - -
    • -
- -
-
- -
-
- -
-

Syntax

- -
-
- -
-Module STLC.
- -
-
- -
-

Types

- -
-
- -
-Inductive ty : Type :=
-  | TBool : ty
-  | TArrow : ty → ty → ty.
- -
-
- -
-

Terms

- -
-
- -
-Inductive tm : Type :=
-  | tvar : id → tm
-  | tapp : tm → tm → tm
-  | tabs : id → ty → tm → tm
-  | ttrue : tm
-  | tfalse : tm
-  | tif : tm → tm → tm → tm.
- -
-
-
-Tactic Notation "t_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "tvar" | Case_aux c "tapp"
-  | Case_aux c "tabs" | Case_aux c "ttrue"
-  | Case_aux c "tfalse" | Case_aux c "tif" ].
-
- -
-
- -
-Note that an abstraction \x:T.t (formally, tabs x T t) is - always annotated with the type T of its parameter, in contrast - to Coq (and other functional languages like ML, Haskell, etc.), - which use type inference to fill in missing annotations. We're - not considering type inference here, to keep things simple. -
- - Some examples... -
-
- -
-Definition x := (Id 0).
-Definition y := (Id 1).
-Definition z := (Id 2).
-
-
-Hint Unfold x.
-Hint Unfold y.
-Hint Unfold z.
-
- -
-
- -
-idB = \x:Bool. x -
-
- -
-Notation idB :=
-  (tabs x TBool (tvar x)).
- -
-
- -
-idBB = \x:Bool→Bool. x -
-
- -
-Notation idBB :=
-  (tabs x (TArrow TBool TBool) (tvar x)).
- -
-
- -
-idBBBB = \x:(Bool→Bool) → (Bool→Bool). x -
-
- -
-Notation idBBBB :=
-  (tabs x (TArrow (TArrow TBool TBool)
-                      (TArrow TBool TBool))
-    (tvar x)).
- -
-
- -
-k = \x:Bool. \y:Bool. x -
-
- -
-Notation k := (tabs x TBool (tabs y TBool (tvar x))).
- -
-
- -
-notB = \x:Bool. if x then false else true -
-
- -
-Notation notB := (tabs x TBool (tif (tvar x) tfalse ttrue)).
- -
-
- -
-(We write these as Notations rather than Definitions to make - things easier for auto.) -
-
- -
-
- -
-

Operational Semantics

- -
- - To define the small-step semantics of STLC terms, we begin — as - always — by defining the set of values. Next, we define the - critical notions of free variables and substitution, which are - used in the reduction rule for application expressions. And - finally we give the small-step relation itself. -
-
- -
-
- -
-

Values

- -
- - To define the values of the STLC, we have a few cases to consider. - -
- - First, for the boolean part of the language, the situation is - clear: true and false are the only values. An if - expression is never a value. -
- - Second, an application is clearly not a value: It represents a - function being invoked on some argument, which clearly still has - work left to do. -
- - Third, for abstractions, we have a choice: - -
- -
    -
  • We can say that \x:T.t1 is a value only when t1 is a - value — i.e., only if the function's body has been - reduced (as much as it can be without knowing what argument it - is going to be applied to). - -
    - - -
    • -
  • Or we can say that \x:T.t1 is always a value, no matter - whether t1 is one or not — in other words, we can say that - reduction stops at abstractions. - -
    • -
- -
- - Coq, in its built-in functional programming langauge, makes the - first choice — for example, - -
- -
-         Eval simpl in (fun x:bool ⇒ 3 + 4) -
- -
- yields fun x:bool ⇒ 7. - -
- - Most real-world functional programming languages make the second - choice — reduction of a function's body only begins when the - function is actually applied to an argument. We also make the - second choice here. -
-
- -
-Inductive value : tm → Prop :=
-  | v_abs : ∀x T t,
-      value (tabs x T t)
-  | v_true :
-      value ttrue
-  | v_false :
-      value tfalse.
- -
-Hint Constructors value.
- -
-
- -
-Finally, we must consider what constitutes a complete program. - -
- - Intuitively, a "complete" program must not refer to any undefined - variables. We'll see shortly how to define the "free" variables - in a STLC term. A program is "closed", that is, it contains no - free variables. - -
- - -
- - Having made the choice not to reduce under abstractions, - we don't need to worry about whether variables are values, since - we'll always be reducing programs "from the outside in," and that - means the step relation will always be working with closed - terms (ones with no free variables). -
-
- -
-
- -
-

Substitution

- -
- - Now we come to the heart of the STLC: the operation of - substituting one term for a variable in another term. - -
- - This operation will be used below to define the operational - semantics of function application, where we will need to - substitute the argument term for the function parameter in the - function's body. For example, we reduce - -
- -
-       (\x:Bool. if x then true else x) false -
- -
- to - -
- -
-       if false then true else false -
- -
- by substituting false for the parameter x in the body of the - function. - -
- - In general, we need to be able to substitute some given - term s for occurrences of some variable x in another term t. - In informal discussions, this is usually written [x:=s]t and - pronounced "substitute x with s in t." -
- - Here are some examples: - -
- -
    -
  • [x:=true] (if x then x else false) yields if true then true else false - -
    - - -
    • -
  • [x:=true] x yields true - -
    - - -
    • -
  • [x:=true] (if x then x else y) yields if true then true else y - -
    - - -
    • -
  • [x:=true] y yields y - -
    - - -
    • -
  • [x:=true] false yields false (vacuous substitution) - -
    - - -
    • -
  • [x:=true] (\y:Bool. if y then x else false) yields \y:Bool. if y then true else false - -
    • -
  • [x:=true] (\y:Bool. x) yields \y:Bool. true - -
    - - -
    • -
  • [x:=true] (\y:Bool. y) yields \y:Bool. y - -
    - - -
    • -
  • [x:=true] (\x:Bool. x) yields \x:Bool. x - -
    • -
- -
- - The last example is very important: substituting x with true in - \x:Bool. x does not yield \x:Bool. true! The reason for - this is that the x in the body of \x:Bool. x is bound by the - abstraction: it is a new, local name that just happens to be - spelled the same as some global name x. -
- - Here is the definition, informally... - -
- -
-   [x:=s]x = s
-   [x:=s]y = y                                   if x ≠ y
-   [x:=s](\x:T11.t12)   = \x:T11. t12      
-   [x:=s](\y:T11.t12)   = \y:T11. [x:=s]t12      if x ≠ y
-   [x:=s](t1 t2)        = ([x:=s]t1) ([x:=s]t2)       
-   [x:=s]true           = true
-   [x:=s]false          = false
-   [x:=s](if t1 then t2 else t3) = 
-                   if [x:=s]t1 then [x:=s]t2 else [x:=s]t3 -
- -
- -
- - ... and formally: -
-
- -
-Reserved Notation "'[' x ':=' s ']' t" (at level 20).
- -
-Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
-  match t with
-  | tvar x' ⇒
-      if eq_id_dec x x' then s else t
-  | tabs x' T t1 ⇒
-      tabs x' T (if eq_id_dec x x' then t1 else ([x:=s] t1))
-  | tapp t1 t2 ⇒
-      tapp ([x:=s] t1) ([x:=s] t2)
-  | ttrue ⇒
-      ttrue
-  | tfalse ⇒
-      tfalse
-  | tif t1 t2 t3 ⇒
-      tif ([x:=s] t1) ([x:=s] t2) ([x:=s] t3)
-  end
-
-where "'[' x ':=' s ']' t" := (subst x s t).
- -
-
- -
-Technical note: Substitution becomes trickier to define if we - consider the case where s, the term being substituted for a - variable in some other term, may itself contain free variables. - Since we are only interested here in defining the step relation - on closed terms (i.e., terms like \x:Bool. x, that do not mention - variables are not bound by some enclosing lambda), we can skip - this extra complexity here, but it must be dealt with when - formalizing richer languages. -
- -

-

Exercise: 3 stars (substi)

- -
- - The definition that we gave above uses Coq's Fixpoint facility - to define substitution as a function. Suppose, instead, we - wanted to define substitution as an inductive relation substi. - We've begun the definition by providing the Inductive header and - one of the constructors; your job is to fill in the rest of the - constructors. -
-
- -
-Inductive substi (s:tm) (x:id) : tm → tm → Prop :=
-  | s_var1 :
-      substi s x (tvar x) s
-  (* FILL IN HERE *)
-.
- -
-Hint Constructors substi.
- -
-Theorem substi_correct : ∀s x t t',
-  [x:=s]t = t' ↔ substi s x t t'.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Reduction

- -
- - The small-step reduction relation for STLC now follows the same - pattern as the ones we have seen before. Intuitively, to reduce a - function application, we first reduce its left-hand side until it - becomes a literal function; then we reduce its right-hand - side (the argument) until it is also a value; and finally we - substitute the argument for the bound variable in the body of the - function. This last rule, written informally as - -
- -
-      (\x:T.t12) v2 ⇒ [x:=v2]t12 -
- -
- is traditionally called "beta-reduction". -
- -
- - - - - - - - - - -
value v2 - (ST_AppAbs)   -
(\x:T.t12) v2 ⇒ [x:=v2]t12
- - - - - - - - - - -
t1 ⇒ t1' - (ST_App1)   -
t1 t2 ⇒ t1' t2
- - - - - - - - - - - - - - -
value v1
t2 ⇒ t2' - (ST_App2)   -
v1 t2 ⇒ v1 t2'
... plus the usual rules for booleans: -
- - - - - - - - - - -
   - (ST_IfTrue)   -
(if true then t1 else t2) ⇒ t1
- - - - - - - - - - -
   - (ST_IfFalse)   -
(if false then t1 else t2) ⇒ t2
- - - - - - - - - - -
t1 ⇒ t1' - (ST_If)   -
(if t1 then t2 else t3) ⇒ (if t1' then t2 else t3)
-
-
- -
-Reserved Notation "t1 '⇒' t2" (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_AppAbs : ∀x T t12 v2,
-         value v2 →
-         (tapp (tabs x T t12) v2) ⇒ [x:=v2]t12
-  | ST_App1 : ∀t1 t1' t2,
-         t1 ⇒ t1' →
-         tapp t1 t2 ⇒ tapp t1' t2
-  | ST_App2 : ∀v1 t2 t2',
-         value v1 →
-         t2 ⇒ t2' →
-         tapp v1 t2 ⇒ tapp v1 t2'
-  | ST_IfTrue : ∀t1 t2,
-      (tif ttrue t1 t2) ⇒ t1
-  | ST_IfFalse : ∀t1 t2,
-      (tif tfalse t1 t2) ⇒ t2
-  | ST_If : ∀t1 t1' t2 t3,
-      t1 ⇒ t1' →
-      (tif t1 t2 t3) ⇒ (tif t1' t2 t3)
-
-where "t1 '⇒' t2" := (step t1 t2).
- -
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1"
-  | Case_aux c "ST_App2" | Case_aux c "ST_IfTrue"
-  | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ].
- -
-Hint Constructors step.
- -
-Notation multistep := (multi step).
-Notation "t1 '⇒*' t2" := (multistep t1 t2) (at level 40).
- -
-
- -
-

Examples

- -
- - Example: - -
- -
-    ((\x:Bool→Bool. x) (\x:Bool. x)) ⇒* (\x:Bool. x) -
- -
-i.e. - -
- -
-    (idBB idB) ⇒* idB -
- -
- -
-
- -
-Lemma step_example1 :
-  (tapp idBB idB) ⇒* idB.
-Proof.
-  eapply multi_step.
-    apply ST_AppAbs.
-    apply v_abs.
-  simpl.
-  apply multi_refl. Qed.
- -
-
- -
-Example: - -
- -
-((\x:Bool→Bool. x) ((\x:Bool→Bool. x) (\x:Bool. x))) 
-      ⇒* (\x:Bool. x) -
- -
-i.e. - -
- -
-  (idBB (idBB idB)) ⇒* idB. -
- -
- -
-
- -
-Lemma step_example2 :
-  (tapp idBB (tapp idBB idB)) ⇒* idB.
-Proof.
-  eapply multi_step.
-    apply ST_App2. auto.
-    apply ST_AppAbs. auto.
-  eapply multi_step.
-    apply ST_AppAbs. simpl. auto.
-  simpl. apply multi_refl. Qed.
- -
-
- -
-Example: - -
- -
-((\x:Bool→Bool. x) (\x:Bool. if x then false
-                              else true)) true)
-      ⇒* false -
- -
-i.e. - -
- -
-  ((idBB notB) ttrue) ⇒* tfalse. -
- -
- -
-
- -
-Lemma step_example3 :
-  tapp (tapp idBB notB) ttrue ⇒* tfalse.
-Proof.
-  eapply multi_step.
-    apply ST_App1. apply ST_AppAbs. auto. simpl.
-  eapply multi_step.
-    apply ST_AppAbs. auto. simpl.
-  eapply multi_step.
-    apply ST_IfTrue. apply multi_refl. Qed.
- -
-
- -
-Example: - -
- -
-((\x:Bool→Bool. x) ((\x:Bool. if x then false
-                               else true) true))
-      ⇒* false -
- -
-i.e. - -
- -
-  (idBB (notB ttrue)) ⇒* tfalse. -
- -
- -
-
- -
-Lemma step_example4 :
-  tapp idBB (tapp notB ttrue) ⇒* tfalse.
-Proof.
-  eapply multi_step.
-    apply ST_App2. auto.
-    apply ST_AppAbs. auto. simpl.
-  eapply multi_step.
-    apply ST_App2. auto.
-    apply ST_IfTrue.
-  eapply multi_step.
-    apply ST_AppAbs. auto. simpl.
-  apply multi_refl. Qed.
- -
-
- -
-A more automatic proof -
-
- -
-Lemma step_example1' :
-  (tapp idBB idB) ⇒* idB.
-Proof. normalize. Qed.
- -
-
- -
-Again, we can use the normalize tactic from above to simplify - the proof. -
-
- -
-Lemma step_example2' :
-  (tapp idBB (tapp idBB idB)) ⇒* idB.
-Proof.
-  normalize.
-Qed.
- -
-Lemma step_example3' :
-  tapp (tapp idBB notB) ttrue ⇒* tfalse.
-Proof. normalize. Qed.
- -
-Lemma step_example4' :
-  tapp idBB (tapp notB ttrue) ⇒* tfalse.
-Proof. normalize. Qed.
- -
-
- -
-

Exercise: 2 stars (step_example3)

- Try to do this one both with and without normalize. -
-
- -
-Lemma step_example5 :
-       (tapp (tapp idBBBB idBB) idB)
-  ⇒* idB.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Typing

- -
-
- -
-
- -
-

Contexts

- -
- - Question: What is the type of the term "x y"? - -
- - Answer: It depends on the types of x and y! - -
- - I.e., in order to assign a type to a term, we need to know - what assumptions we should make about the types of its free - variables. - -
- - This leads us to a three-place "typing judgment", informally - written Γ ⊢ t ∈ T, where Γ is a - "typing context" — a mapping from variables to their types. -
- - We hide the definition of partial maps in a module since it is - actually defined in SfLib. -
-
- -
-Module PartialMap.
- -
-Definition partial_map (A:Type) := id → option A.
- -
-Definition empty {A:Type} : partial_map A := (fun _ ⇒ None).
- -
-
- -
-Informally, we'll write Γ, x:T for "extend the partial - function Γ to also map x to T." Formally, we use the - function extend to add a binding to a partial map. -
-
- -
-Definition extend {A:Type} (Γ : partial_map A) (x:id) (T : A) :=
-  fun x' ⇒ if eq_id_dec x x' then Some T else Γ x'.
- -
-Lemma extend_eq : ∀A (ctxt: partial_map A) x T,
-  (extend ctxt x T) x = Some T.
-
-
-Proof.
-  intros. unfold extend. rewrite eq_id. auto.
-Qed.
-
- -
-Lemma extend_neq : ∀A (ctxt: partial_map A) x1 T x2,
-  x2 ≠ x1 →
-  (extend ctxt x2 T) x1 = ctxt x1.
-
-
-Proof.
-  intros. unfold extend. rewrite neq_id; auto.
-Qed.
-
- -
-End PartialMap.
- -
-Definition context := partial_map ty.
- -
-
- -
-

Typing Relation

- -
- -
- - - - - - - - - - -
Γ x = T - (T_Var)   -
Γ ⊢ x ∈ T
- - - - - - - - - - -
Γ , x:T11 ⊢ t12 ∈ T12 - (T_Abs)   -
Γ ⊢ \x:T11.t12 ∈ T11->T12
- - - - - - - - - - - - - - -
Γ ⊢ t1 ∈ T11->T12
Γ ⊢ t2 ∈ T11 - (T_App)   -
Γ ⊢ t1 t2 ∈ T12
- - - - - - - - - - -
   - (T_True)   -
Γ ⊢ true ∈ Bool
- - - - - - - - - - -
   - (T_False)   -
Γ ⊢ false ∈ Bool
- - - - - - - - - - -
Γ ⊢ t1 ∈ Bool    Γ ⊢ t2 ∈ T    Γ ⊢ t3 ∈ T - (T_If)   -
Γ ⊢ if t1 then t2 else t3 ∈ T
-
- - We can read the three-place relation Γ ⊢ t ∈ T as: - "to the term t we can assign the type T using as types for - the free variables of t the ones specified in the context - Γ." -
-
- -
-Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).
- -
-Inductive has_type : context → tm → ty → Prop :=
-  | T_Var : ∀Γ x T,
-      Γ x = Some T →
-      Γ ⊢ tvar x ∈ T
-  | T_Abs : ∀Γ x T11 T12 t12,
-      extend Γ x T11 ⊢ t12 ∈ T12 →
-      Γ ⊢ tabs x T11 t12 ∈ TArrow T11 T12
-  | T_App : ∀T11 T12 Γ t1 t2,
-      Γ ⊢ t1 ∈ TArrow T11 T12 →
-      Γ ⊢ t2 ∈ T11 →
-      Γ ⊢ tapp t1 t2 ∈ T12
-  | T_True : ∀Γ,
-       Γ ⊢ ttrue ∈ TBool
-  | T_False : ∀Γ,
-       Γ ⊢ tfalse ∈ TBool
-  | T_If : ∀t1 t2 t3 T Γ,
-       Γ ⊢ t1 ∈ TBool →
-       Γ ⊢ t2 ∈ T →
-       Γ ⊢ t3 ∈ T →
-       Γ ⊢ tif t1 t2 t3 ∈ T
-
-where "Gamma '⊢' t '∈' T" := (has_type Γ t T).
-
-
- -
-Tactic Notation "has_type_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "T_Var" | Case_aux c "T_Abs"
-  | Case_aux c "T_App" | Case_aux c "T_True"
-  | Case_aux c "T_False" | Case_aux c "T_If" ].
-
- -
-Hint Constructors has_type.
- -
-
- -
-

Examples

- -
-
- -
-Example typing_example_1 :
-  empty ⊢ tabs x TBool (tvar x) ∈ TArrow TBool TBool.
-Proof.
-  apply T_Abs. apply T_Var. reflexivity. Qed.
- -
-
- -
-Note that since we added the has_type constructors to the hints - database, auto can actually solve this one immediately. -
-
- -
-Example typing_example_1' :
-  empty ⊢ tabs x TBool (tvar x) ∈ TArrow TBool TBool.
-Proof. auto. Qed.
- -
-
- -
-Another example: - -
- -
-     empty ⊢ \x:A. λy:A→A. y (y x)) 
-           ∈ A → (A→A) → A. -
- -
- -
-
- -
-
-
-Example typing_example_2 :
-  empty ⊢
-    (tabs x TBool
-       (tabs y (TArrow TBool TBool)
-          (tapp (tvar y) (tapp (tvar y) (tvar x))))) ∈
-    (TArrow TBool (TArrow (TArrow TBool TBool) TBool)).
-Proof with auto using extend_eq.
-  apply T_Abs.
-  apply T_Abs.
-  eapply T_App. apply T_Var...
-  eapply T_App. apply T_Var...
-  apply T_Var...
-Qed.
-
- -
-
- -
-

Exercise: 2 stars, optional (typing_example_2_full)

- Prove the same result without using auto, eauto, or - eapply. -
-
- -
-Example typing_example_2_full :
-  empty ⊢
-    (tabs x TBool
-       (tabs y (TArrow TBool TBool)
-          (tapp (tvar y) (tapp (tvar y) (tvar x))))) ∈
-    (TArrow TBool (TArrow (TArrow TBool TBool) TBool)).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 2 stars (typing_example_3)

- Formally prove the following typing derivation holds: -
- -
-   empty ⊢ \x:Bool→B. λy:Bool→Bool. λz:Bool.
-               y (x z) 
-         ∈ T. -
- -
- -
-
- -
-Example typing_example_3 :
-  ∃T,
-    empty ⊢
-      (tabs x (TArrow TBool TBool)
-         (tabs y (TArrow TBool TBool)
-            (tabs z TBool
-               (tapp (tvar y) (tapp (tvar x) (tvar z)))))) ∈
-      T.
-Proof with auto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - We can also show that terms are not typable. For example, let's - formally check that there is no typing derivation assigning a type - to the term \x:Bool. \y:Bool, x y — i.e., - -
- -
-    ¬ ∃T,
-        empty ⊢ \x:Bool. λy:Bool, x y : T. -
- -
- -
-
- -
-
-
-Example typing_nonexample_1 :
-  ¬ ∃T,
-      empty ⊢
-        (tabs x TBool
-            (tabs y TBool
-               (tapp (tvar x) (tvar y)))) ∈
-        T.
-Proof.
-  intros Hc. inversion Hc.
-  (* The clear tactic is useful here for tidying away bits of
-     the context that we're not going to need again. *)
-  inversion H. subst. clear H.
-  inversion H5. subst. clear H5.
-  inversion H4. subst. clear H4.
-  inversion H2. subst. clear H2.
-  inversion H5. subst. clear H5.
-  (* rewrite extend_neq in H1. rewrite extend_eq in H1. *)
-  inversion H1. Qed.
-
- -
-
- -
-

Exercise: 3 stars, optional (typing_nonexample_3)

- Another nonexample: - -
- -
-    ¬ (∃S, ∃T,
-          empty ⊢ \x:S. x x : T). -
- -
- -
-
- -
-Example typing_nonexample_3 :
-  ¬ (∃S, ∃T,
-        empty ⊢
-          (tabs x S
-             (tapp (tvar x) (tvar x))) ∈
-          T).
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-End STLC.
- -
-(* $Date: 2013-11-20 13:03:49 -0500 (Wed, 20 Nov 2013) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Stlc.v b/Stlc.v deleted file mode 100644 index 5480053..0000000 --- a/Stlc.v +++ /dev/null @@ -1,816 +0,0 @@ -(** * Stlc: The Simply Typed Lambda-Calculus *) - -Require Export Types. - -(* ###################################################################### *) -(** * The Simply Typed Lambda-Calculus *) - -(** The simply typed lambda-calculus (STLC) is a tiny core calculus - embodying the key concept of _functional abstraction_, which shows - up in pretty much every real-world programming language in some - form (functions, procedures, methods, etc.). - - We will follow exactly the same pattern as in the previous - chapter when formalizing this calculus (syntax, small-step - semantics, typing rules) and its main properties (progress and - preservation). The new technical challenges (which will take some - work to deal with) all arise from the mechanisms of _variable - binding_ and _substitution_. *) - -(* ###################################################################### *) -(** ** Overview *) - -(** The STLC is built on some collection of _base types_ -- booleans, - numbers, strings, etc. The exact choice of base types doesn't - matter -- the construction of the language and its theoretical - properties work out pretty much the same -- so for the sake of - brevity let's take just [Bool] for the moment. At the end of the - chapter we'll see how to add more base types, and in later - chapters we'll enrich the pure STLC with other useful constructs - like pairs, records, subtyping, and mutable state. - - Starting from the booleans, we add three things: - - variables - - function abstractions - - application - - This gives us the following collection of abstract syntax - constructors (written out here in informal BNF notation -- we'll - formalize it below). - -*) - -(** Informal concrete syntax: - t ::= x variable - | \x:T1.t2 abstraction - | t1 t2 application - | true constant true - | false constant false - | if t1 then t2 else t3 conditional -*) - -(** The [\] symbol (backslash, in ascii) in a function abstraction - [\x:T1.t2] is generally written as a greek letter "lambda" (hence - the name of the calculus). The variable [x] is called the - _parameter_ to the function; the term [t1] is its _body_. The - annotation [:T] specifies the type of arguments that the function - can be applied to. *) - -(** Some examples: - - - [\x:Bool. x] - - The identity function for booleans. - - - [(\x:Bool. x) true] - - The identity function for booleans, applied to the boolean [true]. - - - [\x:Bool. if x then false else true] - - The boolean "not" function. - - - [\x:Bool. true] - - The constant function that takes every (boolean) argument to - [true]. *) -(** - - [\x:Bool. \y:Bool. x] - - A two-argument function that takes two booleans and returns - the first one. (Note that, as in Coq, a two-argument function - is really a one-argument function whose body is also a - one-argument function.) - - - [(\x:Bool. \y:Bool. x) false true] - - A two-argument function that takes two booleans and returns - the first one, applied to the booleans [false] and [true]. - - Note that, as in Coq, application associates to the left -- - i.e., this expression is parsed as [((\x:Bool. \y:Bool. x) - false) true]. - - - [\f:Bool->Bool. f (f true)] - - A higher-order function that takes a _function_ [f] (from - booleans to booleans) as an argument, applies [f] to [true], - and applies [f] again to the result. - - - [(\f:Bool->Bool. f (f true)) (\x:Bool. false)] - - The same higher-order function, applied to the constantly - [false] function. *) - -(** As the last several examples show, the STLC is a language of - _higher-order_ functions: we can write down functions that take - other functions as arguments and/or return other functions as - results. - - Another point to note is that the STLC doesn't provide any - primitive syntax for defining _named_ functions -- all functions - are "anonymous." We'll see in chapter [MoreStlc] that it is easy - to add named functions to what we've got -- indeed, the - fundamental naming and binding mechanisms are exactly the same. - - The _types_ of the STLC include [Bool], which classifies the - boolean constants [true] and [false] as well as more complex - computations that yield booleans, plus _arrow types_ that classify - functions. *) -(** - T ::= Bool - | T1 -> T2 - For example: - - - [\x:Bool. false] has type [Bool->Bool] - - - [\x:Bool. x] has type [Bool->Bool] - - - [(\x:Bool. x) true] has type [Bool] - - - [\x:Bool. \y:Bool. x] has type [Bool->Bool->Bool] (i.e. [Bool -> (Bool->Bool)]) - - - [(\x:Bool. \y:Bool. x) false] has type [Bool->Bool] - - - [(\x:Bool. \y:Bool. x) false true] has type [Bool] -*) - - - - - -(* ###################################################################### *) -(** ** Syntax *) - -Module STLC. - -(* ################################### *) -(** *** Types *) - -Inductive ty : Type := - | TBool : ty - | TArrow : ty -> ty -> ty. - -(* ################################### *) -(** *** Terms *) - -Inductive tm : Type := - | tvar : id -> tm - | tapp : tm -> tm -> tm - | tabs : id -> ty -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. - -Tactic Notation "t_cases" tactic(first) ident(c) := - first; - [ Case_aux c "tvar" | Case_aux c "tapp" - | Case_aux c "tabs" | Case_aux c "ttrue" - | Case_aux c "tfalse" | Case_aux c "tif" ]. - -(** Note that an abstraction [\x:T.t] (formally, [tabs x T t]) is - always annotated with the type [T] of its parameter, in contrast - to Coq (and other functional languages like ML, Haskell, etc.), - which use _type inference_ to fill in missing annotations. We're - not considering type inference here, to keep things simple. *) - -(** Some examples... *) - -Definition x := (Id 0). -Definition y := (Id 1). -Definition z := (Id 2). -Hint Unfold x. -Hint Unfold y. -Hint Unfold z. - -(** [idB = \x:Bool. x] *) - -Notation idB := - (tabs x TBool (tvar x)). - -(** [idBB = \x:Bool->Bool. x] *) - -Notation idBB := - (tabs x (TArrow TBool TBool) (tvar x)). - -(** [idBBBB = \x:(Bool->Bool) -> (Bool->Bool). x] *) - -Notation idBBBB := - (tabs x (TArrow (TArrow TBool TBool) - (TArrow TBool TBool)) - (tvar x)). - -(** [k = \x:Bool. \y:Bool. x] *) - -Notation k := (tabs x TBool (tabs y TBool (tvar x))). - -(** [notB = \x:Bool. if x then false else true] *) - -Notation notB := (tabs x TBool (tif (tvar x) tfalse ttrue)). - - -(** (We write these as [Notation]s rather than [Definition]s to make - things easier for [auto].) *) - -(* ###################################################################### *) -(** ** Operational Semantics *) - -(** To define the small-step semantics of STLC terms, we begin -- as - always -- by defining the set of values. Next, we define the - critical notions of _free variables_ and _substitution_, which are - used in the reduction rule for application expressions. And - finally we give the small-step relation itself. *) - -(* ################################### *) -(** *** Values *) - -(** To define the values of the STLC, we have a few cases to consider. - - First, for the boolean part of the language, the situation is - clear: [true] and [false] are the only values. An [if] - expression is never a value. *) - -(** Second, an application is clearly not a value: It represents a - function being invoked on some argument, which clearly still has - work left to do. *) - -(** Third, for abstractions, we have a choice: - - - We can say that [\x:T.t1] is a value only when [t1] is a - value -- i.e., only if the function's body has been - reduced (as much as it can be without knowing what argument it - is going to be applied to). - - - Or we can say that [\x:T.t1] is always a value, no matter - whether [t1] is one or not -- in other words, we can say that - reduction stops at abstractions. - - Coq, in its built-in functional programming langauge, makes the - first choice -- for example, - Eval simpl in (fun x:bool => 3 + 4) - yields [fun x:bool => 7]. - - Most real-world functional programming languages make the second - choice -- reduction of a function's body only begins when the - function is actually applied to an argument. We also make the - second choice here. *) - -Inductive value : tm -> Prop := - | v_abs : forall x T t, - value (tabs x T t) - | v_true : - value ttrue - | v_false : - value tfalse. - -Hint Constructors value. - - -(** Finally, we must consider what constitutes a _complete_ program. - - Intuitively, a "complete" program must not refer to any undefined - variables. We'll see shortly how to define the "free" variables - in a STLC term. A program is "closed", that is, it contains no - free variables. - -*) - -(** Having made the choice not to reduce under abstractions, - we don't need to worry about whether variables are values, since - we'll always be reducing programs "from the outside in," and that - means the [step] relation will always be working with closed - terms (ones with no free variables). *) - - - -(* ###################################################################### *) -(** *** Substitution *) - -(** Now we come to the heart of the STLC: the operation of - substituting one term for a variable in another term. - - This operation will be used below to define the operational - semantics of function application, where we will need to - substitute the argument term for the function parameter in the - function's body. For example, we reduce - (\x:Bool. if x then true else x) false - to - if false then true else false -]] - by substituting [false] for the parameter [x] in the body of the - function. - - In general, we need to be able to substitute some given - term [s] for occurrences of some variable [x] in another term [t]. - In informal discussions, this is usually written [ [x:=s]t ] and - pronounced "substitute [x] with [s] in [t]." *) - -(** Here are some examples: - - - [[x:=true] (if x then x else false)] yields [if true then true else false] - - - [[x:=true] x] yields [true] - - - [[x:=true] (if x then x else y)] yields [if true then true else y] - - - [[x:=true] y] yields [y] - - - [[x:=true] false] yields [false] (vacuous substitution) - - - [[x:=true] (\y:Bool. if y then x else false)] yields [\y:Bool. if y then true else false] - - [[x:=true] (\y:Bool. x)] yields [\y:Bool. true] - - - [[x:=true] (\y:Bool. y)] yields [\y:Bool. y] - - - [[x:=true] (\x:Bool. x)] yields [\x:Bool. x] - - The last example is very important: substituting [x] with [true] in - [\x:Bool. x] does _not_ yield [\x:Bool. true]! The reason for - this is that the [x] in the body of [\x:Bool. x] is _bound_ by the - abstraction: it is a new, local name that just happens to be - spelled the same as some global name [x]. *) - -(** Here is the definition, informally... - [x:=s]x = s - [x:=s]y = y if x <> y - [x:=s](\x:T11.t12) = \x:T11. t12 - [x:=s](\y:T11.t12) = \y:T11. [x:=s]t12 if x <> y - [x:=s](t1 t2) = ([x:=s]t1) ([x:=s]t2) - [x:=s]true = true - [x:=s]false = false - [x:=s](if t1 then t2 else t3) = - if [x:=s]t1 then [x:=s]t2 else [x:=s]t3 -]] -*) - -(** ... and formally: *) - -Reserved Notation "'[' x ':=' s ']' t" (at level 20). - -Fixpoint subst (x:id) (s:tm) (t:tm) : tm := - match t with - | tvar x' => - if eq_id_dec x x' then s else t - | tabs x' T t1 => - tabs x' T (if eq_id_dec x x' then t1 else ([x:=s] t1)) - | tapp t1 t2 => - tapp ([x:=s] t1) ([x:=s] t2) - | ttrue => - ttrue - | tfalse => - tfalse - | tif t1 t2 t3 => - tif ([x:=s] t1) ([x:=s] t2) ([x:=s] t3) - end - -where "'[' x ':=' s ']' t" := (subst x s t). - -(** _Technical note_: Substitution becomes trickier to define if we - consider the case where [s], the term being substituted for a - variable in some other term, may itself contain free variables. - Since we are only interested here in defining the [step] relation - on closed terms (i.e., terms like [\x:Bool. x], that do not mention - variables are not bound by some enclosing lambda), we can skip - this extra complexity here, but it must be dealt with when - formalizing richer languages. *) - -(** *** *) -(** **** Exercise: 3 stars (substi) *) - -(** The definition that we gave above uses Coq's [Fixpoint] facility - to define substitution as a _function_. Suppose, instead, we - wanted to define substitution as an inductive _relation_ [substi]. - We've begun the definition by providing the [Inductive] header and - one of the constructors; your job is to fill in the rest of the - constructors. *) - -Inductive substi (s:tm) (x:id) : tm -> tm -> Prop := - | s_var1 : - substi s x (tvar x) s - (* FILL IN HERE *) -. - -Hint Constructors substi. - -Theorem substi_correct : forall s x t t', - [x:=s]t = t' <-> substi s x t t'. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ################################### *) -(** *** Reduction *) - -(** The small-step reduction relation for STLC now follows the same - pattern as the ones we have seen before. Intuitively, to reduce a - function application, we first reduce its left-hand side until it - becomes a literal function; then we reduce its right-hand - side (the argument) until it is also a value; and finally we - substitute the argument for the bound variable in the body of the - function. This last rule, written informally as - (\x:T.t12) v2 ==> [x:=v2]t12 - is traditionally called "beta-reduction". *) - -(** - value v2 - ---------------------------- (ST_AppAbs) - (\x:T.t12) v2 ==> [x:=v2]t12 - - t1 ==> t1' - ---------------- (ST_App1) - t1 t2 ==> t1' t2 - - value v1 - t2 ==> t2' - ---------------- (ST_App2) - v1 t2 ==> v1 t2' -*) -(** ... plus the usual rules for booleans: - -------------------------------- (ST_IfTrue) - (if true then t1 else t2) ==> t1 - - --------------------------------- (ST_IfFalse) - (if false then t1 else t2) ==> t2 - - t1 ==> t1' - ---------------------------------------------------- (ST_If) - (if t1 then t2 else t3) ==> (if t1' then t2 else t3) -*) - -Reserved Notation "t1 '==>' t2" (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_AppAbs : forall x T t12 v2, - value v2 -> - (tapp (tabs x T t12) v2) ==> [x:=v2]t12 - | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - tapp t1 t2 ==> tapp t1' t2 - | ST_App2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - tapp v1 t2 ==> tapp v1 t2' - | ST_IfTrue : forall t1 t2, - (tif ttrue t1 t2) ==> t1 - | ST_IfFalse : forall t1 t2, - (tif tfalse t1 t2) ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - (tif t1 t2 t3) ==> (tif t1' t2 t3) - -where "t1 '==>' t2" := (step t1 t2). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" - | Case_aux c "ST_App2" | Case_aux c "ST_IfTrue" - | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ]. - -Hint Constructors step. - -Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). - -(* ##################################### *) -(** *** Examples *) - -(** Example: - ((\x:Bool->Bool. x) (\x:Bool. x)) ==>* (\x:Bool. x) -i.e. - (idBB idB) ==>* idB -*) - -Lemma step_example1 : - (tapp idBB idB) ==>* idB. -Proof. - eapply multi_step. - apply ST_AppAbs. - apply v_abs. - simpl. - apply multi_refl. Qed. - -(** Example: -((\x:Bool->Bool. x) ((\x:Bool->Bool. x) (\x:Bool. x))) - ==>* (\x:Bool. x) -i.e. - (idBB (idBB idB)) ==>* idB. -*) - -Lemma step_example2 : - (tapp idBB (tapp idBB idB)) ==>* idB. -Proof. - eapply multi_step. - apply ST_App2. auto. - apply ST_AppAbs. auto. - eapply multi_step. - apply ST_AppAbs. simpl. auto. - simpl. apply multi_refl. Qed. - -(** Example: -((\x:Bool->Bool. x) (\x:Bool. if x then false - else true)) true) - ==>* false -i.e. - ((idBB notB) ttrue) ==>* tfalse. -*) - -Lemma step_example3 : - tapp (tapp idBB notB) ttrue ==>* tfalse. -Proof. - eapply multi_step. - apply ST_App1. apply ST_AppAbs. auto. simpl. - eapply multi_step. - apply ST_AppAbs. auto. simpl. - eapply multi_step. - apply ST_IfTrue. apply multi_refl. Qed. - -(** Example: -((\x:Bool->Bool. x) ((\x:Bool. if x then false - else true) true)) - ==>* false -i.e. - (idBB (notB ttrue)) ==>* tfalse. -*) - -Lemma step_example4 : - tapp idBB (tapp notB ttrue) ==>* tfalse. -Proof. - eapply multi_step. - apply ST_App2. auto. - apply ST_AppAbs. auto. simpl. - eapply multi_step. - apply ST_App2. auto. - apply ST_IfTrue. - eapply multi_step. - apply ST_AppAbs. auto. simpl. - apply multi_refl. Qed. - - -(** A more automatic proof *) - -Lemma step_example1' : - (tapp idBB idB) ==>* idB. -Proof. normalize. Qed. - -(** Again, we can use the [normalize] tactic from above to simplify - the proof. *) - -Lemma step_example2' : - (tapp idBB (tapp idBB idB)) ==>* idB. -Proof. - normalize. -Qed. - -Lemma step_example3' : - tapp (tapp idBB notB) ttrue ==>* tfalse. -Proof. normalize. Qed. - -Lemma step_example4' : - tapp idBB (tapp notB ttrue) ==>* tfalse. -Proof. normalize. Qed. - -(** **** Exercise: 2 stars (step_example3) *) -(** Try to do this one both with and without [normalize]. *) - -Lemma step_example5 : - (tapp (tapp idBBBB idBB) idB) - ==>* idB. -Proof. - (* FILL IN HERE *) Admitted. - -(* FILL IN HERE *) -(** [] *) - -(* ###################################################################### *) -(** ** Typing *) - -(* ################################### *) -(** *** Contexts *) - -(** _Question_: What is the type of the term "[x y]"? - - _Answer_: It depends on the types of [x] and [y]! - - I.e., in order to assign a type to a term, we need to know - what assumptions we should make about the types of its free - variables. - - This leads us to a three-place "typing judgment", informally - written [Gamma |- t \in T], where [Gamma] is a - "typing context" -- a mapping from variables to their types. *) - -(** We hide the definition of partial maps in a module since it is - actually defined in [SfLib]. *) - -Module PartialMap. - -Definition partial_map (A:Type) := id -> option A. - -Definition empty {A:Type} : partial_map A := (fun _ => None). - -(** Informally, we'll write [Gamma, x:T] for "extend the partial - function [Gamma] to also map [x] to [T]." Formally, we use the - function [extend] to add a binding to a partial map. *) - -Definition extend {A:Type} (Gamma : partial_map A) (x:id) (T : A) := - fun x' => if eq_id_dec x x' then Some T else Gamma x'. - -Lemma extend_eq : forall A (ctxt: partial_map A) x T, - (extend ctxt x T) x = Some T. -Proof. - intros. unfold extend. rewrite eq_id. auto. -Qed. - -Lemma extend_neq : forall A (ctxt: partial_map A) x1 T x2, - x2 <> x1 -> - (extend ctxt x2 T) x1 = ctxt x1. -Proof. - intros. unfold extend. rewrite neq_id; auto. -Qed. - -End PartialMap. - -Definition context := partial_map ty. - -(* ################################### *) -(** *** Typing Relation *) - -(** - Gamma x = T - -------------- (T_Var) - Gamma |- x \in T - - Gamma , x:T11 |- t12 \in T12 - ---------------------------- (T_Abs) - Gamma |- \x:T11.t12 \in T11->T12 - - Gamma |- t1 \in T11->T12 - Gamma |- t2 \in T11 - ---------------------- (T_App) - Gamma |- t1 t2 \in T12 - - -------------------- (T_True) - Gamma |- true \in Bool - - --------------------- (T_False) - Gamma |- false \in Bool - - Gamma |- t1 \in Bool Gamma |- t2 \in T Gamma |- t3 \in T - -------------------------------------------------------- (T_If) - Gamma |- if t1 then t2 else t3 \in T - - - We can read the three-place relation [Gamma |- t \in T] as: - "to the term [t] we can assign the type [T] using as types for - the free variables of [t] the ones specified in the context - [Gamma]." *) - -Reserved Notation "Gamma '|-' t '\in' T" (at level 40). - -Inductive has_type : context -> tm -> ty -> Prop := - | T_Var : forall Gamma x T, - Gamma x = Some T -> - Gamma |- tvar x \in T - | T_Abs : forall Gamma x T11 T12 t12, - extend Gamma x T11 |- t12 \in T12 -> - Gamma |- tabs x T11 t12 \in TArrow T11 T12 - | T_App : forall T11 T12 Gamma t1 t2, - Gamma |- t1 \in TArrow T11 T12 -> - Gamma |- t2 \in T11 -> - Gamma |- tapp t1 t2 \in T12 - | T_True : forall Gamma, - Gamma |- ttrue \in TBool - | T_False : forall Gamma, - Gamma |- tfalse \in TBool - | T_If : forall t1 t2 t3 T Gamma, - Gamma |- t1 \in TBool -> - Gamma |- t2 \in T -> - Gamma |- t3 \in T -> - Gamma |- tif t1 t2 t3 \in T - -where "Gamma '|-' t '\in' T" := (has_type Gamma t T). - -Tactic Notation "has_type_cases" tactic(first) ident(c) := - first; - [ Case_aux c "T_Var" | Case_aux c "T_Abs" - | Case_aux c "T_App" | Case_aux c "T_True" - | Case_aux c "T_False" | Case_aux c "T_If" ]. - -Hint Constructors has_type. - -(* ################################### *) -(** *** Examples *) - -Example typing_example_1 : - empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. -Proof. - apply T_Abs. apply T_Var. reflexivity. Qed. - -(** Note that since we added the [has_type] constructors to the hints - database, auto can actually solve this one immediately. *) - -Example typing_example_1' : - empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. -Proof. auto. Qed. - -(** Another example: - empty |- \x:A. \y:A->A. y (y x)) - \in A -> (A->A) -> A. -*) - -Example typing_example_2 : - empty |- - (tabs x TBool - (tabs y (TArrow TBool TBool) - (tapp (tvar y) (tapp (tvar y) (tvar x))))) \in - (TArrow TBool (TArrow (TArrow TBool TBool) TBool)). -Proof with auto using extend_eq. - apply T_Abs. - apply T_Abs. - eapply T_App. apply T_Var... - eapply T_App. apply T_Var... - apply T_Var... -Qed. - -(** **** Exercise: 2 stars, optional (typing_example_2_full) *) -(** Prove the same result without using [auto], [eauto], or - [eapply]. *) - -Example typing_example_2_full : - empty |- - (tabs x TBool - (tabs y (TArrow TBool TBool) - (tapp (tvar y) (tapp (tvar y) (tvar x))))) \in - (TArrow TBool (TArrow (TArrow TBool TBool) TBool)). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 2 stars (typing_example_3) *) -(** Formally prove the following typing derivation holds: *) -(** - empty |- \x:Bool->B. \y:Bool->Bool. \z:Bool. - y (x z) - \in T. -*) - -Example typing_example_3 : - exists T, - empty |- - (tabs x (TArrow TBool TBool) - (tabs y (TArrow TBool TBool) - (tabs z TBool - (tapp (tvar y) (tapp (tvar x) (tvar z)))))) \in - T. -Proof with auto. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** We can also show that terms are _not_ typable. For example, let's - formally check that there is no typing derivation assigning a type - to the term [\x:Bool. \y:Bool, x y] -- i.e., - ~ exists T, - empty |- \x:Bool. \y:Bool, x y : T. -*) - -Example typing_nonexample_1 : - ~ exists T, - empty |- - (tabs x TBool - (tabs y TBool - (tapp (tvar x) (tvar y)))) \in - T. -Proof. - intros Hc. inversion Hc. - (* The [clear] tactic is useful here for tidying away bits of - the context that we're not going to need again. *) - inversion H. subst. clear H. - inversion H5. subst. clear H5. - inversion H4. subst. clear H4. - inversion H2. subst. clear H2. - inversion H5. subst. clear H5. - (* rewrite extend_neq in H1. rewrite extend_eq in H1. *) - inversion H1. Qed. - -(** **** Exercise: 3 stars, optional (typing_nonexample_3) *) -(** Another nonexample: - ~ (exists S, exists T, - empty |- \x:S. x x : T). -*) - -Example typing_nonexample_3 : - ~ (exists S, exists T, - empty |- - (tabs x S - (tapp (tvar x) (tvar x))) \in - T). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - - -End STLC. - -(* $Date: 2013-11-20 13:03:49 -0500 (Wed, 20 Nov 2013) $ *) - diff --git a/StlcProp.html b/StlcProp.html deleted file mode 100644 index 776db4f..0000000 --- a/StlcProp.html +++ /dev/null @@ -1,1487 +0,0 @@ - - - - - -StlcProp: Properties of STLC - - - - - - -
- - - -
- -

StlcPropProperties of STLC

- -
-
- -
- -
-
- -
-Require Export Stlc.
- -
-Module STLCProp.
-Import STLC.
- -
-
- -
-In this chapter, we develop the fundamental theory of the Simply - Typed Lambda Calculus — in particular, the type safety - theorem. -
-
- -
-
- -
-

Canonical Forms

- -
-
- -
-Lemma canonical_forms_bool : ∀t,
-  empty ⊢ t ∈ TBool →
-  value t →
-  (t = ttrue) ∨ (t = tfalse).
-Proof.
-  intros t HT HVal.
-  inversion HVal; intros; subst; try inversion HT; auto.
-Qed.
- -
-Lemma canonical_forms_fun : ∀t T1 T2,
-  empty ⊢ t ∈ (TArrow T1 T2) →
-  value t →
-  ∃x u, t = tabs x T1 u.
-Proof.
-  intros t T1 T2 HT HVal.
-  inversion HVal; intros; subst; try inversion HT; subst; auto.
-  ∃x0. ∃t0. auto.
-Qed.
- -
-
- -
-

Progress

- -
- - As before, the progress theorem tells us that closed, well-typed - terms are not stuck: either a well-typed term is a value, or it - can take an evaluation step. The proof is a relatively - straightforward extension of the progress proof we saw in the - Types chapter. -
-
- -
-Theorem progress : ∀t T,
-     empty ⊢ t ∈ T →
-     value t ∨ ∃t', t ⇒ t'.
- -
-
- -
-Proof: by induction on the derivation of ⊢ t ∈ T. - -
- -
    -
  • The last rule of the derivation cannot be T_Var, since a - variable is never well typed in an empty context. - -
    - - -
    • -
  • The T_True, T_False, and T_Abs cases are trivial, since in - each of these cases we know immediately that t is a value. - -
    - - -
    • -
  • If the last rule of the derivation was T_App, then t = t1 - t2, and we know that t1 and t2 are also well typed in the - empty context; in particular, there exists a type T2 such that - ⊢ t1 ∈ T2 → T and ⊢ t2 ∈ T2. By the induction - hypothesis, either t1 is a value or it can take an evaluation - step. - -
    - -
      -
    • If t1 is a value, we now consider t2, which by the other - induction hypothesis must also either be a value or take an - evaluation step. - -
      - -
        -
      • Suppose t2 is a value. Since t1 is a value with an - arrow type, it must be a lambda abstraction; hence t1 - t2 can take a step by ST_AppAbs. - -
        - - -
        • -
      • Otherwise, t2 can take a step, and hence so can t1 - t2 by ST_App2. - -
        - - -
        • -
      - -
      • -
    • If t1 can take a step, then so can t1 t2 by ST_App1. - -
      - - -
      • -
    - -
    • -
  • If the last rule of the derivation was T_If, then t = if t1 - then t2 else t3, where t1 has type Bool. By the IH, t1 - either is a value or takes a step. - -
    - -
      -
    • If t1 is a value, then since it has type Bool it must be - either true or false. If it is true, then t steps - to t2; otherwise it steps to t3. - -
      - - -
      • -
    • Otherwise, t1 takes a step, and therefore so does t (by - ST_If). - -
      • -
    - -
    • -
- -
-
- -
-
-
-Proof with eauto.
-  intros t T Ht.
-  remember (@empty ty) as Γ.
-  has_type_cases (induction Ht) Case; subst Γ...
-  Case "T_Var".
-    (* contradictory: variables cannot be typed in an 
-       empty context *)
-    inversion H.
- -
-  Case "T_App".
-    (* t = t1 t2.  Proceed by cases on whether t1 is a 
-       value or steps... *)
-    right. destruct IHHt1...
-    SCase "t1 is a value".
-      destruct IHHt2...
-      SSCase "t2 is also a value".
-        assert (∃x0 t0, t1 = tabs x0 T11 t0).
-        eapply canonical_forms_fun; eauto.
-        destruct H1 as [x0 [t0 Heq]]. subst.
-        ∃([x0:=t2]t0)...
- -
-      SSCase "t2 steps".
-        inversion H0 as [t2' Hstp]. ∃(tapp t1 t2')...
- -
-    SCase "t1 steps".
-      inversion H as [t1' Hstp]. ∃(tapp t1' t2)...
- -
-  Case "T_If".
-    right. destruct IHHt1...
- -
-    SCase "t1 is a value".
-      destruct (canonical_forms_bool t1); subst; eauto.
- -
-    SCase "t1 also steps".
-      inversion H as [t1' Hstp]. ∃(tif t1' t2 t3)...
-Qed.
-
- -
-
- -
-

Exercise: 3 stars, optional (progress_from_term_ind)

- Show that progress can also be proved by induction on terms - instead of induction on typing derivations. -
-
- -
-Theorem progress' : ∀t T,
-     empty ⊢ t ∈ T →
-     value t ∨ ∃t', t ⇒ t'.
-Proof.
-  intros t.
-  t_cases (induction t) Case; intros T Ht; auto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Preservation

- -
- - The other half of the type soundness property is the preservation - of types during reduction. For this, we need to develop some - technical machinery for reasoning about variables and - substitution. Working from top to bottom (the high-level property - we are actually interested in to the lowest-level technical lemmas - that are needed by various cases of the more interesting proofs), - the story goes like this: - -
- -
    -
  • The preservation theorem is proved by induction on a typing - derivation, pretty much as we did in the Types chapter. The - one case that is significantly different is the one for the - ST_AppAbs rule, which is defined using the substitution - operation. To see that this step preserves typing, we need to - know that the substitution itself does. So we prove a... - -
    - - -
    • -
  • substitution lemma, stating that substituting a (closed) - term s for a variable x in a term t preserves the type - of t. The proof goes by induction on the form of t and - requires looking at all the different cases in the definition - of substitition. This time, the tricky cases are the ones for - variables and for function abstractions. In both cases, we - discover that we need to take a term s that has been shown - to be well-typed in some context Γ and consider the same - term s in a slightly different context Γ'. For this - we prove a... - -
    - - -
    • -
  • context invariance lemma, showing that typing is preserved - under "inessential changes" to the context Γ — in - particular, changes that do not affect any of the free - variables of the term. For this, we need a careful definition - of - -
    - - -
    • -
  • the free variables of a term — i.e., the variables occuring - in the term that are not in the scope of a function - abstraction that binds them. - -
    • -
- -
-
- -
-
- -
-

Free Occurrences

- -
- - A variable x appears free in a term t if t contains some - occurrence of x that is not under an abstraction labeled x. For example: - -
- -
    -
  • y appears free, but x does not, in \x:T→U. x y - -
    • -
  • both x and y appear free in (\x:T→U. x y) x - -
    • -
  • no variables appear free in \x:T→U. \y:T. x y -
    • -
- -
-
- -
-Inductive appears_free_in : id → tm → Prop :=
-  | afi_var : ∀x,
-      appears_free_in x (tvar x)
-  | afi_app1 : ∀x t1 t2,
-      appears_free_in x t1 → appears_free_in x (tapp t1 t2)
-  | afi_app2 : ∀x t1 t2,
-      appears_free_in x t2 → appears_free_in x (tapp t1 t2)
-  | afi_abs : ∀x y T11 t12,
-      y ≠ x →
-      appears_free_in x t12 →
-      appears_free_in x (tabs y T11 t12)
-  | afi_if1 : ∀x t1 t2 t3,
-      appears_free_in x t1 →
-      appears_free_in x (tif t1 t2 t3)
-  | afi_if2 : ∀x t1 t2 t3,
-      appears_free_in x t2 →
-      appears_free_in x (tif t1 t2 t3)
-  | afi_if3 : ∀x t1 t2 t3,
-      appears_free_in x t3 →
-      appears_free_in x (tif t1 t2 t3).
-
-
- -
-Tactic Notation "afi_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "afi_var"
-  | Case_aux c "afi_app1" | Case_aux c "afi_app2"
-  | Case_aux c "afi_abs"
-  | Case_aux c "afi_if1" | Case_aux c "afi_if2"
-  | Case_aux c "afi_if3" ].
- -
-Hint Constructors appears_free_in.
-
- -
-
- -
-A term in which no variables appear free is said to be closed. -
-
- -
-Definition closed (t:tm) :=
-  ∀x, ¬ appears_free_in x t.
- -
-
- -
-

Substitution

- -
- - We first need a technical lemma connecting free variables and - typing contexts. If a variable x appears free in a term t, - and if we know t is well typed in context Γ, then it must - be the case that Γ assigns a type to x. -
-
- -
-Lemma free_in_context : ∀x t T Γ,
-   appears_free_in x t →
-   Γ ⊢ t ∈ T →
-   ∃T', Γ x = Some T'.
- -
-
- -
-Proof: We show, by induction on the proof that x appears free - in t, that, for all contexts Γ, if t is well typed - under Γ, then Γ assigns some type to x. - -
- -
    -
  • If the last rule used was afi_var, then t = x, and from - the assumption that t is well typed under Γ we have - immediately that Γ assigns a type to x. - -
    - - -
    • -
  • If the last rule used was afi_app1, then t = t1 t2 and x - appears free in t1. Since t is well typed under Γ, - we can see from the typing rules that t1 must also be, and - the IH then tells us that Γ assigns x a type. - -
    - - -
    • -
  • Almost all the other cases are similar: x appears free in a - subterm of t, and since t is well typed under Γ, we - know the subterm of t in which x appears is well typed - under Γ as well, and the IH gives us exactly the - conclusion we want. - -
    - - -
    • -
  • The only remaining case is afi_abs. In this case t = - \y:T11.t12, and x appears free in t12; we also know that - x is different from y. The difference from the previous - cases is that whereas t is well typed under Γ, its - body t12 is well typed under (Γ, y:T11), so the IH - allows us to conclude that x is assigned some type by the - extended context (Γ, y:T11). To conclude that Γ - assigns a type to x, we appeal to lemma extend_neq, noting - that x and y are different variables. -
    • -
- -
-
- -
-
-
-Proof.
-  intros x t T Γ H H0. generalize dependent Γ.
-  generalize dependent T.
-  afi_cases (induction H) Case;
-         intros; try solve [inversion H0; eauto].
-  Case "afi_abs".
-    inversion H1; subst.
-    apply IHappears_free_in in H7.
-    rewrite extend_neq in H7; assumption.
-Qed.
-
- -
-
- -
-Next, we'll need the fact that any term t which is well typed in - the empty context is closed — that is, it has no free variables. -
- -

Exercise: 2 stars, optional (typable_empty__closed)

- -
-
-Corollary typable_empty__closed : ∀t T,
-    empty ⊢ t ∈ T →
-    closed t.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Sometimes, when we have a proof Γ ⊢ t : T, we will need to - replace Γ by a different context Γ'. When is it safe - to do this? Intuitively, it must at least be the case that - Γ' assigns the same types as Γ to all the variables - that appear free in t. In fact, this is the only condition that - is needed. -
-
- -
-Lemma context_invariance : ∀Γ Γ' t T,
-     Γ ⊢ t ∈ T →
-     (∀x, appears_free_in x t → Γ x = Γ' x) →
-     Γ' ⊢ t ∈ T.
- -
-
- -
-Proof: By induction on the derivation of Γ ⊢ t ∈ T. - -
- -
    -
  • If the last rule in the derivation was T_Var, then t = x - and Γ x = T. By assumption, Γ' x = T as well, and - hence Γ' ⊢ t ∈ T by T_Var. - -
    - - -
    • -
  • If the last rule was T_Abs, then t = \y:T11. t12, with T - = T11 → T12 and Γ, y:T11 ⊢ t12 ∈ T12. The induction - hypothesis is that for any context Γ'', if Γ, - y:T11 and Γ'' assign the same types to all the free - variables in t12, then t12 has type T12 under Γ''. - Let Γ' be a context which agrees with Γ on the - free variables in t; we must show Γ' ⊢ \y:T11. t12 ∈ - T11 → T12. - -
    - - By T_Abs, it suffices to show that Γ', y:T11 ⊢ t12 ∈ - T12. By the IH (setting Γ'' = Γ', y:T11), it - suffices to show that Γ, y:T11 and Γ', y:T11 agree - on all the variables that appear free in t12. - -
    - - Any variable occurring free in t12 must either be y, or - some other variable. Γ, y:T11 and Γ', y:T11 - clearly agree on y. Otherwise, we note that any variable - other than y which occurs free in t12 also occurs free in - t = \y:T11. t12, and by assumption Γ and Γ' - agree on all such variables, and hence so do Γ, y:T11 - and Γ', y:T11. - -
    - - -
    • -
  • If the last rule was T_App, then t = t1 t2, with Γ ⊢ - t1 ∈ T2 → T and Γ ⊢ t2 ∈ T2. One induction - hypothesis states that for all contexts Γ', if Γ' - agrees with Γ on the free variables in t1, then t1 - has type T2 → T under Γ'; there is a similar IH for - t2. We must show that t1 t2 also has type T under - Γ', given the assumption that Γ' agrees with - Γ on all the free variables in t1 t2. By T_App, it - suffices to show that t1 and t2 each have the same type - under Γ' as under Γ. However, we note that all - free variables in t1 are also free in t1 t2, and similarly - for free variables in t2; hence the desired result follows - by the two IHs. - -
    • -
- -
-
- -
-
-
-Proof with eauto.
-  intros.
-  generalize dependent Γ'.
-  has_type_cases (induction H) Case; intros; auto.
-  Case "T_Var".
-    apply T_Var. rewrite ← H0...
-  Case "T_Abs".
-    apply T_Abs.
-    apply IHhas_type. intros x1 Hafi.
-    (* the only tricky step... the Γ' we use to 
-       instantiate is extend Γ x T11 *)
-    unfold extend. destruct (eq_id_dec x0 x1)...
-  Case "T_App".
-    apply T_App with T11...
-Qed.
-
- -
-
- -
-Now we come to the conceptual heart of the proof that reduction - preserves types — namely, the observation that substitution - preserves types. - -
- - Formally, the so-called Substitution Lemma says this: suppose we - have a term t with a free variable x, and suppose we've been - able to assign a type T to t under the assumption that x has - some type U. Also, suppose that we have some other term v and - that we've shown that v has type U. Then, since v satisfies - the assumption we made about x when typing t, we should be - able to substitute v for each of the occurrences of x in t - and obtain a new term that still has type T. -
- - Lemma: If Γ,x:U ⊢ t ∈ T and ⊢ v ∈ U, then Γ ⊢ - [x:=v]t ∈ T. -
-
- -
-Lemma substitution_preserves_typing : ∀Γ x U t v T,
-     extend Γ x U ⊢ t ∈ T →
-     empty ⊢ v ∈ U →
-     Γ ⊢ [x:=v]t ∈ T.
- -
-
- -
-One technical subtlety in the statement of the lemma is that we - assign v the type U in the empty context — in other words, - we assume v is closed. This assumption considerably simplifies - the T_Abs case of the proof (compared to assuming Γ ⊢ v ∈ - U, which would be the other reasonable assumption at this point) - because the context invariance lemma then tells us that v has - type U in any context at all — we don't have to worry about - free variables in v clashing with the variable being introduced - into the context by T_Abs. - -
- - Proof: We prove, by induction on t, that, for all T and - Γ, if Γ,x:U ⊢ t ∈ T and ⊢ v ∈ U, then Γ ⊢ - [x:=v]t ∈ T. - -
- -
    -
  • If t is a variable, there are two cases to consider, depending - on whether t is x or some other variable. - -
    - -
      -
    • If t = x, then from the fact that Γ, x:U ⊢ x ∈ T we - conclude that U = T. We must show that [x:=v]x = v has - type T under Γ, given the assumption that v has - type U = T under the empty context. This follows from - context invariance: if a closed term has type T in the - empty context, it has that type in any context. - -
      - - -
      • -
    • If t is some variable y that is not equal to x, then - we need only note that y has the same type under Γ, - x:U as under Γ. - -
      - - -
      • -
    - -
    • -
  • If t is an abstraction \y:T11. t12, then the IH tells us, - for all Γ' and T', that if Γ',x:U ⊢ t12 ∈ T' - and ⊢ v ∈ U, then Γ' ⊢ [x:=v]t12 ∈ T'. - -
    - - The substitution in the conclusion behaves differently, - depending on whether x and y are the same variable name. - -
    - - First, suppose x = y. Then, by the definition of - substitution, [x:=v]t = t, so we just need to show Γ ⊢ - t ∈ T. But we know Γ,x:U ⊢ t : T, and since the - variable y does not appear free in \y:T11. t12, the - context invariance lemma yields Γ ⊢ t ∈ T. - -
    - - Second, suppose x ≠ y. We know Γ,x:U,y:T11 ⊢ t12 ∈ - T12 by inversion of the typing relation, and Γ,y:T11,x:U - ⊢ t12 ∈ T12 follows from this by the context invariance - lemma, so the IH applies, giving us Γ,y:T11 ⊢ [x:=v]t12 ∈ - T12. By T_Abs, Γ ⊢ \y:T11. [x:=v]t12 ∈ T11→T12, and - by the definition of substitution (noting that x ≠ y), - Γ ⊢ \y:T11. [x:=v]t12 ∈ T11→T12 as required. - -
    - - -
    • -
  • If t is an application t1 t2, the result follows - straightforwardly from the definition of substitution and the - induction hypotheses. - -
    - - -
    • -
  • The remaining cases are similar to the application case. - -
    • -
- -
- - Another technical note: This proof is a rare case where an - induction on terms, rather than typing derivations, yields a - simpler argument. The reason for this is that the assumption - extend Γ x U ⊢ t ∈ T is not completely generic, in - the sense that one of the "slots" in the typing relation — namely - the context — is not just a variable, and this means that Coq's - native induction tactic does not give us the induction hypothesis - that we want. It is possible to work around this, but the needed - generalization is a little tricky. The term t, on the other - hand, is completely generic. -
-
- -
-
-
-Proof with eauto.
-  intros Γ x U t v T Ht Ht'.
-  generalize dependent Γ. generalize dependent T.
-  t_cases (induction t) Case; intros T Γ H;
-    (* in each case, we'll want to get at the derivation of H *)
-    inversion H; subst; simpl...
-  Case "tvar".
-    rename i into y. destruct (eq_id_dec x y).
-    SCase "x=y".
-      subst.
-      rewrite extend_eq in H2.
-      inversion H2; subst. clear H2.
-                  eapply context_invariance... intros x Hcontra.
-      destruct (free_in_context _ _ T empty Hcontra) as [T' HT']...
-      inversion HT'.
-    SCase "x≠y".
-      apply T_Var. rewrite extend_neq in H2...
-  Case "tabs".
-    rename i into y. apply T_Abs.
-    destruct (eq_id_dec x y).
-    SCase "x=y".
-      eapply context_invariance...
-      subst.
-      intros x Hafi. unfold extend.
-      destruct (eq_id_dec y x)...
-    SCase "x≠y".
-      apply IHt. eapply context_invariance...
-      intros z Hafi. unfold extend.
-      destruct (eq_id_dec y z)...
-      subst. rewrite neq_id...
-Qed.
-
- -
-
- -
-The substitution lemma can be viewed as a kind of "commutation" - property. Intuitively, it says that substitution and typing can - be done in either order: we can either assign types to the terms - t and v separately (under suitable contexts) and then combine - them using substitution, or we can substitute first and then - assign a type to [x:=v] t — the result is the same either - way. -
-
- -
-
- -
-

Main Theorem

- -
- - We now have the tools we need to prove preservation: if a closed - term t has type T, and takes an evaluation step to t', then t' - is also a closed term with type T. In other words, the small-step - evaluation relation preserves types. - -
-
- -
-Theorem preservation : ∀t t' T,
-     empty ⊢ t ∈ T →
-     t ⇒ t' →
-     empty ⊢ t' ∈ T.
- -
-
- -
-Proof: by induction on the derivation of ⊢ t ∈ T. - -
- -
    -
  • We can immediately rule out T_Var, T_Abs, T_True, and - T_False as the final rules in the derivation, since in each of - these cases t cannot take a step. - -
    - - -
    • -
  • If the last rule in the derivation was T_App, then t = t1 - t2. There are three cases to consider, one for each rule that - could have been used to show that t1 t2 takes a step to t'. - -
    - -
      -
    • If t1 t2 takes a step by ST_App1, with t1 stepping to - t1', then by the IH t1' has the same type as t1, and - hence t1' t2 has the same type as t1 t2. - -
      - - -
      • -
    • The ST_App2 case is similar. - -
      - - -
      • -
    • If t1 t2 takes a step by ST_AppAbs, then t1 = - \x:T11.t12 and t1 t2 steps to [x:=t2]t12; the - desired result now follows from the fact that substitution - preserves types. - -
      - - -
      • -
    - -
    • -
  • If the last rule in the derivation was T_If, then t = if t1 - then t2 else t3, and there are again three cases depending on - how t steps. - -
    - -
      -
    • If t steps to t2 or t3, the result is immediate, since - t2 and t3 have the same type as t. - -
      - - -
      • -
    • Otherwise, t steps by ST_If, and the desired conclusion - follows directly from the induction hypothesis. - -
      • -
    - -
    • -
- -
-
- -
-
-
-Proof with eauto.
-  remember (@empty ty) as Γ.
-  intros t t' T HT. generalize dependent t'.
-  has_type_cases (induction HT) Case;
-       intros t' HE; subst Γ; subst;
-       try solve [inversion HE; subst; auto].
-  Case "T_App".
-    inversion HE; subst...
-    (* Most of the cases are immediate by induction, 
-       and eauto takes care of them *)
-    SCase "ST_AppAbs".
-      apply substitution_preserves_typing with T11...
-      inversion HT1...
-Qed.
-
- -
-
- -
-

Exercise: 2 stars (subject_expansion_stlc)

- An exercise in the Types chapter asked about the subject - expansion property for the simple language of arithmetic and - boolean expressions. Does this property hold for STLC? That is, - is it always the case that, if t ⇒ t' and has_type t' T, - then empty ⊢ t ∈ T? If so, prove it. If not, give a - counter-example not involving conditionals. - -
- -(* FILL IN HERE *)
-☐ - -
-
- -
-
- -
-

Type Soundness

- -
- -

Exercise: 2 stars, optional (type_soundness)

- -
- - Put progress and preservation together and show that a well-typed - term can never reach a stuck state. -
-
- -
-Definition stuck (t:tm) : Prop :=
-  (normal_form step) t ∧ ¬ value t.
- -
-Corollary soundness : ∀t t' T,
-  empty ⊢ t ∈ T →
-  t ⇒* t' →
-  ~(stuck t').
-Proof.
-  intros t t' T Hhas_type Hmulti. unfold stuck.
-  intros [Hnf Hnot_val]. unfold normal_form in Hnf.
-  induction Hmulti.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Uniqueness of Types

- -
- -

Exercise: 3 stars (types_unique)

- Another pleasant property of the STLC is that types are - unique: a given term (in a given context) has at most one - type. Formalize this statement and prove it. -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 1 star (progress_preservation_statement)

- Without peeking, write down the progress and preservation - theorems for the simply typed lambda-calculus. ☐ -
- -

Exercise: 2 stars (stlc_variation1)

- Suppose we add a new term zap with the following reduction rule: -
- - - - - - - - - - -
   - (ST_Zap)   -
t ⇒ zap
and the following typing rule: -
- - - - - - - - - - -
   - (T_Zap)   -
Γ ⊢ zap : T
Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (stlc_variation2)

- Suppose instead that we add a new term foo with the following reduction rules: -
- - - - - - - - - - -
   - (ST_Foo1)   -
(\x:A. x) ⇒ foo
- - - - - - - - - - -
   - (ST_Foo2)   -
foo ⇒ true
Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (stlc_variation3)

- Suppose instead that we remove the rule ST_App1 from the step - relation. Which of the following properties of the STLC remain - true in the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars, optional (stlc_variation4)

- Suppose instead that we add the following new rule to the reduction relation: -
- - - - - - - - - - -
   - (ST_FunnyIfTrue)   -
(if true then t1 else t2) ⇒ true
Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- - -
- -

Exercise: 2 stars, optional (stlc_variation5)

- Suppose instead that we add the following new rule to the typing relation: -
- - - - - - - - - - - - - - -
Γ ⊢ t1 ∈ Bool->Bool->Bool
Γ ⊢ t2 ∈ Bool - (T_FunnyApp)   -
Γ ⊢ t1 t2 ∈ Bool
Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- - -
- -

Exercise: 2 stars, optional (stlc_variation6)

- Suppose instead that we add the following new rule to the typing relation: -
- - - - - - - - - - - - - - -
Γ ⊢ t1 ∈ Bool
Γ ⊢ t2 ∈ Bool - (T_FunnyApp')   -
Γ ⊢ t1 t2 ∈ Bool
Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- - -
- -

Exercise: 2 stars, optional (stlc_variation7)

- Suppose we add the following new rule to the typing - relation of the STLC: -
- - - - - - - - - - -
   - (T_FunnyAbs)   -
⊢ \x:Bool.t ∈ Bool
Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- -☐ - -
-
- -
-End STLCProp.
- -
-
- -
-

Exercise: STLC with Arithmetic

- -
- - To see how the STLC might function as the core of a real - programming language, let's extend it with a concrete base - type of numbers and some constants and primitive - operators. -
-
- -
-Module STLCArith.
- -
-
- -
-To types, we add a base type of natural numbers (and remove - booleans, for brevity) -
-
- -
-Inductive ty : Type :=
-  | TArrow : ty → ty → ty
-  | TNat : ty.
- -
-
- -
-To terms, we add natural number constants, along with - successor, predecessor, multiplication, and zero-testing... -
-
- -
-Inductive tm : Type :=
-  | tvar : id → tm
-  | tapp : tm → tm → tm
-  | tabs : id → ty → tm → tm
-  | tnat : nat → tm
-  | tsucc : tm → tm
-  | tpred : tm → tm
-  | tmult : tm → tm → tm
-  | tif0 : tm → tm → tm → tm.
- -
-
-
-Tactic Notation "t_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "tvar" | Case_aux c "tapp"
-  | Case_aux c "tabs" | Case_aux c "tnat"
-  | Case_aux c "tsucc" | Case_aux c "tpred"
-  | Case_aux c "tmult" | Case_aux c "tif0" ].
-
- -
-
- -
-

Exercise: 4 stars (stlc_arith)

- Finish formalizing the definition and properties of the STLC extended - with arithmetic. Specifically: - -
- -
    -
  • Copy the whole development of STLC that we went through above (from - the definition of values through the Progress theorem), and - paste it into the file at this point. - -
    - - -
    • -
  • Extend the definitions of the subst operation and the step - relation to include appropriate clauses for the arithmetic operators. - -
    - - -
    • -
  • Extend the proofs of all the properties (up to soundness) of - the original STLC to deal with the new syntactic forms. Make - sure Coq accepts the whole file. -
    • -
- -
-
- -
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-End STLCArith.
- -
-(* $Date: 2014-04-23 09:37:37 -0400 (Wed, 23 Apr 2014) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/StlcProp.v b/StlcProp.v deleted file mode 100644 index c26abc9..0000000 --- a/StlcProp.v +++ /dev/null @@ -1,794 +0,0 @@ -(** * StlcProp: Properties of STLC *) - -Require Export Stlc. - -Module STLCProp. -Import STLC. - -(** In this chapter, we develop the fundamental theory of the Simply - Typed Lambda Calculus -- in particular, the type safety - theorem. *) - -(* ###################################################################### *) -(** * Canonical Forms *) - -Lemma canonical_forms_bool : forall t, - empty |- t \in TBool -> - value t -> - (t = ttrue) \/ (t = tfalse). -Proof. - intros t HT HVal. - inversion HVal; intros; subst; try inversion HT; auto. -Qed. - -Lemma canonical_forms_fun : forall t T1 T2, - empty |- t \in (TArrow T1 T2) -> - value t -> - exists x u, t = tabs x T1 u. -Proof. - intros t T1 T2 HT HVal. - inversion HVal; intros; subst; try inversion HT; subst; auto. - exists x0. exists t0. auto. -Qed. - - -(* ###################################################################### *) -(** * Progress *) - -(** As before, the _progress_ theorem tells us that closed, well-typed - terms are not stuck: either a well-typed term is a value, or it - can take an evaluation step. The proof is a relatively - straightforward extension of the progress proof we saw in the - [Types] chapter. *) - -Theorem progress : forall t T, - empty |- t \in T -> - value t \/ exists t', t ==> t'. - -(** _Proof_: by induction on the derivation of [|- t \in T]. - - - The last rule of the derivation cannot be [T_Var], since a - variable is never well typed in an empty context. - - - The [T_True], [T_False], and [T_Abs] cases are trivial, since in - each of these cases we know immediately that [t] is a value. - - - If the last rule of the derivation was [T_App], then [t = t1 - t2], and we know that [t1] and [t2] are also well typed in the - empty context; in particular, there exists a type [T2] such that - [|- t1 \in T2 -> T] and [|- t2 \in T2]. By the induction - hypothesis, either [t1] is a value or it can take an evaluation - step. - - - If [t1] is a value, we now consider [t2], which by the other - induction hypothesis must also either be a value or take an - evaluation step. - - - Suppose [t2] is a value. Since [t1] is a value with an - arrow type, it must be a lambda abstraction; hence [t1 - t2] can take a step by [ST_AppAbs]. - - - Otherwise, [t2] can take a step, and hence so can [t1 - t2] by [ST_App2]. - - - If [t1] can take a step, then so can [t1 t2] by [ST_App1]. - - - If the last rule of the derivation was [T_If], then [t = if t1 - then t2 else t3], where [t1] has type [Bool]. By the IH, [t1] - either is a value or takes a step. - - - If [t1] is a value, then since it has type [Bool] it must be - either [true] or [false]. If it is [true], then [t] steps - to [t2]; otherwise it steps to [t3]. - - - Otherwise, [t1] takes a step, and therefore so does [t] (by - [ST_If]). -*) - -Proof with eauto. - intros t T Ht. - remember (@empty ty) as Gamma. - has_type_cases (induction Ht) Case; subst Gamma... - Case "T_Var". - (* contradictory: variables cannot be typed in an - empty context *) - inversion H. - - Case "T_App". - (* [t] = [t1 t2]. Proceed by cases on whether [t1] is a - value or steps... *) - right. destruct IHHt1... - SCase "t1 is a value". - destruct IHHt2... - SSCase "t2 is also a value". - assert (exists x0 t0, t1 = tabs x0 T11 t0). - eapply canonical_forms_fun; eauto. - destruct H1 as [x0 [t0 Heq]]. subst. - exists ([x0:=t2]t0)... - - SSCase "t2 steps". - inversion H0 as [t2' Hstp]. exists (tapp t1 t2')... - - SCase "t1 steps". - inversion H as [t1' Hstp]. exists (tapp t1' t2)... - - Case "T_If". - right. destruct IHHt1... - - SCase "t1 is a value". - destruct (canonical_forms_bool t1); subst; eauto. - - SCase "t1 also steps". - inversion H as [t1' Hstp]. exists (tif t1' t2 t3)... -Qed. - -(** **** Exercise: 3 stars, optional (progress_from_term_ind) *) -(** Show that progress can also be proved by induction on terms - instead of induction on typing derivations. *) - -Theorem progress' : forall t T, - empty |- t \in T -> - value t \/ exists t', t ==> t'. -Proof. - intros t. - t_cases (induction t) Case; intros T Ht; auto. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** * Preservation *) - -(** The other half of the type soundness property is the preservation - of types during reduction. For this, we need to develop some - technical machinery for reasoning about variables and - substitution. Working from top to bottom (the high-level property - we are actually interested in to the lowest-level technical lemmas - that are needed by various cases of the more interesting proofs), - the story goes like this: - - - The _preservation theorem_ is proved by induction on a typing - derivation, pretty much as we did in the [Types] chapter. The - one case that is significantly different is the one for the - [ST_AppAbs] rule, which is defined using the substitution - operation. To see that this step preserves typing, we need to - know that the substitution itself does. So we prove a... - - - _substitution lemma_, stating that substituting a (closed) - term [s] for a variable [x] in a term [t] preserves the type - of [t]. The proof goes by induction on the form of [t] and - requires looking at all the different cases in the definition - of substitition. This time, the tricky cases are the ones for - variables and for function abstractions. In both cases, we - discover that we need to take a term [s] that has been shown - to be well-typed in some context [Gamma] and consider the same - term [s] in a slightly different context [Gamma']. For this - we prove a... - - - _context invariance_ lemma, showing that typing is preserved - under "inessential changes" to the context [Gamma] -- in - particular, changes that do not affect any of the free - variables of the term. For this, we need a careful definition - of - - - the _free variables_ of a term -- i.e., the variables occuring - in the term that are not in the scope of a function - abstraction that binds them. -*) - -(* ###################################################################### *) -(** ** Free Occurrences *) - -(** A variable [x] _appears free in_ a term _t_ if [t] contains some - occurrence of [x] that is not under an abstraction labeled [x]. For example: - - [y] appears free, but [x] does not, in [\x:T->U. x y] - - both [x] and [y] appear free in [(\x:T->U. x y) x] - - no variables appear free in [\x:T->U. \y:T. x y] *) - -Inductive appears_free_in : id -> tm -> Prop := - | afi_var : forall x, - appears_free_in x (tvar x) - | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) - | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) - | afi_abs : forall x y T11 t12, - y <> x -> - appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) - | afi_if1 : forall x t1 t2 t3, - appears_free_in x t1 -> - appears_free_in x (tif t1 t2 t3) - | afi_if2 : forall x t1 t2 t3, - appears_free_in x t2 -> - appears_free_in x (tif t1 t2 t3) - | afi_if3 : forall x t1 t2 t3, - appears_free_in x t3 -> - appears_free_in x (tif t1 t2 t3). - -Tactic Notation "afi_cases" tactic(first) ident(c) := - first; - [ Case_aux c "afi_var" - | Case_aux c "afi_app1" | Case_aux c "afi_app2" - | Case_aux c "afi_abs" - | Case_aux c "afi_if1" | Case_aux c "afi_if2" - | Case_aux c "afi_if3" ]. - -Hint Constructors appears_free_in. - -(** A term in which no variables appear free is said to be _closed_. *) - -Definition closed (t:tm) := - forall x, ~ appears_free_in x t. - -(* ###################################################################### *) -(** ** Substitution *) - -(** We first need a technical lemma connecting free variables and - typing contexts. If a variable [x] appears free in a term [t], - and if we know [t] is well typed in context [Gamma], then it must - be the case that [Gamma] assigns a type to [x]. *) - -Lemma free_in_context : forall x t T Gamma, - appears_free_in x t -> - Gamma |- t \in T -> - exists T', Gamma x = Some T'. - -(** _Proof_: We show, by induction on the proof that [x] appears free - in [t], that, for all contexts [Gamma], if [t] is well typed - under [Gamma], then [Gamma] assigns some type to [x]. - - - If the last rule used was [afi_var], then [t = x], and from - the assumption that [t] is well typed under [Gamma] we have - immediately that [Gamma] assigns a type to [x]. - - - If the last rule used was [afi_app1], then [t = t1 t2] and [x] - appears free in [t1]. Since [t] is well typed under [Gamma], - we can see from the typing rules that [t1] must also be, and - the IH then tells us that [Gamma] assigns [x] a type. - - - Almost all the other cases are similar: [x] appears free in a - subterm of [t], and since [t] is well typed under [Gamma], we - know the subterm of [t] in which [x] appears is well typed - under [Gamma] as well, and the IH gives us exactly the - conclusion we want. - - - The only remaining case is [afi_abs]. In this case [t = - \y:T11.t12], and [x] appears free in [t12]; we also know that - [x] is different from [y]. The difference from the previous - cases is that whereas [t] is well typed under [Gamma], its - body [t12] is well typed under [(Gamma, y:T11)], so the IH - allows us to conclude that [x] is assigned some type by the - extended context [(Gamma, y:T11)]. To conclude that [Gamma] - assigns a type to [x], we appeal to lemma [extend_neq], noting - that [x] and [y] are different variables. *) - -Proof. - intros x t T Gamma H H0. generalize dependent Gamma. - generalize dependent T. - afi_cases (induction H) Case; - intros; try solve [inversion H0; eauto]. - Case "afi_abs". - inversion H1; subst. - apply IHappears_free_in in H7. - rewrite extend_neq in H7; assumption. -Qed. - -(** Next, we'll need the fact that any term [t] which is well typed in - the empty context is closed -- that is, it has no free variables. *) - -(** **** Exercise: 2 stars, optional (typable_empty__closed) *) -Corollary typable_empty__closed : forall t T, - empty |- t \in T -> - closed t. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Sometimes, when we have a proof [Gamma |- t : T], we will need to - replace [Gamma] by a different context [Gamma']. When is it safe - to do this? Intuitively, it must at least be the case that - [Gamma'] assigns the same types as [Gamma] to all the variables - that appear free in [t]. In fact, this is the only condition that - is needed. *) - -Lemma context_invariance : forall Gamma Gamma' t T, - Gamma |- t \in T -> - (forall x, appears_free_in x t -> Gamma x = Gamma' x) -> - Gamma' |- t \in T. - -(** _Proof_: By induction on the derivation of [Gamma |- t \in T]. - - - If the last rule in the derivation was [T_Var], then [t = x] - and [Gamma x = T]. By assumption, [Gamma' x = T] as well, and - hence [Gamma' |- t \in T] by [T_Var]. - - - If the last rule was [T_Abs], then [t = \y:T11. t12], with [T - = T11 -> T12] and [Gamma, y:T11 |- t12 \in T12]. The induction - hypothesis is that for any context [Gamma''], if [Gamma, - y:T11] and [Gamma''] assign the same types to all the free - variables in [t12], then [t12] has type [T12] under [Gamma'']. - Let [Gamma'] be a context which agrees with [Gamma] on the - free variables in [t]; we must show [Gamma' |- \y:T11. t12 \in - T11 -> T12]. - - By [T_Abs], it suffices to show that [Gamma', y:T11 |- t12 \in - T12]. By the IH (setting [Gamma'' = Gamma', y:T11]), it - suffices to show that [Gamma, y:T11] and [Gamma', y:T11] agree - on all the variables that appear free in [t12]. - - Any variable occurring free in [t12] must either be [y], or - some other variable. [Gamma, y:T11] and [Gamma', y:T11] - clearly agree on [y]. Otherwise, we note that any variable - other than [y] which occurs free in [t12] also occurs free in - [t = \y:T11. t12], and by assumption [Gamma] and [Gamma'] - agree on all such variables, and hence so do [Gamma, y:T11] - and [Gamma', y:T11]. - - - If the last rule was [T_App], then [t = t1 t2], with [Gamma |- - t1 \in T2 -> T] and [Gamma |- t2 \in T2]. One induction - hypothesis states that for all contexts [Gamma'], if [Gamma'] - agrees with [Gamma] on the free variables in [t1], then [t1] - has type [T2 -> T] under [Gamma']; there is a similar IH for - [t2]. We must show that [t1 t2] also has type [T] under - [Gamma'], given the assumption that [Gamma'] agrees with - [Gamma] on all the free variables in [t1 t2]. By [T_App], it - suffices to show that [t1] and [t2] each have the same type - under [Gamma'] as under [Gamma]. However, we note that all - free variables in [t1] are also free in [t1 t2], and similarly - for free variables in [t2]; hence the desired result follows - by the two IHs. -*) - -Proof with eauto. - intros. - generalize dependent Gamma'. - has_type_cases (induction H) Case; intros; auto. - Case "T_Var". - apply T_Var. rewrite <- H0... - Case "T_Abs". - apply T_Abs. - apply IHhas_type. intros x1 Hafi. - (* the only tricky step... the [Gamma'] we use to - instantiate is [extend Gamma x T11] *) - unfold extend. destruct (eq_id_dec x0 x1)... - Case "T_App". - apply T_App with T11... -Qed. - -(** Now we come to the conceptual heart of the proof that reduction - preserves types -- namely, the observation that _substitution_ - preserves types. - - Formally, the so-called _Substitution Lemma_ says this: suppose we - have a term [t] with a free variable [x], and suppose we've been - able to assign a type [T] to [t] under the assumption that [x] has - some type [U]. Also, suppose that we have some other term [v] and - that we've shown that [v] has type [U]. Then, since [v] satisfies - the assumption we made about [x] when typing [t], we should be - able to substitute [v] for each of the occurrences of [x] in [t] - and obtain a new term that still has type [T]. *) - -(** _Lemma_: If [Gamma,x:U |- t \in T] and [|- v \in U], then [Gamma |- - [x:=v]t \in T]. *) - -Lemma substitution_preserves_typing : forall Gamma x U t v T, - extend Gamma x U |- t \in T -> - empty |- v \in U -> - Gamma |- [x:=v]t \in T. - -(** One technical subtlety in the statement of the lemma is that we - assign [v] the type [U] in the _empty_ context -- in other words, - we assume [v] is closed. This assumption considerably simplifies - the [T_Abs] case of the proof (compared to assuming [Gamma |- v \in - U], which would be the other reasonable assumption at this point) - because the context invariance lemma then tells us that [v] has - type [U] in any context at all -- we don't have to worry about - free variables in [v] clashing with the variable being introduced - into the context by [T_Abs]. - - _Proof_: We prove, by induction on [t], that, for all [T] and - [Gamma], if [Gamma,x:U |- t \in T] and [|- v \in U], then [Gamma |- - [x:=v]t \in T]. - - - If [t] is a variable, there are two cases to consider, depending - on whether [t] is [x] or some other variable. - - - If [t = x], then from the fact that [Gamma, x:U |- x \in T] we - conclude that [U = T]. We must show that [[x:=v]x = v] has - type [T] under [Gamma], given the assumption that [v] has - type [U = T] under the empty context. This follows from - context invariance: if a closed term has type [T] in the - empty context, it has that type in any context. - - - If [t] is some variable [y] that is not equal to [x], then - we need only note that [y] has the same type under [Gamma, - x:U] as under [Gamma]. - - - If [t] is an abstraction [\y:T11. t12], then the IH tells us, - for all [Gamma'] and [T'], that if [Gamma',x:U |- t12 \in T'] - and [|- v \in U], then [Gamma' |- [x:=v]t12 \in T']. - - The substitution in the conclusion behaves differently, - depending on whether [x] and [y] are the same variable name. - - First, suppose [x = y]. Then, by the definition of - substitution, [[x:=v]t = t], so we just need to show [Gamma |- - t \in T]. But we know [Gamma,x:U |- t : T], and since the - variable [y] does not appear free in [\y:T11. t12], the - context invariance lemma yields [Gamma |- t \in T]. - - Second, suppose [x <> y]. We know [Gamma,x:U,y:T11 |- t12 \in - T12] by inversion of the typing relation, and [Gamma,y:T11,x:U - |- t12 \in T12] follows from this by the context invariance - lemma, so the IH applies, giving us [Gamma,y:T11 |- [x:=v]t12 \in - T12]. By [T_Abs], [Gamma |- \y:T11. [x:=v]t12 \in T11->T12], and - by the definition of substitution (noting that [x <> y]), - [Gamma |- \y:T11. [x:=v]t12 \in T11->T12] as required. - - - If [t] is an application [t1 t2], the result follows - straightforwardly from the definition of substitution and the - induction hypotheses. - - - The remaining cases are similar to the application case. - - Another technical note: This proof is a rare case where an - induction on terms, rather than typing derivations, yields a - simpler argument. The reason for this is that the assumption - [extend Gamma x U |- t \in T] is not completely generic, in - the sense that one of the "slots" in the typing relation -- namely - the context -- is not just a variable, and this means that Coq's - native induction tactic does not give us the induction hypothesis - that we want. It is possible to work around this, but the needed - generalization is a little tricky. The term [t], on the other - hand, _is_ completely generic. *) - -Proof with eauto. - intros Gamma x U t v T Ht Ht'. - generalize dependent Gamma. generalize dependent T. - t_cases (induction t) Case; intros T Gamma H; - (* in each case, we'll want to get at the derivation of H *) - inversion H; subst; simpl... - Case "tvar". - rename i into y. destruct (eq_id_dec x y). - SCase "x=y". - subst. - rewrite extend_eq in H2. - inversion H2; subst. clear H2. - eapply context_invariance... intros x Hcontra. - destruct (free_in_context _ _ T empty Hcontra) as [T' HT']... - inversion HT'. - SCase "x<>y". - apply T_Var. rewrite extend_neq in H2... - Case "tabs". - rename i into y. apply T_Abs. - destruct (eq_id_dec x y). - SCase "x=y". - eapply context_invariance... - subst. - intros x Hafi. unfold extend. - destruct (eq_id_dec y x)... - SCase "x<>y". - apply IHt. eapply context_invariance... - intros z Hafi. unfold extend. - destruct (eq_id_dec y z)... - subst. rewrite neq_id... -Qed. - -(** The substitution lemma can be viewed as a kind of "commutation" - property. Intuitively, it says that substitution and typing can - be done in either order: we can either assign types to the terms - [t] and [v] separately (under suitable contexts) and then combine - them using substitution, or we can substitute first and then - assign a type to [ [x:=v] t ] -- the result is the same either - way. *) - -(* ###################################################################### *) -(** ** Main Theorem *) - -(** We now have the tools we need to prove preservation: if a closed - term [t] has type [T], and takes an evaluation step to [t'], then [t'] - is also a closed term with type [T]. In other words, the small-step - evaluation relation preserves types. -*) - -Theorem preservation : forall t t' T, - empty |- t \in T -> - t ==> t' -> - empty |- t' \in T. - -(** _Proof_: by induction on the derivation of [|- t \in T]. - - - We can immediately rule out [T_Var], [T_Abs], [T_True], and - [T_False] as the final rules in the derivation, since in each of - these cases [t] cannot take a step. - - - If the last rule in the derivation was [T_App], then [t = t1 - t2]. There are three cases to consider, one for each rule that - could have been used to show that [t1 t2] takes a step to [t']. - - - If [t1 t2] takes a step by [ST_App1], with [t1] stepping to - [t1'], then by the IH [t1'] has the same type as [t1], and - hence [t1' t2] has the same type as [t1 t2]. - - - The [ST_App2] case is similar. - - - If [t1 t2] takes a step by [ST_AppAbs], then [t1 = - \x:T11.t12] and [t1 t2] steps to [[x:=t2]t12]; the - desired result now follows from the fact that substitution - preserves types. - - - If the last rule in the derivation was [T_If], then [t = if t1 - then t2 else t3], and there are again three cases depending on - how [t] steps. - - - If [t] steps to [t2] or [t3], the result is immediate, since - [t2] and [t3] have the same type as [t]. - - - Otherwise, [t] steps by [ST_If], and the desired conclusion - follows directly from the induction hypothesis. -*) - -Proof with eauto. - remember (@empty ty) as Gamma. - intros t t' T HT. generalize dependent t'. - has_type_cases (induction HT) Case; - intros t' HE; subst Gamma; subst; - try solve [inversion HE; subst; auto]. - Case "T_App". - inversion HE; subst... - (* Most of the cases are immediate by induction, - and [eauto] takes care of them *) - SCase "ST_AppAbs". - apply substitution_preserves_typing with T11... - inversion HT1... -Qed. - -(** **** Exercise: 2 stars (subject_expansion_stlc) *) -(** An exercise in the [Types] chapter asked about the subject - expansion property for the simple language of arithmetic and - boolean expressions. Does this property hold for STLC? That is, - is it always the case that, if [t ==> t'] and [has_type t' T], - then [empty |- t \in T]? If so, prove it. If not, give a - counter-example not involving conditionals. - -(* FILL IN HERE *) -[] -*) - - -(* ###################################################################### *) -(** * Type Soundness *) - -(** **** Exercise: 2 stars, optional (type_soundness) *) - -(** Put progress and preservation together and show that a well-typed - term can _never_ reach a stuck state. *) - -Definition stuck (t:tm) : Prop := - (normal_form step) t /\ ~ value t. - -Corollary soundness : forall t t' T, - empty |- t \in T -> - t ==>* t' -> - ~(stuck t'). -Proof. - intros t t' T Hhas_type Hmulti. unfold stuck. - intros [Hnf Hnot_val]. unfold normal_form in Hnf. - induction Hmulti. - (* FILL IN HERE *) Admitted. - -(* ###################################################################### *) -(** * Uniqueness of Types *) - -(** **** Exercise: 3 stars (types_unique) *) -(** Another pleasant property of the STLC is that types are - unique: a given term (in a given context) has at most one - type. *) -(** Formalize this statement and prove it. *) - -(* FILL IN HERE *) -(** [] *) - -(* ###################################################################### *) -(** * Additional Exercises *) - -(** **** Exercise: 1 star (progress_preservation_statement) *) -(** Without peeking, write down the progress and preservation - theorems for the simply typed lambda-calculus. *) -(** [] *) - - -(** **** Exercise: 2 stars (stlc_variation1) *) -(** Suppose we add a new term [zap] with the following reduction rule: - --------- (ST_Zap) - t ==> zap -and the following typing rule: - ---------------- (T_Zap) - Gamma |- zap : T - Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -[] -*) - -(** **** Exercise: 2 stars (stlc_variation2) *) -(** Suppose instead that we add a new term [foo] with the following reduction rules: - ----------------- (ST_Foo1) - (\x:A. x) ==> foo - - ------------ (ST_Foo2) - foo ==> true - Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -[] -*) - -(** **** Exercise: 2 stars (stlc_variation3) *) -(** Suppose instead that we remove the rule [ST_App1] from the [step] - relation. Which of the following properties of the STLC remain - true in the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -[] -*) - -(** **** Exercise: 2 stars, optional (stlc_variation4) *) -(** Suppose instead that we add the following new rule to the reduction relation: - ---------------------------------- (ST_FunnyIfTrue) - (if true then t1 else t2) ==> true - Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -*) - -(** **** Exercise: 2 stars, optional (stlc_variation5) *) -(** Suppose instead that we add the following new rule to the typing relation: - Gamma |- t1 \in Bool->Bool->Bool - Gamma |- t2 \in Bool - ------------------------------ (T_FunnyApp) - Gamma |- t1 t2 \in Bool - Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -*) - -(** **** Exercise: 2 stars, optional (stlc_variation6) *) -(** Suppose instead that we add the following new rule to the typing relation: - Gamma |- t1 \in Bool - Gamma |- t2 \in Bool - --------------------- (T_FunnyApp') - Gamma |- t1 t2 \in Bool - Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -*) - -(** **** Exercise: 2 stars, optional (stlc_variation7) *) -(** Suppose we add the following new rule to the typing - relation of the STLC: - ------------------- (T_FunnyAbs) - |- \x:Bool.t \in Bool - Which of the following properties of the STLC remain true in - the presence of this rule? For each one, write either - "remains true" or else "becomes false." If a property becomes - false, give a counterexample. - - - Determinism of [step] - - - Progress - - - Preservation - -[] -*) - -End STLCProp. - -(* ###################################################################### *) -(* ###################################################################### *) -(** ** Exercise: STLC with Arithmetic *) - -(** To see how the STLC might function as the core of a real - programming language, let's extend it with a concrete base - type of numbers and some constants and primitive - operators. *) - -Module STLCArith. - -(** To types, we add a base type of natural numbers (and remove - booleans, for brevity) *) - -Inductive ty : Type := - | TArrow : ty -> ty -> ty - | TNat : ty. - -(** To terms, we add natural number constants, along with - successor, predecessor, multiplication, and zero-testing... *) - -Inductive tm : Type := - | tvar : id -> tm - | tapp : tm -> tm -> tm - | tabs : id -> ty -> tm -> tm - | tnat : nat -> tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tmult : tm -> tm -> tm - | tif0 : tm -> tm -> tm -> tm. - -Tactic Notation "t_cases" tactic(first) ident(c) := - first; - [ Case_aux c "tvar" | Case_aux c "tapp" - | Case_aux c "tabs" | Case_aux c "tnat" - | Case_aux c "tsucc" | Case_aux c "tpred" - | Case_aux c "tmult" | Case_aux c "tif0" ]. - -(** **** Exercise: 4 stars (stlc_arith) *) -(** Finish formalizing the definition and properties of the STLC extended - with arithmetic. Specifically: - - - Copy the whole development of STLC that we went through above (from - the definition of values through the Progress theorem), and - paste it into the file at this point. - - - Extend the definitions of the [subst] operation and the [step] - relation to include appropriate clauses for the arithmetic operators. - - - Extend the proofs of all the properties (up to [soundness]) of - the original STLC to deal with the new syntactic forms. Make - sure Coq accepts the whole file. *) - -(* FILL IN HERE *) -(** [] *) - -End STLCArith. - -(* $Date: 2014-04-23 09:37:37 -0400 (Wed, 23 Apr 2014) $ *) - diff --git a/Sub.html b/Sub.html deleted file mode 100644 index 2f953d7..0000000 --- a/Sub.html +++ /dev/null @@ -1,2849 +0,0 @@ - - - - - -Sub: Subtyping - - - - - - -
- - - -
- -

SubSubtyping

- -
-
- -
- -
-
- -
-Require Export MoreStlc.
- -
-
- -
-

Concepts

- -
- - We now turn to the study of subtyping, perhaps the most - characteristic feature of the static type systems of recently - designed programming languages and a key feature needed to support - the object-oriented programming style. -
-
- -
-
- -
-

A Motivating Example

- -
- - Suppose we are writing a program involving two record types - defined as follows: -
-    Person  = {name:String, age:Nat}
-    Student = {name:String, age:Nat, gpa:Nat}
-
- -
- - In the simply typed lamdba-calculus with records, the term -
-    (\r:Person. (r.age)+1) {name="Pat",age=21,gpa=1}
-
- is not typable: it involves an application of a function that wants - a one-field record to an argument that actually provides two - fields, while the T_App rule demands that the domain type of the - function being applied must match the type of the argument - precisely. - -
- - But this is silly: we're passing the function a better argument - than it needs! The only thing the body of the function can - possibly do with its record argument r is project the field age - from it: nothing else is allowed by the type, and the presence or - absence of an extra gpa field makes no difference at all. So, - intuitively, it seems that this function should be applicable to - any record value that has at least an age field. - -
- - Looking at the same thing from another point of view, a record with - more fields is "at least as good in any context" as one with just a - subset of these fields, in the sense that any value belonging to - the longer record type can be used safely in any context - expecting the shorter record type. If the context expects - something with the shorter type but we actually give it something - with the longer type, nothing bad will happen (formally, the - program will not get stuck). - -
- - The general principle at work here is called subtyping. We say - that "S is a subtype of T", informally written S <: T, if a - value of type S can safely be used in any context where a value - of type T is expected. The idea of subtyping applies not only to - records, but to all of the type constructors in the language — - functions, pairs, etc. -
- -

Subtyping and Object-Oriented Languages

- -
- - Subtyping plays a fundamental role in many programming - languages — in particular, it is closely related to the notion of - subclassing in object-oriented languages. - -
- - An object in Java, C#, etc. can be thought of as a record, - some of whose fields are functions ("methods") and some of whose - fields are data values ("fields" or "instance variables"). - Invoking a method m of an object o on some arguments a1..an - consists of projecting out the m field of o and applying it to - a1..an. - -
- - The type of an object can be given as either a class or an - interface. Both of these provide a description of which methods - and which data fields the object offers. - -
- - Classes and interfaces are related by the subclass and - subinterface relations. An object belonging to a subclass (or - subinterface) is required to provide all the methods and fields of - one belonging to a superclass (or superinterface), plus possibly - some more. - -
- - The fact that an object from a subclass (or sub-interface) can be - used in place of one from a superclass (or super-interface) - provides a degree of flexibility that is is extremely handy for - organizing complex libraries. For example, a GUI toolkit like - Java's Swing framework might define an abstract interface - Component that collects together the common fields and methods - of all objects having a graphical representation that can be - displayed on the screen and that can interact with the user. - Examples of such object would include the buttons, checkboxes, and - scrollbars of a typical GUI. A method that relies only on this - common interface can now be applied to any of these objects. - -
- - Of course, real object-oriented languages include many other - features besides these. For example, fields can be updated. - Fields and methods can be declared private. Classes also give - code that is used when constructing objects and implementing - their methods, and the code in subclasses cooperate with code in - superclasses via inheritance. Classes can have static methods - and fields, initializers, etc., etc. - -
- - To keep things simple here, we won't deal with any of these - issues — in fact, we won't even talk any more about objects or - classes. (There is a lot of discussion in Types and Programming - Languages, if you are interested.) Instead, we'll study the core - concepts behind the subclass / subinterface relation in the - simplified setting of the STLC. -
- -

- Of course, real OO languages have lots of other features... - -
- -
    -
  • mutable fields - -
    • -
  • private and other visibility modifiers - -
    • -
  • method inheritance - -
    • -
  • static components - -
    • -
  • etc., etc. - -
    • -
- -
- - We'll ignore all these and focus on core mechanisms. -
- -

The Subsumption Rule

- -
- - Our goal for this chapter is to add subtyping to the simply typed - lambda-calculus (with some of the basic extensions from MoreStlc). - This involves two steps: - -
- -
    -
  • Defining a binary subtype relation between types. - -
    - - -
    • -
  • Enriching the typing relation to take subtyping into account. - -
    • -
- -
- - The second step is actually very simple. We add just a single rule - to the typing relation: the so-called rule of subsumption: -
- - - - - - - - - - -
Γ ⊢ t : S     S <: T - (T_Sub)   -
Γ ⊢ t : T
This rule says, intuitively, that it is OK to "forget" some of - what we know about a term. For example, we may know that t is a record with two - fields (e.g., S = {x:A→A, y:B→B}), but choose to forget about - one of the fields (T = {y:B→B}) so that we can pass t to a - function that requires just a single-field record. -
- -

The Subtype Relation

- -
- - The first step — the definition of the relation S <: T — is - where all the action is. Let's look at each of the clauses of its - definition. -
- -

Structural Rules

- -
- - To start off, we impose two "structural rules" that are - independent of any particular type constructor: a rule of - transitivity, which says intuitively that, if S is better than - U and U is better than T, then S is better than T... -
- - - - - - - - - - -
S <: U    U <: T - (S_Trans)   -
S <: T
... and a rule of reflexivity, since certainly any type T is - as good as itself: -
- - - - - - - - - - -
   - (S_Refl)   -
T <: T
-
- -

Products

- -
- - Now we consider the individual type constructors, one by one, - beginning with product types. We consider one pair to be "better - than" another if each of its components is. -
- - - - - - - - - - -
S1 <: T1    S2 <: T2 - (S_Prod)   -
S1 × S2 <: T1 × T2
-
- -

Arrows

- -
- - Suppose we have two functions f and g with these types: - -
- -
-       f : C → Student 
-       g : (C→Person) → D -
- -
- That is, f is a function that yields a record of type Student, - and g is a (higher-order) function that expects its (function) - argument to yield a record of type Person. Also suppose, even - though we haven't yet discussed subtyping for records, that - Student is a subtype of Person. Then the application g f is - safe even though their types do not match up precisely, because - the only thing g can do with f is to apply it to some - argument (of type C); the result will actually be a Student, - while g will be expecting a Person, but this is safe because - the only thing g can then do is to project out the two fields - that it knows about (name and age), and these will certainly - be among the fields that are present. - -
- - This example suggests that the subtyping rule for arrow types - should say that two arrow types are in the subtype relation if - their results are: -
- - - - - - - - - - -
S2 <: T2 - (S_Arrow_Co)   -
S1 → S2 <: S1 → T2
We can generalize this to allow the arguments of the two arrow - types to be in the subtype relation as well: -
- - - - - - - - - - -
T1 <: S1    S2 <: T2 - (S_Arrow)   -
S1 → S2 <: T1 → T2
Notice that the argument types are subtypes "the other way round": - in order to conclude that S1→S2 to be a subtype of T1→T2, it - must be the case that T1 is a subtype of S1. The arrow - constructor is said to be contravariant in its first argument - and covariant in its second. - -
- - Here is an example that illustrates this: - -
- -
-       f : Person → C
-       g : (Student → C) → D -
- -
- The application g f is safe, because the only thing the body of - g can do with f is to apply it to some argument of type - Student. Since f requires records having (at least) the - fields of a Person, this will always work. So Person → C is a - subtype of Student → C since Student is a subtype of - Person. - -
- - The intuition is that, if we have a function f of type S1→S2, - then we know that f accepts elements of type S1; clearly, f - will also accept elements of any subtype T1 of S1. The type of - f also tells us that it returns elements of type S2; we can - also view these results belonging to any supertype T2 of - S2. That is, any function f of type S1→S2 can also be - viewed as having type T1→T2. - -
- -

Records

- -
- - What about subtyping for record types? -
- - The basic intuition about subtyping for record types is that it is - always safe to use a "bigger" record in place of a "smaller" one. - That is, given a record type, adding extra fields will always - result in a subtype. If some code is expecting a record with - fields x and y, it is perfectly safe for it to receive a record - with fields x, y, and z; the z field will simply be ignored. - For example, - -
- -
-       {name:String, age:Nat, gpa:Nat} <: {name:String, age:Nat}
-       {name:String, age:Nat} <: {name:String}
-       {name:String} <: {} -
- -
- This is known as "width subtyping" for records. -
- - We can also create a subtype of a record type by replacing the type - of one of its fields with a subtype. If some code is expecting a - record with a field x of type T, it will be happy with a record - having a field x of type S as long as S is a subtype of - T. For example, - -
- -
-       {x:Student} <: {x:Person} -
- -
- This is known as "depth subtyping". -
- - Finally, although the fields of a record type are written in a - particular order, the order does not really matter. For example, - -
- -
-       {name:String,age:Nat} <: {age:Nat,name:String} -
- -
- This is known as "permutation subtyping". -
- - We could formalize these requirements in a single subtyping rule - for records as follows: -
- - - - - - - - - - - - - - - - - - -
for each jk in j1..jn,
∃ip in i1..im, such that
jk=ip and Sp <: Tk - (S_Rcd)   -
{i1:S1...im:Sm} <: {j1:T1...jn:Tn}
That is, the record on the left should have all the field labels of - the one on the right (and possibly more), while the types of the - common fields should be in the subtype relation. However, this rule - is rather heavy and hard to read. If we like, we can decompose it - into three simpler rules, which can be combined using S_Trans to - achieve all the same effects. -
- - First, adding fields to the end of a record type gives a subtype: -
- - - - - - - - - - -
n > m - (S_RcdWidth)   -
{i1:T1...in:Tn} <: {i1:T1...im:Tm}
We can use S_RcdWidth to drop later fields of a multi-field - record while keeping earlier fields, showing for example that - {age:Nat,name:String} <: {name:String}. -
- - Second, we can apply subtyping inside the components of a compound - record type: -
- - - - - - - - - - -
S1 <: T1  ...  Sn <: Tn - (S_RcdDepth)   -
{i1:S1...in:Sn} <: {i1:T1...in:Tn}
For example, we can use S_RcdDepth and S_RcdWidth together to - show that {y:Student, x:Nat} <: {y:Person}. -
- - Third, we need to be able to reorder fields. For example, we - might expect that {name:String, gpa:Nat, age:Nat} <: Person. We - haven't quite achieved this yet: using just S_RcdDepth and - S_RcdWidth we can only drop fields from the end of a record - type. So we need: -
- - - - - - - - - - -
{i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn} - (S_RcdPerm)   -
{i1:S1...in:Sn} <: {i1:T1...in:Tn}
-
- - It is worth noting that full-blown language designs may choose not - to adopt all of these subtyping rules. For example, in Java: - -
- -
    -
  • A subclass may not change the argument or result types of a - method of its superclass (i.e., no depth subtyping or no arrow - subtyping, depending how you look at it). - -
    - - -
    • -
  • Each class has just one superclass ("single inheritance" of - classes). - -
    - - -
    • -
  • Each class member (field or method) can be assigned a single - index, adding new indices "on the right" as more members are - added in subclasses (i.e., no permutation for classes). - -
    - - -
    • -
  • A class may implement multiple interfaces — so-called "multiple - inheritance" of interfaces (i.e., permutation is allowed for - interfaces). -
    • -
- -
- -

Exercise: 2 stars (arrow_sub_wrong)

- Suppose we had incorrectly defined subtyping as covariant on both - the right and the left of arrow types: -
- - - - - - - - - - -
S1 <: T1    S2 <: T2 - (S_Arrow_wrong)   -
S1 → S2 <: T1 → T2
Give a concrete example of functions f and g with the following types... - -
- -
-       f : Student → Nat
-       g : (Person → Nat) → Nat -
- -
- ... such that the application g f will get stuck during - execution. - -
- -☐ - -
- -

Top

- -
- - Finally, it is natural to give the subtype relation a maximal - element — a type that lies above every other type and is - inhabited by all (well-typed) values. We do this by adding to the - language one new type constant, called Top, together with a - subtyping rule that places it above every other type in the - subtype relation: -
- - - - - - - - - - -
   - (S_Top)   -
S <: Top
The Top type is an analog of the Object type in Java and C#. -
-
- -
-
- -
-

Summary

- -
- - In summary, we form the STLC with subtyping by starting with the - pure STLC (over some set of base types) and... - -
- -
    -
  • adding a base type Top, - -
    - - -
    • -
  • adding the rule of subsumption -
    - - - - - - - - - - -
    Γ ⊢ t : S     S <: T - (T_Sub)   -
    Γ ⊢ t : T
    to the typing relation, and - -
    - - -
    • -
  • defining a subtype relation as follows: -
    - - - - - - - - - - -
    S <: U    U <: T - (S_Trans)   -
    S <: T
    - - - - - - - - - - -
       - (S_Refl)   -
    T <: T
    - - - - - - - - - - -
       - (S_Top)   -
    S <: Top
    - - - - - - - - - - -
    S1 <: T1    S2 <: T2 - (S_Prod)   -
    S1 × S2 <: T1 × T2
    - - - - - - - - - - -
    T1 <: S1    S2 <: T2 - (S_Arrow)   -
    S1 → S2 <: T1 → T2
    - - - - - - - - - - -
    n > m - (S_RcdWidth)   -
    {i1:T1...in:Tn} <: {i1:T1...im:Tm}
    - - - - - - - - - - -
    S1 <: T1  ...  Sn <: Tn - (S_RcdDepth)   -
    {i1:S1...in:Sn} <: {i1:T1...in:Tn}
    - - - - - - - - - - -
    {i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn} - (S_RcdPerm)   -
    {i1:S1...in:Sn} <: {i1:T1...in:Tn}
    -
    • -
- -
-
- -
-
- -
-

Exercises

- -
- -

Exercise: 1 star, optional (subtype_instances_tf_1)

- Suppose we have types S, T, U, and V with S <: T - and U <: V. Which of the following subtyping assertions - are then true? Write true or false after each one. - (A, B, and C here are base types.) - -
- -
    -
  • T→S <: T→S - -
    - - -
    • -
  • Top→U <: S→Top - -
    - - -
    • -
  • (C→C) → (A×B) <: (C→C) → (Top×B) - -
    - - -
    • -
  • T→T→U <: S→S→V - -
    - - -
    • -
  • (T→T)→U <: (S→S)→V - -
    - - -
    • -
  • ((T→S)→T)→U <: ((S→T)→S)→V - -
    - - -
    • -
  • S×V <: T×U - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (subtype_order)

- The following types happen to form a linear order with respect to subtyping: - -
- -
    -
  • Top - -
    • -
  • Top → Student - -
    • -
  • Student → Person - -
    • -
  • Student → Top - -
    • -
  • Person → Student - -
    • -
- -
- -Write these types in order from the most specific to the most general. - -
- -Where does the type Top→Top→Student fit into this order? - -
- - -
- -

Exercise: 1 star (subtype_instances_tf_2)

- Which of the following statements are true? Write true or - false after each one. - -
- -
-      ∀S T,
-          S <: T  →
-          S→S   <:  T→T
-
-      ∀S,
-           S <: A→A →
-           ∃T,
-              S = T→T  ∧  T <: A
-
-      ∀S T1 T2,
-           (S <: T1 → T2) →
-           ∃S1 S2,
-              S = S1 → S2  ∧  T1 <: S1  ∧  S2 <: T2 
-
-      ∃S,
-           S <: S→S 
-
-      ∃S,
-           S→S <: S   
-
-      ∀S T1 T2,
-           S <: T1×T2 →
-           ∃S1 S2,
-              S = S1×S2  ∧  S1 <: T1  ∧  S2 <: T2   -
- -
-☐ -
- -

Exercise: 1 star (subtype_concepts_tf)

- Which of the following statements are true, and which are false? - -
- -
    -
  • There exists a type that is a supertype of every other type. - -
    - - -
    • -
  • There exists a type that is a subtype of every other type. - -
    - - -
    • -
  • There exists a pair type that is a supertype of every other - pair type. - -
    - - -
    • -
  • There exists a pair type that is a subtype of every other - pair type. - -
    - - -
    • -
  • There exists an arrow type that is a supertype of every other - arrow type. - -
    - - -
    • -
  • There exists an arrow type that is a subtype of every other - arrow type. - -
    - - -
    • -
  • There is an infinite descending chain of distinct types in the - subtype relation—-that is, an infinite sequence of types - S0, S1, etc., such that all the Si's are different and - each S(i+1) is a subtype of Si. - -
    - - -
    • -
  • There is an infinite ascending chain of distinct types in - the subtype relation—-that is, an infinite sequence of types - S0, S1, etc., such that all the Si's are different and - each S(i+1) is a supertype of Si. - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (proper_subtypes)

- Is the following statement true or false? Briefly explain your - answer. - -
- -
-    ∀T,
-         ~(∃n, T = TBase n) →
-         ∃S,
-            S <: T  ∧  S ≠ T -
- -
-☐ - -
- -

Exercise: 2 stars (small_large_1)

- -
- -
    -
  • What is the smallest type T ("smallest" in the subtype - relation) that makes the following assertion true? (Assume we - have Unit among the base types and unit as a constant of this - type.) - -
    - -
    -  empty ⊢ (\p:T×Top. p.fst) ((\z:A.z), unit) : A→A -
    - -
    - -
    - - -
    • -
  • What is the largest type T that makes the same assertion true? - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (small_large_2)

- -
- -
    -
  • What is the smallest type T that makes the following - assertion true? - -
    - -
    -  empty ⊢ (\p:(A→A × B→B). p) ((\z:A.z), (\z:B.z)) : T -
    - -
    - -
    - - -
    • -
  • What is the largest type T that makes the same assertion true? - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars, optional (small_large_3)

- -
- -
    -
  • What is the smallest type T that makes the following - assertion true? - -
    - -
    -  a:A ⊢ (\p:(A×T). (p.snd) (p.fst)) (a , \z:A.z) : A -
    - -
    - -
    - - -
    • -
  • What is the largest type T that makes the same assertion true? - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (small_large_4)

- -
- -
    -
  • What is the smallest type T that makes the following - assertion true? - -
    - -
    -  ∃S,
    -    empty ⊢ (\p:(A×T). (p.snd) (p.fst)) : S -
    - -
    - -
    - - -
    • -
  • What is the largest type T that makes the same - assertion true? - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (smallest_1)

- What is the smallest type T that makes the following - assertion true? - -
- -
-      ∃S, ∃t, 
-        empty ⊢ (\x:T. x x) t : S -
- -
-☐ - -
- -

Exercise: 2 stars (smallest_2)

- What is the smallest type T that makes the following - assertion true? - -
- -
-      empty ⊢ (\x:Top. x) ((\z:A.z) , (\z:B.z)) : T -
- -
-☐ - -
- -

Exercise: 3 stars, optional (count_supertypes)

- How many supertypes does the record type {x:A, y:C→C} have? That is, - how many different types T are there such that {x:A, y:C→C} <: - T? (We consider two types to be different if they are written - differently, even if each is a subtype of the other. For example, - {x:A,y:B} and {y:B,x:A} are different.) - -
- -☐ - -
- -

Exercise: 2 stars (pair_permutation)

- The subtyping rule for product types -
- - - - - - - - - - -
S1 <: T1    S2 <: T2 - (S_Prod)   -
S1*S2 <: T1*T2
intuitively corresponds to the "depth" subtyping rule for records. Extending the analogy, we might consider adding a "permutation" rule -
- - - - - - - - - - -
   -   -
T1*T2 <: T2*T1
for products. -Is this a good idea? Briefly explain why or why not. - -
- -☐ - -
-
- -
-
- -
-

Formal Definitions

- -
- - Most of the definitions — in particular, the syntax and - operational semantics of the language — are identical to what we - saw in the last chapter. We just need to extend the typing - relation with the subsumption rule and add a new Inductive - definition for the subtyping relation. Let's first do the - identical bits. -
-
- -
-
- -
-

Core Definitions

- -
-
- -
-
- -
-

Syntax

- -
- - For the sake of more interesting examples below, we'll allow an - arbitrary set of additional base types like String, Float, - etc. We won't bother adding any constants belonging to these - types or any operators on them, but we could easily do so. -
- - In the rest of the chapter, we formalize just base types, - booleans, arrow types, Unit, and Top, omitting record types - and leaving product types as an exercise. -
-
- -
-Inductive ty : Type :=
-  | TTop : ty
-  | TBool : ty
-  | TBase : id → ty
-  | TArrow : ty → ty → ty
-  | TUnit : ty
-.
- -
-Tactic Notation "T_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "TTop" | Case_aux c "TBool"
-  | Case_aux c "TBase" | Case_aux c "TArrow"
-  | Case_aux c "TUnit" |
-  ].
- -
-Inductive tm : Type :=
-  | tvar : id → tm
-  | tapp : tm → tm → tm
-  | tabs : id → ty → tm → tm
-  | ttrue : tm
-  | tfalse : tm
-  | tif : tm → tm → tm → tm
-  | tunit : tm
-.
- -
-Tactic Notation "t_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "tvar" | Case_aux c "tapp"
-  | Case_aux c "tabs" | Case_aux c "ttrue"
-  | Case_aux c "tfalse" | Case_aux c "tif"
-  | Case_aux c "tunit"
-  ].
- -
-
- -
-

Substitution

- -
- - The definition of substitution remains exactly the same as for the - pure STLC. -
-
- -
-Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
-  match t with
-  | tvar y ⇒
-      if eq_id_dec x y then s else t
-  | tabs y T t1 ⇒
-      tabs y T (if eq_id_dec x y then t1 else (subst x s t1))
-  | tapp t1 t2 ⇒
-      tapp (subst x s t1) (subst x s t2)
-  | ttrue ⇒
-      ttrue
-  | tfalse ⇒
-      tfalse
-  | tif t1 t2 t3 ⇒
-      tif (subst x s t1) (subst x s t2) (subst x s t3)
-  | tunit ⇒
-      tunit
-  end.
- -
-Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
- -
-
- -
-

Reduction

- -
- - Likewise the definitions of the value property and the step - relation. -
-
- -
-Inductive value : tm → Prop :=
-  | v_abs : ∀x T t,
-      value (tabs x T t)
-  | v_true :
-      value ttrue
-  | v_false :
-      value tfalse
-  | v_unit :
-      value tunit
-.
- -
-Hint Constructors value.
- -
-Reserved Notation "t1 '⇒' t2" (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_AppAbs : ∀x T t12 v2,
-         value v2 →
-         (tapp (tabs x T t12) v2) ⇒ [x:=v2]t12
-  | ST_App1 : ∀t1 t1' t2,
-         t1 ⇒ t1' →
-         (tapp t1 t2) ⇒ (tapp t1' t2)
-  | ST_App2 : ∀v1 t2 t2',
-         value v1 →
-         t2 ⇒ t2' →
-         (tapp v1 t2) ⇒ (tapp v1 t2')
-  | ST_IfTrue : ∀t1 t2,
-      (tif ttrue t1 t2) ⇒ t1
-  | ST_IfFalse : ∀t1 t2,
-      (tif tfalse t1 t2) ⇒ t2
-  | ST_If : ∀t1 t1' t2 t3,
-      t1 ⇒ t1' →
-      (tif t1 t2 t3) ⇒ (tif t1' t2 t3)
-where "t1 '⇒' t2" := (step t1 t2).
- -
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1"
-  | Case_aux c "ST_App2" | Case_aux c "ST_IfTrue"
-  | Case_aux c "ST_IfFalse" | Case_aux c "ST_If"
-  ].
- -
-Hint Constructors step.
- -
-
- -
-

Subtyping

- -
- - Now we come to the most interesting part. We begin by - defining the subtyping relation and developing some of its - important technical properties. -
- - The definition of subtyping is just what we sketched in the - motivating discussion. -
-
- -
-Reserved Notation "T '<:' U" (at level 40).
- -
-Inductive subtype : ty → ty → Prop :=
-  | S_Refl : ∀T,
-      T <: T
-  | S_Trans : ∀S U T,
-      S <: U →
-      U <: T →
-      S <: T
-  | S_Top : ∀S,
-      S <: TTop
-  | S_Arrow : ∀S1 S2 T1 T2,
-      T1 <: S1 →
-      S2 <: T2 →
-      (TArrow S1 S2) <: (TArrow T1 T2)
-where "T '<:' U" := (subtype T U).
- -
-
- -
-Note that we don't need any special rules for base types: they are - automatically subtypes of themselves (by S_Refl) and Top (by - S_Top), and that's all we want. -
-
- -
-Hint Constructors subtype.
- -
-Tactic Notation "subtype_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "S_Refl" | Case_aux c "S_Trans"
-  | Case_aux c "S_Top" | Case_aux c "S_Arrow"
-  ].
- -
-Module Examples.
- -
-Notation x := (Id 0).
-Notation y := (Id 1).
-Notation z := (Id 2).
- -
-Notation A := (TBase (Id 6)).
-Notation B := (TBase (Id 7)).
-Notation C := (TBase (Id 8)).
- -
-Notation String := (TBase (Id 9)).
-Notation Float := (TBase (Id 10)).
-Notation Integer := (TBase (Id 11)).
- -
-
- -
-

Exercise: 2 stars, optional (subtyping_judgements)

- -
- - (Do this exercise after you have added product types to the - language, at least up to this point in the file). - -
- - Using the encoding of records into pairs, define pair types - representing the record types - -
- -
-    Person   := { name : String }
-    Student  := { name : String ; 
-                  gpa  : Float }
-    Employee := { name : String ;
-                  ssn  : Integer } -
- -
- -
-
- -
-Definition Person : ty :=
-(* FILL IN HERE *) admit.
-Definition Student : ty :=
-(* FILL IN HERE *) admit.
-Definition Employee : ty :=
-(* FILL IN HERE *) admit.
- -
-Example sub_student_person :
-  Student <: Person.
-Proof.
-(* FILL IN HERE *) Admitted.
- -
-Example sub_employee_person :
-  Employee <: Person.
-Proof.
-(* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-Example subtyping_example_0 :
-  (TArrow C Person) <: (TArrow C TTop).
-  (* C->Person <: C->Top *)
-Proof.
-  apply S_Arrow.
-    apply S_Refl. auto.
-Qed.
- -
-
- -
-The following facts are mostly easy to prove in Coq. To get - full benefit from the exercises, make sure you also - understand how to prove them on paper! -
- -

Exercise: 1 star, optional (subtyping_example_1)

- -
-
-Example subtyping_example_1 :
-  (TArrow TTop Student) <: (TArrow (TArrow C C) Person).
-  (* Top->Student <: (C->C)->Person *)
-Proof with eauto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- -

Exercise: 1 star, optional (subtyping_example_2)

- -
-
-Example subtyping_example_2 :
-  (TArrow TTop Person) <: (TArrow Person TTop).
-  (* Top->Person <: Person->Top *)
-Proof with eauto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-End Examples.
- -
-
- -
-

Typing

- -
- - The only change to the typing relation is the addition of the rule - of subsumption, T_Sub. -
-
- -
-Definition context := id → (option ty).
-Definition empty : context := (fun _ ⇒ None).
-Definition extend (Γ : context) (x:id) (T : ty) :=
-  fun x' ⇒ if eq_id_dec x x' then Some T else Γ x'.
- -
-Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).
- -
-Inductive has_type : context → tm → ty → Prop :=
-  (* Same as before *)
-  | T_Var : ∀Γ x T,
-      Γ x = Some T →
-      Γ ⊢ (tvar x) ∈ T
-  | T_Abs : ∀Γ x T11 T12 t12,
-      (extend Γ x T11) ⊢ t12 ∈ T12 →
-      Γ ⊢ (tabs x T11 t12) ∈ (TArrow T11 T12)
-  | T_App : ∀T1 T2 Γ t1 t2,
-      Γ ⊢ t1 ∈ (TArrow T1 T2) →
-      Γ ⊢ t2 ∈ T1 →
-      Γ ⊢ (tapp t1 t2) ∈ T2
-  | T_True : ∀Γ,
-       Γ ⊢ ttrue ∈ TBool
-  | T_False : ∀Γ,
-       Γ ⊢ tfalse ∈ TBool
-  | T_If : ∀t1 t2 t3 T Γ,
-       Γ ⊢ t1 ∈ TBool →
-       Γ ⊢ t2 ∈ T →
-       Γ ⊢ t3 ∈ T →
-       Γ ⊢ (tif t1 t2 t3) ∈ T
-  | T_Unit : ∀Γ,
-      Γ ⊢ tunit ∈ TUnit
-  (* New rule of subsumption *)
-  | T_Sub : ∀Γ t S T,
-      Γ ⊢ t ∈ S →
-      S <: T →
-      Γ ⊢ t ∈ T
-
-where "Gamma '⊢' t '∈' T" := (has_type Γ t T).
- -
-Hint Constructors has_type.
- -
-Tactic Notation "has_type_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "T_Var" | Case_aux c "T_Abs"
-  | Case_aux c "T_App" | Case_aux c "T_True"
-  | Case_aux c "T_False" | Case_aux c "T_If"
-  | Case_aux c "T_Unit"
-  | Case_aux c "T_Sub" ].
- -
-
- -
-

Typing examples

- -
-
- -
-Module Examples2.
-Import Examples.
- -
-
- -
-Do the following exercises after you have added product types to - the language. For each informal typing judgement, write it as a - formal statement in Coq and prove it. -
- -

Exercise: 1 star, optional (typing_example_0)

- -
-
-(* empty |- ((\z:A.z), (\z:B.z)) 
-          : (A->A * B->B) *)
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 2 stars, optional (typing_example_1)

- -
-
-(* empty |- (\x:(Top * B->B). x.snd) ((\z:A.z), (\z:B.z)) 
-          : B->B *)
-(* FILL IN HERE *)
-
- -
-☐ -
- -

Exercise: 2 stars, optional (typing_example_2)

- -
-
-(* empty |- (\z:(C->C)->(Top * B->B). (z (\x:C.x)).snd)
-              (\z:C->C. ((\z:A.z), (\z:B.z)))
-          : B->B *)
-(* FILL IN HERE *)
-
- -
-☐ -
-
- -
-End Examples2.
- -
-
- -
-

Properties

- -
- - The fundamental properties of the system that we want to check are - the same as always: progress and preservation. Unlike the - extension of the STLC with references, we don't need to change the - statements of these properties to take subtyping into account. - However, their proofs do become a little bit more involved. -
-
- -
-
- -
-

Inversion Lemmas for Subtyping

- -
- - Before we look at the properties of the typing relation, we need - to record a couple of critical structural properties of the subtype - relation: - -
- -
    -
  • Bool is the only subtype of Bool - -
    • -
  • every subtype of an arrow type is itself an arrow type. -
    • -
- -
- - These are called inversion lemmas because they play the same - role in later proofs as the built-in inversion tactic: given a - hypothesis that there exists a derivation of some subtyping - statement S <: T and some constraints on the shape of S and/or - T, each one reasons about what this derivation must look like to - tell us something further about the shapes of S and T and the - existence of subtype relations between their parts. -
- -

Exercise: 2 stars, optional (sub_inversion_Bool)

- -
-
-Lemma sub_inversion_Bool : ∀U,
-     U <: TBool →
-       U = TBool.
-Proof with auto.
-  intros U Hs.
-  remember TBool as V.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-

Exercise: 3 stars, optional (sub_inversion_arrow)

- -
-
-Lemma sub_inversion_arrow : ∀U V1 V2,
-     U <: (TArrow V1 V2) →
-     ∃U1, ∃U2,
-       U = (TArrow U1 U2) ∧ (V1 <: U1) ∧ (U2 <: V2).
-Proof with eauto.
-  intros U V1 V2 Hs.
-  remember (TArrow V1 V2) as V.
-  generalize dependent V2. generalize dependent V1.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-☐ -
-
- -
-
- -
-

Canonical Forms

- -
- - We'll see first that the proof of the progress theorem doesn't - change too much — we just need one small refinement. When we're - considering the case where the term in question is an application - t1 t2 where both t1 and t2 are values, we need to know that - t1 has the form of a lambda-abstraction, so that we can apply - the ST_AppAbs reduction rule. In the ordinary STLC, this is - obvious: we know that t1 has a function type T11→T12, and - there is only one rule that can be used to give a function type to - a value — rule T_Abs — and the form of the conclusion of this - rule forces t1 to be an abstraction. - -
- - In the STLC with subtyping, this reasoning doesn't quite work - because there's another rule that can be used to show that a value - has a function type: subsumption. Fortunately, this possibility - doesn't change things much: if the last rule used to show Γ - ⊢ t1 : T11→T12 is subsumption, then there is some - sub-derivation whose subject is also t1, and we can reason by - induction until we finally bottom out at a use of T_Abs. - -
- - This bit of reasoning is packaged up in the following lemma, which - tells us the possible "canonical forms" (i.e. values) of function - type. -
- -

Exercise: 3 stars, optional (canonical_forms_of_arrow_types)

- -
-
-Lemma canonical_forms_of_arrow_types : ∀Γ s T1 T2,
-  Γ ⊢ s ∈ (TArrow T1 T2) →
-  value s →
-  ∃x, ∃S1, ∃s2,
-     s = tabs x S1 s2.
-Proof with eauto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
- - Similarly, the canonical forms of type Bool are the constants - true and false. -
-
- -
-Lemma canonical_forms_of_Bool : ∀Γ s,
-  Γ ⊢ s ∈ TBool →
-  value s →
-  (s = ttrue ∨ s = tfalse).
-
-
-Proof with eauto.
-  intros Γ s Hty Hv.
-  remember TBool as T.
-  has_type_cases (induction Hty) Case; try solve by inversion...
-  Case "T_Sub".
-    subst. apply sub_inversion_Bool in H. subst...
-Qed.
-
- -
-
- -
-

Progress

- -
- - The proof of progress proceeds like the one for the pure - STLC, except that in several places we invoke canonical forms - lemmas... -
- - Theorem (Progress): For any term t and type T, if empty ⊢ - t : T then t is a value or t ⇒ t' for some term t'. - -
- - Proof: Let t and T be given, with empty ⊢ t : T. Proceed - by induction on the typing derivation. - -
- - The cases for T_Abs, T_Unit, T_True and T_False are - immediate because abstractions, unit, true, and false are - already values. The T_Var case is vacuous because variables - cannot be typed in the empty context. The remaining cases are - more interesting: - -
- -
    -
  • If the last step in the typing derivation uses rule T_App, - then there are terms t1 t2 and types T1 and T2 such that - t = t1 t2, T = T2, empty ⊢ t1 : T1 → T2, and empty ⊢ - t2 : T1. Moreover, by the induction hypothesis, either t1 is - a value or it steps, and either t2 is a value or it steps. - There are three possibilities to consider: - -
    - -
      -
    • Suppose t1 ⇒ t1' for some term t1'. Then t1 t2 ⇒ t1' t2 - by ST_App1. - -
      - - -
      • -
    • Suppose t1 is a value and t2 ⇒ t2' for some term t2'. - Then t1 t2 ⇒ t1 t2' by rule ST_App2 because t1 is a - value. - -
      - - -
      • -
    • Finally, suppose t1 and t2 are both values. By Lemma - canonical_forms_for_arrow_types, we know that t1 has the - form \x:S1.s2 for some x, S1, and s2. But then - (\x:S1.s2) t2 ⇒ [x:=t2]s2 by ST_AppAbs, since t2 is a - value. - -
      - - -
      • -
    - -
    • -
  • If the final step of the derivation uses rule T_If, then there - are terms t1, t2, and t3 such that t = if t1 then t2 else - t3, with empty ⊢ t1 : Bool and with empty ⊢ t2 : T and - empty ⊢ t3 : T. Moreover, by the induction hypothesis, - either t1 is a value or it steps. - -
    - -
      -
    • If t1 is a value, then by the canonical forms lemma for - booleans, either t1 = true or t1 = false. In either - case, t can step, using rule ST_IfTrue or ST_IfFalse. - -
      - - -
      • -
    • If t1 can step, then so can t, by rule ST_If. - -
      - - -
      • -
    - -
    • -
  • If the final step of the derivation is by T_Sub, then there is - a type S such that S <: T and empty ⊢ t : S. The desired - result is exactly the induction hypothesis for the typing - subderivation. - -
    • -
- -
-
- -
-Theorem progress : ∀t T,
-     empty ⊢ t ∈ T →
-     value t ∨ ∃t', t ⇒ t'.
-
-
-Proof with eauto.
-  intros t T Ht.
-  remember empty as Γ.
-  revert HeqGamma.
-  has_type_cases (induction Ht) Case;
-    intros HeqGamma; subst...
-  Case "T_Var".
-    inversion H.
-  Case "T_App".
-    right.
-    destruct IHHt1; subst...
-    SCase "t1 is a value".
-      destruct IHHt2; subst...
-      SSCase "t2 is a value".
-        destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
-          as [x [S1 [t12 Heqt1]]]...
-        subst. ∃([x:=t2]t12)...
-      SSCase "t2 steps".
-        inversion H0 as [t2' Hstp]. ∃(tapp t1 t2')...
-    SCase "t1 steps".
-      inversion H as [t1' Hstp]. ∃(tapp t1' t2)...
-  Case "T_If".
-    right.
-    destruct IHHt1.
-    SCase "t1 is a value"...
-      assert (t1 = ttrue ∨ t1 = tfalse)
-        by (eapply canonical_forms_of_Bool; eauto).
-      inversion H0; subst...
-      inversion H. rename x into t1'. eauto.
- -
-Qed.
-
- -
-
- -
-

Inversion Lemmas for Typing

- -
- - The proof of the preservation theorem also becomes a little more - complex with the addition of subtyping. The reason is that, as - with the "inversion lemmas for subtyping" above, there are a - number of facts about the typing relation that are "obvious from - the definition" in the pure STLC (and hence can be obtained - directly from the inversion tactic) but that require real proofs - in the presence of subtyping because there are multiple ways to - derive the same has_type statement. - -
- - The following "inversion lemma" tells us that, if we have a - derivation of some typing statement Γ ⊢ \x:S1.t2 : T whose - subject is an abstraction, then there must be some subderivation - giving a type to the body t2. -
- - Lemma: If Γ ⊢ \x:S1.t2 : T, then there is a type S2 - such that Γ, x:S1 ⊢ t2 : S2 and S1 → S2 <: T. - -
- - (Notice that the lemma does not say, "then T itself is an arrow - type" — this is tempting, but false!) - -
- - Proof: Let Γ, x, S1, t2 and T be given as - described. Proceed by induction on the derivation of Γ ⊢ - \x:S1.t2 : T. Cases T_Var, T_App, are vacuous as those - rules cannot be used to give a type to a syntactic abstraction. - -
- -
    -
  • If the last step of the derivation is a use of T_Abs then - there is a type T12 such that T = S1 → T12 and Γ, - x:S1 ⊢ t2 : T12. Picking T12 for S2 gives us what we - need: S1 → T12 <: S1 → T12 follows from S_Refl. - -
    - - -
    • -
  • If the last step of the derivation is a use of T_Sub then - there is a type S such that S <: T and Γ ⊢ \x:S1.t2 : - S. The IH for the typing subderivation tell us that there is - some type S2 with S1 → S2 <: S and Γ, x:S1 ⊢ t2 : - S2. Picking type S2 gives us what we need, since S1 → S2 - <: T then follows by S_Trans. -
    • -
- -
-
- -
-Lemma typing_inversion_abs : ∀Γ x S1 t2 T,
-     Γ ⊢ (tabs x S1 t2) ∈ T →
-     (∃S2, (TArrow S1 S2) <: T
-              ∧ (extend Γ x S1) ⊢ t2 ∈ S2).
-
-
-Proof with eauto.
-  intros Γ x S1 t2 T H.
-  remember (tabs x S1 t2) as t.
-  has_type_cases (induction H) Case;
-    inversion Heqt; subst; intros; try solve by inversion.
-  Case "T_Abs".
-    ∃T12...
-  Case "T_Sub".
-    destruct IHhas_type as [S2 [Hsub Hty]]...
-  Qed.
-
- -
-
- -
-Similarly... -
-
- -
-Lemma typing_inversion_var : ∀Γ x T,
-  Γ ⊢ (tvar x) ∈ T →
-  ∃S,
-    Γ x = Some S ∧ S <: T.
-
-
-Proof with eauto.
-  intros Γ x T Hty.
-  remember (tvar x) as t.
-  has_type_cases (induction Hty) Case; intros;
-    inversion Heqt; subst; try solve by inversion.
-  Case "T_Var".
-    ∃T...
-  Case "T_Sub".
-    destruct IHHty as [U [Hctx HsubU]]... Qed.
-
- -
-Lemma typing_inversion_app : ∀Γ t1 t2 T2,
-  Γ ⊢ (tapp t1 t2) ∈ T2 →
-  ∃T1,
-    Γ ⊢ t1 ∈ (TArrow T1 T2) ∧
-    Γ ⊢ t2 ∈ T1.
-
-
-Proof with eauto.
-  intros Γ t1 t2 T2 Hty.
-  remember (tapp t1 t2) as t.
-  has_type_cases (induction Hty) Case; intros;
-    inversion Heqt; subst; try solve by inversion.
-  Case "T_App".
-    ∃T1...
-  Case "T_Sub".
-    destruct IHHty as [U1 [Hty1 Hty2]]...
-Qed.
-
- -
-Lemma typing_inversion_true : ∀Γ T,
-  Γ ⊢ ttrue ∈ T →
-  TBool <: T.
-
-
-Proof with eauto.
-  intros Γ T Htyp. remember ttrue as tu.
-  has_type_cases (induction Htyp) Case;
-    inversion Heqtu; subst; intros...
-Qed.
-
- -
-Lemma typing_inversion_false : ∀Γ T,
-  Γ ⊢ tfalse ∈ T →
-  TBool <: T.
-
-
-Proof with eauto.
-  intros Γ T Htyp. remember tfalse as tu.
-  has_type_cases (induction Htyp) Case;
-    inversion Heqtu; subst; intros...
-Qed.
-
- -
-Lemma typing_inversion_if : ∀Γ t1 t2 t3 T,
-  Γ ⊢ (tif t1 t2 t3) ∈ T →
-  Γ ⊢ t1 ∈ TBool
-  ∧ Γ ⊢ t2 ∈ T
-  ∧ Γ ⊢ t3 ∈ T.
-
-
-Proof with eauto.
-  intros Γ t1 t2 t3 T Hty.
-  remember (tif t1 t2 t3) as t.
-  has_type_cases (induction Hty) Case; intros;
-    inversion Heqt; subst; try solve by inversion.
-  Case "T_If".
-    auto.
-  Case "T_Sub".
-    destruct (IHHty H0) as [H1 [H2 H3]]...
-Qed.
-
- -
-Lemma typing_inversion_unit : ∀Γ T,
-  Γ ⊢ tunit ∈ T →
-    TUnit <: T.
-
-
-Proof with eauto.
-  intros Γ T Htyp. remember tunit as tu.
-  has_type_cases (induction Htyp) Case;
-    inversion Heqtu; subst; intros...
-Qed.
-
- -
-
- -
-The inversion lemmas for typing and for subtyping between arrow - types can be packaged up as a useful "combination lemma" telling - us exactly what we'll actually require below. -
-
- -
-Lemma abs_arrow : ∀x S1 s2 T1 T2,
-  empty ⊢ (tabs x S1 s2) ∈ (TArrow T1 T2) →
-     T1 <: S1
-  ∧ (extend empty x S1) ⊢ s2 ∈ T2.
-
-
-Proof with eauto.
-  intros x S1 s2 T1 T2 Hty.
-  apply typing_inversion_abs in Hty.
-  inversion Hty as [S2 [Hsub Hty1]].
-  apply sub_inversion_arrow in Hsub.
-  inversion Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
-  inversion Heq; subst... Qed.
-
- -
-
- -
-

Context Invariance

- -
- - The context invariance lemma follows the same pattern as in the - pure STLC. -
-
- -
-Inductive appears_free_in : id → tm → Prop :=
-  | afi_var : ∀x,
-      appears_free_in x (tvar x)
-  | afi_app1 : ∀x t1 t2,
-      appears_free_in x t1 → appears_free_in x (tapp t1 t2)
-  | afi_app2 : ∀x t1 t2,
-      appears_free_in x t2 → appears_free_in x (tapp t1 t2)
-  | afi_abs : ∀x y T11 t12,
-        y ≠ x →
-        appears_free_in x t12 →
-        appears_free_in x (tabs y T11 t12)
-  | afi_if1 : ∀x t1 t2 t3,
-      appears_free_in x t1 →
-      appears_free_in x (tif t1 t2 t3)
-  | afi_if2 : ∀x t1 t2 t3,
-      appears_free_in x t2 →
-      appears_free_in x (tif t1 t2 t3)
-  | afi_if3 : ∀x t1 t2 t3,
-      appears_free_in x t3 →
-      appears_free_in x (tif t1 t2 t3)
-.
- -
-Hint Constructors appears_free_in.
- -
-Lemma context_invariance : ∀Γ Γ' t S,
-     Γ ⊢ t ∈ S →
-     (∀x, appears_free_in x t → Γ x = Γ' x) →
-     Γ' ⊢ t ∈ S.
-
-
-Proof with eauto.
-  intros. generalize dependent Γ'.
-  has_type_cases (induction H) Case;
-    intros Γ' Heqv...
-  Case "T_Var".
-    apply T_Var... rewrite ← Heqv...
-  Case "T_Abs".
-    apply T_Abs... apply IHhas_type. intros x0 Hafi.
-    unfold extend. destruct (eq_id_dec x x0)...
- -
-  Case "T_App".
-    apply T_App with T1...
-  Case "T_If".
-    apply T_If...
- -
-Qed.
-
- -
-Lemma free_in_context : ∀x t T Γ,
-   appears_free_in x t →
-   Γ ⊢ t ∈ T →
-   ∃T', Γ x = Some T'.
-
-
-Proof with eauto.
-  intros x t T Γ Hafi Htyp.
-  has_type_cases (induction Htyp) Case;
-      subst; inversion Hafi; subst...
-  Case "T_Abs".
-    destruct (IHHtyp H4) as [T Hctx]. ∃T.
-    unfold extend in Hctx. rewrite neq_id in Hctx... Qed.
-
- -
-
- -
-

Substitution

- -
- - The substitution lemma is proved along the same lines as - for the pure STLC. The only significant change is that there are - several places where, instead of the built-in inversion tactic, - we need to use the inversion lemmas that we proved above to - extract structural information from assumptions about the - well-typedness of subterms. -
-
- -
-Lemma substitution_preserves_typing : ∀Γ x U v t S,
-     (extend Γ x U) ⊢ t ∈ S →
-     empty ⊢ v ∈ U →
-     Γ ⊢ ([x:=v]t) ∈ S.
-
-
-Proof with eauto.
-  intros Γ x U v t S Htypt Htypv.
-  generalize dependent S. generalize dependent Γ.
-  t_cases (induction t) Case; intros; simpl.
-  Case "tvar".
-    rename i into y.
-    destruct (typing_inversion_var _ _ _ Htypt)
-        as [T [Hctx Hsub]].
-    unfold extend in Hctx.
-    destruct (eq_id_dec x y)...
-    SCase "x=y".
-      subst.
-      inversion Hctx; subst. clear Hctx.
-      apply context_invariance with empty...
-      intros x Hcontra.
-      destruct (free_in_context _ _ S empty Hcontra)
-          as [T' HT']...
-      inversion HT'.
-  Case "tapp".
-    destruct (typing_inversion_app _ _ _ _ Htypt)
-        as [T1 [Htypt1 Htypt2]].
-    eapply T_App...
-  Case "tabs".
-    rename i into y. rename t into T1.
-    destruct (typing_inversion_abs _ _ _ _ _ Htypt)
-      as [T2 [Hsub Htypt2]].
-    apply T_Sub with (TArrow T1 T2)... apply T_Abs...
-    destruct (eq_id_dec x y).
-    SCase "x=y".
-      eapply context_invariance...
-      subst.
-      intros x Hafi. unfold extend.
-      destruct (eq_id_dec y x)...
-    SCase "x≠y".
-      apply IHt. eapply context_invariance...
-      intros z Hafi. unfold extend.
-      destruct (eq_id_dec y z)...
-      subst. rewrite neq_id...
-  Case "ttrue".
-      assert (TBool <: S)
-        by apply (typing_inversion_true _ _ Htypt)...
-  Case "tfalse".
-      assert (TBool <: S)
-        by apply (typing_inversion_false _ _ Htypt)...
-  Case "tif".
-    assert ((extend Γ x U) ⊢ t1 ∈ TBool
-            ∧ (extend Γ x U) ⊢ t2 ∈ S
-            ∧ (extend Γ x U) ⊢ t3 ∈ S)
-      by apply (typing_inversion_if _ _ _ _ _ Htypt).
-    inversion H as [H1 [H2 H3]].
-    apply IHt1 in H1. apply IHt2 in H2. apply IHt3 in H3.
-    auto.
-  Case "tunit".
-    assert (TUnit <: S)
-      by apply (typing_inversion_unit _ _ Htypt)...
-Qed.
-
- -
-
- -
-

Preservation

- -
- - The proof of preservation now proceeds pretty much as in earlier - chapters, using the substitution lemma at the appropriate point - and again using inversion lemmas from above to extract structural - information from typing assumptions. -
- - Theorem (Preservation): If t, t' are terms and T is a type - such that empty ⊢ t : T and t ⇒ t', then empty ⊢ t' : - T. - -
- - Proof: Let t and T be given such that empty ⊢ t : T. We - proceed by induction on the structure of this typing derivation, - leaving t' general. The cases T_Abs, T_Unit, T_True, and - T_False cases are vacuous because abstractions and constants - don't step. Case T_Var is vacuous as well, since the context is - empty. - -
- -
    -
  • If the final step of the derivation is by T_App, then there - are terms t1 and t2 and types T1 and T2 such that - t = t1 t2, T = T2, empty ⊢ t1 : T1 → T2, and - empty ⊢ t2 : T1. - -
    - - By the definition of the step relation, there are three ways - t1 t2 can step. Cases ST_App1 and ST_App2 follow - immediately by the induction hypotheses for the typing - subderivations and a use of T_App. - -
    - - Suppose instead t1 t2 steps by ST_AppAbs. Then t1 = - \x:S.t12 for some type S and term t12, and t' = - [x:=t2]t12. - -
    - - By lemma abs_arrow, we have T1 <: S and x:S1 ⊢ s2 : T2. - It then follows by the substitution lemma - (substitution_preserves_typing) that empty ⊢ [x:=t2] - t12 : T2 as desired. - -
    - -
      -
    • If the final step of the derivation uses rule T_If, then - there are terms t1, t2, and t3 such that t = if t1 then - t2 else t3, with empty ⊢ t1 : Bool and with empty ⊢ t2 : - T and empty ⊢ t3 : T. Moreover, by the induction - hypothesis, if t1 steps to t1' then empty ⊢ t1' : Bool. - There are three cases to consider, depending on which rule was - used to show t ⇒ t'. - -
      - -
        -
      • If t ⇒ t' by rule ST_If, then t' = if t1' then t2 - else t3 with t1 ⇒ t1'. By the induction hypothesis, - empty ⊢ t1' : Bool, and so empty ⊢ t' : T by T_If. - -
        - - -
        • -
      • If t ⇒ t' by rule ST_IfTrue or ST_IfFalse, then - either t' = t2 or t' = t3, and empty ⊢ t' : T - follows by assumption. - -
        - - -
        • -
      - -
      • -
    - -
    • -
  • If the final step of the derivation is by T_Sub, then there - is a type S such that S <: T and empty ⊢ t : S. The - result is immediate by the induction hypothesis for the typing - subderivation and an application of T_Sub. ☐ -
    • -
- -
-
- -
-Theorem preservation : ∀t t' T,
-     empty ⊢ t ∈ T →
-     t ⇒ t' →
-     empty ⊢ t' ∈ T.
-
-
-Proof with eauto.
-  intros t t' T HT.
-  remember empty as Γ. generalize dependent HeqGamma.
-  generalize dependent t'.
-  has_type_cases (induction HT) Case;
-    intros t' HeqGamma HE; subst; inversion HE; subst...
-  Case "T_App".
-    inversion HE; subst...
-    SCase "ST_AppAbs".
-      destruct (abs_arrow _ _ _ _ _ HT1) as [HA1 HA2].
-      apply substitution_preserves_typing with T...
-Qed.
-
- -
-
- -
-

Records, via Products and Top

- -
- - This formalization of the STLC with subtyping has omitted record - types, for brevity. If we want to deal with them more seriously, - we have two choices. - -
- - First, we can treat them as part of the core language, writing - down proper syntax, typing, and subtyping rules for them. Chapter - RecordSub shows how this extension works. - -
- - On the other hand, if we are treating them as a derived form that - is desugared in the parser, then we shouldn't need any new rules: - we should just check that the existing rules for subtyping product - and Unit types give rise to reasonable rules for record - subtyping via this encoding. To do this, we just need to make one - small change to the encoding described earlier: instead of using - Unit as the base case in the encoding of tuples and the "don't - care" placeholder in the encoding of records, we use Top. So: -
-    {a:Nat, b:Nat} ----> {Nat,Nat}       i.e. (Nat,(Nat,Top))
-    {c:Nat, a:Nat} ----> {Nat,Top,Nat}   i.e. (Nat,(Top,(Nat,Top)))
-
- The encoding of record values doesn't change at all. It is - easy (and instructive) to check that the subtyping rules above are - validated by the encoding. For the rest of this chapter, we'll - follow this encoding-based approach. -
-
- -
-
- -
-

Exercises

- -
- -

Exercise: 2 stars (variations)

- Each part of this problem suggests a different way of - changing the definition of the STLC with Unit and - subtyping. (These changes are not cumulative: each part - starts from the original language.) In each part, list which - properties (Progress, Preservation, both, or neither) become - false. If a property becomes false, give a counterexample. - -
- -
    -
  • Suppose we add the following typing rule: -
    - - - - - - - - - - - - - - -
    Γ ⊢ t : S1->S2
    S1 <: T1      T1 <: S1     S2 <: T2 - (T_Funny1)   -
    Γ ⊢ t : T1->T2
    -
    - - -
    • -
  • Suppose we add the following reduction rule: -
    - - - - - - - - - - -
       - (ST_Funny21)   -
    unit ⇒ (\x:Top. x)
    -
    - - -
    • -
  • Suppose we add the following subtyping rule: -
    - - - - - - - - - - -
       - (S_Funny3)   -
    Unit <: Top->Top
    -
    - - -
    • -
  • Suppose we add the following subtyping rule: -
    - - - - - - - - - - -
       - (S_Funny4)   -
    Top->Top <: Unit
    -
    - - -
    • -
  • Suppose we add the following evaluation rule: -
    - - - - - - - - - - -
       - (ST_Funny5)   -
    (unit t) ⇒ (t unit)
    -
    - - -
    • -
  • Suppose we add the same evaluation rule and a new typing rule: -
    - - - - - - - - - - -
       - (ST_Funny5)   -
    (unit t) ⇒ (t unit)
    - - - - - - - - - - -
       - (T_Funny6)   -
    empty ⊢ Unit : Top->Top
    -
    - - -
    • -
  • Suppose we change the arrow subtyping rule to: -
    - - - - - - - - - - -
    S1 <: T1       S2 <: T2 - (S_Arrow')   -
    S1->S2 <: T1->T2
    -
    • -
- -
- -☐ - -
-
- -
-
- -
-

Exercise: Adding Products

- -
- -

Exercise: 4 stars, optional (products)

- Adding pairs, projections, and product types to the system we have - defined is a relatively straightforward matter. Carry out this - extension: - -
- -
    -
  • Add constructors for pairs, first and second projections, and - product types to the definitions of ty and tm. (Don't - forget to add corresponding cases to T_cases and t_cases.) - -
    - - -
    • -
  • Extend the well-formedness relation in the obvious way. - -
    - - -
    • -
  • Extend the operational semantics with the same reduction rules - as in the last chapter. - -
    - - -
    • -
  • Extend the subtyping relation with this rule: -
    - - - - - - - - - - -
    S1 <: T1     S2 <: T2 - (Sub_Prod)   -
    S1 × S2 <: T1 × T2
    -
    • -
  • Extend the typing relation with the same rules for pairs and - projections as in the last chapter. - -
    - - -
    • -
  • Extend the proofs of progress, preservation, and all their - supporting lemmas to deal with the new constructs. (You'll also - need to add some completely new lemmas.) ☐ - -
    • -
- -
-
- -
-(* $Date: 2013-12-05 11:55:09 -0500 (Thu, 05 Dec 2013) $ *)
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Sub.v b/Sub.v deleted file mode 100644 index 50dff1e..0000000 --- a/Sub.v +++ /dev/null @@ -1,1584 +0,0 @@ -(** * Sub: Subtyping *) - - -Require Export MoreStlc. - -(* ###################################################### *) -(** * Concepts *) - -(** We now turn to the study of _subtyping_, perhaps the most - characteristic feature of the static type systems of recently - designed programming languages and a key feature needed to support - the object-oriented programming style. *) - -(* ###################################################### *) -(** ** A Motivating Example *) - -(** Suppose we are writing a program involving two record types - defined as follows: -<< - Person = {name:String, age:Nat} - Student = {name:String, age:Nat, gpa:Nat} ->> -*) - -(** In the simply typed lamdba-calculus with records, the term -<< - (\r:Person. (r.age)+1) {name="Pat",age=21,gpa=1} ->> - is not typable: it involves an application of a function that wants - a one-field record to an argument that actually provides two - fields, while the [T_App] rule demands that the domain type of the - function being applied must match the type of the argument - precisely. - - But this is silly: we're passing the function a _better_ argument - than it needs! The only thing the body of the function can - possibly do with its record argument [r] is project the field [age] - from it: nothing else is allowed by the type, and the presence or - absence of an extra [gpa] field makes no difference at all. So, - intuitively, it seems that this function should be applicable to - any record value that has at least an [age] field. - - Looking at the same thing from another point of view, a record with - more fields is "at least as good in any context" as one with just a - subset of these fields, in the sense that any value belonging to - the longer record type can be used _safely_ in any context - expecting the shorter record type. If the context expects - something with the shorter type but we actually give it something - with the longer type, nothing bad will happen (formally, the - program will not get stuck). - - The general principle at work here is called _subtyping_. We say - that "[S] is a subtype of [T]", informally written [S <: T], if a - value of type [S] can safely be used in any context where a value - of type [T] is expected. The idea of subtyping applies not only to - records, but to all of the type constructors in the language -- - functions, pairs, etc. *) - -(** ** Subtyping and Object-Oriented Languages *) - -(** Subtyping plays a fundamental role in many programming - languages -- in particular, it is closely related to the notion of - _subclassing_ in object-oriented languages. - - An _object_ in Java, C[#], etc. can be thought of as a record, - some of whose fields are functions ("methods") and some of whose - fields are data values ("fields" or "instance variables"). - Invoking a method [m] of an object [o] on some arguments [a1..an] - consists of projecting out the [m] field of [o] and applying it to - [a1..an]. - - The type of an object can be given as either a _class_ or an - _interface_. Both of these provide a description of which methods - and which data fields the object offers. - - Classes and interfaces are related by the _subclass_ and - _subinterface_ relations. An object belonging to a subclass (or - subinterface) is required to provide all the methods and fields of - one belonging to a superclass (or superinterface), plus possibly - some more. - - The fact that an object from a subclass (or sub-interface) can be - used in place of one from a superclass (or super-interface) - provides a degree of flexibility that is is extremely handy for - organizing complex libraries. For example, a GUI toolkit like - Java's Swing framework might define an abstract interface - [Component] that collects together the common fields and methods - of all objects having a graphical representation that can be - displayed on the screen and that can interact with the user. - Examples of such object would include the buttons, checkboxes, and - scrollbars of a typical GUI. A method that relies only on this - common interface can now be applied to any of these objects. - - Of course, real object-oriented languages include many other - features besides these. For example, fields can be updated. - Fields and methods can be declared [private]. Classes also give - _code_ that is used when constructing objects and implementing - their methods, and the code in subclasses cooperate with code in - superclasses via _inheritance_. Classes can have static methods - and fields, initializers, etc., etc. - - To keep things simple here, we won't deal with any of these - issues -- in fact, we won't even talk any more about objects or - classes. (There is a lot of discussion in _Types and Programming - Languages_, if you are interested.) Instead, we'll study the core - concepts behind the subclass / subinterface relation in the - simplified setting of the STLC. *) - -(** *** *) -(** Of course, real OO languages have lots of other features... - - mutable fields - - [private] and other visibility modifiers - - method inheritance - - static components - - etc., etc. - - We'll ignore all these and focus on core mechanisms. *) - -(** ** The Subsumption Rule *) - -(** Our goal for this chapter is to add subtyping to the simply typed - lambda-calculus (with some of the basic extensions from [MoreStlc]). - This involves two steps: - - - Defining a binary _subtype relation_ between types. - - - Enriching the typing relation to take subtyping into account. - - The second step is actually very simple. We add just a single rule - to the typing relation: the so-called _rule of subsumption_: - Gamma |- t : S S <: T - ------------------------- (T_Sub) - Gamma |- t : T - This rule says, intuitively, that it is OK to "forget" some of - what we know about a term. *) -(** For example, we may know that [t] is a record with two - fields (e.g., [S = {x:A->A, y:B->B}]), but choose to forget about - one of the fields ([T = {y:B->B}]) so that we can pass [t] to a - function that requires just a single-field record. *) - -(** ** The Subtype Relation *) - -(** The first step -- the definition of the relation [S <: T] -- is - where all the action is. Let's look at each of the clauses of its - definition. *) - -(** *** Structural Rules *) - -(** To start off, we impose two "structural rules" that are - independent of any particular type constructor: a rule of - _transitivity_, which says intuitively that, if [S] is better than - [U] and [U] is better than [T], then [S] is better than [T]... - S <: U U <: T - ---------------- (S_Trans) - S <: T - ... and a rule of _reflexivity_, since certainly any type [T] is - as good as itself: - ------ (S_Refl) - T <: T -*) - -(** *** Products *) - -(** Now we consider the individual type constructors, one by one, - beginning with product types. We consider one pair to be "better - than" another if each of its components is. - S1 <: T1 S2 <: T2 - -------------------- (S_Prod) - S1 * S2 <: T1 * T2 -*) - -(** *** Arrows *) - -(** Suppose we have two functions [f] and [g] with these types: - f : C -> Student - g : (C->Person) -> D - That is, [f] is a function that yields a record of type [Student], - and [g] is a (higher-order) function that expects its (function) - argument to yield a record of type [Person]. Also suppose, even - though we haven't yet discussed subtyping for records, that - [Student] is a subtype of [Person]. Then the application [g f] is - safe even though their types do not match up precisely, because - the only thing [g] can do with [f] is to apply it to some - argument (of type [C]); the result will actually be a [Student], - while [g] will be expecting a [Person], but this is safe because - the only thing [g] can then do is to project out the two fields - that it knows about ([name] and [age]), and these will certainly - be among the fields that are present. - - This example suggests that the subtyping rule for arrow types - should say that two arrow types are in the subtype relation if - their results are: - S2 <: T2 - ---------------- (S_Arrow_Co) - S1 -> S2 <: S1 -> T2 - We can generalize this to allow the arguments of the two arrow - types to be in the subtype relation as well: - T1 <: S1 S2 <: T2 - -------------------- (S_Arrow) - S1 -> S2 <: T1 -> T2 - Notice that the argument types are subtypes "the other way round": - in order to conclude that [S1->S2] to be a subtype of [T1->T2], it - must be the case that [T1] is a subtype of [S1]. The arrow - constructor is said to be _contravariant_ in its first argument - and _covariant_ in its second. - - Here is an example that illustrates this: - f : Person -> C - g : (Student -> C) -> D - The application [g f] is safe, because the only thing the body of - [g] can do with [f] is to apply it to some argument of type - [Student]. Since [f] requires records having (at least) the - fields of a [Person], this will always work. So [Person -> C] is a - subtype of [Student -> C] since [Student] is a subtype of - [Person]. - - The intuition is that, if we have a function [f] of type [S1->S2], - then we know that [f] accepts elements of type [S1]; clearly, [f] - will also accept elements of any subtype [T1] of [S1]. The type of - [f] also tells us that it returns elements of type [S2]; we can - also view these results belonging to any supertype [T2] of - [S2]. That is, any function [f] of type [S1->S2] can also be - viewed as having type [T1->T2]. -*) - -(** *** Records *) - -(** What about subtyping for record types? *) - -(** The basic intuition about subtyping for record types is that it is - always safe to use a "bigger" record in place of a "smaller" one. - That is, given a record type, adding extra fields will always - result in a subtype. If some code is expecting a record with - fields [x] and [y], it is perfectly safe for it to receive a record - with fields [x], [y], and [z]; the [z] field will simply be ignored. - For example, - {name:String, age:Nat, gpa:Nat} <: {name:String, age:Nat} - {name:String, age:Nat} <: {name:String} - {name:String} <: {} - This is known as "width subtyping" for records. *) - -(** We can also create a subtype of a record type by replacing the type - of one of its fields with a subtype. If some code is expecting a - record with a field [x] of type [T], it will be happy with a record - having a field [x] of type [S] as long as [S] is a subtype of - [T]. For example, - {x:Student} <: {x:Person} - This is known as "depth subtyping". *) - -(** Finally, although the fields of a record type are written in a - particular order, the order does not really matter. For example, - {name:String,age:Nat} <: {age:Nat,name:String} - This is known as "permutation subtyping". *) - -(** We could formalize these requirements in a single subtyping rule - for records as follows: - for each jk in j1..jn, - exists ip in i1..im, such that - jk=ip and Sp <: Tk - ---------------------------------- (S_Rcd) - {i1:S1...im:Sm} <: {j1:T1...jn:Tn} - That is, the record on the left should have all the field labels of - the one on the right (and possibly more), while the types of the - common fields should be in the subtype relation. However, this rule - is rather heavy and hard to read. If we like, we can decompose it - into three simpler rules, which can be combined using [S_Trans] to - achieve all the same effects. *) - -(** First, adding fields to the end of a record type gives a subtype: - n > m - --------------------------------- (S_RcdWidth) - {i1:T1...in:Tn} <: {i1:T1...im:Tm} - We can use [S_RcdWidth] to drop later fields of a multi-field - record while keeping earlier fields, showing for example that - [{age:Nat,name:String} <: {name:String}]. *) - -(** Second, we can apply subtyping inside the components of a compound - record type: - S1 <: T1 ... Sn <: Tn - ---------------------------------- (S_RcdDepth) - {i1:S1...in:Sn} <: {i1:T1...in:Tn} - For example, we can use [S_RcdDepth] and [S_RcdWidth] together to - show that [{y:Student, x:Nat} <: {y:Person}]. *) - -(** Third, we need to be able to reorder fields. For example, we - might expect that [{name:String, gpa:Nat, age:Nat} <: Person]. We - haven't quite achieved this yet: using just [S_RcdDepth] and - [S_RcdWidth] we can only drop fields from the _end_ of a record - type. So we need: - {i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn} - --------------------------------------------------- (S_RcdPerm) - {i1:S1...in:Sn} <: {i1:T1...in:Tn} -*) - -(** It is worth noting that full-blown language designs may choose not - to adopt all of these subtyping rules. For example, in Java: - - - A subclass may not change the argument or result types of a - method of its superclass (i.e., no depth subtyping or no arrow - subtyping, depending how you look at it). - - - Each class has just one superclass ("single inheritance" of - classes). - - - Each class member (field or method) can be assigned a single - index, adding new indices "on the right" as more members are - added in subclasses (i.e., no permutation for classes). - - - A class may implement multiple interfaces -- so-called "multiple - inheritance" of interfaces (i.e., permutation is allowed for - interfaces). *) - -(** **** Exercise: 2 stars (arrow_sub_wrong) *) -(** Suppose we had incorrectly defined subtyping as covariant on both - the right and the left of arrow types: - S1 <: T1 S2 <: T2 - -------------------- (S_Arrow_wrong) - S1 -> S2 <: T1 -> T2 - Give a concrete example of functions [f] and [g] with the following types... - f : Student -> Nat - g : (Person -> Nat) -> Nat - ... such that the application [g f] will get stuck during - execution. - -[] -*) - -(** *** Top *) - -(** Finally, it is natural to give the subtype relation a maximal - element -- a type that lies above every other type and is - inhabited by all (well-typed) values. We do this by adding to the - language one new type constant, called [Top], together with a - subtyping rule that places it above every other type in the - subtype relation: - -------- (S_Top) - S <: Top - The [Top] type is an analog of the [Object] type in Java and C[#]. *) - -(* ############################################### *) -(** *** Summary *) - -(** In summary, we form the STLC with subtyping by starting with the - pure STLC (over some set of base types) and... - - - adding a base type [Top], - - - adding the rule of subsumption - Gamma |- t : S S <: T - ------------------------- (T_Sub) - Gamma |- t : T - to the typing relation, and - - - defining a subtype relation as follows: - S <: U U <: T - ---------------- (S_Trans) - S <: T - - ------ (S_Refl) - T <: T - - -------- (S_Top) - S <: Top - - S1 <: T1 S2 <: T2 - -------------------- (S_Prod) - S1 * S2 <: T1 * T2 - - T1 <: S1 S2 <: T2 - -------------------- (S_Arrow) - S1 -> S2 <: T1 -> T2 - - n > m - --------------------------------- (S_RcdWidth) - {i1:T1...in:Tn} <: {i1:T1...im:Tm} - - S1 <: T1 ... Sn <: Tn - ---------------------------------- (S_RcdDepth) - {i1:S1...in:Sn} <: {i1:T1...in:Tn} - - {i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn} - --------------------------------------------------- (S_RcdPerm) - {i1:S1...in:Sn} <: {i1:T1...in:Tn} -*) - - - -(* ############################################### *) -(** ** Exercises *) - -(** **** Exercise: 1 star, optional (subtype_instances_tf_1) *) -(** Suppose we have types [S], [T], [U], and [V] with [S <: T] - and [U <: V]. Which of the following subtyping assertions - are then true? Write _true_ or _false_ after each one. - ([A], [B], and [C] here are base types.) - - - [T->S <: T->S] - - - [Top->U <: S->Top] - - - [(C->C) -> (A*B) <: (C->C) -> (Top*B)] - - - [T->T->U <: S->S->V] - - - [(T->T)->U <: (S->S)->V] - - - [((T->S)->T)->U <: ((S->T)->S)->V] - - - [S*V <: T*U] - -[] -*) - -(** **** Exercise: 2 stars (subtype_order) *) -(** The following types happen to form a linear order with respect to subtyping: - - [Top] - - [Top -> Student] - - [Student -> Person] - - [Student -> Top] - - [Person -> Student] - -Write these types in order from the most specific to the most general. - - -Where does the type [Top->Top->Student] fit into this order? - - -*) - -(** **** Exercise: 1 star (subtype_instances_tf_2) *) -(** Which of the following statements are true? Write _true_ or - _false_ after each one. - forall S T, - S <: T -> - S->S <: T->T - - forall S, - S <: A->A -> - exists T, - S = T->T /\ T <: A - - forall S T1 T2, - (S <: T1 -> T2) -> - exists S1 S2, - S = S1 -> S2 /\ T1 <: S1 /\ S2 <: T2 - - exists S, - S <: S->S - - exists S, - S->S <: S - - forall S T1 T2, - S <: T1*T2 -> - exists S1 S2, - S = S1*S2 /\ S1 <: T1 /\ S2 <: T2 -[] *) - -(** **** Exercise: 1 star (subtype_concepts_tf) *) -(** Which of the following statements are true, and which are false? - - There exists a type that is a supertype of every other type. - - - There exists a type that is a subtype of every other type. - - - There exists a pair type that is a supertype of every other - pair type. - - - There exists a pair type that is a subtype of every other - pair type. - - - There exists an arrow type that is a supertype of every other - arrow type. - - - There exists an arrow type that is a subtype of every other - arrow type. - - - There is an infinite descending chain of distinct types in the - subtype relation---that is, an infinite sequence of types - [S0], [S1], etc., such that all the [Si]'s are different and - each [S(i+1)] is a subtype of [Si]. - - - There is an infinite _ascending_ chain of distinct types in - the subtype relation---that is, an infinite sequence of types - [S0], [S1], etc., such that all the [Si]'s are different and - each [S(i+1)] is a supertype of [Si]. - -[] -*) - -(** **** Exercise: 2 stars (proper_subtypes) *) -(** Is the following statement true or false? Briefly explain your - answer. - forall T, - ~(exists n, T = TBase n) -> - exists S, - S <: T /\ S <> T -]] -[] -*) - -(** **** Exercise: 2 stars (small_large_1) *) -(** - - What is the _smallest_ type [T] ("smallest" in the subtype - relation) that makes the following assertion true? (Assume we - have [Unit] among the base types and [unit] as a constant of this - type.) - empty |- (\p:T*Top. p.fst) ((\z:A.z), unit) : A->A - - - What is the _largest_ type [T] that makes the same assertion true? - -[] -*) - -(** **** Exercise: 2 stars (small_large_2) *) -(** - - What is the _smallest_ type [T] that makes the following - assertion true? - empty |- (\p:(A->A * B->B). p) ((\z:A.z), (\z:B.z)) : T - - - What is the _largest_ type [T] that makes the same assertion true? - -[] -*) - -(** **** Exercise: 2 stars, optional (small_large_3) *) -(** - - What is the _smallest_ type [T] that makes the following - assertion true? - a:A |- (\p:(A*T). (p.snd) (p.fst)) (a , \z:A.z) : A - - - What is the _largest_ type [T] that makes the same assertion true? - -[] -*) - - - - -(** **** Exercise: 2 stars (small_large_4) *) -(** - - What is the _smallest_ type [T] that makes the following - assertion true? - exists S, - empty |- (\p:(A*T). (p.snd) (p.fst)) : S - - - What is the _largest_ type [T] that makes the same - assertion true? - -[] -*) - -(** **** Exercise: 2 stars (smallest_1) *) -(** What is the _smallest_ type [T] that makes the following - assertion true? - exists S, exists t, - empty |- (\x:T. x x) t : S -]] -[] -*) - -(** **** Exercise: 2 stars (smallest_2) *) -(** What is the _smallest_ type [T] that makes the following - assertion true? - empty |- (\x:Top. x) ((\z:A.z) , (\z:B.z)) : T -]] -[] -*) - -(** **** Exercise: 3 stars, optional (count_supertypes) *) -(** How many supertypes does the record type [{x:A, y:C->C}] have? That is, - how many different types [T] are there such that [{x:A, y:C->C} <: - T]? (We consider two types to be different if they are written - differently, even if each is a subtype of the other. For example, - [{x:A,y:B}] and [{y:B,x:A}] are different.) - - -[] -*) - -(** **** Exercise: 2 stars (pair_permutation) *) -(** The subtyping rule for product types - S1 <: T1 S2 <: T2 - -------------------- (S_Prod) - S1*S2 <: T1*T2 -intuitively corresponds to the "depth" subtyping rule for records. Extending the analogy, we might consider adding a "permutation" rule - -------------- - T1*T2 <: T2*T1 -for products. -Is this a good idea? Briefly explain why or why not. - -[] -*) - -(* ###################################################### *) -(** * Formal Definitions *) - -(** Most of the definitions -- in particular, the syntax and - operational semantics of the language -- are identical to what we - saw in the last chapter. We just need to extend the typing - relation with the subsumption rule and add a new [Inductive] - definition for the subtyping relation. Let's first do the - identical bits. *) - -(* ###################################################### *) -(** ** Core Definitions *) - -(* ################################### *) -(** *** Syntax *) - -(** For the sake of more interesting examples below, we'll allow an - arbitrary set of additional base types like [String], [Float], - etc. We won't bother adding any constants belonging to these - types or any operators on them, but we could easily do so. *) - -(** In the rest of the chapter, we formalize just base types, - booleans, arrow types, [Unit], and [Top], omitting record types - and leaving product types as an exercise. *) - -Inductive ty : Type := - | TTop : ty - | TBool : ty - | TBase : id -> ty - | TArrow : ty -> ty -> ty - | TUnit : ty -. - -Tactic Notation "T_cases" tactic(first) ident(c) := - first; - [ Case_aux c "TTop" | Case_aux c "TBool" - | Case_aux c "TBase" | Case_aux c "TArrow" - | Case_aux c "TUnit" | - ]. - -Inductive tm : Type := - | tvar : id -> tm - | tapp : tm -> tm -> tm - | tabs : id -> ty -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm - | tunit : tm -. - -Tactic Notation "t_cases" tactic(first) ident(c) := - first; - [ Case_aux c "tvar" | Case_aux c "tapp" - | Case_aux c "tabs" | Case_aux c "ttrue" - | Case_aux c "tfalse" | Case_aux c "tif" - | Case_aux c "tunit" - ]. - -(* ################################### *) -(** *** Substitution *) - -(** The definition of substitution remains exactly the same as for the - pure STLC. *) - -Fixpoint subst (x:id) (s:tm) (t:tm) : tm := - match t with - | tvar y => - if eq_id_dec x y then s else t - | tabs y T t1 => - tabs y T (if eq_id_dec x y then t1 else (subst x s t1)) - | tapp t1 t2 => - tapp (subst x s t1) (subst x s t2) - | ttrue => - ttrue - | tfalse => - tfalse - | tif t1 t2 t3 => - tif (subst x s t1) (subst x s t2) (subst x s t3) - | tunit => - tunit - end. - -Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). - -(* ################################### *) -(** *** Reduction *) - -(** Likewise the definitions of the [value] property and the [step] - relation. *) - -Inductive value : tm -> Prop := - | v_abs : forall x T t, - value (tabs x T t) - | v_true : - value ttrue - | v_false : - value tfalse - | v_unit : - value tunit -. - -Hint Constructors value. - -Reserved Notation "t1 '==>' t2" (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_AppAbs : forall x T t12 v2, - value v2 -> - (tapp (tabs x T t12) v2) ==> [x:=v2]t12 - | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) - | ST_App2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - (tapp v1 t2) ==> (tapp v1 t2') - | ST_IfTrue : forall t1 t2, - (tif ttrue t1 t2) ==> t1 - | ST_IfFalse : forall t1 t2, - (tif tfalse t1 t2) ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - (tif t1 t2 t3) ==> (tif t1' t2 t3) -where "t1 '==>' t2" := (step t1 t2). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" - | Case_aux c "ST_App2" | Case_aux c "ST_IfTrue" - | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" - ]. - -Hint Constructors step. - -(* ###################################################################### *) -(** ** Subtyping *) - -(** Now we come to the most interesting part. We begin by - defining the subtyping relation and developing some of its - important technical properties. *) - -(** The definition of subtyping is just what we sketched in the - motivating discussion. *) - -Reserved Notation "T '<:' U" (at level 40). - -Inductive subtype : ty -> ty -> Prop := - | S_Refl : forall T, - T <: T - | S_Trans : forall S U T, - S <: U -> - U <: T -> - S <: T - | S_Top : forall S, - S <: TTop - | S_Arrow : forall S1 S2 T1 T2, - T1 <: S1 -> - S2 <: T2 -> - (TArrow S1 S2) <: (TArrow T1 T2) -where "T '<:' U" := (subtype T U). - -(** Note that we don't need any special rules for base types: they are - automatically subtypes of themselves (by [S_Refl]) and [Top] (by - [S_Top]), and that's all we want. *) - -Hint Constructors subtype. - -Tactic Notation "subtype_cases" tactic(first) ident(c) := - first; - [ Case_aux c "S_Refl" | Case_aux c "S_Trans" - | Case_aux c "S_Top" | Case_aux c "S_Arrow" - ]. - -Module Examples. - -Notation x := (Id 0). -Notation y := (Id 1). -Notation z := (Id 2). - -Notation A := (TBase (Id 6)). -Notation B := (TBase (Id 7)). -Notation C := (TBase (Id 8)). - -Notation String := (TBase (Id 9)). -Notation Float := (TBase (Id 10)). -Notation Integer := (TBase (Id 11)). - -(** **** Exercise: 2 stars, optional (subtyping_judgements) *) - -(** (Do this exercise after you have added product types to the - language, at least up to this point in the file). - - Using the encoding of records into pairs, define pair types - representing the record types - Person := { name : String } - Student := { name : String ; - gpa : Float } - Employee := { name : String ; - ssn : Integer } -*) - -Definition Person : ty := -(* FILL IN HERE *) admit. -Definition Student : ty := -(* FILL IN HERE *) admit. -Definition Employee : ty := -(* FILL IN HERE *) admit. - -Example sub_student_person : - Student <: Person. -Proof. -(* FILL IN HERE *) Admitted. - -Example sub_employee_person : - Employee <: Person. -Proof. -(* FILL IN HERE *) Admitted. -(** [] *) - -Example subtyping_example_0 : - (TArrow C Person) <: (TArrow C TTop). - (* C->Person <: C->Top *) -Proof. - apply S_Arrow. - apply S_Refl. auto. -Qed. - -(** The following facts are mostly easy to prove in Coq. To get - full benefit from the exercises, make sure you also - understand how to prove them on paper! *) - -(** **** Exercise: 1 star, optional (subtyping_example_1) *) -Example subtyping_example_1 : - (TArrow TTop Student) <: (TArrow (TArrow C C) Person). - (* Top->Student <: (C->C)->Person *) -Proof with eauto. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 1 star, optional (subtyping_example_2) *) -Example subtyping_example_2 : - (TArrow TTop Person) <: (TArrow Person TTop). - (* Top->Person <: Person->Top *) -Proof with eauto. - (* FILL IN HERE *) Admitted. -(** [] *) - -End Examples. - - -(* ###################################################################### *) -(** ** Typing *) - -(** The only change to the typing relation is the addition of the rule - of subsumption, [T_Sub]. *) - -Definition context := id -> (option ty). -Definition empty : context := (fun _ => None). -Definition extend (Gamma : context) (x:id) (T : ty) := - fun x' => if eq_id_dec x x' then Some T else Gamma x'. - -Reserved Notation "Gamma '|-' t '\in' T" (at level 40). - -Inductive has_type : context -> tm -> ty -> Prop := - (* Same as before *) - | T_Var : forall Gamma x T, - Gamma x = Some T -> - Gamma |- (tvar x) \in T - | T_Abs : forall Gamma x T11 T12 t12, - (extend Gamma x T11) |- t12 \in T12 -> - Gamma |- (tabs x T11 t12) \in (TArrow T11 T12) - | T_App : forall T1 T2 Gamma t1 t2, - Gamma |- t1 \in (TArrow T1 T2) -> - Gamma |- t2 \in T1 -> - Gamma |- (tapp t1 t2) \in T2 - | T_True : forall Gamma, - Gamma |- ttrue \in TBool - | T_False : forall Gamma, - Gamma |- tfalse \in TBool - | T_If : forall t1 t2 t3 T Gamma, - Gamma |- t1 \in TBool -> - Gamma |- t2 \in T -> - Gamma |- t3 \in T -> - Gamma |- (tif t1 t2 t3) \in T - | T_Unit : forall Gamma, - Gamma |- tunit \in TUnit - (* New rule of subsumption *) - | T_Sub : forall Gamma t S T, - Gamma |- t \in S -> - S <: T -> - Gamma |- t \in T - -where "Gamma '|-' t '\in' T" := (has_type Gamma t T). - -Hint Constructors has_type. - -Tactic Notation "has_type_cases" tactic(first) ident(c) := - first; - [ Case_aux c "T_Var" | Case_aux c "T_Abs" - | Case_aux c "T_App" | Case_aux c "T_True" - | Case_aux c "T_False" | Case_aux c "T_If" - | Case_aux c "T_Unit" - | Case_aux c "T_Sub" ]. - -(* ############################################### *) -(** ** Typing examples *) - -Module Examples2. -Import Examples. - -(** Do the following exercises after you have added product types to - the language. For each informal typing judgement, write it as a - formal statement in Coq and prove it. *) - -(** **** Exercise: 1 star, optional (typing_example_0) *) -(* empty |- ((\z:A.z), (\z:B.z)) - : (A->A * B->B) *) -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 2 stars, optional (typing_example_1) *) -(* empty |- (\x:(Top * B->B). x.snd) ((\z:A.z), (\z:B.z)) - : B->B *) -(* FILL IN HERE *) -(** [] *) - -(** **** Exercise: 2 stars, optional (typing_example_2) *) -(* empty |- (\z:(C->C)->(Top * B->B). (z (\x:C.x)).snd) - (\z:C->C. ((\z:A.z), (\z:B.z))) - : B->B *) -(* FILL IN HERE *) -(** [] *) - -End Examples2. - -(* ###################################################################### *) -(** * Properties *) - -(** The fundamental properties of the system that we want to check are - the same as always: progress and preservation. Unlike the - extension of the STLC with references, we don't need to change the - _statements_ of these properties to take subtyping into account. - However, their proofs do become a little bit more involved. *) - -(* ###################################################################### *) -(** ** Inversion Lemmas for Subtyping *) - -(** Before we look at the properties of the typing relation, we need - to record a couple of critical structural properties of the subtype - relation: - - [Bool] is the only subtype of [Bool] - - every subtype of an arrow type is itself an arrow type. *) - -(** These are called _inversion lemmas_ because they play the same - role in later proofs as the built-in [inversion] tactic: given a - hypothesis that there exists a derivation of some subtyping - statement [S <: T] and some constraints on the shape of [S] and/or - [T], each one reasons about what this derivation must look like to - tell us something further about the shapes of [S] and [T] and the - existence of subtype relations between their parts. *) - -(** **** Exercise: 2 stars, optional (sub_inversion_Bool) *) -Lemma sub_inversion_Bool : forall U, - U <: TBool -> - U = TBool. -Proof with auto. - intros U Hs. - remember TBool as V. - (* FILL IN HERE *) Admitted. - -(** **** Exercise: 3 stars, optional (sub_inversion_arrow) *) -Lemma sub_inversion_arrow : forall U V1 V2, - U <: (TArrow V1 V2) -> - exists U1, exists U2, - U = (TArrow U1 U2) /\ (V1 <: U1) /\ (U2 <: V2). -Proof with eauto. - intros U V1 V2 Hs. - remember (TArrow V1 V2) as V. - generalize dependent V2. generalize dependent V1. - (* FILL IN HERE *) Admitted. - - -(** [] *) - -(* ########################################## *) -(** ** Canonical Forms *) - -(** We'll see first that the proof of the progress theorem doesn't - change too much -- we just need one small refinement. When we're - considering the case where the term in question is an application - [t1 t2] where both [t1] and [t2] are values, we need to know that - [t1] has the _form_ of a lambda-abstraction, so that we can apply - the [ST_AppAbs] reduction rule. In the ordinary STLC, this is - obvious: we know that [t1] has a function type [T11->T12], and - there is only one rule that can be used to give a function type to - a value -- rule [T_Abs] -- and the form of the conclusion of this - rule forces [t1] to be an abstraction. - - In the STLC with subtyping, this reasoning doesn't quite work - because there's another rule that can be used to show that a value - has a function type: subsumption. Fortunately, this possibility - doesn't change things much: if the last rule used to show [Gamma - |- t1 : T11->T12] is subsumption, then there is some - _sub_-derivation whose subject is also [t1], and we can reason by - induction until we finally bottom out at a use of [T_Abs]. - - This bit of reasoning is packaged up in the following lemma, which - tells us the possible "canonical forms" (i.e. values) of function - type. *) - -(** **** Exercise: 3 stars, optional (canonical_forms_of_arrow_types) *) -Lemma canonical_forms_of_arrow_types : forall Gamma s T1 T2, - Gamma |- s \in (TArrow T1 T2) -> - value s -> - exists x, exists S1, exists s2, - s = tabs x S1 s2. -Proof with eauto. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** Similarly, the canonical forms of type [Bool] are the constants - [true] and [false]. *) - -Lemma canonical_forms_of_Bool : forall Gamma s, - Gamma |- s \in TBool -> - value s -> - (s = ttrue \/ s = tfalse). -Proof with eauto. - intros Gamma s Hty Hv. - remember TBool as T. - has_type_cases (induction Hty) Case; try solve by inversion... - Case "T_Sub". - subst. apply sub_inversion_Bool in H. subst... -Qed. - - -(* ########################################## *) -(** ** Progress *) - -(** The proof of progress proceeds like the one for the pure - STLC, except that in several places we invoke canonical forms - lemmas... *) - -(** _Theorem_ (Progress): For any term [t] and type [T], if [empty |- - t : T] then [t] is a value or [t ==> t'] for some term [t']. - - _Proof_: Let [t] and [T] be given, with [empty |- t : T]. Proceed - by induction on the typing derivation. - - The cases for [T_Abs], [T_Unit], [T_True] and [T_False] are - immediate because abstractions, [unit], [true], and [false] are - already values. The [T_Var] case is vacuous because variables - cannot be typed in the empty context. The remaining cases are - more interesting: - - - If the last step in the typing derivation uses rule [T_App], - then there are terms [t1] [t2] and types [T1] and [T2] such that - [t = t1 t2], [T = T2], [empty |- t1 : T1 -> T2], and [empty |- - t2 : T1]. Moreover, by the induction hypothesis, either [t1] is - a value or it steps, and either [t2] is a value or it steps. - There are three possibilities to consider: - - - Suppose [t1 ==> t1'] for some term [t1']. Then [t1 t2 ==> t1' t2] - by [ST_App1]. - - - Suppose [t1] is a value and [t2 ==> t2'] for some term [t2']. - Then [t1 t2 ==> t1 t2'] by rule [ST_App2] because [t1] is a - value. - - - Finally, suppose [t1] and [t2] are both values. By Lemma - [canonical_forms_for_arrow_types], we know that [t1] has the - form [\x:S1.s2] for some [x], [S1], and [s2]. But then - [(\x:S1.s2) t2 ==> [x:=t2]s2] by [ST_AppAbs], since [t2] is a - value. - - - If the final step of the derivation uses rule [T_If], then there - are terms [t1], [t2], and [t3] such that [t = if t1 then t2 else - t3], with [empty |- t1 : Bool] and with [empty |- t2 : T] and - [empty |- t3 : T]. Moreover, by the induction hypothesis, - either [t1] is a value or it steps. - - - If [t1] is a value, then by the canonical forms lemma for - booleans, either [t1 = true] or [t1 = false]. In either - case, [t] can step, using rule [ST_IfTrue] or [ST_IfFalse]. - - - If [t1] can step, then so can [t], by rule [ST_If]. - - - If the final step of the derivation is by [T_Sub], then there is - a type [S] such that [S <: T] and [empty |- t : S]. The desired - result is exactly the induction hypothesis for the typing - subderivation. -*) - -Theorem progress : forall t T, - empty |- t \in T -> - value t \/ exists t', t ==> t'. -Proof with eauto. - intros t T Ht. - remember empty as Gamma. - revert HeqGamma. - has_type_cases (induction Ht) Case; - intros HeqGamma; subst... - Case "T_Var". - inversion H. - Case "T_App". - right. - destruct IHHt1; subst... - SCase "t1 is a value". - destruct IHHt2; subst... - SSCase "t2 is a value". - destruct (canonical_forms_of_arrow_types empty t1 T1 T2) - as [x [S1 [t12 Heqt1]]]... - subst. exists ([x:=t2]t12)... - SSCase "t2 steps". - inversion H0 as [t2' Hstp]. exists (tapp t1 t2')... - SCase "t1 steps". - inversion H as [t1' Hstp]. exists (tapp t1' t2)... - Case "T_If". - right. - destruct IHHt1. - SCase "t1 is a value"... - assert (t1 = ttrue \/ t1 = tfalse) - by (eapply canonical_forms_of_Bool; eauto). - inversion H0; subst... - inversion H. rename x into t1'. eauto. - -Qed. - -(* ########################################## *) -(** ** Inversion Lemmas for Typing *) - -(** The proof of the preservation theorem also becomes a little more - complex with the addition of subtyping. The reason is that, as - with the "inversion lemmas for subtyping" above, there are a - number of facts about the typing relation that are "obvious from - the definition" in the pure STLC (and hence can be obtained - directly from the [inversion] tactic) but that require real proofs - in the presence of subtyping because there are multiple ways to - derive the same [has_type] statement. - - The following "inversion lemma" tells us that, if we have a - derivation of some typing statement [Gamma |- \x:S1.t2 : T] whose - subject is an abstraction, then there must be some subderivation - giving a type to the body [t2]. *) - -(** _Lemma_: If [Gamma |- \x:S1.t2 : T], then there is a type [S2] - such that [Gamma, x:S1 |- t2 : S2] and [S1 -> S2 <: T]. - - (Notice that the lemma does _not_ say, "then [T] itself is an arrow - type" -- this is tempting, but false!) - - _Proof_: Let [Gamma], [x], [S1], [t2] and [T] be given as - described. Proceed by induction on the derivation of [Gamma |- - \x:S1.t2 : T]. Cases [T_Var], [T_App], are vacuous as those - rules cannot be used to give a type to a syntactic abstraction. - - - If the last step of the derivation is a use of [T_Abs] then - there is a type [T12] such that [T = S1 -> T12] and [Gamma, - x:S1 |- t2 : T12]. Picking [T12] for [S2] gives us what we - need: [S1 -> T12 <: S1 -> T12] follows from [S_Refl]. - - - If the last step of the derivation is a use of [T_Sub] then - there is a type [S] such that [S <: T] and [Gamma |- \x:S1.t2 : - S]. The IH for the typing subderivation tell us that there is - some type [S2] with [S1 -> S2 <: S] and [Gamma, x:S1 |- t2 : - S2]. Picking type [S2] gives us what we need, since [S1 -> S2 - <: T] then follows by [S_Trans]. *) - -Lemma typing_inversion_abs : forall Gamma x S1 t2 T, - Gamma |- (tabs x S1 t2) \in T -> - (exists S2, (TArrow S1 S2) <: T - /\ (extend Gamma x S1) |- t2 \in S2). -Proof with eauto. - intros Gamma x S1 t2 T H. - remember (tabs x S1 t2) as t. - has_type_cases (induction H) Case; - inversion Heqt; subst; intros; try solve by inversion. - Case "T_Abs". - exists T12... - Case "T_Sub". - destruct IHhas_type as [S2 [Hsub Hty]]... - Qed. - -(** Similarly... *) - -Lemma typing_inversion_var : forall Gamma x T, - Gamma |- (tvar x) \in T -> - exists S, - Gamma x = Some S /\ S <: T. -Proof with eauto. - intros Gamma x T Hty. - remember (tvar x) as t. - has_type_cases (induction Hty) Case; intros; - inversion Heqt; subst; try solve by inversion. - Case "T_Var". - exists T... - Case "T_Sub". - destruct IHHty as [U [Hctx HsubU]]... Qed. - -Lemma typing_inversion_app : forall Gamma t1 t2 T2, - Gamma |- (tapp t1 t2) \in T2 -> - exists T1, - Gamma |- t1 \in (TArrow T1 T2) /\ - Gamma |- t2 \in T1. -Proof with eauto. - intros Gamma t1 t2 T2 Hty. - remember (tapp t1 t2) as t. - has_type_cases (induction Hty) Case; intros; - inversion Heqt; subst; try solve by inversion. - Case "T_App". - exists T1... - Case "T_Sub". - destruct IHHty as [U1 [Hty1 Hty2]]... -Qed. - -Lemma typing_inversion_true : forall Gamma T, - Gamma |- ttrue \in T -> - TBool <: T. -Proof with eauto. - intros Gamma T Htyp. remember ttrue as tu. - has_type_cases (induction Htyp) Case; - inversion Heqtu; subst; intros... -Qed. - -Lemma typing_inversion_false : forall Gamma T, - Gamma |- tfalse \in T -> - TBool <: T. -Proof with eauto. - intros Gamma T Htyp. remember tfalse as tu. - has_type_cases (induction Htyp) Case; - inversion Heqtu; subst; intros... -Qed. - -Lemma typing_inversion_if : forall Gamma t1 t2 t3 T, - Gamma |- (tif t1 t2 t3) \in T -> - Gamma |- t1 \in TBool - /\ Gamma |- t2 \in T - /\ Gamma |- t3 \in T. -Proof with eauto. - intros Gamma t1 t2 t3 T Hty. - remember (tif t1 t2 t3) as t. - has_type_cases (induction Hty) Case; intros; - inversion Heqt; subst; try solve by inversion. - Case "T_If". - auto. - Case "T_Sub". - destruct (IHHty H0) as [H1 [H2 H3]]... -Qed. - -Lemma typing_inversion_unit : forall Gamma T, - Gamma |- tunit \in T -> - TUnit <: T. -Proof with eauto. - intros Gamma T Htyp. remember tunit as tu. - has_type_cases (induction Htyp) Case; - inversion Heqtu; subst; intros... -Qed. - - -(** The inversion lemmas for typing and for subtyping between arrow - types can be packaged up as a useful "combination lemma" telling - us exactly what we'll actually require below. *) - -Lemma abs_arrow : forall x S1 s2 T1 T2, - empty |- (tabs x S1 s2) \in (TArrow T1 T2) -> - T1 <: S1 - /\ (extend empty x S1) |- s2 \in T2. -Proof with eauto. - intros x S1 s2 T1 T2 Hty. - apply typing_inversion_abs in Hty. - inversion Hty as [S2 [Hsub Hty1]]. - apply sub_inversion_arrow in Hsub. - inversion Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]]. - inversion Heq; subst... Qed. - -(* ########################################## *) -(** ** Context Invariance *) - -(** The context invariance lemma follows the same pattern as in the - pure STLC. *) - -Inductive appears_free_in : id -> tm -> Prop := - | afi_var : forall x, - appears_free_in x (tvar x) - | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) - | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) - | afi_abs : forall x y T11 t12, - y <> x -> - appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) - | afi_if1 : forall x t1 t2 t3, - appears_free_in x t1 -> - appears_free_in x (tif t1 t2 t3) - | afi_if2 : forall x t1 t2 t3, - appears_free_in x t2 -> - appears_free_in x (tif t1 t2 t3) - | afi_if3 : forall x t1 t2 t3, - appears_free_in x t3 -> - appears_free_in x (tif t1 t2 t3) -. - -Hint Constructors appears_free_in. - -Lemma context_invariance : forall Gamma Gamma' t S, - Gamma |- t \in S -> - (forall x, appears_free_in x t -> Gamma x = Gamma' x) -> - Gamma' |- t \in S. -Proof with eauto. - intros. generalize dependent Gamma'. - has_type_cases (induction H) Case; - intros Gamma' Heqv... - Case "T_Var". - apply T_Var... rewrite <- Heqv... - Case "T_Abs". - apply T_Abs... apply IHhas_type. intros x0 Hafi. - unfold extend. destruct (eq_id_dec x x0)... - - Case "T_App". - apply T_App with T1... - Case "T_If". - apply T_If... - -Qed. - -Lemma free_in_context : forall x t T Gamma, - appears_free_in x t -> - Gamma |- t \in T -> - exists T', Gamma x = Some T'. -Proof with eauto. - intros x t T Gamma Hafi Htyp. - has_type_cases (induction Htyp) Case; - subst; inversion Hafi; subst... - Case "T_Abs". - destruct (IHHtyp H4) as [T Hctx]. exists T. - unfold extend in Hctx. rewrite neq_id in Hctx... Qed. - -(* ########################################## *) -(** ** Substitution *) - -(** The _substitution lemma_ is proved along the same lines as - for the pure STLC. The only significant change is that there are - several places where, instead of the built-in [inversion] tactic, - we need to use the inversion lemmas that we proved above to - extract structural information from assumptions about the - well-typedness of subterms. *) - -Lemma substitution_preserves_typing : forall Gamma x U v t S, - (extend Gamma x U) |- t \in S -> - empty |- v \in U -> - Gamma |- ([x:=v]t) \in S. -Proof with eauto. - intros Gamma x U v t S Htypt Htypv. - generalize dependent S. generalize dependent Gamma. - t_cases (induction t) Case; intros; simpl. - Case "tvar". - rename i into y. - destruct (typing_inversion_var _ _ _ Htypt) - as [T [Hctx Hsub]]. - unfold extend in Hctx. - destruct (eq_id_dec x y)... - SCase "x=y". - subst. - inversion Hctx; subst. clear Hctx. - apply context_invariance with empty... - intros x Hcontra. - destruct (free_in_context _ _ S empty Hcontra) - as [T' HT']... - inversion HT'. - Case "tapp". - destruct (typing_inversion_app _ _ _ _ Htypt) - as [T1 [Htypt1 Htypt2]]. - eapply T_App... - Case "tabs". - rename i into y. rename t into T1. - destruct (typing_inversion_abs _ _ _ _ _ Htypt) - as [T2 [Hsub Htypt2]]. - apply T_Sub with (TArrow T1 T2)... apply T_Abs... - destruct (eq_id_dec x y). - SCase "x=y". - eapply context_invariance... - subst. - intros x Hafi. unfold extend. - destruct (eq_id_dec y x)... - SCase "x<>y". - apply IHt. eapply context_invariance... - intros z Hafi. unfold extend. - destruct (eq_id_dec y z)... - subst. rewrite neq_id... - Case "ttrue". - assert (TBool <: S) - by apply (typing_inversion_true _ _ Htypt)... - Case "tfalse". - assert (TBool <: S) - by apply (typing_inversion_false _ _ Htypt)... - Case "tif". - assert ((extend Gamma x U) |- t1 \in TBool - /\ (extend Gamma x U) |- t2 \in S - /\ (extend Gamma x U) |- t3 \in S) - by apply (typing_inversion_if _ _ _ _ _ Htypt). - inversion H as [H1 [H2 H3]]. - apply IHt1 in H1. apply IHt2 in H2. apply IHt3 in H3. - auto. - Case "tunit". - assert (TUnit <: S) - by apply (typing_inversion_unit _ _ Htypt)... -Qed. - -(* ########################################## *) -(** ** Preservation *) - -(** The proof of preservation now proceeds pretty much as in earlier - chapters, using the substitution lemma at the appropriate point - and again using inversion lemmas from above to extract structural - information from typing assumptions. *) - -(** _Theorem_ (Preservation): If [t], [t'] are terms and [T] is a type - such that [empty |- t : T] and [t ==> t'], then [empty |- t' : - T]. - - _Proof_: Let [t] and [T] be given such that [empty |- t : T]. We - proceed by induction on the structure of this typing derivation, - leaving [t'] general. The cases [T_Abs], [T_Unit], [T_True], and - [T_False] cases are vacuous because abstractions and constants - don't step. Case [T_Var] is vacuous as well, since the context is - empty. - - - If the final step of the derivation is by [T_App], then there - are terms [t1] and [t2] and types [T1] and [T2] such that - [t = t1 t2], [T = T2], [empty |- t1 : T1 -> T2], and - [empty |- t2 : T1]. - - By the definition of the step relation, there are three ways - [t1 t2] can step. Cases [ST_App1] and [ST_App2] follow - immediately by the induction hypotheses for the typing - subderivations and a use of [T_App]. - - Suppose instead [t1 t2] steps by [ST_AppAbs]. Then [t1 = - \x:S.t12] for some type [S] and term [t12], and [t' = - [x:=t2]t12]. - - By lemma [abs_arrow], we have [T1 <: S] and [x:S1 |- s2 : T2]. - It then follows by the substitution lemma - ([substitution_preserves_typing]) that [empty |- [x:=t2] - t12 : T2] as desired. - - - If the final step of the derivation uses rule [T_If], then - there are terms [t1], [t2], and [t3] such that [t = if t1 then - t2 else t3], with [empty |- t1 : Bool] and with [empty |- t2 : - T] and [empty |- t3 : T]. Moreover, by the induction - hypothesis, if [t1] steps to [t1'] then [empty |- t1' : Bool]. - There are three cases to consider, depending on which rule was - used to show [t ==> t']. - - - If [t ==> t'] by rule [ST_If], then [t' = if t1' then t2 - else t3] with [t1 ==> t1']. By the induction hypothesis, - [empty |- t1' : Bool], and so [empty |- t' : T] by [T_If]. - - - If [t ==> t'] by rule [ST_IfTrue] or [ST_IfFalse], then - either [t' = t2] or [t' = t3], and [empty |- t' : T] - follows by assumption. - - - If the final step of the derivation is by [T_Sub], then there - is a type [S] such that [S <: T] and [empty |- t : S]. The - result is immediate by the induction hypothesis for the typing - subderivation and an application of [T_Sub]. [] *) - -Theorem preservation : forall t t' T, - empty |- t \in T -> - t ==> t' -> - empty |- t' \in T. -Proof with eauto. - intros t t' T HT. - remember empty as Gamma. generalize dependent HeqGamma. - generalize dependent t'. - has_type_cases (induction HT) Case; - intros t' HeqGamma HE; subst; inversion HE; subst... - Case "T_App". - inversion HE; subst... - SCase "ST_AppAbs". - destruct (abs_arrow _ _ _ _ _ HT1) as [HA1 HA2]. - apply substitution_preserves_typing with T... -Qed. - -(** ** Records, via Products and Top *) - -(** This formalization of the STLC with subtyping has omitted record - types, for brevity. If we want to deal with them more seriously, - we have two choices. - - First, we can treat them as part of the core language, writing - down proper syntax, typing, and subtyping rules for them. Chapter - [RecordSub] shows how this extension works. - - On the other hand, if we are treating them as a derived form that - is desugared in the parser, then we shouldn't need any new rules: - we should just check that the existing rules for subtyping product - and [Unit] types give rise to reasonable rules for record - subtyping via this encoding. To do this, we just need to make one - small change to the encoding described earlier: instead of using - [Unit] as the base case in the encoding of tuples and the "don't - care" placeholder in the encoding of records, we use [Top]. So: -<< - {a:Nat, b:Nat} ----> {Nat,Nat} i.e. (Nat,(Nat,Top)) - {c:Nat, a:Nat} ----> {Nat,Top,Nat} i.e. (Nat,(Top,(Nat,Top))) ->> - The encoding of record values doesn't change at all. It is - easy (and instructive) to check that the subtyping rules above are - validated by the encoding. For the rest of this chapter, we'll - follow this encoding-based approach. *) - -(* ###################################################### *) -(** ** Exercises *) - -(** **** Exercise: 2 stars (variations) *) -(** Each part of this problem suggests a different way of - changing the definition of the STLC with Unit and - subtyping. (These changes are not cumulative: each part - starts from the original language.) In each part, list which - properties (Progress, Preservation, both, or neither) become - false. If a property becomes false, give a counterexample. - - Suppose we add the following typing rule: - Gamma |- t : S1->S2 - S1 <: T1 T1 <: S1 S2 <: T2 - ----------------------------------- (T_Funny1) - Gamma |- t : T1->T2 - - - Suppose we add the following reduction rule: - ------------------ (ST_Funny21) - unit ==> (\x:Top. x) - - - Suppose we add the following subtyping rule: - -------------- (S_Funny3) - Unit <: Top->Top - - - Suppose we add the following subtyping rule: - -------------- (S_Funny4) - Top->Top <: Unit - - - Suppose we add the following evaluation rule: - ----------------- (ST_Funny5) - (unit t) ==> (t unit) - - - Suppose we add the same evaluation rule _and_ a new typing rule: - ----------------- (ST_Funny5) - (unit t) ==> (t unit) - - ---------------------- (T_Funny6) - empty |- Unit : Top->Top - - - Suppose we _change_ the arrow subtyping rule to: - S1 <: T1 S2 <: T2 - ----------------------- (S_Arrow') - S1->S2 <: T1->T2 - -[] -*) - -(* ###################################################################### *) -(** * Exercise: Adding Products *) - -(** **** Exercise: 4 stars, optional (products) *) -(** Adding pairs, projections, and product types to the system we have - defined is a relatively straightforward matter. Carry out this - extension: - - - Add constructors for pairs, first and second projections, and - product types to the definitions of [ty] and [tm]. (Don't - forget to add corresponding cases to [T_cases] and [t_cases].) - - - Extend the well-formedness relation in the obvious way. - - - Extend the operational semantics with the same reduction rules - as in the last chapter. - - - Extend the subtyping relation with this rule: - S1 <: T1 S2 <: T2 - --------------------- (Sub_Prod) - S1 * S2 <: T1 * T2 - - Extend the typing relation with the same rules for pairs and - projections as in the last chapter. - - - Extend the proofs of progress, preservation, and all their - supporting lemmas to deal with the new constructs. (You'll also - need to add some completely new lemmas.) [] -*) - - -(* $Date: 2013-12-05 11:55:09 -0500 (Thu, 05 Dec 2013) $ *) - diff --git a/Symbols.html b/Symbols.html deleted file mode 100644 index 1d1ffb5..0000000 --- a/Symbols.html +++ /dev/null @@ -1,51 +0,0 @@ - - - - - -Symbols: Special symbols - - - - - - -
- - - -
- -

SymbolsSpecial symbols

- -
-
- -
- -
-
- -
-(* $Date: 2013-04-01 20:39:05 -0400 (Mon, 01 Apr 2013) $ *)
- -
-(* This file defines some HTML symbols for use by the coqdoc
-   preprocessor.  It is not intended to be read by anybody. *)
- -
- -
-
-
- - - -
- - - \ No newline at end of file diff --git a/Symbols.v b/Symbols.v deleted file mode 100644 index f477ea2..0000000 --- a/Symbols.v +++ /dev/null @@ -1,27 +0,0 @@ -(** * Symbols: Special symbols *) - -(* $Date: 2013-04-01 20:39:05 -0400 (Mon, 01 Apr 2013) $ *) - -(* This file defines some HTML symbols for use by the coqdoc - preprocessor. It is not intended to be read by anybody. *) - -(** printing -> #→# *) -(** printing || #⇓# *) -(** printing ==> #⇒# *) -(** printing ==>* #⇒*# *) -(** printing ==>+ #⇒+# *) -(** printing |- #⊢# *) -(** printing <- #←# *) -(** printing <-> #↔# *) -(** printing forall #∀# *) -(** printing exists #∃# *) -(** printing /\ #∧# *) -(** printing \/ #∨# *) -(** printing ->> #⇾# *) -(** printing <<->> #⇿# *) -(** printing |- #⊢# *) -(** printing Gamma #Γ# *) -(** printing Gamma' #Γ'# *) -(** printing Gamma'' #Γ''# *) -(** printing |-> #↦# *) - diff --git a/Types.html b/Types.html deleted file mode 100644 index de0b00e..0000000 --- a/Types.html +++ /dev/null @@ -1,1450 +0,0 @@ - - - - - -Types: Type Systems - - - - - - -
- - - -
- -

TypesType Systems

- -
-
- -
- -
-
- -
-Require Export Smallstep.
- -
-Hint Constructors multi.
- -
-
- -
-Our next major topic is type systems — static program - analyses that classify expressions according to the "shapes" of - their results. We'll begin with a typed version of a very simple - language with just booleans and numbers, to introduce the basic - ideas of types, typing rules, and the fundamental theorems about - type systems: type preservation and progress. Then we'll move - on to the simply typed lambda-calculus, which lives at the core - of every modern functional programming language (including - Coq). -
-
- -
-
- -
-

Typed Arithmetic Expressions

- -
- - To motivate the discussion of type systems, let's begin as - usual with an extremely simple toy language. We want it to have - the potential for programs "going wrong" because of runtime type - errors, so we need something a tiny bit more complex than the - language of constants and addition that we used in chapter - Smallstep: a single kind of data (just numbers) is too simple, - but just two kinds (numbers and booleans) already gives us enough - material to tell an interesting story. - -
- - The language definition is completely routine. The only thing to - notice is that we are not using the asnum/aslist trick that - we used in chapter HoareList to make all the operations total by - forcibly coercing the arguments to + (for example) into numbers. - Instead, we simply let terms get stuck if they try to use an - operator with the wrong kind of operands: the step relation - doesn't relate them to anything. -
-
- -
-
- -
-

Syntax

- -
- - Informally: - -
- -
-    t ::= true
-        | false
-        | if t then t else t
-        | 0
-        | succ t
-        | pred t
-        | iszero t -
- -
- Formally: - -
-
- -
-Inductive tm : Type :=
-  | ttrue : tm
-  | tfalse : tm
-  | tif : tm → tm → tm → tm
-  | tzero : tm
-  | tsucc : tm → tm
-  | tpred : tm → tm
-  | tiszero : tm → tm.
- -
-
- -
-Values are true, false, and numeric values... -
-
- -
-Inductive bvalue : tm → Prop :=
-  | bv_true : bvalue ttrue
-  | bv_false : bvalue tfalse.
- -
-Inductive nvalue : tm → Prop :=
-  | nv_zero : nvalue tzero
-  | nv_succ : ∀t, nvalue t → nvalue (tsucc t).
- -
-Definition value (t:tm) := bvalue t ∨ nvalue t.
- -
-
-
-Hint Constructors bvalue nvalue.
-Hint Unfold value.
-Hint Unfold extend.
-
- -
-
- -
-

Operational Semantics

- -
- - Informally: -
- -
- - - - - - - - - - -
   - (ST_IfTrue)   -
if true then t1 else t2 ⇒ t1
- - - - - - - - - - -
   - (ST_IfFalse)   -
if false then t1 else t2 ⇒ t2
- - - - - - - - - - - - - - -
t1 ⇒ t1' - (ST_If)   -
if t1 then t2 else t3 ⇒
if t1' then t2 else t3
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Succ)   -
succ t1 ⇒ succ t1'
- - - - - - - - - - -
   - (ST_PredZero)   -
pred 0 ⇒ 0
- - - - - - - - - - -
numeric value v1 - (ST_PredSucc)   -
pred (succ v1) ⇒ v1
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Pred)   -
pred t1 ⇒ pred t1'
- - - - - - - - - - -
   - (ST_IszeroZero)   -
iszero 0 ⇒ true
- - - - - - - - - - -
numeric value v1 - (ST_IszeroSucc)   -
iszero (succ v1) ⇒ false
- - - - - - - - - - -
t1 ⇒ t1' - (ST_Iszero)   -
iszero t1 ⇒ iszero t1'
-
- - Formally: -
-
- -
-Reserved Notation "t1 '⇒' t2" (at level 40).
- -
-Inductive step : tm → tm → Prop :=
-  | ST_IfTrue : ∀t1 t2,
-      (tif ttrue t1 t2) ⇒ t1
-  | ST_IfFalse : ∀t1 t2,
-      (tif tfalse t1 t2) ⇒ t2
-  | ST_If : ∀t1 t1' t2 t3,
-      t1 ⇒ t1' →
-      (tif t1 t2 t3) ⇒ (tif t1' t2 t3)
-  | ST_Succ : ∀t1 t1',
-      t1 ⇒ t1' →
-      (tsucc t1) ⇒ (tsucc t1')
-  | ST_PredZero :
-      (tpred tzero) ⇒ tzero
-  | ST_PredSucc : ∀t1,
-      nvalue t1 →
-      (tpred (tsucc t1)) ⇒ t1
-  | ST_Pred : ∀t1 t1',
-      t1 ⇒ t1' →
-      (tpred t1) ⇒ (tpred t1')
-  | ST_IszeroZero :
-      (tiszero tzero) ⇒ ttrue
-  | ST_IszeroSucc : ∀t1,
-       nvalue t1 →
-      (tiszero (tsucc t1)) ⇒ tfalse
-  | ST_Iszero : ∀t1 t1',
-      t1 ⇒ t1' →
-      (tiszero t1) ⇒ (tiszero t1')
-
-where "t1 '⇒' t2" := (step t1 t2).
- -
-
-
-Tactic Notation "step_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If"
-  | Case_aux c "ST_Succ" | Case_aux c "ST_PredZero"
-  | Case_aux c "ST_PredSucc" | Case_aux c "ST_Pred"
-  | Case_aux c "ST_IszeroZero" | Case_aux c "ST_IszeroSucc"
-  | Case_aux c "ST_Iszero" ].
- -
-Hint Constructors step.
-
-
- -
-Notice that the step relation doesn't care about whether - expressions make global sense — it just checks that the operation - in the next reduction step is being applied to the right kinds - of operands. - -
- - For example, the term succ true (i.e., tsucc ttrue in the - formal syntax) cannot take a step, but the almost as obviously - nonsensical term - -
- -
-       succ (if true then true else true)  -
- -
- can take a step (once, before becoming stuck). -
-
- -
-
- -
-

Normal Forms and Values

- -
- - The first interesting thing about the step relation in this - language is that the strong progress theorem from the Smallstep - chapter fails! That is, there are terms that are normal - forms (they can't take a step) but not values (because we have not - included them in our definition of possible "results of - evaluation"). Such terms are stuck. -
-
- -
-Notation step_normal_form := (normal_form step).
- -
-Definition stuck (t:tm) : Prop :=
-  step_normal_form t ∧ ¬ value t.
- -
-Hint Unfold stuck.
- -
-
- -
-

Exercise: 2 stars (some_term_is_stuck)

- -
-
-Example some_term_is_stuck :
-  ∃t, stuck t.
-
-
-Proof.
-  (* FILL IN HERE *) Admitted.
-
-
- -
-☐ -
- - However, although values and normal forms are not the same in this - language, the former set is included in the latter. This is - important because it shows we did not accidentally define things - so that some value could still take a step. -
- -

Exercise: 3 stars, advanced (value_is_nf)

- Hint: You will reach a point in this proof where you need to - use an induction to reason about a term that is known to be a - numeric value. This induction can be performed either over the - term itself or over the evidence that it is a numeric value. The - proof goes through in either case, but you will find that one way - is quite a bit shorter than the other. For the sake of the - exercise, try to complete the proof both ways. -
-
- -
-Lemma value_is_nf : ∀t,
-  value t → step_normal_form t.
-
-
-Proof.
-  (* FILL IN HERE *) Admitted.
-
-
- -
-☐ -
- -

Exercise: 3 stars, optional (step_deterministic)

- Using value_is_nf, we can show that the step relation is - also deterministic... -
-
- -
-Theorem step_deterministic:
-  deterministic step.
-Proof with eauto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Typing

- -
- - The next critical observation about this language is that, - although there are stuck terms, they are all "nonsensical", mixing - booleans and numbers in a way that we don't even want to have a - meaning. We can easily exclude such ill-typed terms by defining a - typing relation that relates terms to the types (either numeric - or boolean) of their final results. -
-
- -
-Inductive ty : Type :=
-  | TBool : ty
-  | TNat : ty.
- -
-
- -
-In informal notation, the typing relation is often written - ⊢ t ∈ T, pronounced "t has type T." The ⊢ symbol is - called a "turnstile". (Below, we're going to see richer typing - relations where an additional "context" argument is written to the - left of the turnstile. Here, the context is always empty.)
- - - - - - - - - - -
   - (T_True)   -
⊢ true ∈ Bool
- - - - - - - - - - -
   - (T_False)   -
⊢ false ∈ Bool
- - - - - - - - - - -
⊢ t1 ∈ Bool    ⊢ t2 ∈ T    ⊢ t3 ∈ T - (T_If)   -
⊢ if t1 then t2 else t3 ∈ T
- - - - - - - - - - -
   - (T_Zero)   -
⊢ 0 ∈ Nat
- - - - - - - - - - -
⊢ t1 ∈ Nat - (T_Succ)   -
⊢ succ t1 ∈ Nat
- - - - - - - - - - -
⊢ t1 ∈ Nat - (T_Pred)   -
⊢ pred t1 ∈ Nat
- - - - - - - - - - -
⊢ t1 ∈ Nat - (T_IsZero)   -
⊢ iszero t1 ∈ Bool
-
-
- -
-Reserved Notation "'⊢' t '∈' T" (at level 40).
- -
-Inductive has_type : tm → ty → Prop :=
-  | T_True :
-       ⊢ ttrue ∈ TBool
-  | T_False :
-       ⊢ tfalse ∈ TBool
-  | T_If : ∀t1 t2 t3 T,
-       ⊢ t1 ∈ TBool →
-       ⊢ t2 ∈ T →
-       ⊢ t3 ∈ T →
-       ⊢ tif t1 t2 t3 ∈ T
-  | T_Zero :
-       ⊢ tzero ∈ TNat
-  | T_Succ : ∀t1,
-       ⊢ t1 ∈ TNat →
-       ⊢ tsucc t1 ∈ TNat
-  | T_Pred : ∀t1,
-       ⊢ t1 ∈ TNat →
-       ⊢ tpred t1 ∈ TNat
-  | T_Iszero : ∀t1,
-       ⊢ t1 ∈ TNat →
-       ⊢ tiszero t1 ∈ TBool
-
-where "'⊢' t '∈' T" := (has_type t T).
- -
-
-
-Tactic Notation "has_type_cases" tactic(first) ident(c) :=
-  first;
-  [ Case_aux c "T_True" | Case_aux c "T_False" | Case_aux c "T_If"
-  | Case_aux c "T_Zero" | Case_aux c "T_Succ" | Case_aux c "T_Pred"
-  | Case_aux c "T_Iszero" ].
- -
-Hint Constructors has_type.
-
- -
-
- -
-

Examples

- -
- - It's important to realize that the typing relation is a - conservative (or static) approximation: it does not calculate - the type of the normal form of a term. -
-
- -
-Example has_type_1 :
-  ⊢ tif tfalse tzero (tsucc tzero) ∈ TNat.
-
-
-Proof.
-  apply T_If.
-    apply T_False.
-    apply T_Zero.
-    apply T_Succ.
-      apply T_Zero.
-Qed.
-
- -
-
- -
-(Since we've included all the constructors of the typing relation - in the hint database, the auto tactic can actually find this - proof automatically.) -
-
- -
-Example has_type_not :
-  ¬ (⊢ tif tfalse tzero ttrue ∈ TBool).
-
-
-Proof.
-  intros Contra. solve by inversion 2. Qed.
-
- -
-
- -
-

Exercise: 1 star, optional (succ_hastype_nat__hastype_nat)

- -
-
-Example succ_hastype_nat__hastype_nat : ∀t,
-  ⊢ tsucc t ∈ TNat →
-  ⊢ t ∈ TNat.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Canonical forms

- -
- - The following two lemmas capture the basic property that defines - the shape of well-typed values. They say that the definition of value - and the typing relation agree. -
-
- -
-Lemma bool_canonical : ∀t,
-  ⊢ t ∈ TBool → value t → bvalue t.
-
-
-Proof.
-  intros t HT HV.
-  inversion HV; auto.
- -
-  induction H; inversion HT; auto.
-Qed.
-
- -
-Lemma nat_canonical : ∀t,
-  ⊢ t ∈ TNat → value t → nvalue t.
-
-
-Proof.
-  intros t HT HV.
-  inversion HV.
-  inversion H; subst; inversion HT.
- -
-  auto.
-Qed.
-
- -
-
- -
-

Progress

- -
- - The typing relation enjoys two critical properties. The first is - that well-typed normal forms are values (i.e., not stuck). -
-
- -
-Theorem progress : ∀t T,
-  ⊢ t ∈ T →
-  value t ∨ ∃t', t ⇒ t'.
- -
-
- -
-

Exercise: 3 stars (finish_progress)

- Complete the formal proof of the progress property. (Make sure - you understand the informal proof fragment in the following - exercise before starting — this will save you a lot of time.) -
-
- -
-
-
-Proof with auto.
-  intros t T HT.
-  has_type_cases (induction HT) Case...
-  (* The cases that were obviously values, like T_True and
-     T_False, were eliminated immediately by auto *)
-  Case "T_If".
-    right. inversion IHHT1; clear IHHT1.
-    SCase "t1 is a value".
-    apply (bool_canonical t1 HT1) in H.
-    inversion H; subst; clear H.
-      ∃t2...
-      ∃t3...
-    SCase "t1 can take a step".
-      inversion H as [t1' H1].
-      ∃(tif t1' t2 t3)...
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
-
- -
-
- -
-

Exercise: 3 stars, advanced (finish_progress_informal)

- Complete the corresponding informal proof: -
- - Theorem: If ⊢ t ∈ T, then either t is a value or else - t ⇒ t' for some t'. -
- - Proof: By induction on a derivation of ⊢ t ∈ T. - -
- -
    -
  • If the last rule in the derivation is T_If, then t = if t1 - then t2 else t3, with ⊢ t1 ∈ Bool, ⊢ t2 ∈ T and ⊢ t3 - ∈ T. By the IH, either t1 is a value or else t1 can step - to some t1'. - -
    - -
      -
    • If t1 is a value, then by the canonical forms lemmas - and the fact that ⊢ t1 ∈ Bool we have that t1 - is a bvalue — i.e., it is either true or false. - If t1 = true, then t steps to t2 by ST_IfTrue, - while if t1 = false, then t steps to t3 by - ST_IfFalse. Either way, t can step, which is what - we wanted to show. - -
      - - -
      • -
    • If t1 itself can take a step, then, by ST_If, so can - t. - -
      • -
    - -
    • -
- -
- - (* FILL IN HERE *)
-☐ - -
- - This is more interesting than the strong progress theorem that we - saw in the Smallstep chapter, where all normal forms were - values. Here, a term can be stuck, but only if it is ill - typed. -
- -

Exercise: 1 star (step_review)

- Quick review. Answer true or false. In this language... - -
- -
    -
  • Every well-typed normal form is a value. - -
    - - -
    • -
  • Every value is a normal form. - -
    - - -
    • -
  • The single-step evaluation relation is - a partial function (i.e., it is deterministic). - -
    - - -
    • -
  • The single-step evaluation relation is a total function. - -
    • -
- -
- - ☐ -
-
- -
-
- -
-

Type Preservation

- -
- - The second critical property of typing is that, when a well-typed - term takes a step, the result is also a well-typed term. - -
- - This theorem is often called the subject reduction property, - because it tells us what happens when the "subject" of the typing - relation is reduced. This terminology comes from thinking of - typing statements as sentences, where the term is the subject and - the type is the predicate. -
-
- -
-Theorem preservation : ∀t t' T,
-  ⊢ t ∈ T →
-  t ⇒ t' →
-  ⊢ t' ∈ T.
- -
-
- -
-

Exercise: 2 stars (finish_preservation)

- Complete the formal proof of the preservation property. (Again, - make sure you understand the informal proof fragment in the - following exercise first.) -
-
- -
-
-
-Proof with auto.
-  intros t t' T HT HE.
-  generalize dependent t'.
-  has_type_cases (induction HT) Case;
-         (* every case needs to introduce a couple of things *)
-         intros t' HE;
-         (* and we can deal with several impossible
-            cases all at once *)
-         try (solve by inversion).
-    Case "T_If". inversion HE; subst; clear HE.
-      SCase "ST_IFTrue". assumption.
-      SCase "ST_IfFalse". assumption.
-      SCase "ST_If". apply T_If; try assumption.
-        apply IHHT1; assumption.
-    (* FILL IN HERE *) Admitted.
-
-
- -
-☐ -
- -

Exercise: 3 stars, advanced (finish_preservation_informal)

- Complete the following proof: -
- - Theorem: If ⊢ t ∈ T and t ⇒ t', then ⊢ t' ∈ T. -
- - Proof: By induction on a derivation of ⊢ t ∈ T. - -
- -
    -
  • If the last rule in the derivation is T_If, then t = if t1 - then t2 else t3, with ⊢ t1 ∈ Bool, ⊢ t2 ∈ T and ⊢ t3 - ∈ T. - -
    - - Inspecting the rules for the small-step reduction relation and - remembering that t has the form if ..., we see that the - only ones that could have been used to prove t ⇒ t' are - ST_IfTrue, ST_IfFalse, or ST_If. - -
    - -
      -
    • If the last rule was ST_IfTrue, then t' = t2. But we - know that ⊢ t2 ∈ T, so we are done. - -
      - - -
      • -
    • If the last rule was ST_IfFalse, then t' = t3. But we - know that ⊢ t3 ∈ T, so we are done. - -
      - - -
      • -
    • If the last rule was ST_If, then t' = if t1' then t2 - else t3, where t1 ⇒ t1'. We know ⊢ t1 ∈ Bool so, - by the IH, ⊢ t1' ∈ Bool. The T_If rule then gives us - ⊢ if t1' then t2 else t3 ∈ T, as required. - -
      • -
    - -
    • -
- -
- - (* FILL IN HERE *)
-☐ - -
- -

Exercise: 3 stars (preservation_alternate_proof)

- Now prove the same property again by induction on the - evaluation derivation instead of on the typing derivation. - Begin by carefully reading and thinking about the first few - lines of the above proof to make sure you understand what - each one is doing. The set-up for this proof is similar, but - not exactly the same. -
-
- -
-Theorem preservation' : ∀t t' T,
-  ⊢ t ∈ T →
-  t ⇒ t' →
-  ⊢ t' ∈ T.
-Proof with eauto.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Type Soundness

- -
- - Putting progress and preservation together, we can see that a - well-typed term can never reach a stuck state. -
-
- -
-Definition multistep := (multi step).
-Notation "t1 '⇒*' t2" := (multistep t1 t2) (at level 40).
- -
-Corollary soundness : ∀t t' T,
-  ⊢ t ∈ T →
-  t ⇒* t' →
-  ~(stuck t').
-
-
-Proof.
-  intros t t' T HT P. induction P; intros [R S].
-  destruct (progress x T HT); auto.
-  apply IHP. apply (preservation x y T HT H).
-  unfold stuck. split; auto. Qed.
-
- -
-
- -
-

Aside: the normalize Tactic

- -
- - When experimenting with definitions of programming languages in - Coq, we often want to see what a particular concrete term steps - to — i.e., we want to find proofs for goals of the form t ⇒* - t', where t is a completely concrete term and t' is unknown. - These proofs are simple but repetitive to do by hand. Consider for - example reducing an arithmetic expression using the small-step - relation astep. -
-
- -
-
-
-Definition amultistep st := multi (astep st).
-Notation " t '/' st '⇒a×' t' " := (amultistep st t t')
-  (at level 40, st at level 39).
-
- -
-Example astep_example1 :
-  (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
-  ⇒a× (ANum 15).
-Proof.
-  apply multi_step with (APlus (ANum 3) (ANum 12)).
-    apply AS_Plus2.
-      apply av_num.
-      apply AS_Mult.
-  apply multi_step with (ANum 15).
-    apply AS_Plus.
-  apply multi_refl.
-Qed.
- -
-
- -
-We repeatedly apply multi_step until we get to a normal - form. The proofs that the intermediate steps are possible are - simple enough that auto, with appropriate hints, can solve - them. -
-
- -
-Hint Constructors astep aval.
-Example astep_example1' :
-  (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
-  ⇒a× (ANum 15).
-Proof.
-  eapply multi_step. auto. simpl.
-  eapply multi_step. auto. simpl.
-  apply multi_refl.
-Qed.
- -
-
- -
-The following custom Tactic Notation definition captures this - pattern. In addition, before each multi_step we print out the - current goal, so that the user can follow how the term is being - evaluated. -
-
- -
-Tactic Notation "print_goal" := match goal with ⊢ ?x ⇒ idtac x end.
-Tactic Notation "normalize" :=
-   repeat (print_goal; eapply multi_step ;
-             [ (eauto 10; fail) | (instantiate; simpl)]);
-   apply multi_refl.
- -
-Example astep_example1'' :
-  (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
-  ⇒a× (ANum 15).
-Proof.
-  normalize.
-  (* At this point in the proof script, the Coq response shows 
-     a trace of how the expression evaluated. 
-
-   (APlus (ANum 3) (AMult (ANum 3) (ANum 4)) / empty_state ==>a* ANum 15)
-   (multi (astep empty_state) (APlus (ANum 3) (ANum 12)) (ANum 15))
-   (multi (astep empty_state) (ANum 15) (ANum 15))
-*)
-Qed.
- -
-
- -
-The normalize tactic also provides a simple way to calculate - what the normal form of a term is, by proving a goal with an - existential variable in it. -
-
- -
-Example astep_example1''' : ∃e',
-  (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
-  ⇒a× e'.
-Proof.
-  eapply ex_intro. normalize.
- -
-(* This time, the trace will be:
-
-    (APlus (ANum 3) (AMult (ANum 3) (ANum 4)) / empty_state ==>a* ??)
-    (multi (astep empty_state) (APlus (ANum 3) (ANum 12)) ??)
-    (multi (astep empty_state) (ANum 15) ??)
-
-   where ?? is the variable ``guessed'' by eapply.
-*)
-Qed.
- -
-
- -
-

Exercise: 1 star (normalize_ex)

- -
-
-Theorem normalize_ex : ∃e',
-  (AMult (ANum 3) (AMult (ANum 2) (ANum 1))) / empty_state
-  ⇒a× e'.
-Proof.
-  (* FILL IN HERE *) Admitted.
- -
-
- -
-☐ -
- -

Exercise: 1 star, optional (normalize_ex')

- For comparison, prove it using apply instead of eapply. -
-
- -
-Theorem normalize_ex' : ∃e',
-  (AMult (ANum 3) (AMult (ANum 2) (ANum 1))) / empty_state
-  ⇒a× e'.
-Proof.
-  (* FILL IN HERE *) Admitted.
-
- -
-☐ -
-
- -
-
- -
-

Additional Exercises

- -
- -

Exercise: 2 stars (subject_expansion)

- Having seen the subject reduction property, it is reasonable to - wonder whether the opposity property — subject expansion — - also holds. That is, is it always the case that, if t ⇒ t' - and ⊢ t' ∈ T, then ⊢ t ∈ T? If so, prove it. If - not, give a counter-example. (You do not need to prove your - counter-example in Coq, but feel free to do so if you like.) - -
- - (* FILL IN HERE *)
-☐ - -
- -

Exercise: 2 stars (variation1)

- Suppose, that we add this new rule to the typing relation: - -
- -
-      | T_SuccBool : ∀t,
-           ⊢ t ∈ TBool →
-           ⊢ tsucc t ∈ TBool -
- -
- Which of the following properties remain true in the presence of - this rule? For each one, write either "remains true" or - else "becomes false." If a property becomes false, give a - counterexample. - -
- -
    -
  • Determinism of step - -
    - - -
    • -
  • Progress - -
    - - -
    • -
  • Preservation - -
    • -
- -
- -☐ - -
- -

Exercise: 2 stars (variation2)

- Suppose, instead, that we add this new rule to the step relation: - -
- -
-      | ST_Funny1 : ∀t2 t3,
-           (tif ttrue t2 t3) ⇒ t3 -
- -
- Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -
- -☐ - -
- -

Exercise: 2 stars, optional (variation3)

- Suppose instead that we add this rule: - -
- -
-      | ST_Funny2 : ∀t1 t2 t2' t3,
-           t2 ⇒ t2' →
-           (tif t1 t2 t3) ⇒ (tif t1 t2' t3) -
- -
- Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -
- -☐ - -
- -

Exercise: 2 stars, optional (variation4)

- Suppose instead that we add this rule: - -
- -
-      | ST_Funny3 : 
-          (tpred tfalse) ⇒ (tpred (tpred tfalse)) -
- -
- Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -
- -☐ - -
- -

Exercise: 2 stars, optional (variation5)

- Suppose instead that we add this rule: - -
- -
-      | T_Funny4 : 
-            ⊢ tzero ∈ TBool -
- -
- Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -
- -☐ - -
- -

Exercise: 2 stars, optional (variation6)

- Suppose instead that we add this rule: - -
- -
-      | T_Funny5 : 
-            ⊢ tpred tzero ∈ TBool -
- -
- Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -
- -☐ - -
- -

Exercise: 3 stars, optional (more_variations)

- Make up some exercises of your own along the same lines as - the ones above. Try to find ways of selectively breaking - properties — i.e., ways of changing the definitions that - break just one of the properties and leave the others alone. - ☐ - -
- -

Exercise: 1 star (remove_predzero)

- The evaluation rule E_PredZero is a bit counter-intuitive: we - might feel that it makes more sense for the predecessor of zero to - be undefined, rather than being defined to be zero. Can we - achieve this simply by removing the rule from the definition of - step? Would doing so create any problems elsewhere? - -
- -(* FILL IN HERE *)
-☐ -
- -

Exercise: 4 stars, advanced (prog_pres_bigstep)

- Suppose our evaluation relation is defined in the big-step style. - What are the appropriate analogs of the progress and preservation - properties? - -
- -(* FILL IN HERE *)
-☐ - -
-
- -
-(* $Date: 2014-04-08 23:31:16 -0400 (Tue, 08 Apr 2014) $ *)
-
-
- - - -
- - - \ No newline at end of file diff --git a/Types.v b/Types.v deleted file mode 100644 index cad1546..0000000 --- a/Types.v +++ /dev/null @@ -1,787 +0,0 @@ -(** * Types: Type Systems *) - -Require Export Smallstep. - -Hint Constructors multi. - -(** Our next major topic is _type systems_ -- static program - analyses that classify expressions according to the "shapes" of - their results. We'll begin with a typed version of a very simple - language with just booleans and numbers, to introduce the basic - ideas of types, typing rules, and the fundamental theorems about - type systems: _type preservation_ and _progress_. Then we'll move - on to the _simply typed lambda-calculus_, which lives at the core - of every modern functional programming language (including - Coq). *) - -(* ###################################################################### *) -(** * Typed Arithmetic Expressions *) - -(** To motivate the discussion of type systems, let's begin as - usual with an extremely simple toy language. We want it to have - the potential for programs "going wrong" because of runtime type - errors, so we need something a tiny bit more complex than the - language of constants and addition that we used in chapter - [Smallstep]: a single kind of data (just numbers) is too simple, - but just two kinds (numbers and booleans) already gives us enough - material to tell an interesting story. - - The language definition is completely routine. The only thing to - notice is that we are _not_ using the [asnum]/[aslist] trick that - we used in chapter [HoareList] to make all the operations total by - forcibly coercing the arguments to [+] (for example) into numbers. - Instead, we simply let terms get stuck if they try to use an - operator with the wrong kind of operands: the [step] relation - doesn't relate them to anything. *) - -(* ###################################################################### *) -(** ** Syntax *) - -(** Informally: - t ::= true - | false - | if t then t else t - | 0 - | succ t - | pred t - | iszero t - Formally: -*) - -Inductive tm : Type := - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm - | tzero : tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tiszero : tm -> tm. - -(** _Values_ are [true], [false], and numeric values... *) - -Inductive bvalue : tm -> Prop := - | bv_true : bvalue ttrue - | bv_false : bvalue tfalse. - -Inductive nvalue : tm -> Prop := - | nv_zero : nvalue tzero - | nv_succ : forall t, nvalue t -> nvalue (tsucc t). - -Definition value (t:tm) := bvalue t \/ nvalue t. - -Hint Constructors bvalue nvalue. -Hint Unfold value. -Hint Unfold extend. - -(* ###################################################################### *) -(** ** Operational Semantics *) - -(** Informally: *) -(** - ------------------------------ (ST_IfTrue) - if true then t1 else t2 ==> t1 - - ------------------------------- (ST_IfFalse) - if false then t1 else t2 ==> t2 - - t1 ==> t1' - ------------------------- (ST_If) - if t1 then t2 else t3 ==> - if t1' then t2 else t3 - - t1 ==> t1' - -------------------- (ST_Succ) - succ t1 ==> succ t1' - - ------------ (ST_PredZero) - pred 0 ==> 0 - - numeric value v1 - --------------------- (ST_PredSucc) - pred (succ v1) ==> v1 - - t1 ==> t1' - -------------------- (ST_Pred) - pred t1 ==> pred t1' - - ----------------- (ST_IszeroZero) - iszero 0 ==> true - - numeric value v1 - -------------------------- (ST_IszeroSucc) - iszero (succ v1) ==> false - - t1 ==> t1' - ------------------------ (ST_Iszero) - iszero t1 ==> iszero t1' -*) - -(** Formally: *) - -Reserved Notation "t1 '==>' t2" (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_IfTrue : forall t1 t2, - (tif ttrue t1 t2) ==> t1 - | ST_IfFalse : forall t1 t2, - (tif tfalse t1 t2) ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - (tif t1 t2 t3) ==> (tif t1' t2 t3) - | ST_Succ : forall t1 t1', - t1 ==> t1' -> - (tsucc t1) ==> (tsucc t1') - | ST_PredZero : - (tpred tzero) ==> tzero - | ST_PredSucc : forall t1, - nvalue t1 -> - (tpred (tsucc t1)) ==> t1 - | ST_Pred : forall t1 t1', - t1 ==> t1' -> - (tpred t1) ==> (tpred t1') - | ST_IszeroZero : - (tiszero tzero) ==> ttrue - | ST_IszeroSucc : forall t1, - nvalue t1 -> - (tiszero (tsucc t1)) ==> tfalse - | ST_Iszero : forall t1 t1', - t1 ==> t1' -> - (tiszero t1) ==> (tiszero t1') - -where "t1 '==>' t2" := (step t1 t2). - -Tactic Notation "step_cases" tactic(first) ident(c) := - first; - [ Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" - | Case_aux c "ST_Succ" | Case_aux c "ST_PredZero" - | Case_aux c "ST_PredSucc" | Case_aux c "ST_Pred" - | Case_aux c "ST_IszeroZero" | Case_aux c "ST_IszeroSucc" - | Case_aux c "ST_Iszero" ]. - -Hint Constructors step. -(** Notice that the [step] relation doesn't care about whether - expressions make global sense -- it just checks that the operation - in the _next_ reduction step is being applied to the right kinds - of operands. - - For example, the term [succ true] (i.e., [tsucc ttrue] in the - formal syntax) cannot take a step, but the almost as obviously - nonsensical term - succ (if true then true else true) - can take a step (once, before becoming stuck). *) - -(* ###################################################################### *) -(** ** Normal Forms and Values *) - -(** The first interesting thing about the [step] relation in this - language is that the strong progress theorem from the Smallstep - chapter fails! That is, there are terms that are normal - forms (they can't take a step) but not values (because we have not - included them in our definition of possible "results of - evaluation"). Such terms are _stuck_. *) - -Notation step_normal_form := (normal_form step). - -Definition stuck (t:tm) : Prop := - step_normal_form t /\ ~ value t. - -Hint Unfold stuck. - -(** **** Exercise: 2 stars (some_term_is_stuck) *) -Example some_term_is_stuck : - exists t, stuck t. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** However, although values and normal forms are not the same in this - language, the former set is included in the latter. This is - important because it shows we did not accidentally define things - so that some value could still take a step. *) - -(** **** Exercise: 3 stars, advanced (value_is_nf) *) -(** Hint: You will reach a point in this proof where you need to - use an induction to reason about a term that is known to be a - numeric value. This induction can be performed either over the - term itself or over the evidence that it is a numeric value. The - proof goes through in either case, but you will find that one way - is quite a bit shorter than the other. For the sake of the - exercise, try to complete the proof both ways. *) - -Lemma value_is_nf : forall t, - value t -> step_normal_form t. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(** **** Exercise: 3 stars, optional (step_deterministic) *) -(** Using [value_is_nf], we can show that the [step] relation is - also deterministic... *) - -Theorem step_deterministic: - deterministic step. -Proof with eauto. - (* FILL IN HERE *) Admitted. -(** [] *) - - - -(* ###################################################################### *) -(** ** Typing *) - -(** The next critical observation about this language is that, - although there are stuck terms, they are all "nonsensical", mixing - booleans and numbers in a way that we don't even _want_ to have a - meaning. We can easily exclude such ill-typed terms by defining a - _typing relation_ that relates terms to the types (either numeric - or boolean) of their final results. *) - -Inductive ty : Type := - | TBool : ty - | TNat : ty. - -(** In informal notation, the typing relation is often written - [|- t \in T], pronounced "[t] has type [T]." The [|-] symbol is - called a "turnstile". (Below, we're going to see richer typing - relations where an additional "context" argument is written to the - left of the turnstile. Here, the context is always empty.) *) -(** - ---------------- (T_True) - |- true \in Bool - - ----------------- (T_False) - |- false \in Bool - - |- t1 \in Bool |- t2 \in T |- t3 \in T - -------------------------------------------- (T_If) - |- if t1 then t2 else t3 \in T - - ------------ (T_Zero) - |- 0 \in Nat - - |- t1 \in Nat - ------------------ (T_Succ) - |- succ t1 \in Nat - - |- t1 \in Nat - ------------------ (T_Pred) - |- pred t1 \in Nat - - |- t1 \in Nat - --------------------- (T_IsZero) - |- iszero t1 \in Bool -*) - -Reserved Notation "'|-' t '\in' T" (at level 40). - -Inductive has_type : tm -> ty -> Prop := - | T_True : - |- ttrue \in TBool - | T_False : - |- tfalse \in TBool - | T_If : forall t1 t2 t3 T, - |- t1 \in TBool -> - |- t2 \in T -> - |- t3 \in T -> - |- tif t1 t2 t3 \in T - | T_Zero : - |- tzero \in TNat - | T_Succ : forall t1, - |- t1 \in TNat -> - |- tsucc t1 \in TNat - | T_Pred : forall t1, - |- t1 \in TNat -> - |- tpred t1 \in TNat - | T_Iszero : forall t1, - |- t1 \in TNat -> - |- tiszero t1 \in TBool - -where "'|-' t '\in' T" := (has_type t T). - -Tactic Notation "has_type_cases" tactic(first) ident(c) := - first; - [ Case_aux c "T_True" | Case_aux c "T_False" | Case_aux c "T_If" - | Case_aux c "T_Zero" | Case_aux c "T_Succ" | Case_aux c "T_Pred" - | Case_aux c "T_Iszero" ]. - -Hint Constructors has_type. - -(* ###################################################################### *) -(** *** Examples *) - -(** It's important to realize that the typing relation is a - _conservative_ (or _static_) approximation: it does not calculate - the type of the normal form of a term. *) - -Example has_type_1 : - |- tif tfalse tzero (tsucc tzero) \in TNat. -Proof. - apply T_If. - apply T_False. - apply T_Zero. - apply T_Succ. - apply T_Zero. -Qed. - -(** (Since we've included all the constructors of the typing relation - in the hint database, the [auto] tactic can actually find this - proof automatically.) *) - -Example has_type_not : - ~ (|- tif tfalse tzero ttrue \in TBool). -Proof. - intros Contra. solve by inversion 2. Qed. - -(** **** Exercise: 1 star, optional (succ_hastype_nat__hastype_nat) *) -Example succ_hastype_nat__hastype_nat : forall t, - |- tsucc t \in TNat -> - |- t \in TNat. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** ** Canonical forms *) - -(** The following two lemmas capture the basic property that defines - the shape of well-typed values. They say that the definition of value - and the typing relation agree. *) - -Lemma bool_canonical : forall t, - |- t \in TBool -> value t -> bvalue t. -Proof. - intros t HT HV. - inversion HV; auto. - - induction H; inversion HT; auto. -Qed. - -Lemma nat_canonical : forall t, - |- t \in TNat -> value t -> nvalue t. -Proof. - intros t HT HV. - inversion HV. - inversion H; subst; inversion HT. - - auto. -Qed. - -(* ###################################################################### *) -(** ** Progress *) - -(** The typing relation enjoys two critical properties. The first is - that well-typed normal forms are values (i.e., not stuck). *) - -Theorem progress : forall t T, - |- t \in T -> - value t \/ exists t', t ==> t'. - -(** **** Exercise: 3 stars (finish_progress) *) -(** Complete the formal proof of the [progress] property. (Make sure - you understand the informal proof fragment in the following - exercise before starting -- this will save you a lot of time.) *) - -Proof with auto. - intros t T HT. - has_type_cases (induction HT) Case... - (* The cases that were obviously values, like T_True and - T_False, were eliminated immediately by auto *) - Case "T_If". - right. inversion IHHT1; clear IHHT1. - SCase "t1 is a value". - apply (bool_canonical t1 HT1) in H. - inversion H; subst; clear H. - exists t2... - exists t3... - SCase "t1 can take a step". - inversion H as [t1' H1]. - exists (tif t1' t2 t3)... - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (finish_progress_informal) *) -(** Complete the corresponding informal proof: *) - -(** _Theorem_: If [|- t \in T], then either [t] is a value or else - [t ==> t'] for some [t']. *) - -(** _Proof_: By induction on a derivation of [|- t \in T]. - - - If the last rule in the derivation is [T_If], then [t = if t1 - then t2 else t3], with [|- t1 \in Bool], [|- t2 \in T] and [|- t3 - \in T]. By the IH, either [t1] is a value or else [t1] can step - to some [t1']. - - - If [t1] is a value, then by the canonical forms lemmas - and the fact that [|- t1 \in Bool] we have that [t1] - is a [bvalue] -- i.e., it is either [true] or [false]. - If [t1 = true], then [t] steps to [t2] by [ST_IfTrue], - while if [t1 = false], then [t] steps to [t3] by - [ST_IfFalse]. Either way, [t] can step, which is what - we wanted to show. - - - If [t1] itself can take a step, then, by [ST_If], so can - [t]. - - (* FILL IN HERE *) -[] -*) - -(** This is more interesting than the strong progress theorem that we - saw in the Smallstep chapter, where _all_ normal forms were - values. Here, a term can be stuck, but only if it is ill - typed. *) - -(** **** Exercise: 1 star (step_review) *) -(** Quick review. Answer _true_ or _false_. In this language... - - Every well-typed normal form is a value. - - - Every value is a normal form. - - - The single-step evaluation relation is - a partial function (i.e., it is deterministic). - - - The single-step evaluation relation is a _total_ function. - -*) -(** [] *) - -(* ###################################################################### *) -(** ** Type Preservation *) - -(** The second critical property of typing is that, when a well-typed - term takes a step, the result is also a well-typed term. - - This theorem is often called the _subject reduction_ property, - because it tells us what happens when the "subject" of the typing - relation is reduced. This terminology comes from thinking of - typing statements as sentences, where the term is the subject and - the type is the predicate. *) - -Theorem preservation : forall t t' T, - |- t \in T -> - t ==> t' -> - |- t' \in T. - -(** **** Exercise: 2 stars (finish_preservation) *) -(** Complete the formal proof of the [preservation] property. (Again, - make sure you understand the informal proof fragment in the - following exercise first.) *) - -Proof with auto. - intros t t' T HT HE. - generalize dependent t'. - has_type_cases (induction HT) Case; - (* every case needs to introduce a couple of things *) - intros t' HE; - (* and we can deal with several impossible - cases all at once *) - try (solve by inversion). - Case "T_If". inversion HE; subst; clear HE. - SCase "ST_IFTrue". assumption. - SCase "ST_IfFalse". assumption. - SCase "ST_If". apply T_If; try assumption. - apply IHHT1; assumption. - (* FILL IN HERE *) Admitted. -(** [] *) - -(** **** Exercise: 3 stars, advanced (finish_preservation_informal) *) -(** Complete the following proof: *) - -(** _Theorem_: If [|- t \in T] and [t ==> t'], then [|- t' \in T]. *) - -(** _Proof_: By induction on a derivation of [|- t \in T]. - - - If the last rule in the derivation is [T_If], then [t = if t1 - then t2 else t3], with [|- t1 \in Bool], [|- t2 \in T] and [|- t3 - \in T]. - - Inspecting the rules for the small-step reduction relation and - remembering that [t] has the form [if ...], we see that the - only ones that could have been used to prove [t ==> t'] are - [ST_IfTrue], [ST_IfFalse], or [ST_If]. - - - If the last rule was [ST_IfTrue], then [t' = t2]. But we - know that [|- t2 \in T], so we are done. - - - If the last rule was [ST_IfFalse], then [t' = t3]. But we - know that [|- t3 \in T], so we are done. - - - If the last rule was [ST_If], then [t' = if t1' then t2 - else t3], where [t1 ==> t1']. We know [|- t1 \in Bool] so, - by the IH, [|- t1' \in Bool]. The [T_If] rule then gives us - [|- if t1' then t2 else t3 \in T], as required. - - (* FILL IN HERE *) -[] -*) - -(** **** Exercise: 3 stars (preservation_alternate_proof) *) -(** Now prove the same property again by induction on the - _evaluation_ derivation instead of on the typing derivation. - Begin by carefully reading and thinking about the first few - lines of the above proof to make sure you understand what - each one is doing. The set-up for this proof is similar, but - not exactly the same. *) - -Theorem preservation' : forall t t' T, - |- t \in T -> - t ==> t' -> - |- t' \in T. -Proof with eauto. - (* FILL IN HERE *) Admitted. -(** [] *) - -(* ###################################################################### *) -(** ** Type Soundness *) - -(** Putting progress and preservation together, we can see that a - well-typed term can _never_ reach a stuck state. *) - -Definition multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). - -Corollary soundness : forall t t' T, - |- t \in T -> - t ==>* t' -> - ~(stuck t'). -Proof. - intros t t' T HT P. induction P; intros [R S]. - destruct (progress x T HT); auto. - apply IHP. apply (preservation x y T HT H). - unfold stuck. split; auto. Qed. - - -(* ###################################################################### *) -(** * Aside: the [normalize] Tactic *) - -(** When experimenting with definitions of programming languages in - Coq, we often want to see what a particular concrete term steps - to -- i.e., we want to find proofs for goals of the form [t ==>* - t'], where [t] is a completely concrete term and [t'] is unknown. - These proofs are simple but repetitive to do by hand. Consider for - example reducing an arithmetic expression using the small-step - relation [astep]. *) - - -Definition amultistep st := multi (astep st). -Notation " t '/' st '==>a*' t' " := (amultistep st t t') - (at level 40, st at level 39). - -Example astep_example1 : - (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state - ==>a* (ANum 15). -Proof. - apply multi_step with (APlus (ANum 3) (ANum 12)). - apply AS_Plus2. - apply av_num. - apply AS_Mult. - apply multi_step with (ANum 15). - apply AS_Plus. - apply multi_refl. -Qed. - -(** We repeatedly apply [multi_step] until we get to a normal - form. The proofs that the intermediate steps are possible are - simple enough that [auto], with appropriate hints, can solve - them. *) - -Hint Constructors astep aval. -Example astep_example1' : - (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state - ==>a* (ANum 15). -Proof. - eapply multi_step. auto. simpl. - eapply multi_step. auto. simpl. - apply multi_refl. -Qed. - - -(** The following custom [Tactic Notation] definition captures this - pattern. In addition, before each [multi_step] we print out the - current goal, so that the user can follow how the term is being - evaluated. *) - -Tactic Notation "print_goal" := match goal with |- ?x => idtac x end. -Tactic Notation "normalize" := - repeat (print_goal; eapply multi_step ; - [ (eauto 10; fail) | (instantiate; simpl)]); - apply multi_refl. - - -Example astep_example1'' : - (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state - ==>a* (ANum 15). -Proof. - normalize. - (* At this point in the proof script, the Coq response shows - a trace of how the expression evaluated. - - (APlus (ANum 3) (AMult (ANum 3) (ANum 4)) / empty_state ==>a* ANum 15) - (multi (astep empty_state) (APlus (ANum 3) (ANum 12)) (ANum 15)) - (multi (astep empty_state) (ANum 15) (ANum 15)) -*) -Qed. - - -(** The [normalize] tactic also provides a simple way to calculate - what the normal form of a term is, by proving a goal with an - existential variable in it. *) - -Example astep_example1''' : exists e', - (APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state - ==>a* e'. -Proof. - eapply ex_intro. normalize. - -(* This time, the trace will be: - - (APlus (ANum 3) (AMult (ANum 3) (ANum 4)) / empty_state ==>a* ??) - (multi (astep empty_state) (APlus (ANum 3) (ANum 12)) ??) - (multi (astep empty_state) (ANum 15) ??) - - where ?? is the variable ``guessed'' by eapply. -*) -Qed. - - -(** **** Exercise: 1 star (normalize_ex) *) -Theorem normalize_ex : exists e', - (AMult (ANum 3) (AMult (ANum 2) (ANum 1))) / empty_state - ==>a* e'. -Proof. - (* FILL IN HERE *) Admitted. - -(** [] *) - -(** **** Exercise: 1 star, optional (normalize_ex') *) -(** For comparison, prove it using [apply] instead of [eapply]. *) - -Theorem normalize_ex' : exists e', - (AMult (ANum 3) (AMult (ANum 2) (ANum 1))) / empty_state - ==>a* e'. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) - - -(* ###################################################################### *) -(** ** Additional Exercises *) - -(** **** Exercise: 2 stars (subject_expansion) *) -(** Having seen the subject reduction property, it is reasonable to - wonder whether the opposity property -- subject _expansion_ -- - also holds. That is, is it always the case that, if [t ==> t'] - and [|- t' \in T], then [|- t \in T]? If so, prove it. If - not, give a counter-example. (You do not need to prove your - counter-example in Coq, but feel free to do so if you like.) - - (* FILL IN HERE *) -[] -*) - - - - -(** **** Exercise: 2 stars (variation1) *) -(** Suppose, that we add this new rule to the typing relation: - | T_SuccBool : forall t, - |- t \in TBool -> - |- tsucc t \in TBool - Which of the following properties remain true in the presence of - this rule? For each one, write either "remains true" or - else "becomes false." If a property becomes false, give a - counterexample. - - Determinism of [step] - - - Progress - - - Preservation - -[] -*) - -(** **** Exercise: 2 stars (variation2) *) -(** Suppose, instead, that we add this new rule to the [step] relation: - | ST_Funny1 : forall t2 t3, - (tif ttrue t2 t3) ==> t3 - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -[] -*) - -(** **** Exercise: 2 stars, optional (variation3) *) -(** Suppose instead that we add this rule: - | ST_Funny2 : forall t1 t2 t2' t3, - t2 ==> t2' -> - (tif t1 t2 t3) ==> (tif t1 t2' t3) - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -[] -*) - -(** **** Exercise: 2 stars, optional (variation4) *) -(** Suppose instead that we add this rule: - | ST_Funny3 : - (tpred tfalse) ==> (tpred (tpred tfalse)) - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -[] -*) - -(** **** Exercise: 2 stars, optional (variation5) *) -(** Suppose instead that we add this rule: - - | T_Funny4 : - |- tzero \in TBool - ]] - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -[] -*) - -(** **** Exercise: 2 stars, optional (variation6) *) -(** Suppose instead that we add this rule: - - | T_Funny5 : - |- tpred tzero \in TBool - ]] - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. - -[] -*) - -(** **** Exercise: 3 stars, optional (more_variations) *) -(** Make up some exercises of your own along the same lines as - the ones above. Try to find ways of selectively breaking - properties -- i.e., ways of changing the definitions that - break just one of the properties and leave the others alone. - [] -*) - -(** **** Exercise: 1 star (remove_predzero) *) -(** The evaluation rule [E_PredZero] is a bit counter-intuitive: we - might feel that it makes more sense for the predecessor of zero to - be undefined, rather than being defined to be zero. Can we - achieve this simply by removing the rule from the definition of - [step]? Would doing so create any problems elsewhere? - -(* FILL IN HERE *) -[] *) - -(** **** Exercise: 4 stars, advanced (prog_pres_bigstep) *) -(** Suppose our evaluation relation is defined in the big-step style. - What are the appropriate analogs of the progress and preservation - properties? - -(* FILL IN HERE *) -[] -*) - -(* $Date: 2014-04-08 23:31:16 -0400 (Tue, 08 Apr 2014) $ *) diff --git a/coqdoc.css b/coqdoc.css deleted file mode 100644 index 0de6e40..0000000 --- a/coqdoc.css +++ /dev/null @@ -1,389 +0,0 @@ -body { padding: 0px 0px; - margin: 0px 0px; - padding-left: 1em; - background-color: white; } - -#page { display: block; - padding: 0px; - margin: 0px; - padding-bottom: 10px; } - -#header { display: block; - position: relative; - padding: 0; - margin: 0; - vertical-align: middle; - border-bottom-style: solid; - border-width: thin } - -#header h1 { padding: 0; - margin: 0;} - -/* Contents */ - -#main{ display: block; - padding: 10px; - /* font-family: "Palatino Linotype", ‘Book Antiqua’, Palatino, serif; */ - font-family: "Times New Roman", Times, serif; - /* font-family: Georgia, "Lucida Sans", sans-serif; */ -/* overflow: hidden; seems to break printing in Firefox */ - font-size: 100%; - line-height: 100% } - -#main h1 { line-height: 80% } /* allow for multi-line headers */ - -#main a.idref:visited {color : #416DFF; text-decoration : none; } -#main a.idref:link {color : #416DFF; text-decoration : none; } -#main a.idref:hover {text-decoration : none; } -#main a.idref:active {text-decoration : none; } - -#main a.modref:visited {color : #416DFF; text-decoration : none; } -#main a.modref:link {color : #416DFF; text-decoration : none; } -#main a.modref:hover {text-decoration : none; } -#main a.modref:active {text-decoration : none; } - -#main .keyword { color : #cf1d1d } -#main { color: black } - -.section { background-color: rgb(60%,50%,100%); - padding-top: 13px; - padding-bottom: 13px; - padding-left: 8px; - margin-top: 5px; - margin-bottom: 5px; - margin-top: 12px; - font-size : 175% } - -.libtitle { background-color: rgb(60%,50%,100%); - padding-top: 22px; - border-style: solid; - padding-bottom: 22px; - padding-left: 20px; - padding-right: 20px; - margin-top: 5px; - margin-bottom: 5px; - max-width: 13.5em; /* 15.5em; */ - text-align: center; - letter-spacing: 1px; - font-size : 240% } - -.subtitle { display: block; - padding-top: 10px; - font-size: 70%; } - -h2.section { background-color: rgb(80%,80%,100%); - padding-left: 8px; - padding-top: 12px; - padding-bottom: 10px; - margin-top: 10px; - font-size : 130%; } - -h3.section { background-color: rgb(90%,90%,100%); - padding-left: 8px; - padding-top: 7px; - padding-bottom: 7px; - margin-top: 5px; - font-size : 115% } - -h4.section { -/* - background-color: rgb(80%,80%,80%); - max-width: 20em; - padding-left: 5px; - padding-top: 5px; - padding-bottom: 5px; -*/ - background-color: white; - padding-left: 0px; - padding-top: 0px; - padding-bottom: 0.5em; /* 0px; */ - font-size : 100%; - font-style : bold; - text-decoration : underline; - } - -#main .doc { margin: 0px; - /* font-family: sans-serif; */ - font-size: 100%; - line-height: 125%; - max-width: 35em; /* 40em; */ - color: black; - text-align: justify; - border-style: plain} - -.inlinecode { - display: inline; -/* font-size: 125%; */ - color: #444444; - font-family: monospace } - -.doc .inlinecode { - display: inline; - font-size: 115%; - color: rgb(35%,35%,70%); - font-family: monospace } - -.doc .inlinecode .id { - color: rgb(35%,35%,70%); -} - -.inlinecodenm { - display: inline; -/* font-size: 125%; */ - color: #444444; -} - -.doc .inlinecodenm { - display: inline; - color: rgb(35%,35%,70%); -} - -.doc .inlinecodenm .id { - color: rgb(35%,35%,70%); -} - - -.doc .code { - display: inline; - font-size: 110%; - color: rgb(35%,35%,70%); - font-family: monospace; - padding-left: 0px; - } - -.comment { - display: inline; - font-family: monospace; - color: rgb(50%,50%,80%); -} - -.show { - display: inline; -/* background-color: rgb(95%,95%,95%); */ - font-family: monospace; - font-size: 60%; - padding-top: 0px; - padding-bottom: 0px; - padding-left: 10px; - border: 1px; - border-style: solid; - color: rgb(75%,75%,85%); -} - -/* Inline quizzes */ -.quiz:before { - color: rgb(40%,40%,40%); - /* content: "- Quick Check -" ; */ - display: block; - text-align: center; - margin-bottom: 5px; -} -.quiz { - border: 4px; - border-color: rgb(80%,80%,80%); - margin-left: 40px; - margin-right: 100px; - padding: 5px; - padding-left: 8px; - padding-right: 8px; - margin-top: 10px; - margin-bottom: 15px; - border-style: solid; -} - -/* For textual ones... */ -.show-old { - display: inline; - font-family: monospace; - font-size: 80%; - padding-top: 0px; - padding-bottom: 0px; - padding-left: 3px; - padding-right: 3px; - border: 1px; - margin-top: 5px; /* doesn't work?! */ - border-style: solid; - color: rgb(75%,75%,85%); -} - -.largebr { - margin-top: 10px; -} - -.code { - display: block; - padding-left: 12px; - font-size: 110%; - font-family: monospace; - } - -.code-space { - margin-top: 0em; -} - -.code-tight { - margin-top: -0.8em; -} - -/* -code.br { - height: 5em; -} -*/ - -table.infrule { - border: 0px; - margin-left: 50px; - margin-top: 10px; - margin-bottom: 10px; -} - -td.infrule { - font-family: monospace; - text-align: center; -/* color: rgb(35%,35%,70%); */ - padding: 0px; - line-height: 100%; -} - -tr.infrulemiddle hr { - margin: 1px 0 1px 0; -} - -.infrulenamecol { - color: rgb(60%,60%,60%); - font-size: 80%; - padding-left: 1em; - padding-bottom: 0.1em -} - -/* Pied de page */ - -#footer { font-size: 65%; - font-family: sans-serif; } - -.id { display: inline; } - -.id[type="constructor"] { - color: rgb(60%,0%,0%); -} - -.id[type="var"] { - color: rgb(40%,0%,40%); -} - -.id[type="variable"] { - color: rgb(40%,0%,40%); -} - -.id[type="definition"] { - color: rgb(0%,40%,0%); -} - -.id[type="abbreviation"] { - color: rgb(0%,40%,0%); -} - -.id[type="lemma"] { - color: rgb(0%,40%,0%); -} - -.id[type="instance"] { - color: rgb(0%,40%,0%); -} - -.id[type="projection"] { - color: rgb(0%,40%,0%); -} - -.id[type="method"] { - color: rgb(0%,40%,0%); -} - -.id[type="inductive"] { - color: rgb(0%,0%,80%); -} - -.id[type="record"] { - color: rgb(0%,0%,80%); -} - -.id[type="class"] { - color: rgb(0%,0%,80%); -} - -.id[type="keyword"] { - color : #cf1d1d; -/* color: black; */ -} - -.inlinecode .id { - color: rgb(0%,0%,0%); -} - - -/* TOC */ - -#toc h2 { - padding: 10px; - line-height: 120%; - background-color: rgb(60%,60%,100%); -} - -#toc ul { - padding-top: 8px; - margin-bottom: -8px; -} - -#toc li { - padding-bottom: 8px; -} - -/* Index */ - -#index { - margin: 0; - padding: 0; - width: 100%; - font-style : normal; -} - -#index #frontispiece { - margin: auto; - padding: 1em; - width: 700px; -} - -.booktitle { font-size : 600%; line-height: 100%; font-style:bold; } -.authors { font-size : 200%; - line-height: 115%; } -.moreauthors { font-size : 170% } -.buttons { font-size : 170%; - margin-left: auto; - margin-right: auto; - font-style : bold; - } - -A:link {text-decoration: none; color:black} -A:visited {text-decoration: none; color:black} -A:active {text-decoration: none; color:black} -A:hover {text-decoration: none; color: #555555 } - -#index #entrance { - text-align: center; -} - -#index #footer { - position: absolute; - bottom: 0; - text-align: bottom; -} - -.paragraph { - height: 0.6em; -} - -ul.doclist { - margin-top: 0em; - margin-bottom: 0em; -} diff --git a/coqindex.html b/coqindex.html deleted file mode 100644 index a9dcc87..0000000 --- a/coqindex.html +++ /dev/null @@ -1,239 +0,0 @@ - - - - - -Index - - - - - - -
- - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Global IndexABCDEFGHIJKLMNOPQRSTUVWXYZ_(29 entries)
Library IndexABCDEFGHIJKLMNOPQRSTUVWXYZ_(29 entries)
-
-

Global Index

-

A

-Auto [library]
-

B

-Basics [library]
-

E

-Equiv [library]
-Extraction [library]
-

H

-Hoare [library]
-Hoare2 [library]
-

I

-Imp [library]
-ImpCEvalFun [library]
-ImpParser [library]
-Induction [library]
-

L

-Lists [library]
-Logic [library]
-

M

-MoreCoq [library]
-MoreInd [library]
-MoreLogic [library]
-MoreStlc [library]
-

P

-Poly [library]
-Preface [library]
-ProofObjects [library]
-Prop [library]
-

R

-Review1 [library]
-Review2 [library]
-

S

-SfLib [library]
-Smallstep [library]
-Stlc [library]
-StlcProp [library]
-Sub [library]
-Symbols [library]
-

T

-Types [library]
-

-

Library Index

-

A

-Auto
-

B

-Basics
-

E

-Equiv
-Extraction
-

H

-Hoare
-Hoare2
-

I

-Imp
-ImpCEvalFun
-ImpParser
-Induction
-

L

-Lists
-Logic
-

M

-MoreCoq
-MoreInd
-MoreLogic
-MoreStlc
-

P

-Poly
-Preface
-ProofObjects
-Prop
-

R

-Review1
-Review2
-

S

-SfLib
-Smallstep
-Stlc
-StlcProp
-Sub
-Symbols
-

T

-Types
-

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Global IndexABCDEFGHIJKLMNOPQRSTUVWXYZ_(29 entries)
Library IndexABCDEFGHIJKLMNOPQRSTUVWXYZ_(29 entries)
-
This page has been generated by coqdoc -
- -
- - - \ No newline at end of file diff --git a/deps.gif b/deps.gif deleted file mode 100644 index 3333f04..0000000 Binary files a/deps.gif and /dev/null differ diff --git a/deps.html b/deps.html deleted file mode 100644 index 18cdf11..0000000 --- a/deps.html +++ /dev/null @@ -1,76 +0,0 @@ -X-Powered-By: PHP/5.3.17 -Content-type: text/html - - - - - - -Chapter Dependencies - - - - - - - - - -
- - - -
- -

Chapter Dependencies

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/deps.map b/deps.map deleted file mode 100644 index dc0d82c..0000000 --- a/deps.map +++ /dev/null @@ -1,41 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/imp.ml b/imp.ml deleted file mode 100644 index c5b3401..0000000 --- a/imp.ml +++ /dev/null @@ -1,6852 +0,0 @@ -type __ = Obj.t -let __ = let rec f _ = Obj.repr f in Obj.repr f - -type unit0 = -| Tt - -(** val negb : bool -> bool **) - -let negb = function -| true -> false -| false -> true - -type 'a option = -| Some of 'a -| None - -type ('a, 'b) prod = -| Pair of 'a * 'b - -(** val fst : ('a1, 'a2) prod -> 'a1 **) - -let fst = function -| Pair (x, y) -> x - -(** val snd : ('a1, 'a2) prod -> 'a2 **) - -let snd = function -| Pair (x, y) -> y - -type 'a list = -| Nil -| Cons of 'a * 'a list - -(** val app : 'a1 list -> 'a1 list -> 'a1 list **) - -let rec app l m = - match l with - | Nil -> m - | Cons (a, l1) -> Cons (a, (app l1 m)) - -type comparison = -| Eq -| Lt -| Gt - -type compareSpecT = -| CompEqT -| CompLtT -| CompGtT - -(** val compareSpec2Type : comparison -> compareSpecT **) - -let compareSpec2Type = function -| Eq -> CompEqT -| Lt -> CompLtT -| Gt -> CompGtT - -type 'a compSpecT = compareSpecT - -(** val compSpec2Type : 'a1 -> 'a1 -> comparison -> 'a1 compSpecT **) - -let compSpec2Type x y c = - compareSpec2Type c - -type 'a sig0 = - 'a - (* singleton inductive, whose constructor was exist *) - -type 'a sumor = -| Inleft of 'a -| Inright - -(** val plus : int -> int -> int **) - -let rec plus = ( + ) - -(** val mult : int -> int -> int **) - -let rec mult = ( * ) - -(** val minus : int -> int -> int **) - -let rec minus n0 m = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - n0) - (fun k -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - n0) - (fun l -> - minus k l) - m) - n0 - -(** val nat_iter : int -> ('a1 -> 'a1) -> 'a1 -> 'a1 **) - -let rec nat_iter n0 f x = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - x) - (fun n' -> - f (nat_iter n' f x)) - n0 - -type positive = -| XI of positive -| XO of positive -| XH - -type n = -| N0 -| Npos of positive - -type reflect = -| ReflectT -| ReflectF - -(** val iff_reflect : bool -> reflect **) - -let iff_reflect = function -| true -> ReflectT -| false -> ReflectF - -module type TotalOrder' = - sig - type t - end - -module MakeOrderTac = - functor (O:TotalOrder') -> - struct - - end - -module MaxLogicalProperties = - functor (O:TotalOrder') -> - functor (M:sig - val max : O.t -> O.t -> O.t - end) -> - struct - module Private_Tac = MakeOrderTac(O) - end - -module Pos = - struct - type t = positive - - (** val succ : positive -> positive **) - - let rec succ = function - | XI p -> XO (succ p) - | XO p -> XI p - | XH -> XO XH - - (** val add : positive -> positive -> positive **) - - let rec add x y = - match x with - | XI p -> - (match y with - | XI q -> XO (add_carry p q) - | XO q -> XI (add p q) - | XH -> XO (succ p)) - | XO p -> - (match y with - | XI q -> XI (add p q) - | XO q -> XO (add p q) - | XH -> XI p) - | XH -> - (match y with - | XI q -> XO (succ q) - | XO q -> XI q - | XH -> XO XH) - - (** val add_carry : positive -> positive -> positive **) - - and add_carry x y = - match x with - | XI p -> - (match y with - | XI q -> XI (add_carry p q) - | XO q -> XO (add_carry p q) - | XH -> XI (succ p)) - | XO p -> - (match y with - | XI q -> XO (add_carry p q) - | XO q -> XI (add p q) - | XH -> XO (succ p)) - | XH -> - (match y with - | XI q -> XI (succ q) - | XO q -> XO (succ q) - | XH -> XI XH) - - (** val pred_double : positive -> positive **) - - let rec pred_double = function - | XI p -> XI (XO p) - | XO p -> XI (pred_double p) - | XH -> XH - - (** val pred : positive -> positive **) - - let pred = function - | XI p -> XO p - | XO p -> pred_double p - | XH -> XH - - (** val pred_N : positive -> n **) - - let pred_N = function - | XI p -> Npos (XO p) - | XO p -> Npos (pred_double p) - | XH -> N0 - - type mask = - | IsNul - | IsPos of positive - | IsNeg - - (** val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **) - - let mask_rect f f0 f1 = function - | IsNul -> f - | IsPos x -> f0 x - | IsNeg -> f1 - - (** val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **) - - let mask_rec f f0 f1 = function - | IsNul -> f - | IsPos x -> f0 x - | IsNeg -> f1 - - (** val succ_double_mask : mask -> mask **) - - let succ_double_mask = function - | IsNul -> IsPos XH - | IsPos p -> IsPos (XI p) - | IsNeg -> IsNeg - - (** val double_mask : mask -> mask **) - - let double_mask = function - | IsPos p -> IsPos (XO p) - | x0 -> x0 - - (** val double_pred_mask : positive -> mask **) - - let double_pred_mask = function - | XI p -> IsPos (XO (XO p)) - | XO p -> IsPos (XO (pred_double p)) - | XH -> IsNul - - (** val pred_mask : mask -> mask **) - - let pred_mask = function - | IsPos q -> - (match q with - | XH -> IsNul - | _ -> IsPos (pred q)) - | _ -> IsNeg - - (** val sub_mask : positive -> positive -> mask **) - - let rec sub_mask x y = - match x with - | XI p -> - (match y with - | XI q -> double_mask (sub_mask p q) - | XO q -> succ_double_mask (sub_mask p q) - | XH -> IsPos (XO p)) - | XO p -> - (match y with - | XI q -> succ_double_mask (sub_mask_carry p q) - | XO q -> double_mask (sub_mask p q) - | XH -> IsPos (pred_double p)) - | XH -> - (match y with - | XH -> IsNul - | _ -> IsNeg) - - (** val sub_mask_carry : positive -> positive -> mask **) - - and sub_mask_carry x y = - match x with - | XI p -> - (match y with - | XI q -> succ_double_mask (sub_mask_carry p q) - | XO q -> double_mask (sub_mask p q) - | XH -> IsPos (pred_double p)) - | XO p -> - (match y with - | XI q -> double_mask (sub_mask_carry p q) - | XO q -> succ_double_mask (sub_mask_carry p q) - | XH -> double_pred_mask p) - | XH -> IsNeg - - (** val sub : positive -> positive -> positive **) - - let sub x y = - match sub_mask x y with - | IsPos z -> z - | _ -> XH - - (** val mul : positive -> positive -> positive **) - - let rec mul x y = - match x with - | XI p -> add y (XO (mul p y)) - | XO p -> XO (mul p y) - | XH -> y - - (** val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 **) - - let rec iter n0 f x = - match n0 with - | XI n' -> f (iter n' f (iter n' f x)) - | XO n' -> iter n' f (iter n' f x) - | XH -> f x - - (** val pow : positive -> positive -> positive **) - - let pow x y = - iter y (mul x) XH - - (** val square : positive -> positive **) - - let rec square = function - | XI p0 -> XI (XO (add (square p0) p0)) - | XO p0 -> XO (XO (square p0)) - | XH -> XH - - (** val div2 : positive -> positive **) - - let div2 = function - | XI p0 -> p0 - | XO p0 -> p0 - | XH -> XH - - (** val div2_up : positive -> positive **) - - let div2_up = function - | XI p0 -> succ p0 - | XO p0 -> p0 - | XH -> XH - - (** val size_nat : positive -> int **) - - let rec size_nat = function - | XI p0 -> (fun x -> x + 1) (size_nat p0) - | XO p0 -> (fun x -> x + 1) (size_nat p0) - | XH -> (fun x -> x + 1) 0 - - (** val size : positive -> positive **) - - let rec size = function - | XI p0 -> succ (size p0) - | XO p0 -> succ (size p0) - | XH -> XH - - (** val compare_cont : positive -> positive -> comparison -> comparison **) - - let rec compare_cont x y r = - match x with - | XI p -> - (match y with - | XI q -> compare_cont p q r - | XO q -> compare_cont p q Gt - | XH -> Gt) - | XO p -> - (match y with - | XI q -> compare_cont p q Lt - | XO q -> compare_cont p q r - | XH -> Gt) - | XH -> - (match y with - | XH -> r - | _ -> Lt) - - (** val compare : positive -> positive -> comparison **) - - let compare x y = - compare_cont x y Eq - - (** val min : positive -> positive -> positive **) - - let min p p' = - match compare p p' with - | Gt -> p' - | _ -> p - - (** val max : positive -> positive -> positive **) - - let max p p' = - match compare p p' with - | Gt -> p - | _ -> p' - - (** val eqb : positive -> positive -> bool **) - - let rec eqb p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> eqb p0 q0 - | _ -> false) - | XO p0 -> - (match q with - | XO q0 -> eqb p0 q0 - | _ -> false) - | XH -> - (match q with - | XH -> true - | _ -> false) - - (** val leb : positive -> positive -> bool **) - - let leb x y = - match compare x y with - | Gt -> false - | _ -> true - - (** val ltb : positive -> positive -> bool **) - - let ltb x y = - match compare x y with - | Lt -> true - | _ -> false - - (** val sqrtrem_step : - (positive -> positive) -> (positive -> positive) -> (positive, mask) - prod -> (positive, mask) prod **) - - let sqrtrem_step f g = function - | Pair (s, y) -> - (match y with - | IsPos r -> - let s' = XI (XO s) in - let r' = g (f r) in - if leb s' r' - then Pair ((XI s), (sub_mask r' s')) - else Pair ((XO s), (IsPos r')) - | _ -> Pair ((XO s), (sub_mask (g (f XH)) (XO (XO XH))))) - - (** val sqrtrem : positive -> (positive, mask) prod **) - - let rec sqrtrem = function - | XI p0 -> - (match p0 with - | XI p1 -> sqrtrem_step (fun x -> XI x) (fun x -> XI x) (sqrtrem p1) - | XO p1 -> sqrtrem_step (fun x -> XO x) (fun x -> XI x) (sqrtrem p1) - | XH -> Pair (XH, (IsPos (XO XH)))) - | XO p0 -> - (match p0 with - | XI p1 -> sqrtrem_step (fun x -> XI x) (fun x -> XO x) (sqrtrem p1) - | XO p1 -> sqrtrem_step (fun x -> XO x) (fun x -> XO x) (sqrtrem p1) - | XH -> Pair (XH, (IsPos XH))) - | XH -> Pair (XH, IsNul) - - (** val sqrt : positive -> positive **) - - let sqrt p = - fst (sqrtrem p) - - (** val gcdn : int -> positive -> positive -> positive **) - - let rec gcdn n0 a b = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun n1 -> - match a with - | XI a' -> - (match b with - | XI b' -> - (match compare a' b' with - | Eq -> a - | Lt -> gcdn n1 (sub b' a') a - | Gt -> gcdn n1 (sub a' b') b) - | XO b0 -> gcdn n1 a b0 - | XH -> XH) - | XO a0 -> - (match b with - | XI p -> gcdn n1 a0 b - | XO b0 -> XO (gcdn n1 a0 b0) - | XH -> XH) - | XH -> XH) - n0 - - (** val gcd : positive -> positive -> positive **) - - let gcd a b = - gcdn (plus (size_nat a) (size_nat b)) a b - - (** val ggcdn : - int -> positive -> positive -> (positive, (positive, positive) prod) - prod **) - - let rec ggcdn n0 a b = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> Pair (XH, (Pair (a, - b)))) - (fun n1 -> - match a with - | XI a' -> - (match b with - | XI b' -> - (match compare a' b' with - | Eq -> Pair (a, (Pair (XH, XH))) - | Lt -> - let Pair (g, p) = ggcdn n1 (sub b' a') a in - let Pair (ba, aa) = p in - Pair (g, (Pair (aa, (add aa (XO ba))))) - | Gt -> - let Pair (g, p) = ggcdn n1 (sub a' b') b in - let Pair (ab, bb) = p in - Pair (g, (Pair ((add bb (XO ab)), bb)))) - | XO b0 -> - let Pair (g, p) = ggcdn n1 a b0 in - let Pair (aa, bb) = p in Pair (g, (Pair (aa, (XO bb)))) - | XH -> Pair (XH, (Pair (a, XH)))) - | XO a0 -> - (match b with - | XI p -> - let Pair (g, p0) = ggcdn n1 a0 b in - let Pair (aa, bb) = p0 in Pair (g, (Pair ((XO aa), bb))) - | XO b0 -> let Pair (g, p) = ggcdn n1 a0 b0 in Pair ((XO g), p) - | XH -> Pair (XH, (Pair (a, XH)))) - | XH -> Pair (XH, (Pair (XH, b)))) - n0 - - (** val ggcd : - positive -> positive -> (positive, (positive, positive) prod) prod **) - - let ggcd a b = - ggcdn (plus (size_nat a) (size_nat b)) a b - - (** val coq_Nsucc_double : n -> n **) - - let coq_Nsucc_double = function - | N0 -> Npos XH - | Npos p -> Npos (XI p) - - (** val coq_Ndouble : n -> n **) - - let coq_Ndouble = function - | N0 -> N0 - | Npos p -> Npos (XO p) - - (** val coq_lor : positive -> positive -> positive **) - - let rec coq_lor p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> XI (coq_lor p0 q0) - | XO q0 -> XI (coq_lor p0 q0) - | XH -> p) - | XO p0 -> - (match q with - | XI q0 -> XI (coq_lor p0 q0) - | XO q0 -> XO (coq_lor p0 q0) - | XH -> XI p0) - | XH -> - (match q with - | XO q0 -> XI q0 - | _ -> q) - - (** val coq_land : positive -> positive -> n **) - - let rec coq_land p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> coq_Nsucc_double (coq_land p0 q0) - | XO q0 -> coq_Ndouble (coq_land p0 q0) - | XH -> Npos XH) - | XO p0 -> - (match q with - | XI q0 -> coq_Ndouble (coq_land p0 q0) - | XO q0 -> coq_Ndouble (coq_land p0 q0) - | XH -> N0) - | XH -> - (match q with - | XO q0 -> N0 - | _ -> Npos XH) - - (** val ldiff : positive -> positive -> n **) - - let rec ldiff p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> coq_Ndouble (ldiff p0 q0) - | XO q0 -> coq_Nsucc_double (ldiff p0 q0) - | XH -> Npos (XO p0)) - | XO p0 -> - (match q with - | XI q0 -> coq_Ndouble (ldiff p0 q0) - | XO q0 -> coq_Ndouble (ldiff p0 q0) - | XH -> Npos p) - | XH -> - (match q with - | XO q0 -> Npos XH - | _ -> N0) - - (** val coq_lxor : positive -> positive -> n **) - - let rec coq_lxor p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> coq_Ndouble (coq_lxor p0 q0) - | XO q0 -> coq_Nsucc_double (coq_lxor p0 q0) - | XH -> Npos (XO p0)) - | XO p0 -> - (match q with - | XI q0 -> coq_Nsucc_double (coq_lxor p0 q0) - | XO q0 -> coq_Ndouble (coq_lxor p0 q0) - | XH -> Npos (XI p0)) - | XH -> - (match q with - | XI q0 -> Npos (XO q0) - | XO q0 -> Npos (XI q0) - | XH -> N0) - - (** val shiftl_nat : positive -> int -> positive **) - - let shiftl_nat p n0 = - nat_iter n0 (fun x -> XO x) p - - (** val shiftr_nat : positive -> int -> positive **) - - let shiftr_nat p n0 = - nat_iter n0 div2 p - - (** val shiftl : positive -> n -> positive **) - - let shiftl p = function - | N0 -> p - | Npos n1 -> iter n1 (fun x -> XO x) p - - (** val shiftr : positive -> n -> positive **) - - let shiftr p = function - | N0 -> p - | Npos n1 -> iter n1 div2 p - - (** val testbit_nat : positive -> int -> bool **) - - let rec testbit_nat p n0 = - match p with - | XI p0 -> - ((fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun n' -> - testbit_nat p0 n') - n0) - | XO p0 -> - ((fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - false) - (fun n' -> - testbit_nat p0 n') - n0) - | XH -> - ((fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun n1 -> - false) - n0) - - (** val testbit : positive -> n -> bool **) - - let rec testbit p n0 = - match p with - | XI p0 -> - (match n0 with - | N0 -> true - | Npos n1 -> testbit p0 (pred_N n1)) - | XO p0 -> - (match n0 with - | N0 -> false - | Npos n1 -> testbit p0 (pred_N n1)) - | XH -> - (match n0 with - | N0 -> true - | Npos p0 -> false) - - (** val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 **) - - let rec iter_op op p a = - match p with - | XI p0 -> op a (iter_op op p0 (op a a)) - | XO p0 -> iter_op op p0 (op a a) - | XH -> a - - (** val to_nat : positive -> int **) - - let to_nat x = - iter_op plus x ((fun x -> x + 1) 0) - - (** val of_nat : int -> positive **) - - let rec of_nat n0 = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun x -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun n1 -> - succ (of_nat x)) - x) - n0 - - (** val of_succ_nat : int -> positive **) - - let rec of_succ_nat n0 = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun x -> - succ (of_succ_nat x)) - n0 - end - -module Coq_Pos = - struct - type t = positive - - (** val succ : positive -> positive **) - - let rec succ = function - | XI p -> XO (succ p) - | XO p -> XI p - | XH -> XO XH - - (** val add : positive -> positive -> positive **) - - let rec add x y = - match x with - | XI p -> - (match y with - | XI q -> XO (add_carry p q) - | XO q -> XI (add p q) - | XH -> XO (succ p)) - | XO p -> - (match y with - | XI q -> XI (add p q) - | XO q -> XO (add p q) - | XH -> XI p) - | XH -> - (match y with - | XI q -> XO (succ q) - | XO q -> XI q - | XH -> XO XH) - - (** val add_carry : positive -> positive -> positive **) - - and add_carry x y = - match x with - | XI p -> - (match y with - | XI q -> XI (add_carry p q) - | XO q -> XO (add_carry p q) - | XH -> XI (succ p)) - | XO p -> - (match y with - | XI q -> XO (add_carry p q) - | XO q -> XI (add p q) - | XH -> XO (succ p)) - | XH -> - (match y with - | XI q -> XI (succ q) - | XO q -> XO (succ q) - | XH -> XI XH) - - (** val pred_double : positive -> positive **) - - let rec pred_double = function - | XI p -> XI (XO p) - | XO p -> XI (pred_double p) - | XH -> XH - - (** val pred : positive -> positive **) - - let pred = function - | XI p -> XO p - | XO p -> pred_double p - | XH -> XH - - (** val pred_N : positive -> n **) - - let pred_N = function - | XI p -> Npos (XO p) - | XO p -> Npos (pred_double p) - | XH -> N0 - - type mask = Pos.mask = - | IsNul - | IsPos of positive - | IsNeg - - (** val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **) - - let mask_rect f f0 f1 = function - | IsNul -> f - | IsPos x -> f0 x - | IsNeg -> f1 - - (** val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **) - - let mask_rec f f0 f1 = function - | IsNul -> f - | IsPos x -> f0 x - | IsNeg -> f1 - - (** val succ_double_mask : mask -> mask **) - - let succ_double_mask = function - | IsNul -> IsPos XH - | IsPos p -> IsPos (XI p) - | IsNeg -> IsNeg - - (** val double_mask : mask -> mask **) - - let double_mask = function - | IsPos p -> IsPos (XO p) - | x0 -> x0 - - (** val double_pred_mask : positive -> mask **) - - let double_pred_mask = function - | XI p -> IsPos (XO (XO p)) - | XO p -> IsPos (XO (pred_double p)) - | XH -> IsNul - - (** val pred_mask : mask -> mask **) - - let pred_mask = function - | IsPos q -> - (match q with - | XH -> IsNul - | _ -> IsPos (pred q)) - | _ -> IsNeg - - (** val sub_mask : positive -> positive -> mask **) - - let rec sub_mask x y = - match x with - | XI p -> - (match y with - | XI q -> double_mask (sub_mask p q) - | XO q -> succ_double_mask (sub_mask p q) - | XH -> IsPos (XO p)) - | XO p -> - (match y with - | XI q -> succ_double_mask (sub_mask_carry p q) - | XO q -> double_mask (sub_mask p q) - | XH -> IsPos (pred_double p)) - | XH -> - (match y with - | XH -> IsNul - | _ -> IsNeg) - - (** val sub_mask_carry : positive -> positive -> mask **) - - and sub_mask_carry x y = - match x with - | XI p -> - (match y with - | XI q -> succ_double_mask (sub_mask_carry p q) - | XO q -> double_mask (sub_mask p q) - | XH -> IsPos (pred_double p)) - | XO p -> - (match y with - | XI q -> double_mask (sub_mask_carry p q) - | XO q -> succ_double_mask (sub_mask_carry p q) - | XH -> double_pred_mask p) - | XH -> IsNeg - - (** val sub : positive -> positive -> positive **) - - let sub x y = - match sub_mask x y with - | IsPos z -> z - | _ -> XH - - (** val mul : positive -> positive -> positive **) - - let rec mul x y = - match x with - | XI p -> add y (XO (mul p y)) - | XO p -> XO (mul p y) - | XH -> y - - (** val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 **) - - let rec iter n0 f x = - match n0 with - | XI n' -> f (iter n' f (iter n' f x)) - | XO n' -> iter n' f (iter n' f x) - | XH -> f x - - (** val pow : positive -> positive -> positive **) - - let pow x y = - iter y (mul x) XH - - (** val square : positive -> positive **) - - let rec square = function - | XI p0 -> XI (XO (add (square p0) p0)) - | XO p0 -> XO (XO (square p0)) - | XH -> XH - - (** val div2 : positive -> positive **) - - let div2 = function - | XI p0 -> p0 - | XO p0 -> p0 - | XH -> XH - - (** val div2_up : positive -> positive **) - - let div2_up = function - | XI p0 -> succ p0 - | XO p0 -> p0 - | XH -> XH - - (** val size_nat : positive -> int **) - - let rec size_nat = function - | XI p0 -> (fun x -> x + 1) (size_nat p0) - | XO p0 -> (fun x -> x + 1) (size_nat p0) - | XH -> (fun x -> x + 1) 0 - - (** val size : positive -> positive **) - - let rec size = function - | XI p0 -> succ (size p0) - | XO p0 -> succ (size p0) - | XH -> XH - - (** val compare_cont : positive -> positive -> comparison -> comparison **) - - let rec compare_cont x y r = - match x with - | XI p -> - (match y with - | XI q -> compare_cont p q r - | XO q -> compare_cont p q Gt - | XH -> Gt) - | XO p -> - (match y with - | XI q -> compare_cont p q Lt - | XO q -> compare_cont p q r - | XH -> Gt) - | XH -> - (match y with - | XH -> r - | _ -> Lt) - - (** val compare : positive -> positive -> comparison **) - - let compare x y = - compare_cont x y Eq - - (** val min : positive -> positive -> positive **) - - let min p p' = - match compare p p' with - | Gt -> p' - | _ -> p - - (** val max : positive -> positive -> positive **) - - let max p p' = - match compare p p' with - | Gt -> p - | _ -> p' - - (** val eqb : positive -> positive -> bool **) - - let rec eqb p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> eqb p0 q0 - | _ -> false) - | XO p0 -> - (match q with - | XO q0 -> eqb p0 q0 - | _ -> false) - | XH -> - (match q with - | XH -> true - | _ -> false) - - (** val leb : positive -> positive -> bool **) - - let leb x y = - match compare x y with - | Gt -> false - | _ -> true - - (** val ltb : positive -> positive -> bool **) - - let ltb x y = - match compare x y with - | Lt -> true - | _ -> false - - (** val sqrtrem_step : - (positive -> positive) -> (positive -> positive) -> (positive, mask) - prod -> (positive, mask) prod **) - - let sqrtrem_step f g = function - | Pair (s, y) -> - (match y with - | IsPos r -> - let s' = XI (XO s) in - let r' = g (f r) in - if leb s' r' - then Pair ((XI s), (sub_mask r' s')) - else Pair ((XO s), (IsPos r')) - | _ -> Pair ((XO s), (sub_mask (g (f XH)) (XO (XO XH))))) - - (** val sqrtrem : positive -> (positive, mask) prod **) - - let rec sqrtrem = function - | XI p0 -> - (match p0 with - | XI p1 -> sqrtrem_step (fun x -> XI x) (fun x -> XI x) (sqrtrem p1) - | XO p1 -> sqrtrem_step (fun x -> XO x) (fun x -> XI x) (sqrtrem p1) - | XH -> Pair (XH, (IsPos (XO XH)))) - | XO p0 -> - (match p0 with - | XI p1 -> sqrtrem_step (fun x -> XI x) (fun x -> XO x) (sqrtrem p1) - | XO p1 -> sqrtrem_step (fun x -> XO x) (fun x -> XO x) (sqrtrem p1) - | XH -> Pair (XH, (IsPos XH))) - | XH -> Pair (XH, IsNul) - - (** val sqrt : positive -> positive **) - - let sqrt p = - fst (sqrtrem p) - - (** val gcdn : int -> positive -> positive -> positive **) - - let rec gcdn n0 a b = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun n1 -> - match a with - | XI a' -> - (match b with - | XI b' -> - (match compare a' b' with - | Eq -> a - | Lt -> gcdn n1 (sub b' a') a - | Gt -> gcdn n1 (sub a' b') b) - | XO b0 -> gcdn n1 a b0 - | XH -> XH) - | XO a0 -> - (match b with - | XI p -> gcdn n1 a0 b - | XO b0 -> XO (gcdn n1 a0 b0) - | XH -> XH) - | XH -> XH) - n0 - - (** val gcd : positive -> positive -> positive **) - - let gcd a b = - gcdn (plus (size_nat a) (size_nat b)) a b - - (** val ggcdn : - int -> positive -> positive -> (positive, (positive, positive) prod) - prod **) - - let rec ggcdn n0 a b = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> Pair (XH, (Pair (a, - b)))) - (fun n1 -> - match a with - | XI a' -> - (match b with - | XI b' -> - (match compare a' b' with - | Eq -> Pair (a, (Pair (XH, XH))) - | Lt -> - let Pair (g, p) = ggcdn n1 (sub b' a') a in - let Pair (ba, aa) = p in - Pair (g, (Pair (aa, (add aa (XO ba))))) - | Gt -> - let Pair (g, p) = ggcdn n1 (sub a' b') b in - let Pair (ab, bb) = p in - Pair (g, (Pair ((add bb (XO ab)), bb)))) - | XO b0 -> - let Pair (g, p) = ggcdn n1 a b0 in - let Pair (aa, bb) = p in Pair (g, (Pair (aa, (XO bb)))) - | XH -> Pair (XH, (Pair (a, XH)))) - | XO a0 -> - (match b with - | XI p -> - let Pair (g, p0) = ggcdn n1 a0 b in - let Pair (aa, bb) = p0 in Pair (g, (Pair ((XO aa), bb))) - | XO b0 -> let Pair (g, p) = ggcdn n1 a0 b0 in Pair ((XO g), p) - | XH -> Pair (XH, (Pair (a, XH)))) - | XH -> Pair (XH, (Pair (XH, b)))) - n0 - - (** val ggcd : - positive -> positive -> (positive, (positive, positive) prod) prod **) - - let ggcd a b = - ggcdn (plus (size_nat a) (size_nat b)) a b - - (** val coq_Nsucc_double : n -> n **) - - let coq_Nsucc_double = function - | N0 -> Npos XH - | Npos p -> Npos (XI p) - - (** val coq_Ndouble : n -> n **) - - let coq_Ndouble = function - | N0 -> N0 - | Npos p -> Npos (XO p) - - (** val coq_lor : positive -> positive -> positive **) - - let rec coq_lor p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> XI (coq_lor p0 q0) - | XO q0 -> XI (coq_lor p0 q0) - | XH -> p) - | XO p0 -> - (match q with - | XI q0 -> XI (coq_lor p0 q0) - | XO q0 -> XO (coq_lor p0 q0) - | XH -> XI p0) - | XH -> - (match q with - | XO q0 -> XI q0 - | _ -> q) - - (** val coq_land : positive -> positive -> n **) - - let rec coq_land p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> coq_Nsucc_double (coq_land p0 q0) - | XO q0 -> coq_Ndouble (coq_land p0 q0) - | XH -> Npos XH) - | XO p0 -> - (match q with - | XI q0 -> coq_Ndouble (coq_land p0 q0) - | XO q0 -> coq_Ndouble (coq_land p0 q0) - | XH -> N0) - | XH -> - (match q with - | XO q0 -> N0 - | _ -> Npos XH) - - (** val ldiff : positive -> positive -> n **) - - let rec ldiff p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> coq_Ndouble (ldiff p0 q0) - | XO q0 -> coq_Nsucc_double (ldiff p0 q0) - | XH -> Npos (XO p0)) - | XO p0 -> - (match q with - | XI q0 -> coq_Ndouble (ldiff p0 q0) - | XO q0 -> coq_Ndouble (ldiff p0 q0) - | XH -> Npos p) - | XH -> - (match q with - | XO q0 -> Npos XH - | _ -> N0) - - (** val coq_lxor : positive -> positive -> n **) - - let rec coq_lxor p q = - match p with - | XI p0 -> - (match q with - | XI q0 -> coq_Ndouble (coq_lxor p0 q0) - | XO q0 -> coq_Nsucc_double (coq_lxor p0 q0) - | XH -> Npos (XO p0)) - | XO p0 -> - (match q with - | XI q0 -> coq_Nsucc_double (coq_lxor p0 q0) - | XO q0 -> coq_Ndouble (coq_lxor p0 q0) - | XH -> Npos (XI p0)) - | XH -> - (match q with - | XI q0 -> Npos (XO q0) - | XO q0 -> Npos (XI q0) - | XH -> N0) - - (** val shiftl_nat : positive -> int -> positive **) - - let shiftl_nat p n0 = - nat_iter n0 (fun x -> XO x) p - - (** val shiftr_nat : positive -> int -> positive **) - - let shiftr_nat p n0 = - nat_iter n0 div2 p - - (** val shiftl : positive -> n -> positive **) - - let shiftl p = function - | N0 -> - p - | Npos n1 -> - iter - n1 - (fun x -> - XO - x) - p - - (** val shiftr : - positive - -> - n - -> - positive **) - - let shiftr p = function - | N0 -> - p - | Npos n1 -> - iter - n1 - div2 - p - - (** val testbit_nat : - positive - -> - int - -> - bool **) - - let rec testbit_nat p n0 = - match p with - | XI p0 -> - ((fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun n' -> - testbit_nat - p0 - n') - n0) - | XO p0 -> - ((fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - false) - (fun n' -> - testbit_nat - p0 - n') - n0) - | XH -> - ((fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun n1 -> - false) - n0) - - (** val testbit : - positive - -> - n - -> - bool **) - - let rec testbit p n0 = - match p with - | XI p0 -> - (match n0 with - | N0 -> - true - | Npos n1 -> - testbit - p0 - (pred_N - n1)) - | XO p0 -> - (match n0 with - | N0 -> - false - | Npos n1 -> - testbit - p0 - (pred_N - n1)) - | XH -> - (match n0 with - | N0 -> - true - | Npos p0 -> - false) - - (** val iter_op : - ('a1 - -> - 'a1 - -> - 'a1) - -> - positive - -> - 'a1 - -> - 'a1 **) - - let rec iter_op op p a = - match p with - | XI p0 -> - op - a - (iter_op - op - p0 - (op - a - a)) - | XO p0 -> - iter_op - op - p0 - (op - a - a) - | XH -> - a - - (** val to_nat : - positive - -> - int **) - - let to_nat x = - iter_op - plus - x - ((fun x -> x + 1) - 0) - - (** val of_nat : - int - -> - positive **) - - let rec of_nat n0 = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun x -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun n1 -> - succ - (of_nat - x)) - x) - n0 - - (** val of_succ_nat : - int - -> - positive **) - - let rec of_succ_nat n0 = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - XH) - (fun x -> - succ - (of_succ_nat - x)) - n0 - - (** val eq_dec : - positive - -> - positive - -> - bool **) - - let rec eq_dec p y0 = - match p with - | XI p0 -> - (match y0 with - | XI p1 -> - eq_dec - p0 - p1 - | _ -> - false) - | XO p0 -> - (match y0 with - | XO p1 -> - eq_dec - p0 - p1 - | _ -> - false) - | XH -> - (match y0 with - | XH -> - true - | _ -> - false) - - (** val peano_rect : - 'a1 - -> - (positive - -> - 'a1 - -> - 'a1) - -> - positive - -> - 'a1 **) - - let rec peano_rect a f p = - let f2 = - peano_rect - (f - XH - a) - (fun p0 x -> - f - (succ - (XO - p0)) - (f - (XO - p0) - x)) - in - (match p with - | XI q -> - f - (XO - q) - (f2 - q) - | XO q -> - f2 - q - | XH -> - a) - - (** val peano_rec : - 'a1 - -> - (positive - -> - 'a1 - -> - 'a1) - -> - positive - -> - 'a1 **) - - let peano_rec = - peano_rect - - type coq_PeanoView = - | PeanoOne - | PeanoSucc of positive - * coq_PeanoView - - (** val coq_PeanoView_rect : - 'a1 - -> - (positive - -> - coq_PeanoView - -> - 'a1 - -> - 'a1) - -> - positive - -> - coq_PeanoView - -> - 'a1 **) - - let rec coq_PeanoView_rect f f0 p = function - | PeanoOne -> - f - | PeanoSucc (p1, - p2) -> - f0 - p1 - p2 - (coq_PeanoView_rect - f - f0 - p1 - p2) - - (** val coq_PeanoView_rec : - 'a1 - -> - (positive - -> - coq_PeanoView - -> - 'a1 - -> - 'a1) - -> - positive - -> - coq_PeanoView - -> - 'a1 **) - - let rec coq_PeanoView_rec f f0 p = function - | PeanoOne -> - f - | PeanoSucc (p1, - p2) -> - f0 - p1 - p2 - (coq_PeanoView_rec - f - f0 - p1 - p2) - - (** val peanoView_xO : - positive - -> - coq_PeanoView - -> - coq_PeanoView **) - - let rec peanoView_xO p = function - | PeanoOne -> - PeanoSucc - (XH, - PeanoOne) - | PeanoSucc (p0, - q0) -> - PeanoSucc - ((succ - (XO - p0)), - (PeanoSucc - ((XO - p0), - (peanoView_xO - p0 - q0)))) - - (** val peanoView_xI : - positive - -> - coq_PeanoView - -> - coq_PeanoView **) - - let rec peanoView_xI p = function - | PeanoOne -> - PeanoSucc - ((succ - XH), - (PeanoSucc - (XH, - PeanoOne))) - | PeanoSucc (p0, - q0) -> - PeanoSucc - ((succ - (XI - p0)), - (PeanoSucc - ((XI - p0), - (peanoView_xI - p0 - q0)))) - - (** val peanoView : - positive - -> - coq_PeanoView **) - - let rec peanoView = function - | XI p0 -> - peanoView_xI - p0 - (peanoView - p0) - | XO p0 -> - peanoView_xO - p0 - (peanoView - p0) - | XH -> - PeanoOne - - (** val coq_PeanoView_iter : - 'a1 - -> - (positive - -> - 'a1 - -> - 'a1) - -> - positive - -> - coq_PeanoView - -> - 'a1 **) - - let rec coq_PeanoView_iter a f p = function - | PeanoOne -> - a - | PeanoSucc (p0, - q0) -> - f - p0 - (coq_PeanoView_iter - a - f - p0 - q0) - - (** val eqb_spec : - positive - -> - positive - -> - reflect **) - - let eqb_spec x y = - iff_reflect - (eqb - x - y) - - (** val switch_Eq : - comparison - -> - comparison - -> - comparison **) - - let switch_Eq c = function - | Eq -> - c - | x -> - x - - (** val mask2cmp : - mask - -> - comparison **) - - let mask2cmp = function - | IsNul -> - Eq - | IsPos p0 -> - Gt - | IsNeg -> - Lt - - (** val leb_spec0 : - positive - -> - positive - -> - reflect **) - - let leb_spec0 x y = - iff_reflect - (leb - x - y) - - (** val ltb_spec0 : - positive - -> - positive - -> - reflect **) - - let ltb_spec0 x y = - iff_reflect - (ltb - x - y) - - module Private_Tac = - struct - - end - - module Private_Rev = - struct - module ORev = - struct - type t - = - positive - end - - module MRev = - struct - (** val max : - positive - -> - positive - -> - positive **) - - let max x y = - min - y - x - end - - module MPRev = MaxLogicalProperties(ORev)(MRev) - end - - module Private_Dec = - struct - (** val max_case_strong : - positive - -> - positive - -> - (positive - -> - positive - -> - __ - -> - 'a1 - -> - 'a1) - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let max_case_strong n0 m compat hl hr = - let c = - compSpec2Type - n0 - m - (compare - n0 - m) - in - (match c with - | CompGtT -> - compat - n0 - (max - n0 - m) - __ - (hl - __) - | _ -> - compat - m - (max - n0 - m) - __ - (hr - __)) - - (** val max_case : - positive - -> - positive - -> - (positive - -> - positive - -> - __ - -> - 'a1 - -> - 'a1) - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let max_case n0 m x x0 x1 = - max_case_strong - n0 - m - x - (fun _ -> - x0) - (fun _ -> - x1) - - (** val max_dec : - positive - -> - positive - -> - bool **) - - let max_dec n0 m = - max_case - n0 - m - (fun x y _ h0 -> - h0) - true - false - - (** val min_case_strong : - positive - -> - positive - -> - (positive - -> - positive - -> - __ - -> - 'a1 - -> - 'a1) - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let min_case_strong n0 m compat hl hr = - let c = - compSpec2Type - n0 - m - (compare - n0 - m) - in - (match c with - | CompGtT -> - compat - m - (min - n0 - m) - __ - (hr - __) - | _ -> - compat - n0 - (min - n0 - m) - __ - (hl - __)) - - (** val min_case : - positive - -> - positive - -> - (positive - -> - positive - -> - __ - -> - 'a1 - -> - 'a1) - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let min_case n0 m x x0 x1 = - min_case_strong - n0 - m - x - (fun _ -> - x0) - (fun _ -> - x1) - - (** val min_dec : - positive - -> - positive - -> - bool **) - - let min_dec n0 m = - min_case - n0 - m - (fun x y _ h0 -> - h0) - true - false - end - - (** val max_case_strong : - positive - -> - positive - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let max_case_strong n0 m x x0 = - Private_Dec.max_case_strong - n0 - m - (fun x1 y _ x2 -> - x2) - x - x0 - - (** val max_case : - positive - -> - positive - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let max_case n0 m x x0 = - max_case_strong - n0 - m - (fun _ -> - x) - (fun _ -> - x0) - - (** val max_dec : - positive - -> - positive - -> - bool **) - - let max_dec = - Private_Dec.max_dec - - (** val min_case_strong : - positive - -> - positive - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let min_case_strong n0 m x x0 = - Private_Dec.min_case_strong - n0 - m - (fun x1 y _ x2 -> - x2) - x - x0 - - (** val min_case : - positive - -> - positive - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let min_case n0 m x x0 = - min_case_strong - n0 - m - (fun _ -> - x) - (fun _ -> - x0) - - (** val min_dec : - positive - -> - positive - -> - bool **) - - let min_dec = - Private_Dec.min_dec - end - -module N = - struct - type t - = - n - - (** val zero : - n **) - - let zero = - N0 - - (** val one : - n **) - - let one = - Npos - XH - - (** val two : - n **) - - let two = - Npos - (XO - XH) - - (** val succ_double : - n - -> - n **) - - let succ_double = function - | N0 -> - Npos - XH - | Npos p -> - Npos - (XI - p) - - (** val double : - n - -> - n **) - - let double = function - | N0 -> - N0 - | Npos p -> - Npos - (XO - p) - - (** val succ : - n - -> - n **) - - let succ = function - | N0 -> - Npos - XH - | Npos p -> - Npos - (Coq_Pos.succ - p) - - (** val pred : - n - -> - n **) - - let pred = function - | N0 -> - N0 - | Npos p -> - Coq_Pos.pred_N - p - - (** val succ_pos : - n - -> - positive **) - - let succ_pos = function - | N0 -> - XH - | Npos p -> - Coq_Pos.succ - p - - (** val add : - n - -> - n - -> - n **) - - let add n0 m = - match n0 with - | N0 -> - m - | Npos p -> - (match m with - | N0 -> - n0 - | Npos q -> - Npos - (Coq_Pos.add - p - q)) - - (** val sub : - n - -> - n - -> - n **) - - let sub n0 m = - match n0 with - | N0 -> - N0 - | Npos n' -> - (match m with - | N0 -> - n0 - | Npos m' -> - (match Coq_Pos.sub_mask - n' - m' with - | Coq_Pos.IsPos p -> - Npos - p - | _ -> - N0)) - - (** val mul : - n - -> - n - -> - n **) - - let mul n0 m = - match n0 with - | N0 -> - N0 - | Npos p -> - (match m with - | N0 -> - N0 - | Npos q -> - Npos - (Coq_Pos.mul - p - q)) - - (** val compare : - n - -> - n - -> - comparison **) - - let compare n0 m = - match n0 with - | N0 -> - (match m with - | N0 -> - Eq - | Npos m' -> - Lt) - | Npos n' -> - (match m with - | N0 -> - Gt - | Npos m' -> - Coq_Pos.compare - n' - m') - - (** val eqb : - n - -> - n - -> - bool **) - - let rec eqb n0 m = - match n0 with - | N0 -> - (match m with - | N0 -> - true - | Npos p -> - false) - | Npos p -> - (match m with - | N0 -> - false - | Npos q -> - Coq_Pos.eqb - p - q) - - (** val leb : - n - -> - n - -> - bool **) - - let leb x y = - match compare - x - y with - | Gt -> - false - | _ -> - true - - (** val ltb : - n - -> - n - -> - bool **) - - let ltb x y = - match compare - x - y with - | Lt -> - true - | _ -> - false - - (** val min : - n - -> - n - -> - n **) - - let min n0 n' = - match compare - n0 - n' with - | Gt -> - n' - | _ -> - n0 - - (** val max : - n - -> - n - -> - n **) - - let max n0 n' = - match compare - n0 - n' with - | Gt -> - n0 - | _ -> - n' - - (** val div2 : - n - -> - n **) - - let div2 = function - | N0 -> - N0 - | Npos p0 -> - (match p0 with - | XI p -> - Npos - p - | XO p -> - Npos - p - | XH -> - N0) - - (** val even : - n - -> - bool **) - - let even = function - | N0 -> - true - | Npos p -> - (match p with - | XO p0 -> - true - | _ -> - false) - - (** val odd : - n - -> - bool **) - - let odd n0 = - negb - (even - n0) - - (** val pow : - n - -> - n - -> - n **) - - let pow n0 = function - | N0 -> - Npos - XH - | Npos p0 -> - (match n0 with - | N0 -> - N0 - | Npos q -> - Npos - (Coq_Pos.pow - q - p0)) - - (** val square : - n - -> - n **) - - let square = function - | N0 -> - N0 - | Npos p -> - Npos - (Coq_Pos.square - p) - - (** val log2 : - n - -> - n **) - - let log2 = function - | N0 -> - N0 - | Npos p0 -> - (match p0 with - | XI p -> - Npos - (Coq_Pos.size - p) - | XO p -> - Npos - (Coq_Pos.size - p) - | XH -> - N0) - - (** val size : - n - -> - n **) - - let size = function - | N0 -> - N0 - | Npos p -> - Npos - (Coq_Pos.size - p) - - (** val size_nat : - n - -> - int **) - - let size_nat = function - | N0 -> - 0 - | Npos p -> - Coq_Pos.size_nat - p - - (** val pos_div_eucl : - positive - -> - n - -> - (n, - n) - prod **) - - let rec pos_div_eucl a b = - match a with - | XI a' -> - let Pair (q, - r) = - pos_div_eucl - a' - b - in - let r' = - succ_double - r - in - if leb - b - r' - then Pair - ((succ_double - q), - (sub - r' - b)) - else Pair - ((double - q), - r') - | XO a' -> - let Pair (q, - r) = - pos_div_eucl - a' - b - in - let r' = - double - r - in - if leb - b - r' - then Pair - ((succ_double - q), - (sub - r' - b)) - else Pair - ((double - q), - r') - | XH -> - (match b with - | N0 -> - Pair - (N0, - (Npos - XH)) - | Npos p -> - (match p with - | XH -> - Pair - ((Npos - XH), - N0) - | _ -> - Pair - (N0, - (Npos - XH)))) - - (** val div_eucl : - n - -> - n - -> - (n, - n) - prod **) - - let div_eucl a b = - match a with - | N0 -> - Pair - (N0, - N0) - | Npos na -> - (match b with - | N0 -> - Pair - (N0, - a) - | Npos p -> - pos_div_eucl - na - b) - - (** val div : - n - -> - n - -> - n **) - - let div a b = - fst - (div_eucl - a - b) - - (** val modulo : - n - -> - n - -> - n **) - - let modulo a b = - snd - (div_eucl - a - b) - - (** val gcd : - n - -> - n - -> - n **) - - let gcd a b = - match a with - | N0 -> - b - | Npos p -> - (match b with - | N0 -> - a - | Npos q -> - Npos - (Coq_Pos.gcd - p - q)) - - (** val ggcd : - n - -> - n - -> - (n, - (n, - n) - prod) - prod **) - - let ggcd a b = - match a with - | N0 -> - Pair - (b, - (Pair - (N0, - (Npos - XH)))) - | Npos p -> - (match b with - | N0 -> - Pair - (a, - (Pair - ((Npos - XH), - N0))) - | Npos q -> - let Pair (g, - p0) = - Coq_Pos.ggcd - p - q - in - let Pair (aa, - bb) = - p0 - in - Pair - ((Npos - g), - (Pair - ((Npos - aa), - (Npos - bb))))) - - (** val sqrtrem : - n - -> - (n, - n) - prod **) - - let sqrtrem = function - | N0 -> - Pair - (N0, - N0) - | Npos p -> - let Pair (s, - m) = - Coq_Pos.sqrtrem - p - in - (match m with - | Coq_Pos.IsPos r -> - Pair - ((Npos - s), - (Npos - r)) - | _ -> - Pair - ((Npos - s), - N0)) - - (** val sqrt : - n - -> - n **) - - let sqrt = function - | N0 -> - N0 - | Npos p -> - Npos - (Coq_Pos.sqrt - p) - - (** val coq_lor : - n - -> - n - -> - n **) - - let coq_lor n0 m = - match n0 with - | N0 -> - m - | Npos p -> - (match m with - | N0 -> - n0 - | Npos q -> - Npos - (Coq_Pos.coq_lor - p - q)) - - (** val coq_land : - n - -> - n - -> - n **) - - let coq_land n0 m = - match n0 with - | N0 -> - N0 - | Npos p -> - (match m with - | N0 -> - N0 - | Npos q -> - Coq_Pos.coq_land - p - q) - - (** val ldiff : - n - -> - n - -> - n **) - - let rec ldiff n0 m = - match n0 with - | N0 -> - N0 - | Npos p -> - (match m with - | N0 -> - n0 - | Npos q -> - Coq_Pos.ldiff - p - q) - - (** val coq_lxor : - n - -> - n - -> - n **) - - let coq_lxor n0 m = - match n0 with - | N0 -> - m - | Npos p -> - (match m with - | N0 -> - n0 - | Npos q -> - Coq_Pos.coq_lxor - p - q) - - (** val shiftl_nat : - n - -> - int - -> - n **) - - let shiftl_nat a n0 = - nat_iter - n0 - double - a - - (** val shiftr_nat : - n - -> - int - -> - n **) - - let shiftr_nat a n0 = - nat_iter - n0 - div2 - a - - (** val shiftl : - n - -> - n - -> - n **) - - let shiftl a n0 = - match a with - | N0 -> - N0 - | Npos a0 -> - Npos - (Coq_Pos.shiftl - a0 - n0) - - (** val shiftr : - n - -> - n - -> - n **) - - let shiftr a = function - | N0 -> - a - | Npos p -> - Coq_Pos.iter - p - div2 - a - - (** val testbit_nat : - n - -> - int - -> - bool **) - - let testbit_nat = function - | N0 -> - (fun x -> - false) - | Npos p -> - Coq_Pos.testbit_nat - p - - (** val testbit : - n - -> - n - -> - bool **) - - let testbit a n0 = - match a with - | N0 -> - false - | Npos p -> - Coq_Pos.testbit - p - n0 - - (** val to_nat : - n - -> - int **) - - let to_nat = function - | N0 -> - 0 - | Npos p -> - Coq_Pos.to_nat - p - - (** val of_nat : - int - -> - n **) - - let of_nat n0 = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - N0) - (fun n' -> - Npos - (Coq_Pos.of_succ_nat - n')) - n0 - - (** val iter : - n - -> - ('a1 - -> - 'a1) - -> - 'a1 - -> - 'a1 **) - - let iter n0 f x = - match n0 with - | N0 -> - x - | Npos p -> - Coq_Pos.iter - p - f - x - - (** val eq_dec : - n - -> - n - -> - bool **) - - let eq_dec n0 m = - match n0 with - | N0 -> - (match m with - | N0 -> - true - | Npos p -> - false) - | Npos x -> - (match m with - | N0 -> - false - | Npos p0 -> - Coq_Pos.eq_dec - x - p0) - - (** val discr : - n - -> - positive - sumor **) - - let discr = function - | N0 -> - Inright - | Npos p -> - Inleft - p - - (** val binary_rect : - 'a1 - -> - (n - -> - 'a1 - -> - 'a1) - -> - (n - -> - 'a1 - -> - 'a1) - -> - n - -> - 'a1 **) - - let binary_rect f0 f2 fS2 n0 = - let f2' = - fun p -> - f2 - (Npos - p) - in - let fS2' = - fun p -> - fS2 - (Npos - p) - in - (match n0 with - | N0 -> - f0 - | Npos p -> - let rec f = function - | XI p1 -> - fS2' - p1 - (f - p1) - | XO p1 -> - f2' - p1 - (f - p1) - | XH -> - fS2 - N0 - f0 - in f - p) - - (** val binary_rec : - 'a1 - -> - (n - -> - 'a1 - -> - 'a1) - -> - (n - -> - 'a1 - -> - 'a1) - -> - n - -> - 'a1 **) - - let binary_rec = - binary_rect - - (** val peano_rect : - 'a1 - -> - (n - -> - 'a1 - -> - 'a1) - -> - n - -> - 'a1 **) - - let peano_rect f0 f n0 = - let f' = - fun p -> - f - (Npos - p) - in - (match n0 with - | N0 -> - f0 - | Npos p -> - Coq_Pos.peano_rect - (f - N0 - f0) - f' - p) - - (** val peano_rec : - 'a1 - -> - (n - -> - 'a1 - -> - 'a1) - -> - n - -> - 'a1 **) - - let peano_rec = - peano_rect - - (** val leb_spec0 : - n - -> - n - -> - reflect **) - - let leb_spec0 x y = - iff_reflect - (leb - x - y) - - (** val ltb_spec0 : - n - -> - n - -> - reflect **) - - let ltb_spec0 x y = - iff_reflect - (ltb - x - y) - - module Private_BootStrap = - struct - - end - - (** val recursion : - 'a1 - -> - (n - -> - 'a1 - -> - 'a1) - -> - n - -> - 'a1 **) - - let recursion x = - peano_rect - x - - module Private_OrderTac = - struct - module Elts = - struct - type t - = - n - end - - module Tac = MakeOrderTac(Elts) - end - - module Private_NZPow = - struct - - end - - module Private_NZSqrt = - struct - - end - - (** val sqrt_up : - n - -> - n **) - - let sqrt_up a = - match compare - N0 - a with - | Lt -> - succ - (sqrt - (pred - a)) - | _ -> - N0 - - (** val log2_up : - n - -> - n **) - - let log2_up a = - match compare - (Npos - XH) - a with - | Lt -> - succ - (log2 - (pred - a)) - | _ -> - N0 - - module Private_NZDiv = - struct - - end - - (** val lcm : - n - -> - n - -> - n **) - - let lcm a b = - mul - a - (div - b - (gcd - a - b)) - - (** val eqb_spec : - n - -> - n - -> - reflect **) - - let eqb_spec x y = - iff_reflect - (eqb - x - y) - - (** val b2n : - bool - -> - n **) - - let b2n = function - | true -> - Npos - XH - | false -> - N0 - - (** val setbit : - n - -> - n - -> - n **) - - let setbit a n0 = - coq_lor - a - (shiftl - (Npos - XH) - n0) - - (** val clearbit : - n - -> - n - -> - n **) - - let clearbit a n0 = - ldiff - a - (shiftl - (Npos - XH) - n0) - - (** val ones : - n - -> - n **) - - let ones n0 = - pred - (shiftl - (Npos - XH) - n0) - - (** val lnot : - n - -> - n - -> - n **) - - let lnot a n0 = - coq_lxor - a - (ones - n0) - - module Private_Tac = - struct - - end - - module Private_Rev = - struct - module ORev = - struct - type t - = - n - end - - module MRev = - struct - (** val max : - n - -> - n - -> - n **) - - let max x y = - min - y - x - end - - module MPRev = MaxLogicalProperties(ORev)(MRev) - end - - module Private_Dec = - struct - (** val max_case_strong : - n - -> - n - -> - (n - -> - n - -> - __ - -> - 'a1 - -> - 'a1) - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let max_case_strong n0 m compat hl hr = - let c = - compSpec2Type - n0 - m - (compare - n0 - m) - in - (match c with - | CompGtT -> - compat - n0 - (max - n0 - m) - __ - (hl - __) - | _ -> - compat - m - (max - n0 - m) - __ - (hr - __)) - - (** val max_case : - n - -> - n - -> - (n - -> - n - -> - __ - -> - 'a1 - -> - 'a1) - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let max_case n0 m x x0 x1 = - max_case_strong - n0 - m - x - (fun _ -> - x0) - (fun _ -> - x1) - - (** val max_dec : - n - -> - n - -> - bool **) - - let max_dec n0 m = - max_case - n0 - m - (fun x y _ h0 -> - h0) - true - false - - (** val min_case_strong : - n - -> - n - -> - (n - -> - n - -> - __ - -> - 'a1 - -> - 'a1) - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let min_case_strong n0 m compat hl hr = - let c = - compSpec2Type - n0 - m - (compare - n0 - m) - in - (match c with - | CompGtT -> - compat - m - (min - n0 - m) - __ - (hr - __) - | _ -> - compat - n0 - (min - n0 - m) - __ - (hl - __)) - - (** val min_case : - n - -> - n - -> - (n - -> - n - -> - __ - -> - 'a1 - -> - 'a1) - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let min_case n0 m x x0 x1 = - min_case_strong - n0 - m - x - (fun _ -> - x0) - (fun _ -> - x1) - - (** val min_dec : - n - -> - n - -> - bool **) - - let min_dec n0 m = - min_case - n0 - m - (fun x y _ h0 -> - h0) - true - false - end - - (** val max_case_strong : - n - -> - n - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let max_case_strong n0 m x x0 = - Private_Dec.max_case_strong - n0 - m - (fun x1 y _ x2 -> - x2) - x - x0 - - (** val max_case : - n - -> - n - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let max_case n0 m x x0 = - max_case_strong - n0 - m - (fun _ -> - x) - (fun _ -> - x0) - - (** val max_dec : - n - -> - n - -> - bool **) - - let max_dec = - Private_Dec.max_dec - - (** val min_case_strong : - n - -> - n - -> - (__ - -> - 'a1) - -> - (__ - -> - 'a1) - -> - 'a1 **) - - let min_case_strong n0 m x x0 = - Private_Dec.min_case_strong - n0 - m - (fun x1 y _ x2 -> - x2) - x - x0 - - (** val min_case : - n - -> - n - -> - 'a1 - -> - 'a1 - -> - 'a1 **) - - let min_case n0 m x x0 = - min_case_strong - n0 - m - (fun _ -> - x) - (fun _ -> - x0) - - (** val min_dec : - n - -> - n - -> - bool **) - - let min_dec = - Private_Dec.min_dec - end - -(** val eq_nat_dec : - int - -> - int - -> - bool **) - -let rec eq_nat_dec n0 m = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun m0 -> - false) - m) - (fun n1 -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - false) - (fun m0 -> - eq_nat_dec - n1 - m0) - m) - n0 - -(** val beq_nat : - int - -> - int - -> - bool **) - -let rec beq_nat = ( = ) - -(** val rev : - 'a1 - list - -> - 'a1 - list **) - -let rec rev = function -| Nil -> - Nil -| Cons (x, - l') -> - app - (rev - l') - (Cons - (x, - Nil)) - -(** val map : - ('a1 - -> - 'a2) - -> - 'a1 - list - -> - 'a2 - list **) - -let rec map f = function -| Nil -> - Nil -| Cons (a, - t0) -> - Cons - ((f - a), - (map - f - t0)) - -(** val fold_left : - ('a1 - -> - 'a2 - -> - 'a1) - -> - 'a2 - list - -> - 'a1 - -> - 'a1 **) - -let rec fold_left f l a0 = - match l with - | Nil -> - a0 - | Cons (b, - t0) -> - fold_left - f - t0 - (f - a0 - b) - -(** val fold_right : - ('a2 - -> - 'a1 - -> - 'a1) - -> - 'a1 - -> - 'a2 - list - -> - 'a1 **) - -let rec fold_right f a0 = function -| Nil -> - a0 -| Cons (b, - t0) -> - f - b - (fold_right - f - a0 - t0) - -(** val forallb : - ('a1 - -> - bool) - -> - 'a1 - list - -> - bool **) - -let rec forallb f = function -| Nil -> - true -| Cons (a, - l0) -> - if f - a - then forallb - f - l0 - else false - -(** val n_of_digits : - bool - list - -> - n **) - -let rec n_of_digits = function -| Nil -> - N0 -| Cons (b, - l') -> - N.add - (if b - then Npos - XH - else N0) - (N.mul - (Npos - (XO - XH)) - (n_of_digits - l')) - -(** val n_of_ascii : - char - -> - n **) - -let n_of_ascii a = - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun a0 a1 a2 a3 a4 a5 a6 a7 -> - n_of_digits - (Cons - (a0, - (Cons - (a1, - (Cons - (a2, - (Cons - (a3, - (Cons - (a4, - (Cons - (a5, - (Cons - (a6, - (Cons - (a7, - Nil))))))))))))))))) - a - -(** val nat_of_ascii : - char - -> - int **) - -let nat_of_ascii a = - N.to_nat - (n_of_ascii - a) - -type string = -| EmptyString -| String of char - * string - -(** val string_dec : - string - -> - string - -> - bool **) - -let rec string_dec s s0 = - match s with - | EmptyString -> - (match s0 with - | EmptyString -> - true - | String (a, - s1) -> - false) - | String (a, - s1) -> - (match s0 with - | EmptyString -> - false - | String (a0, - s2) -> - if (=) - a - a0 - then string_dec - s1 - s2 - else false) - -(** val append : - string - -> - string - -> - string **) - -let rec append s1 s2 = - match s1 with - | EmptyString -> - s2 - | String (c, - s1') -> - String - (c, - (append - s1' - s2)) - -(** val ble_nat : - int - -> - int - -> - bool **) - -let rec ble_nat n0 m = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun n' -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - false) - (fun m' -> - ble_nat - n' - m') - m) - n0 - -type id = - int - (* singleton inductive, whose constructor was Id *) - -(** val eq_id_dec : - id - -> - id - -> - bool **) - -let eq_id_dec id1 id2 = - eq_nat_dec - id1 - id2 - -type state - = - id - -> - int - -(** val empty_state : - state **) - -let empty_state x = - 0 - -(** val update : - state - -> - id - -> - int - -> - state **) - -let update st x n0 x' = - if eq_id_dec - x - x' - then n0 - else st - x' - -type aexp = -| ANum of int -| AId of id -| APlus of aexp - * aexp -| AMinus of aexp - * aexp -| AMult of aexp - * aexp - -type bexp = -| BTrue -| BFalse -| BEq of aexp - * aexp -| BLe of aexp - * aexp -| BNot of bexp -| BAnd of bexp - * bexp - -(** val aeval : - state - -> - aexp - -> - int **) - -let rec aeval st = function -| ANum n0 -> - n0 -| AId x -> - st - x -| APlus (a1, - a2) -> - plus - (aeval - st - a1) - (aeval - st - a2) -| AMinus (a1, - a2) -> - minus - (aeval - st - a1) - (aeval - st - a2) -| AMult (a1, - a2) -> - mult - (aeval - st - a1) - (aeval - st - a2) - -(** val beval : - state - -> - bexp - -> - bool **) - -let rec beval st = function -| BTrue -> - true -| BFalse -> - false -| BEq (a1, - a2) -> - beq_nat - (aeval - st - a1) - (aeval - st - a2) -| BLe (a1, - a2) -> - ble_nat - (aeval - st - a1) - (aeval - st - a2) -| BNot b1 -> - negb - (beval - st - b1) -| BAnd (b1, - b2) -> - if beval - st - b1 - then beval - st - b2 - else false - -type com = -| CSkip -| CAss of id - * aexp -| CSeq of com - * com -| CIf of bexp - * com - * com -| CWhile of bexp - * com - -(** val ceval_step : - state - -> - com - -> - int - -> - state - option **) - -let rec ceval_step st c i = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - None) - (fun i' -> - match c with - | CSkip -> - Some - st - | CAss (l, - a1) -> - Some - (update - st - l - (aeval - st - a1)) - | CSeq (c1, - c2) -> - (match ceval_step - st - c1 - i' with - | Some st' -> - ceval_step - st' - c2 - i' - | None -> - None) - | CIf (b, - c1, - c2) -> - if beval - st - b - then ceval_step - st - c1 - i' - else ceval_step - st - c2 - i' - | CWhile (b1, - c1) -> - if beval - st - b1 - then (match ceval_step - st - c1 - i' with - | Some st' -> - ceval_step - st' - c - i' - | None -> - None) - else Some - st) - i - -(** val isWhite : - char - -> - bool **) - -let isWhite c = - let n0 = - nat_of_ascii - c - in - if if beq_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0)))))))))))))))))))))))))))))))) - then true - else beq_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0))))))))) - then true - else if beq_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0)))))))))) - then true - else beq_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0))))))))))))) - -(** val isLowerAlpha : - char - -> - bool **) - -let isLowerAlpha c = - let n0 = - nat_of_ascii - c - in - if ble_nat - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - n0 - then ble_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - else false - -(** val isAlpha : - char - -> - bool **) - -let isAlpha c = - let n0 = - nat_of_ascii - c - in - if if ble_nat - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - n0 - then ble_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - else false - then true - else if ble_nat - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - n0 - then ble_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - else false - -(** val isDigit : - char - -> - bool **) - -let isDigit c = - let n0 = - nat_of_ascii - c - in - if ble_nat - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0)))))))))))))))))))))))))))))))))))))))))))))))) - n0 - then ble_nat - n0 - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - ((fun x -> x + 1) - 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - else false - -type chartype = -| White -| Alpha -| Digit -| Other - -(** val classifyChar : - char - -> - chartype **) - -let classifyChar c = - if isWhite - c - then White - else if isAlpha - c - then Alpha - else if isDigit - c - then Digit - else Other - -(** val list_of_string : - string - -> - char - list **) - -let rec list_of_string = function -| EmptyString -> - Nil -| String (c, - s0) -> - Cons - (c, - (list_of_string - s0)) - -(** val string_of_list : - char - list - -> - string **) - -let rec string_of_list xs = - fold_right - (fun x x0 -> - String - (x, - x0)) - EmptyString - xs - -type token - = - string - -(** val tokenize_helper : - chartype - -> - char - list - -> - char - list - -> - char - list - list **) - -let rec tokenize_helper cls acc xs = - let tk = - match acc with - | Nil -> - Nil - | Cons (a, - l) -> - Cons - ((rev - acc), - Nil) - in - (match xs with - | Nil -> - tk - | Cons (x, - xs') -> - (match cls with - | White -> - (match classifyChar - x with - | White -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b1 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b2 - then if b3 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b4 - then if b5 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b6 - then app - tk - (tokenize_helper - White - Nil - xs') - else app - tk - (Cons - ((Cons - (')', - Nil)), - (tokenize_helper - Other - Nil - xs'))) - else app - tk - (tokenize_helper - White - Nil - xs') - else app - tk - (tokenize_helper - White - Nil - xs') - else if b0 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b1 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b2 - then if b3 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b4 - then if b5 - then app - tk - (tokenize_helper - White - Nil - xs') - else if b6 - then app - tk - (tokenize_helper - White - Nil - xs') - else app - tk - (Cons - ((Cons - ('(', - Nil)), - (tokenize_helper - Other - Nil - xs'))) - else app - tk - (tokenize_helper - White - Nil - xs') - else app - tk - (tokenize_helper - White - Nil - xs')) - x - | Other -> - let tp = - Other - in - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b1 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b2 - then if b3 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b4 - then if b5 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b6 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else app - tk - (Cons - ((Cons - (')', - Nil)), - (tokenize_helper - Other - Nil - xs'))) - else app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b0 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b1 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b2 - then if b3 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b4 - then if b5 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else if b6 - then app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else app - tk - (Cons - ((Cons - ('(', - Nil)), - (tokenize_helper - Other - Nil - xs'))) - else app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs') - else app - tk - (tokenize_helper - tp - (Cons - (x, - Nil)) - xs')) - x - | x0 -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b1 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b2 - then if b3 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b4 - then if b5 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b6 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else app - tk - (Cons - ((Cons - (')', - Nil)), - (tokenize_helper - Other - Nil - xs'))) - else app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b0 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b1 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b2 - then if b3 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b4 - then if b5 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else if b6 - then app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else app - tk - (Cons - ((Cons - ('(', - Nil)), - (tokenize_helper - Other - Nil - xs'))) - else app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs') - else app - tk - (tokenize_helper - x0 - (Cons - (x, - Nil)) - xs')) - x) - | Alpha -> - (match classifyChar - x with - | White -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper White Nil xs') - else if b1 - then app tk (tokenize_helper White Nil xs') - else if b2 - then if b3 - then app tk (tokenize_helper White Nil xs') - else if b4 - then if b5 - then app tk - (tokenize_helper White Nil - xs') - else if b6 - then app tk - (tokenize_helper White - Nil xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper White Nil xs') - else app tk (tokenize_helper White Nil xs') - else if b0 - then app tk (tokenize_helper White Nil xs') - else if b1 - then app tk (tokenize_helper White Nil xs') - else if b2 - then if b3 - then app tk (tokenize_helper White Nil xs') - else if b4 - then if b5 - then app tk - (tokenize_helper White Nil - xs') - else if b6 - then app tk - (tokenize_helper White - Nil xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper White Nil xs') - else app tk (tokenize_helper White Nil xs')) - x - | Alpha -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then tokenize_helper Alpha (Cons (x, acc)) xs' - else if b1 - then tokenize_helper Alpha (Cons (x, acc)) xs' - else if b2 - then if b3 - then tokenize_helper Alpha (Cons (x, acc)) - xs' - else if b4 - then if b5 - then tokenize_helper Alpha (Cons - (x, acc)) xs' - else if b6 - then tokenize_helper Alpha - (Cons (x, acc)) xs' - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else tokenize_helper Alpha (Cons (x, - acc)) xs' - else tokenize_helper Alpha (Cons (x, acc)) xs' - else if b0 - then tokenize_helper Alpha (Cons (x, acc)) xs' - else if b1 - then tokenize_helper Alpha (Cons (x, acc)) xs' - else if b2 - then if b3 - then tokenize_helper Alpha (Cons (x, acc)) - xs' - else if b4 - then if b5 - then tokenize_helper Alpha (Cons - (x, acc)) xs' - else if b6 - then tokenize_helper Alpha - (Cons (x, acc)) xs' - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else tokenize_helper Alpha (Cons (x, - acc)) xs' - else tokenize_helper Alpha (Cons (x, acc)) xs') - x - | Digit -> - let tp = Digit in - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs') - else if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs')) - x - | Other -> - let tp = Other in - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs') - else if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs')) - x) - | Digit -> - (match classifyChar x with - | White -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper White Nil xs') - else if b1 - then app tk (tokenize_helper White Nil xs') - else if b2 - then if b3 - then app tk (tokenize_helper White Nil xs') - else if b4 - then if b5 - then app tk - (tokenize_helper White Nil - xs') - else if b6 - then app tk - (tokenize_helper White - Nil xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper White Nil xs') - else app tk (tokenize_helper White Nil xs') - else if b0 - then app tk (tokenize_helper White Nil xs') - else if b1 - then app tk (tokenize_helper White Nil xs') - else if b2 - then if b3 - then app tk (tokenize_helper White Nil xs') - else if b4 - then if b5 - then app tk - (tokenize_helper White Nil - xs') - else if b6 - then app tk - (tokenize_helper White - Nil xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper White Nil xs') - else app tk (tokenize_helper White Nil xs')) - x - | Alpha -> - let tp = Alpha in - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs') - else if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs')) - x - | Digit -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then tokenize_helper Digit (Cons (x, acc)) xs' - else if b1 - then tokenize_helper Digit (Cons (x, acc)) xs' - else if b2 - then if b3 - then tokenize_helper Digit (Cons (x, acc)) - xs' - else if b4 - then if b5 - then tokenize_helper Digit (Cons - (x, acc)) xs' - else if b6 - then tokenize_helper Digit - (Cons (x, acc)) xs' - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else tokenize_helper Digit (Cons (x, - acc)) xs' - else tokenize_helper Digit (Cons (x, acc)) xs' - else if b0 - then tokenize_helper Digit (Cons (x, acc)) xs' - else if b1 - then tokenize_helper Digit (Cons (x, acc)) xs' - else if b2 - then if b3 - then tokenize_helper Digit (Cons (x, acc)) - xs' - else if b4 - then if b5 - then tokenize_helper Digit (Cons - (x, acc)) xs' - else if b6 - then tokenize_helper Digit - (Cons (x, acc)) xs' - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else tokenize_helper Digit (Cons (x, - acc)) xs' - else tokenize_helper Digit (Cons (x, acc)) xs') - x - | Other -> - let tp = Other in - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs') - else if b0 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper tp (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper tp (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper tp (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper tp - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper tp (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper tp (Cons (x, Nil)) xs')) - x) - | Other -> - (match classifyChar x with - | White -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper White Nil xs') - else if b1 - then app tk (tokenize_helper White Nil xs') - else if b2 - then if b3 - then app tk (tokenize_helper White Nil xs') - else if b4 - then if b5 - then app tk - (tokenize_helper White Nil - xs') - else if b6 - then app tk - (tokenize_helper White - Nil xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper White Nil xs') - else app tk (tokenize_helper White Nil xs') - else if b0 - then app tk (tokenize_helper White Nil xs') - else if b1 - then app tk (tokenize_helper White Nil xs') - else if b2 - then if b3 - then app tk (tokenize_helper White Nil xs') - else if b4 - then if b5 - then app tk - (tokenize_helper White Nil - xs') - else if b6 - then app tk - (tokenize_helper White - Nil xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper White Nil xs') - else app tk (tokenize_helper White Nil xs')) - x - | Other -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then tokenize_helper Other (Cons (x, acc)) xs' - else if b1 - then tokenize_helper Other (Cons (x, acc)) xs' - else if b2 - then if b3 - then tokenize_helper Other (Cons (x, acc)) - xs' - else if b4 - then if b5 - then tokenize_helper Other (Cons - (x, acc)) xs' - else if b6 - then tokenize_helper Other - (Cons (x, acc)) xs' - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else tokenize_helper Other (Cons (x, - acc)) xs' - else tokenize_helper Other (Cons (x, acc)) xs' - else if b0 - then tokenize_helper Other (Cons (x, acc)) xs' - else if b1 - then tokenize_helper Other (Cons (x, acc)) xs' - else if b2 - then if b3 - then tokenize_helper Other (Cons (x, acc)) - xs' - else if b4 - then if b5 - then tokenize_helper Other (Cons - (x, acc)) xs' - else if b6 - then tokenize_helper Other - (Cons (x, acc)) xs' - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else tokenize_helper Other (Cons (x, - acc)) xs' - else tokenize_helper Other (Cons (x, acc)) xs') - x - | x0 -> - (* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7)) - (fun b b0 b1 b2 b3 b4 b5 b6 -> - if b - then if b0 - then app tk (tokenize_helper x0 (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper x0 (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper x0 (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper x0 (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper x0 - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - (')', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper x0 (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper x0 (Cons (x, Nil)) xs') - else if b0 - then app tk (tokenize_helper x0 (Cons (x, Nil)) xs') - else if b1 - then app tk (tokenize_helper x0 (Cons (x, Nil)) xs') - else if b2 - then if b3 - then app tk - (tokenize_helper x0 (Cons (x, Nil)) - xs') - else if b4 - then if b5 - then app tk - (tokenize_helper x0 (Cons - (x, Nil)) xs') - else if b6 - then app tk - (tokenize_helper x0 - (Cons (x, Nil)) xs') - else app tk (Cons ((Cons - ('(', Nil)), - (tokenize_helper Other - Nil xs'))) - else app tk - (tokenize_helper x0 (Cons (x, - Nil)) xs') - else app tk - (tokenize_helper x0 (Cons (x, Nil)) xs')) - x))) - -(** val tokenize : string -> string list **) - -let tokenize s = - map string_of_list (tokenize_helper White Nil (list_of_string s)) - -type 'x optionE = -| SomeE of 'x -| NoneE of string - -(** val build_symtable : token list -> int -> token -> int **) - -let rec build_symtable xs n0 = - match xs with - | Nil -> (fun s -> n0) - | Cons (x, xs0) -> - if forallb isLowerAlpha (list_of_string x) - then (fun s -> - if string_dec s x - then n0 - else build_symtable xs0 ((fun x -> x + 1) n0) s) - else build_symtable xs0 n0 - -type 't parser0 = token list -> ('t, token list) prod optionE - -(** val many_helper : - 'a1 parser0 -> 'a1 list -> int -> token list -> ('a1 list, token list) - prod optionE **) - -let rec many_helper p acc steps xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match p xs with - | SomeE p0 -> - let Pair (t0, xs') = p0 in many_helper p (Cons (t0, acc)) steps' xs' - | NoneE s -> SomeE (Pair ((rev acc), xs))) - steps - -(** val many : 'a1 parser0 -> int -> 'a1 list parser0 **) - -let rec many p steps = - many_helper p Nil steps - -(** val firstExpect : token -> 'a1 parser0 -> 'a1 parser0 **) - -let firstExpect t0 p = function -| Nil -> - NoneE - (append (String ('e', (String ('x', (String ('p', (String ('e', (String - ('c', (String ('t', (String ('e', (String ('d', (String (' ', (String - ('\'', EmptyString)))))))))))))))))))) - (append t0 (String ('\'', (String ('.', EmptyString)))))) -| Cons (x, xs') -> - if string_dec x t0 - then p xs' - else NoneE - (append (String ('e', (String ('x', (String ('p', (String ('e', - (String ('c', (String ('t', (String ('e', (String ('d', (String - (' ', (String ('\'', EmptyString)))))))))))))))))))) - (append t0 (String ('\'', (String ('.', EmptyString)))))) - -(** val expect : token -> unit0 parser0 **) - -let expect t0 = - firstExpect t0 (fun xs -> SomeE (Pair (Tt, xs))) - -(** val parseIdentifier : - (string -> int) -> token list -> (id, token list) prod optionE **) - -let parseIdentifier symtable = function -| Nil -> - NoneE (String ('E', (String ('x', (String ('p', (String ('e', (String ('c', - (String ('t', (String ('e', (String ('d', (String (' ', (String ('i', - (String ('d', (String ('e', (String ('n', (String ('t', (String ('i', - (String ('f', (String ('i', (String ('e', (String ('r', - EmptyString)))))))))))))))))))))))))))))))))))))) -| Cons (x, xs') -> - if forallb isLowerAlpha (list_of_string x) - then SomeE (Pair ((symtable x), xs')) - else NoneE - (append (String ('I', (String ('l', (String ('l', (String ('e', - (String ('g', (String ('a', (String ('l', (String (' ', (String - ('i', (String ('d', (String ('e', (String ('n', (String ('t', - (String ('i', (String ('f', (String ('i', (String ('e', (String - ('r', (String (':', (String ('\'', - EmptyString)))))))))))))))))))))))))))))))))))))))) - (append x (String ('\'', EmptyString)))) - -(** val parseNumber : token list -> (int, token list) prod optionE **) - -let parseNumber = function -| Nil -> - NoneE (String ('E', (String ('x', (String ('p', (String ('e', (String ('c', - (String ('t', (String ('e', (String ('d', (String (' ', (String ('n', - (String ('u', (String ('m', (String ('b', (String ('e', (String ('r', - EmptyString)))))))))))))))))))))))))))))) -| Cons (x, xs') -> - if forallb isDigit (list_of_string x) - then SomeE (Pair - ((fold_left (fun n0 d -> - plus - (mult ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) 0)))))))))) n0) - (minus (nat_of_ascii d) (nat_of_ascii '0'))) (list_of_string x) - 0), xs')) - else NoneE (String ('E', (String ('x', (String ('p', (String ('e', (String - ('c', (String ('t', (String ('e', (String ('d', (String (' ', - (String ('n', (String ('u', (String ('m', (String ('b', (String - ('e', (String ('r', EmptyString)))))))))))))))))))))))))))))) - -(** val parsePrimaryExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE **) - -let rec parsePrimaryExp steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match parseIdentifier symtable xs with - | SomeE p -> let Pair (i, rest) = p in SomeE (Pair ((AId i), rest)) - | NoneE err -> - (match parseNumber xs with - | SomeE p -> let Pair (n0, rest) = p in SomeE (Pair ((ANum n0), rest)) - | NoneE err0 -> - (match firstExpect (String ('(', EmptyString)) - (parseSumExp steps' symtable) xs with - | SomeE p -> - let Pair (e, rest) = p in - (match expect (String (')', EmptyString)) rest with - | SomeE p0 -> - let Pair (u, rest') = p0 in SomeE (Pair (e, rest')) - | NoneE err1 -> NoneE err1) - | NoneE err1 -> NoneE err1))) - steps - -(** val parseProductExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE **) - -and parseProductExp steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match parsePrimaryExp steps' symtable xs with - | SomeE p -> - let Pair (e, rest) = p in - (match many - (firstExpect (String ('*', EmptyString)) - (parsePrimaryExp steps' symtable)) steps' rest with - | SomeE p0 -> - let Pair (es, rest') = p0 in - SomeE (Pair ((fold_left (fun x x0 -> AMult (x, x0)) es e), rest')) - | NoneE err -> NoneE err) - | NoneE err -> NoneE err) - steps - -(** val parseSumExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE **) - -and parseSumExp steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match parseProductExp steps' symtable xs with - | SomeE p -> - let Pair (e, rest) = p in - (match many (fun xs0 -> - match firstExpect (String ('+', EmptyString)) - (parseProductExp steps' symtable) xs0 with - | SomeE p0 -> - let Pair (e0, rest') = p0 in - SomeE (Pair ((Pair (true, e0)), rest')) - | NoneE err -> - (match firstExpect (String ('-', EmptyString)) - (parseProductExp steps' symtable) xs0 with - | SomeE p0 -> - let Pair (e0, rest') = p0 in - SomeE (Pair ((Pair (false, e0)), rest')) - | NoneE err0 -> NoneE err0)) steps' rest with - | SomeE p0 -> - let Pair (es, rest') = p0 in - SomeE (Pair - ((fold_left (fun e0 term -> - let Pair (y, e1) = term in - if y then APlus (e0, e1) else AMinus (e0, e1)) es e), rest')) - | NoneE err -> NoneE err) - | NoneE err -> NoneE err) - steps - -(** val parseAExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE **) - -let parseAExp = - parseSumExp - -(** val parseAtomicExp : - int -> (string -> int) -> token list -> (bexp, token list) prod optionE **) - -let rec parseAtomicExp steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match expect (String ('t', (String ('r', (String ('u', (String ('e', - EmptyString)))))))) xs with - | SomeE p -> let Pair (u, rest) = p in SomeE (Pair (BTrue, rest)) - | NoneE err -> - (match expect (String ('f', (String ('a', (String ('l', (String ('s', - (String ('e', EmptyString)))))))))) xs with - | SomeE p -> let Pair (u, rest) = p in SomeE (Pair (BFalse, rest)) - | NoneE err0 -> - (match firstExpect (String ('n', (String ('o', (String ('t', - EmptyString)))))) (parseAtomicExp steps' symtable) xs with - | SomeE p -> - let Pair (e, rest) = p in SomeE (Pair ((BNot e), rest)) - | NoneE err1 -> - (match firstExpect (String ('(', EmptyString)) - (parseConjunctionExp steps' symtable) xs with - | SomeE p -> - let Pair (e, rest) = p in - (match expect (String (')', EmptyString)) rest with - | SomeE p0 -> - let Pair (u, rest') = p0 in SomeE (Pair (e, rest')) - | NoneE err2 -> NoneE err2) - | NoneE err2 -> - (match parseProductExp steps' symtable xs with - | SomeE p -> - let Pair (e, rest) = p in - (match firstExpect (String ('=', (String ('=', - EmptyString)))) (parseAExp steps' symtable) rest with - | SomeE p0 -> - let Pair (e', rest') = p0 in - SomeE (Pair ((BEq (e, e')), rest')) - | NoneE err3 -> - (match firstExpect (String ('<', (String ('=', - EmptyString)))) (parseAExp steps' symtable) - rest with - | SomeE p0 -> - let Pair (e', rest') = p0 in - SomeE (Pair ((BLe (e, e')), rest')) - | NoneE err4 -> - NoneE (String ('E', (String ('x', (String ('p', - (String ('e', (String ('c', (String ('t', (String - ('e', (String ('d', (String (' ', (String ('\'', - (String ('=', (String ('=', (String ('\'', (String - (' ', (String ('o', (String ('r', (String (' ', - (String ('\'', (String ('<', (String ('=', (String - ('\'', (String (' ', (String ('a', (String ('f', - (String ('t', (String ('e', (String ('r', (String - (' ', (String ('a', (String ('r', (String ('i', - (String ('t', (String ('h', (String ('m', (String - ('e', (String ('t', (String ('i', (String ('c', - (String (' ', (String ('e', (String ('x', (String - ('p', (String ('r', (String ('e', (String ('s', - (String ('s', (String ('i', (String ('o', (String - ('n', - EmptyString)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - | NoneE err3 -> NoneE err3))))) - steps - -(** val parseConjunctionExp : - int -> (string -> int) -> token list -> (bexp, token list) prod optionE **) - -and parseConjunctionExp steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match parseAtomicExp steps' symtable xs with - | SomeE p -> - let Pair (e, rest) = p in - (match many - (firstExpect (String ('&', (String ('&', EmptyString)))) - (parseAtomicExp steps' symtable)) steps' rest with - | SomeE p0 -> - let Pair (es, rest') = p0 in - SomeE (Pair ((fold_left (fun x x0 -> BAnd (x, x0)) es e), rest')) - | NoneE err -> NoneE err) - | NoneE err -> NoneE err) - steps - -(** val parseBExp : - int -> (string -> int) -> token list -> (bexp, token list) prod optionE **) - -let parseBExp = - parseConjunctionExp - -(** val parseSimpleCommand : - int -> (string -> int) -> token list -> (com, token list) prod optionE **) - -let rec parseSimpleCommand steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match expect (String ('S', (String ('K', (String ('I', (String ('P', - EmptyString)))))))) xs with - | SomeE p -> let Pair (u, rest) = p in SomeE (Pair (CSkip, rest)) - | NoneE err -> - (match firstExpect (String ('I', (String ('F', EmptyString)))) - (parseBExp steps' symtable) xs with - | SomeE p -> - let Pair (e, rest) = p in - (match firstExpect (String ('T', (String ('H', (String ('E', (String - ('N', EmptyString)))))))) - (parseSequencedCommand steps' symtable) rest with - | SomeE p0 -> - let Pair (c, rest') = p0 in - (match firstExpect (String ('E', (String ('L', (String ('S', - (String ('E', EmptyString)))))))) - (parseSequencedCommand steps' symtable) rest' with - | SomeE p1 -> - let Pair (c', rest'') = p1 in - (match expect (String ('E', (String ('N', (String ('D', - EmptyString)))))) rest'' with - | SomeE p2 -> - let Pair (u, rest''') = p2 in - SomeE (Pair ((CIf (e, c, c')), rest''')) - | NoneE err0 -> NoneE err0) - | NoneE err0 -> NoneE err0) - | NoneE err0 -> NoneE err0) - | NoneE err0 -> - (match firstExpect (String ('W', (String ('H', (String ('I', (String - ('L', (String ('E', EmptyString)))))))))) - (parseBExp steps' symtable) xs with - | SomeE p -> - let Pair (e, rest) = p in - (match firstExpect (String ('D', (String ('O', EmptyString)))) - (parseSequencedCommand steps' symtable) rest with - | SomeE p0 -> - let Pair (c, rest') = p0 in - (match expect (String ('E', (String ('N', (String ('D', - EmptyString)))))) rest' with - | SomeE p1 -> - let Pair (u, rest'') = p1 in - SomeE (Pair ((CWhile (e, c)), rest'')) - | NoneE err1 -> NoneE err1) - | NoneE err1 -> NoneE err1) - | NoneE err1 -> - (match parseIdentifier symtable xs with - | SomeE p -> - let Pair (i, rest) = p in - (match firstExpect (String (':', (String ('=', EmptyString)))) - (parseAExp steps' symtable) rest with - | SomeE p0 -> - let Pair (e, rest') = p0 in - SomeE (Pair ((CAss (i, e)), rest')) - | NoneE err2 -> NoneE err2) - | NoneE err2 -> NoneE err2)))) - steps - -(** val parseSequencedCommand : - int -> (string -> int) -> token list -> (com, token list) prod optionE **) - -and parseSequencedCommand steps symtable xs = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> NoneE (String ('T', (String ('o', (String ('o', (String (' ', - (String ('m', (String ('a', (String ('n', (String ('y', (String (' ', - (String ('r', (String ('e', (String ('c', (String ('u', (String ('r', - (String ('s', (String ('i', (String ('v', (String ('e', (String (' ', - (String ('c', (String ('a', (String ('l', (String ('l', (String ('s', - EmptyString))))))))))))))))))))))))))))))))))))))))))))))))) - (fun steps' -> - match parseSimpleCommand steps' symtable xs with - | SomeE p -> - let Pair (c, rest) = p in - (match firstExpect (String (';', (String (';', EmptyString)))) - (parseSequencedCommand steps' symtable) rest with - | SomeE p0 -> - let Pair (c', rest') = p0 in SomeE (Pair ((CSeq (c, c')), rest')) - | NoneE err -> SomeE (Pair (c, rest))) - | NoneE err -> NoneE err) - steps - -(** val bignumber : int **) - -let bignumber = - (fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) - 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - -(** val parse : string -> (com, token list) prod optionE **) - -let parse str = - let tokens = tokenize str in - parseSequencedCommand bignumber (build_symtable tokens 0) tokens - diff --git a/imp.mli b/imp.mli deleted file mode 100644 index 0280ad5..0000000 --- a/imp.mli +++ /dev/null @@ -1,809 +0,0 @@ -type __ = Obj.t - -type unit0 = -| Tt - -val negb : bool -> bool - -type 'a option = -| Some of 'a -| None - -type ('a, 'b) prod = -| Pair of 'a * 'b - -val fst : ('a1, 'a2) prod -> 'a1 - -val snd : ('a1, 'a2) prod -> 'a2 - -type 'a list = -| Nil -| Cons of 'a * 'a list - -val app : 'a1 list -> 'a1 list -> 'a1 list - -type comparison = -| Eq -| Lt -| Gt - -type compareSpecT = -| CompEqT -| CompLtT -| CompGtT - -val compareSpec2Type : comparison -> compareSpecT - -type 'a compSpecT = compareSpecT - -val compSpec2Type : 'a1 -> 'a1 -> comparison -> 'a1 compSpecT - -type 'a sig0 = - 'a - (* singleton inductive, whose constructor was exist *) - -type 'a sumor = -| Inleft of 'a -| Inright - -val plus : int -> int -> int - -val mult : int -> int -> int - -val minus : int -> int -> int - -val nat_iter : int -> ('a1 -> 'a1) -> 'a1 -> 'a1 - -type positive = -| XI of positive -| XO of positive -| XH - -type n = -| N0 -| Npos of positive - -type reflect = -| ReflectT -| ReflectF - -val iff_reflect : bool -> reflect - -module type TotalOrder' = - sig - type t - end - -module MakeOrderTac : - functor (O:TotalOrder') -> - sig - - end - -module MaxLogicalProperties : - functor (O:TotalOrder') -> - functor (M:sig - val max : O.t -> O.t -> O.t - end) -> - sig - module Private_Tac : - sig - - end - end - -module Pos : - sig - type t = positive - - val succ : positive -> positive - - val add : positive -> positive -> positive - - val add_carry : positive -> positive -> positive - - val pred_double : positive -> positive - - val pred : positive -> positive - - val pred_N : positive -> n - - type mask = - | IsNul - | IsPos of positive - | IsNeg - - val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 - - val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 - - val succ_double_mask : mask -> mask - - val double_mask : mask -> mask - - val double_pred_mask : positive -> mask - - val pred_mask : mask -> mask - - val sub_mask : positive -> positive -> mask - - val sub_mask_carry : positive -> positive -> mask - - val sub : positive -> positive -> positive - - val mul : positive -> positive -> positive - - val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 - - val pow : positive -> positive -> positive - - val square : positive -> positive - - val div2 : positive -> positive - - val div2_up : positive -> positive - - val size_nat : positive -> int - - val size : positive -> positive - - val compare_cont : positive -> positive -> comparison -> comparison - - val compare : positive -> positive -> comparison - - val min : positive -> positive -> positive - - val max : positive -> positive -> positive - - val eqb : positive -> positive -> bool - - val leb : positive -> positive -> bool - - val ltb : positive -> positive -> bool - - val sqrtrem_step : - (positive -> positive) -> (positive -> positive) -> (positive, mask) prod - -> (positive, mask) prod - - val sqrtrem : positive -> (positive, mask) prod - - val sqrt : positive -> positive - - val gcdn : int -> positive -> positive -> positive - - val gcd : positive -> positive -> positive - - val ggcdn : - int -> positive -> positive -> (positive, (positive, positive) prod) prod - - val ggcd : - positive -> positive -> (positive, (positive, positive) prod) prod - - val coq_Nsucc_double : n -> n - - val coq_Ndouble : n -> n - - val coq_lor : positive -> positive -> positive - - val coq_land : positive -> positive -> n - - val ldiff : positive -> positive -> n - - val coq_lxor : positive -> positive -> n - - val shiftl_nat : positive -> int -> positive - - val shiftr_nat : positive -> int -> positive - - val shiftl : positive -> n -> positive - - val shiftr : positive -> n -> positive - - val testbit_nat : positive -> int -> bool - - val testbit : positive -> n -> bool - - val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 - - val to_nat : positive -> int - - val of_nat : int -> positive - - val of_succ_nat : int -> positive - end - -module Coq_Pos : - sig - type t = positive - - val succ : positive -> positive - - val add : positive -> positive -> positive - - val add_carry : positive -> positive -> positive - - val pred_double : positive -> positive - - val pred : positive -> positive - - val pred_N : positive -> n - - type mask = Pos.mask = - | IsNul - | IsPos of positive - | IsNeg - - val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 - - val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 - - val succ_double_mask : mask -> mask - - val double_mask : mask -> mask - - val double_pred_mask : positive -> mask - - val pred_mask : mask -> mask - - val sub_mask : positive -> positive -> mask - - val sub_mask_carry : positive -> positive -> mask - - val sub : positive -> positive -> positive - - val mul : positive -> positive -> positive - - val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 - - val pow : positive -> positive -> positive - - val square : positive -> positive - - val div2 : positive -> positive - - val div2_up : positive -> positive - - val size_nat : positive -> int - - val size : positive -> positive - - val compare_cont : positive -> positive -> comparison -> comparison - - val compare : positive -> positive -> comparison - - val min : positive -> positive -> positive - - val max : positive -> positive -> positive - - val eqb : positive -> positive -> bool - - val leb : positive -> positive -> bool - - val ltb : positive -> positive -> bool - - val sqrtrem_step : - (positive -> positive) -> (positive -> positive) -> (positive, mask) prod - -> (positive, mask) prod - - val sqrtrem : positive -> (positive, mask) prod - - val sqrt : positive -> positive - - val gcdn : int -> positive -> positive -> positive - - val gcd : positive -> positive -> positive - - val ggcdn : - int -> positive -> positive -> (positive, (positive, positive) prod) prod - - val ggcd : - positive -> positive -> (positive, (positive, positive) prod) prod - - val coq_Nsucc_double : n -> n - - val coq_Ndouble : n -> n - - val coq_lor : positive -> positive -> positive - - val coq_land : positive -> positive -> n - - val ldiff : positive -> positive -> n - - val coq_lxor : positive -> positive -> n - - val shiftl_nat : positive -> int -> positive - - val shiftr_nat : positive -> int -> positive - - val shiftl : positive -> n -> positive - - val shiftr : positive -> n -> positive - - val testbit_nat : positive -> int -> bool - - val testbit : positive -> n -> bool - - val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 - - val to_nat : positive -> int - - val of_nat : int -> positive - - val of_succ_nat : int -> positive - - val eq_dec : positive -> positive -> bool - - val peano_rect : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1 - - val peano_rec : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1 - - type coq_PeanoView = - | PeanoOne - | PeanoSucc of positive * coq_PeanoView - - val coq_PeanoView_rect : - 'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive -> - coq_PeanoView -> 'a1 - - val coq_PeanoView_rec : - 'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive -> - coq_PeanoView -> 'a1 - - val peanoView_xO : positive -> coq_PeanoView -> coq_PeanoView - - val peanoView_xI : positive -> coq_PeanoView -> coq_PeanoView - - val peanoView : positive -> coq_PeanoView - - val coq_PeanoView_iter : - 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> coq_PeanoView -> 'a1 - - val eqb_spec : positive -> positive -> reflect - - val switch_Eq : comparison -> comparison -> comparison - - val mask2cmp : mask -> comparison - - val leb_spec0 : positive -> positive -> reflect - - val ltb_spec0 : positive -> positive -> reflect - - module Private_Tac : - sig - - end - - module Private_Rev : - sig - module ORev : - sig - type t = positive - end - - module MRev : - sig - val max : positive -> positive -> positive - end - - module MPRev : - sig - module Private_Tac : - sig - - end - end - end - - module Private_Dec : - sig - val max_case_strong : - positive -> positive -> (positive -> positive -> __ -> 'a1 -> 'a1) -> - (__ -> 'a1) -> (__ -> 'a1) -> 'a1 - - val max_case : - positive -> positive -> (positive -> positive -> __ -> 'a1 -> 'a1) -> - 'a1 -> 'a1 -> 'a1 - - val max_dec : positive -> positive -> bool - - val min_case_strong : - positive -> positive -> (positive -> positive -> __ -> 'a1 -> 'a1) -> - (__ -> 'a1) -> (__ -> 'a1) -> 'a1 - - val min_case : - positive -> positive -> (positive -> positive -> __ -> 'a1 -> 'a1) -> - 'a1 -> 'a1 -> 'a1 - - val min_dec : positive -> positive -> bool - end - - val max_case_strong : - positive -> positive -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 - - val max_case : positive -> positive -> 'a1 -> 'a1 -> 'a1 - - val max_dec : positive -> positive -> bool - - val min_case_strong : - positive -> positive -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 - - val min_case : positive -> positive -> 'a1 -> 'a1 -> 'a1 - - val min_dec : positive -> positive -> bool - end - -module N : - sig - type t = n - - val zero : n - - val one : n - - val two : n - - val succ_double : n -> n - - val double : n -> n - - val succ : n -> n - - val pred : n -> n - - val succ_pos : n -> positive - - val add : n -> n -> n - - val sub : n -> n -> n - - val mul : n -> n -> n - - val compare : n -> n -> comparison - - val eqb : n -> n -> bool - - val leb : n -> n -> bool - - val ltb : n -> n -> bool - - val min : n -> n -> n - - val max : n -> n -> n - - val div2 : n -> n - - val even : n -> bool - - val odd : n -> bool - - val pow : n -> n -> n - - val square : n -> n - - val log2 : n -> n - - val size : n -> n - - val size_nat : n -> int - - val pos_div_eucl : positive -> n -> (n, n) prod - - val div_eucl : n -> n -> (n, n) prod - - val div : n -> n -> n - - val modulo : n -> n -> n - - val gcd : n -> n -> n - - val ggcd : n -> n -> (n, (n, n) prod) prod - - val sqrtrem : n -> (n, n) prod - - val sqrt : n -> n - - val coq_lor : n -> n -> n - - val coq_land : n -> n -> n - - val ldiff : n -> n -> n - - val coq_lxor : n -> n -> n - - val shiftl_nat : n -> int -> n - - val shiftr_nat : n -> int -> n - - val shiftl : n -> n -> n - - val shiftr : n -> n -> n - - val testbit_nat : n -> int -> bool - - val testbit : n -> n -> bool - - val to_nat : n -> int - - val of_nat : int -> n - - val iter : n -> ('a1 -> 'a1) -> 'a1 -> 'a1 - - val eq_dec : n -> n -> bool - - val discr : n -> positive sumor - - val binary_rect : 'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1 - - val binary_rec : 'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1 - - val peano_rect : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 - - val peano_rec : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 - - val leb_spec0 : n -> n -> reflect - - val ltb_spec0 : n -> n -> reflect - - module Private_BootStrap : - sig - - end - - val recursion : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 - - module Private_OrderTac : - sig - module Elts : - sig - type t = n - end - - module Tac : - sig - - end - end - - module Private_NZPow : - sig - - end - - module Private_NZSqrt : - sig - - end - - val sqrt_up : n -> n - - val log2_up : n -> n - - module Private_NZDiv : - sig - - end - - val lcm : n -> n -> n - - val eqb_spec : n -> n -> reflect - - val b2n : bool -> n - - val setbit : n -> n -> n - - val clearbit : n -> n -> n - - val ones : n -> n - - val lnot : n -> n -> n - - module Private_Tac : - sig - - end - - module Private_Rev : - sig - module ORev : - sig - type t = n - end - - module MRev : - sig - val max : n -> n -> n - end - - module MPRev : - sig - module Private_Tac : - sig - - end - end - end - - module Private_Dec : - sig - val max_case_strong : - n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) -> - 'a1 - - val max_case : - n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 - - val max_dec : n -> n -> bool - - val min_case_strong : - n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) -> - 'a1 - - val min_case : - n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 - - val min_dec : n -> n -> bool - end - - val max_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 - - val max_case : n -> n -> 'a1 -> 'a1 -> 'a1 - - val max_dec : n -> n -> bool - - val min_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 - - val min_case : n -> n -> 'a1 -> 'a1 -> 'a1 - - val min_dec : n -> n -> bool - end - -val eq_nat_dec : int -> int -> bool - -val beq_nat : int -> int -> bool - -val rev : 'a1 list -> 'a1 list - -val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list - -val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a2 list -> 'a1 -> 'a1 - -val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1 - -val forallb : ('a1 -> bool) -> 'a1 list -> bool - -val n_of_digits : bool list -> n - -val n_of_ascii : char -> n - -val nat_of_ascii : char -> int - -type string = -| EmptyString -| String of char * string - -val string_dec : string -> string -> bool - -val append : string -> string -> string - -val ble_nat : int -> int -> bool - -type id = - int - (* singleton inductive, whose constructor was Id *) - -val eq_id_dec : id -> id -> bool - -type state = id -> int - -val empty_state : state - -val update : state -> id -> int -> state - -type aexp = -| ANum of int -| AId of id -| APlus of aexp * aexp -| AMinus of aexp * aexp -| AMult of aexp * aexp - -type bexp = -| BTrue -| BFalse -| BEq of aexp * aexp -| BLe of aexp * aexp -| BNot of bexp -| BAnd of bexp * bexp - -val aeval : state -> aexp -> int - -val beval : state -> bexp -> bool - -type com = -| CSkip -| CAss of id * aexp -| CSeq of com * com -| CIf of bexp * com * com -| CWhile of bexp * com - -val ceval_step : state -> com -> int -> state option - -val isWhite : char -> bool - -val isLowerAlpha : char -> bool - -val isAlpha : char -> bool - -val isDigit : char -> bool - -type chartype = -| White -| Alpha -| Digit -| Other - -val classifyChar : char -> chartype - -val list_of_string : string -> char list - -val string_of_list : char list -> string - -type token = string - -val tokenize_helper : chartype -> char list -> char list -> char list list - -val tokenize : string -> string list - -type 'x optionE = -| SomeE of 'x -| NoneE of string - -val build_symtable : token list -> int -> token -> int - -type 't parser0 = token list -> ('t, token list) prod optionE - -val many_helper : - 'a1 parser0 -> 'a1 list -> int -> token list -> ('a1 list, token list) prod - optionE - -val many : 'a1 parser0 -> int -> 'a1 list parser0 - -val firstExpect : token -> 'a1 parser0 -> 'a1 parser0 - -val expect : token -> unit0 parser0 - -val parseIdentifier : - (string -> int) -> token list -> (id, token list) prod optionE - -val parseNumber : token list -> (int, token list) prod optionE - -val parsePrimaryExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE - -val parseProductExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE - -val parseSumExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE - -val parseAExp : - int -> (string -> int) -> token list -> (aexp, token list) prod optionE - -val parseAtomicExp : - int -> (string -> int) -> token list -> (bexp, token list) prod optionE - -val parseConjunctionExp : - int -> (string -> int) -> token list -> (bexp, token list) prod optionE - -val parseBExp : - int -> (string -> int) -> token list -> (bexp, token list) prod optionE - -val parseSimpleCommand : - int -> (string -> int) -> token list -> (com, token list) prod optionE - -val parseSequencedCommand : - int -> (string -> int) -> token list -> (com, token list) prod optionE - -val bignumber : int - -val parse : string -> (com, token list) prod optionE - diff --git a/imp1.ml b/imp1.ml deleted file mode 100644 index e141d30..0000000 --- a/imp1.ml +++ /dev/null @@ -1,168 +0,0 @@ -type bool = -| True -| False - -(** val negb : bool -> bool **) - -let negb = function -| True -> False -| False -> True - -type nat = -| O -| S of nat - -type 'a option = -| Some of 'a -| None - -type sumbool = -| Left -| Right - -(** val plus : nat -> nat -> nat **) - -let rec plus n m = - match n with - | O -> m - | S p -> S (plus p m) - -(** val mult : nat -> nat -> nat **) - -let rec mult n m = - match n with - | O -> O - | S p -> plus m (mult p m) - -(** val minus : nat -> nat -> nat **) - -let rec minus n m = - match n with - | O -> n - | S k -> - (match m with - | O -> n - | S l -> minus k l) - -(** val eq_nat_dec : nat -> nat -> sumbool **) - -let rec eq_nat_dec n m = - match n with - | O -> - (match m with - | O -> Left - | S m0 -> Right) - | S n0 -> - (match m with - | O -> Right - | S m0 -> eq_nat_dec n0 m0) - -(** val beq_nat : nat -> nat -> bool **) - -let rec beq_nat n m = - match n with - | O -> - (match m with - | O -> True - | S n0 -> False) - | S n1 -> - (match m with - | O -> False - | S m1 -> beq_nat n1 m1) - -(** val ble_nat : nat -> nat -> bool **) - -let rec ble_nat n m = - match n with - | O -> True - | S n' -> - (match m with - | O -> False - | S m' -> ble_nat n' m') - -type id = - nat - (* singleton inductive, whose constructor was Id *) - -(** val eq_id_dec : id -> id -> sumbool **) - -let eq_id_dec id1 id2 = - eq_nat_dec id1 id2 - -type state = id -> nat - -(** val update : state -> id -> nat -> state **) - -let update st x n x' = - match eq_id_dec x x' with - | Left -> n - | Right -> st x' - -type aexp = -| ANum of nat -| AId of id -| APlus of aexp * aexp -| AMinus of aexp * aexp -| AMult of aexp * aexp - -type bexp = -| BTrue -| BFalse -| BEq of aexp * aexp -| BLe of aexp * aexp -| BNot of bexp -| BAnd of bexp * bexp - -(** val aeval : state -> aexp -> nat **) - -let rec aeval st = function -| ANum n -> n -| AId x -> st x -| APlus (a1, a2) -> plus (aeval st a1) (aeval st a2) -| AMinus (a1, a2) -> minus (aeval st a1) (aeval st a2) -| AMult (a1, a2) -> mult (aeval st a1) (aeval st a2) - -(** val beval : state -> bexp -> bool **) - -let rec beval st = function -| BTrue -> True -| BFalse -> False -| BEq (a1, a2) -> beq_nat (aeval st a1) (aeval st a2) -| BLe (a1, a2) -> ble_nat (aeval st a1) (aeval st a2) -| BNot b1 -> negb (beval st b1) -| BAnd (b1, b2) -> - (match beval st b1 with - | True -> beval st b2 - | False -> False) - -type com = -| CSkip -| CAss of id * aexp -| CSeq of com * com -| CIf of bexp * com * com -| CWhile of bexp * com - -(** val ceval_step : state -> com -> nat -> state option **) - -let rec ceval_step st c = function -| O -> None -| S i' -> - (match c with - | CSkip -> Some st - | CAss (l, a1) -> Some (update st l (aeval st a1)) - | CSeq (c1, c2) -> - (match ceval_step st c1 i' with - | Some st' -> ceval_step st' c2 i' - | None -> None) - | CIf (b, c1, c2) -> - (match beval st b with - | True -> ceval_step st c1 i' - | False -> ceval_step st c2 i') - | CWhile (b1, c1) -> - (match beval st b1 with - | True -> - (match ceval_step st c1 i' with - | Some st' -> ceval_step st' c i' - | None -> None) - | False -> Some st)) - diff --git a/imp1.mli b/imp1.mli deleted file mode 100644 index ae13b58..0000000 --- a/imp1.mli +++ /dev/null @@ -1,68 +0,0 @@ -type bool = -| True -| False - -val negb : bool -> bool - -type nat = -| O -| S of nat - -type 'a option = -| Some of 'a -| None - -type sumbool = -| Left -| Right - -val plus : nat -> nat -> nat - -val mult : nat -> nat -> nat - -val minus : nat -> nat -> nat - -val eq_nat_dec : nat -> nat -> sumbool - -val beq_nat : nat -> nat -> bool - -val ble_nat : nat -> nat -> bool - -type id = - nat - (* singleton inductive, whose constructor was Id *) - -val eq_id_dec : id -> id -> sumbool - -type state = id -> nat - -val update : state -> id -> nat -> state - -type aexp = -| ANum of nat -| AId of id -| APlus of aexp * aexp -| AMinus of aexp * aexp -| AMult of aexp * aexp - -type bexp = -| BTrue -| BFalse -| BEq of aexp * aexp -| BLe of aexp * aexp -| BNot of bexp -| BAnd of bexp * bexp - -val aeval : state -> aexp -> nat - -val beval : state -> bexp -> bool - -type com = -| CSkip -| CAss of id * aexp -| CSeq of com * com -| CIf of bexp * com * com -| CWhile of bexp * com - -val ceval_step : state -> com -> nat -> state option - diff --git a/imp2.ml b/imp2.ml deleted file mode 100644 index abb86bd..0000000 --- a/imp2.ml +++ /dev/null @@ -1,167 +0,0 @@ -(** val negb : bool -> bool **) - -let negb = function -| true -> false -| false -> true - -type 'a option = -| Some of 'a -| None - -type sumbool = -| Left -| Right - -(** val plus : int -> int -> int **) - -let rec plus = ( + ) - -(** val mult : int -> int -> int **) - -let rec mult = ( * ) - -(** val minus : int -> int -> int **) - -let rec minus n m = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - n) - (fun k -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - n) - (fun l -> - minus k l) - m) - n - -(** val eq_nat_dec : int -> int -> sumbool **) - -let rec eq_nat_dec n m = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - Left) - (fun m0 -> - Right) - m) - (fun n0 -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - Right) - (fun m0 -> - eq_nat_dec n0 m0) - m) - n - -(** val beq_nat : int -> int -> bool **) - -let rec beq_nat = ( = ) - -(** val ble_nat : int -> int -> bool **) - -let rec ble_nat n m = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - true) - (fun n' -> - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - false) - (fun m' -> - ble_nat n' m') - m) - n - -type id = - int - (* singleton inductive, whose constructor was Id *) - -(** val eq_id_dec : id -> id -> sumbool **) - -let eq_id_dec id1 id2 = - eq_nat_dec id1 id2 - -type state = id -> int - -(** val update : state -> id -> int -> state **) - -let update st x n x' = - match eq_id_dec x x' with - | Left -> n - | Right -> st x' - -type aexp = -| ANum of int -| AId of id -| APlus of aexp * aexp -| AMinus of aexp * aexp -| AMult of aexp * aexp - -type bexp = -| BTrue -| BFalse -| BEq of aexp * aexp -| BLe of aexp * aexp -| BNot of bexp -| BAnd of bexp * bexp - -(** val aeval : state -> aexp -> int **) - -let rec aeval st = function -| ANum n -> n -| AId x -> st x -| APlus (a1, a2) -> plus (aeval st a1) (aeval st a2) -| AMinus (a1, a2) -> minus (aeval st a1) (aeval st a2) -| AMult (a1, a2) -> mult (aeval st a1) (aeval st a2) - -(** val beval : state -> bexp -> bool **) - -let rec beval st = function -| BTrue -> true -| BFalse -> false -| BEq (a1, a2) -> beq_nat (aeval st a1) (aeval st a2) -| BLe (a1, a2) -> ble_nat (aeval st a1) (aeval st a2) -| BNot b1 -> negb (beval st b1) -| BAnd (b1, b2) -> if beval st b1 then beval st b2 else false - -type com = -| CSkip -| CAss of id * aexp -| CSeq of com * com -| CIf of bexp * com * com -| CWhile of bexp * com - -(** val ceval_step : state -> com -> int -> state option **) - -let rec ceval_step st c i = - (fun zero succ n -> - if n=0 then zero () else succ (n-1)) - (fun _ -> - None) - (fun i' -> - match c with - | CSkip -> Some st - | CAss (l, a1) -> Some (update st l (aeval st a1)) - | CSeq (c1, c2) -> - (match ceval_step st c1 i' with - | Some st' -> ceval_step st' c2 i' - | None -> None) - | CIf (b, c1, c2) -> - if beval st b then ceval_step st c1 i' else ceval_step st c2 i' - | CWhile (b1, c1) -> - if beval st b1 - then (match ceval_step st c1 i' with - | Some st' -> ceval_step st' c i' - | None -> None) - else Some st) - i - diff --git a/imp2.mli b/imp2.mli deleted file mode 100644 index 5b12dd9..0000000 --- a/imp2.mli +++ /dev/null @@ -1,60 +0,0 @@ -val negb : bool -> bool - -type 'a option = -| Some of 'a -| None - -type sumbool = -| Left -| Right - -val plus : int -> int -> int - -val mult : int -> int -> int - -val minus : int -> int -> int - -val eq_nat_dec : int -> int -> sumbool - -val beq_nat : int -> int -> bool - -val ble_nat : int -> int -> bool - -type id = - int - (* singleton inductive, whose constructor was Id *) - -val eq_id_dec : id -> id -> sumbool - -type state = id -> int - -val update : state -> id -> int -> state - -type aexp = -| ANum of int -| AId of id -| APlus of aexp * aexp -| AMinus of aexp * aexp -| AMult of aexp * aexp - -type bexp = -| BTrue -| BFalse -| BEq of aexp * aexp -| BLe of aexp * aexp -| BNot of bexp -| BAnd of bexp * bexp - -val aeval : state -> aexp -> int - -val beval : state -> bexp -> bool - -type com = -| CSkip -| CAss of id * aexp -| CSeq of com * com -| CIf of bexp * com * com -| CWhile of bexp * com - -val ceval_step : state -> com -> int -> state option - diff --git a/impdriver.ml b/impdriver.ml deleted file mode 100644 index 8a32855..0000000 --- a/impdriver.ml +++ /dev/null @@ -1,39 +0,0 @@ -open Imp - -let explode s = - let rec exp i l = - if i < 0 then l else exp (i - 1) (s.[i] :: l) in - exp (String.length s - 1) [];; - -let tweak_string s = - let ss = explode s in - let rec loop = function - [] -> EmptyString - | h::t -> String (h, loop t) - in loop ss;; - -let test s = - print_endline s; - let parse_res = parse (tweak_string s) in - (match parse_res with - NoneE _ -> print_endline ("Syntax error"); - | SomeE (Pair (c, _)) -> - let fuel = 1000 in - match (ceval_step empty_state c fuel) with - None -> print_endline ("Still running after " ^ string_of_int fuel ^ " steps") - | Some res -> - print_endline ("Result: [" ^ string_of_int (res 0) - ^ " " ^ string_of_int (res 1) - ^ " " ^ string_of_int (res 2) - ^ " " ^ string_of_int (res 3) - ^ " ...]")); - print_newline(); -;; - -test "true";; -test "SKIP";; -test "SKIP;SKIP";; -test "WHILE true DO SKIP END";; -test "x:=3";; -test "x:=3; WHILE 0<=x DO SKIP END";; -test "x:=3; WHILE 1<=x DO y:=y+1; x:=x-1 END";; diff --git a/index-bg.jpg b/index-bg.jpg deleted file mode 100644 index a0547ef..0000000 Binary files a/index-bg.jpg and /dev/null differ diff --git a/index.html b/index.html deleted file mode 100644 index 9388e49..0000000 --- a/index.html +++ /dev/null @@ -1,93 +0,0 @@ - - - - - - -Software Foundations - - - - -
-
- -
- -
- ]", "i"), - rcheckableType = /^(?:checkbox|radio)$/, - // checked="checked" or checked - rchecked = /checked\s*(?:[^=]|=\s*.checked.)/i, - rscriptType = /\/(java|ecma)script/i, - rcleanScript = /^\s*\s*$/g, - wrapMap = { - option: [ 1, "" ], - legend: [ 1, "
", "
" ], - thead: [ 1, "
-
-
-
- Software Foundations -
-
-
-

-

- Benjamin C. Pierce
- Chris Casinghino
- Marco Gaboardi
- Michael Greenberg
- Cătălin Hriţcu
- Vilhelm Sjberg
- Brent Yorgey -
-

-

-

- with - Loris D'Antoni, - Andrew W. Appel, - Arthur Azevedo de Amorim, - Arthur Chargueraud, - Anthony Cowley, - Jeffrey Foster, - Dmitri Garbuzov, - Michael Hicks, - Ranjit Jhala, - Greg Morrisett, - Jennifer Paykin, - Mukund Raghothaman, - Chung-chieh Shan, - Leonid Spesivtsev, - Andrew Tolmach, - and - Steve Zdancewic -
-

- -
-
- -
- - - - -
- - Contents - - Overview - - Download -
-
- -
-
-
- Version 3.0 (June 2014) -
-
- - - - - diff --git a/jquery-1.8.3.js b/jquery-1.8.3.js deleted file mode 100644 index a86bf79..0000000 --- a/jquery-1.8.3.js +++ /dev/null @@ -1,9472 +0,0 @@ -/*! - * jQuery JavaScript Library v1.8.3 - * http://jquery.com/ - * - * Includes Sizzle.js - * http://sizzlejs.com/ - * - * Copyright 2012 jQuery Foundation and other contributors - * Released under the MIT license - * http://jquery.org/license - * - * Date: Tue Nov 13 2012 08:20:33 GMT-0500 (Eastern Standard Time) - */ -(function( window, undefined ) { -var - // A central reference to the root jQuery(document) - rootjQuery, - - // The deferred used on DOM ready - readyList, - - // Use the correct document accordingly with window argument (sandbox) - document = window.document, - location = window.location, - navigator = window.navigator, - - // Map over jQuery in case of overwrite - _jQuery = window.jQuery, - - // Map over the $ in case of overwrite - _$ = window.$, - - // Save a reference to some core methods - core_push = Array.prototype.push, - core_slice = Array.prototype.slice, - core_indexOf = Array.prototype.indexOf, - core_toString = Object.prototype.toString, - core_hasOwn = Object.prototype.hasOwnProperty, - core_trim = String.prototype.trim, - - // Define a local copy of jQuery - jQuery = function( selector, context ) { - // The jQuery object is actually just the init constructor 'enhanced' - return new jQuery.fn.init( selector, context, rootjQuery ); - }, - - // Used for matching numbers - core_pnum = /[\-+]?(?:\d*\.|)\d+(?:[eE][\-+]?\d+|)/.source, - - // Used for detecting and trimming whitespace - core_rnotwhite = /\S/, - core_rspace = /\s+/, - - // Make sure we trim BOM and NBSP (here's looking at you, Safari 5.0 and IE) - rtrim = /^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g, - - // A simple way to check for HTML strings - // Prioritize #id over to avoid XSS via location.hash (#9521) - rquickExpr = /^(?:[^#<]*(<[\w\W]+>)[^>]*$|#([\w\-]*)$)/, - - // Match a standalone tag - rsingleTag = /^<(\w+)\s*\/?>(?:<\/\1>|)$/, - - // JSON RegExp - rvalidchars = /^[\],:{}\s]*$/, - rvalidbraces = /(?:^|:|,)(?:\s*\[)+/g, - rvalidescape = /\\(?:["\\\/bfnrt]|u[\da-fA-F]{4})/g, - rvalidtokens = /"[^"\\\r\n]*"|true|false|null|-?(?:\d\d*\.|)\d+(?:[eE][\-+]?\d+|)/g, - - // Matches dashed string for camelizing - rmsPrefix = /^-ms-/, - rdashAlpha = /-([\da-z])/gi, - - // Used by jQuery.camelCase as callback to replace() - fcamelCase = function( all, letter ) { - return ( letter + "" ).toUpperCase(); - }, - - // The ready event handler and self cleanup method - DOMContentLoaded = function() { - if ( document.addEventListener ) { - document.removeEventListener( "DOMContentLoaded", DOMContentLoaded, false ); - jQuery.ready(); - } else if ( document.readyState === "complete" ) { - // we're here because readyState === "complete" in oldIE - // which is good enough for us to call the dom ready! - document.detachEvent( "onreadystatechange", DOMContentLoaded ); - jQuery.ready(); - } - }, - - // [[Class]] -> type pairs - class2type = {}; - -jQuery.fn = jQuery.prototype = { - constructor: jQuery, - init: function( selector, context, rootjQuery ) { - var match, elem, ret, doc; - - // Handle $(""), $(null), $(undefined), $(false) - if ( !selector ) { - return this; - } - - // Handle $(DOMElement) - if ( selector.nodeType ) { - this.context = this[0] = selector; - this.length = 1; - return this; - } - - // Handle HTML strings - if ( typeof selector === "string" ) { - if ( selector.charAt(0) === "<" && selector.charAt( selector.length - 1 ) === ">" && selector.length >= 3 ) { - // Assume that strings that start and end with <> are HTML and skip the regex check - match = [ null, selector, null ]; - - } else { - match = rquickExpr.exec( selector ); - } - - // Match html or make sure no context is specified for #id - if ( match && (match[1] || !context) ) { - - // HANDLE: $(html) -> $(array) - if ( match[1] ) { - context = context instanceof jQuery ? context[0] : context; - doc = ( context && context.nodeType ? context.ownerDocument || context : document ); - - // scripts is true for back-compat - selector = jQuery.parseHTML( match[1], doc, true ); - if ( rsingleTag.test( match[1] ) && jQuery.isPlainObject( context ) ) { - this.attr.call( selector, context, true ); - } - - return jQuery.merge( this, selector ); - - // HANDLE: $(#id) - } else { - elem = document.getElementById( match[2] ); - - // Check parentNode to catch when Blackberry 4.6 returns - // nodes that are no longer in the document #6963 - if ( elem && elem.parentNode ) { - // Handle the case where IE and Opera return items - // by name instead of ID - if ( elem.id !== match[2] ) { - return rootjQuery.find( selector ); - } - - // Otherwise, we inject the element directly into the jQuery object - this.length = 1; - this[0] = elem; - } - - this.context = document; - this.selector = selector; - return this; - } - - // HANDLE: $(expr, $(...)) - } else if ( !context || context.jquery ) { - return ( context || rootjQuery ).find( selector ); - - // HANDLE: $(expr, context) - // (which is just equivalent to: $(context).find(expr) - } else { - return this.constructor( context ).find( selector ); - } - - // HANDLE: $(function) - // Shortcut for document ready - } else if ( jQuery.isFunction( selector ) ) { - return rootjQuery.ready( selector ); - } - - if ( selector.selector !== undefined ) { - this.selector = selector.selector; - this.context = selector.context; - } - - return jQuery.makeArray( selector, this ); - }, - - // Start with an empty selector - selector: "", - - // The current version of jQuery being used - jquery: "1.8.3", - - // The default length of a jQuery object is 0 - length: 0, - - // The number of elements contained in the matched element set - size: function() { - return this.length; - }, - - toArray: function() { - return core_slice.call( this ); - }, - - // Get the Nth element in the matched element set OR - // Get the whole matched element set as a clean array - get: function( num ) { - return num == null ? - - // Return a 'clean' array - this.toArray() : - - // Return just the object - ( num < 0 ? this[ this.length + num ] : this[ num ] ); - }, - - // Take an array of elements and push it onto the stack - // (returning the new matched element set) - pushStack: function( elems, name, selector ) { - - // Build a new jQuery matched element set - var ret = jQuery.merge( this.constructor(), elems ); - - // Add the old object onto the stack (as a reference) - ret.prevObject = this; - - ret.context = this.context; - - if ( name === "find" ) { - ret.selector = this.selector + ( this.selector ? " " : "" ) + selector; - } else if ( name ) { - ret.selector = this.selector + "." + name + "(" + selector + ")"; - } - - // Return the newly-formed element set - return ret; - }, - - // Execute a callback for every element in the matched set. - // (You can seed the arguments with an array of args, but this is - // only used internally.) - each: function( callback, args ) { - return jQuery.each( this, callback, args ); - }, - - ready: function( fn ) { - // Add the callback - jQuery.ready.promise().done( fn ); - - return this; - }, - - eq: function( i ) { - i = +i; - return i === -1 ? - this.slice( i ) : - this.slice( i, i + 1 ); - }, - - first: function() { - return this.eq( 0 ); - }, - - last: function() { - return this.eq( -1 ); - }, - - slice: function() { - return this.pushStack( core_slice.apply( this, arguments ), - "slice", core_slice.call(arguments).join(",") ); - }, - - map: function( callback ) { - return this.pushStack( jQuery.map(this, function( elem, i ) { - return callback.call( elem, i, elem ); - })); - }, - - end: function() { - return this.prevObject || this.constructor(null); - }, - - // For internal use only. - // Behaves like an Array's method, not like a jQuery method. - push: core_push, - sort: [].sort, - splice: [].splice -}; - -// Give the init function the jQuery prototype for later instantiation -jQuery.fn.init.prototype = jQuery.fn; - -jQuery.extend = jQuery.fn.extend = function() { - var options, name, src, copy, copyIsArray, clone, - target = arguments[0] || {}, - i = 1, - length = arguments.length, - deep = false; - - // Handle a deep copy situation - if ( typeof target === "boolean" ) { - deep = target; - target = arguments[1] || {}; - // skip the boolean and the target - i = 2; - } - - // Handle case when target is a string or something (possible in deep copy) - if ( typeof target !== "object" && !jQuery.isFunction(target) ) { - target = {}; - } - - // extend jQuery itself if only one argument is passed - if ( length === i ) { - target = this; - --i; - } - - for ( ; i < length; i++ ) { - // Only deal with non-null/undefined values - if ( (options = arguments[ i ]) != null ) { - // Extend the base object - for ( name in options ) { - src = target[ name ]; - copy = options[ name ]; - - // Prevent never-ending loop - if ( target === copy ) { - continue; - } - - // Recurse if we're merging plain objects or arrays - if ( deep && copy && ( jQuery.isPlainObject(copy) || (copyIsArray = jQuery.isArray(copy)) ) ) { - if ( copyIsArray ) { - copyIsArray = false; - clone = src && jQuery.isArray(src) ? src : []; - - } else { - clone = src && jQuery.isPlainObject(src) ? src : {}; - } - - // Never move original objects, clone them - target[ name ] = jQuery.extend( deep, clone, copy ); - - // Don't bring in undefined values - } else if ( copy !== undefined ) { - target[ name ] = copy; - } - } - } - } - - // Return the modified object - return target; -}; - -jQuery.extend({ - noConflict: function( deep ) { - if ( window.$ === jQuery ) { - window.$ = _$; - } - - if ( deep && window.jQuery === jQuery ) { - window.jQuery = _jQuery; - } - - return jQuery; - }, - - // Is the DOM ready to be used? Set to true once it occurs. - isReady: false, - - // A counter to track how many items to wait for before - // the ready event fires. See #6781 - readyWait: 1, - - // Hold (or release) the ready event - holdReady: function( hold ) { - if ( hold ) { - jQuery.readyWait++; - } else { - jQuery.ready( true ); - } - }, - - // Handle when the DOM is ready - ready: function( wait ) { - - // Abort if there are pending holds or we're already ready - if ( wait === true ? --jQuery.readyWait : jQuery.isReady ) { - return; - } - - // Make sure body exists, at least, in case IE gets a little overzealous (ticket #5443). - if ( !document.body ) { - return setTimeout( jQuery.ready, 1 ); - } - - // Remember that the DOM is ready - jQuery.isReady = true; - - // If a normal DOM Ready event fired, decrement, and wait if need be - if ( wait !== true && --jQuery.readyWait > 0 ) { - return; - } - - // If there are functions bound, to execute - readyList.resolveWith( document, [ jQuery ] ); - - // Trigger any bound ready events - if ( jQuery.fn.trigger ) { - jQuery( document ).trigger("ready").off("ready"); - } - }, - - // See test/unit/core.js for details concerning isFunction. - // Since version 1.3, DOM methods and functions like alert - // aren't supported. They return false on IE (#2968). - isFunction: function( obj ) { - return jQuery.type(obj) === "function"; - }, - - isArray: Array.isArray || function( obj ) { - return jQuery.type(obj) === "array"; - }, - - isWindow: function( obj ) { - return obj != null && obj == obj.window; - }, - - isNumeric: function( obj ) { - return !isNaN( parseFloat(obj) ) && isFinite( obj ); - }, - - type: function( obj ) { - return obj == null ? - String( obj ) : - class2type[ core_toString.call(obj) ] || "object"; - }, - - isPlainObject: function( obj ) { - // Must be an Object. - // Because of IE, we also have to check the presence of the constructor property. - // Make sure that DOM nodes and window objects don't pass through, as well - if ( !obj || jQuery.type(obj) !== "object" || obj.nodeType || jQuery.isWindow( obj ) ) { - return false; - } - - try { - // Not own constructor property must be Object - if ( obj.constructor && - !core_hasOwn.call(obj, "constructor") && - !core_hasOwn.call(obj.constructor.prototype, "isPrototypeOf") ) { - return false; - } - } catch ( e ) { - // IE8,9 Will throw exceptions on certain host objects #9897 - return false; - } - - // Own properties are enumerated firstly, so to speed up, - // if last one is own, then all properties are own. - - var key; - for ( key in obj ) {} - - return key === undefined || core_hasOwn.call( obj, key ); - }, - - isEmptyObject: function( obj ) { - var name; - for ( name in obj ) { - return false; - } - return true; - }, - - error: function( msg ) { - throw new Error( msg ); - }, - - // data: string of html - // context (optional): If specified, the fragment will be created in this context, defaults to document - // scripts (optional): If true, will include scripts passed in the html string - parseHTML: function( data, context, scripts ) { - var parsed; - if ( !data || typeof data !== "string" ) { - return null; - } - if ( typeof context === "boolean" ) { - scripts = context; - context = 0; - } - context = context || document; - - // Single tag - if ( (parsed = rsingleTag.exec( data )) ) { - return [ context.createElement( parsed[1] ) ]; - } - - parsed = jQuery.buildFragment( [ data ], context, scripts ? null : [] ); - return jQuery.merge( [], - (parsed.cacheable ? jQuery.clone( parsed.fragment ) : parsed.fragment).childNodes ); - }, - - parseJSON: function( data ) { - if ( !data || typeof data !== "string") { - return null; - } - - // Make sure leading/trailing whitespace is removed (IE can't handle it) - data = jQuery.trim( data ); - - // Attempt to parse using the native JSON parser first - if ( window.JSON && window.JSON.parse ) { - return window.JSON.parse( data ); - } - - // Make sure the incoming data is actual JSON - // Logic borrowed from http://json.org/json2.js - if ( rvalidchars.test( data.replace( rvalidescape, "@" ) - .replace( rvalidtokens, "]" ) - .replace( rvalidbraces, "")) ) { - - return ( new Function( "return " + data ) )(); - - } - jQuery.error( "Invalid JSON: " + data ); - }, - - // Cross-browser xml parsing - parseXML: function( data ) { - var xml, tmp; - if ( !data || typeof data !== "string" ) { - return null; - } - try { - if ( window.DOMParser ) { // Standard - tmp = new DOMParser(); - xml = tmp.parseFromString( data , "text/xml" ); - } else { // IE - xml = new ActiveXObject( "Microsoft.XMLDOM" ); - xml.async = "false"; - xml.loadXML( data ); - } - } catch( e ) { - xml = undefined; - } - if ( !xml || !xml.documentElement || xml.getElementsByTagName( "parsererror" ).length ) { - jQuery.error( "Invalid XML: " + data ); - } - return xml; - }, - - noop: function() {}, - - // Evaluates a script in a global context - // Workarounds based on findings by Jim Driscoll - // http://weblogs.java.net/blog/driscoll/archive/2009/09/08/eval-javascript-global-context - globalEval: function( data ) { - if ( data && core_rnotwhite.test( data ) ) { - // We use execScript on Internet Explorer - // We use an anonymous function so that context is window - // rather than jQuery in Firefox - ( window.execScript || function( data ) { - window[ "eval" ].call( window, data ); - } )( data ); - } - }, - - // Convert dashed to camelCase; used by the css and data modules - // Microsoft forgot to hump their vendor prefix (#9572) - camelCase: function( string ) { - return string.replace( rmsPrefix, "ms-" ).replace( rdashAlpha, fcamelCase ); - }, - - nodeName: function( elem, name ) { - return elem.nodeName && elem.nodeName.toLowerCase() === name.toLowerCase(); - }, - - // args is for internal usage only - each: function( obj, callback, args ) { - var name, - i = 0, - length = obj.length, - isObj = length === undefined || jQuery.isFunction( obj ); - - if ( args ) { - if ( isObj ) { - for ( name in obj ) { - if ( callback.apply( obj[ name ], args ) === false ) { - break; - } - } - } else { - for ( ; i < length; ) { - if ( callback.apply( obj[ i++ ], args ) === false ) { - break; - } - } - } - - // A special, fast, case for the most common use of each - } else { - if ( isObj ) { - for ( name in obj ) { - if ( callback.call( obj[ name ], name, obj[ name ] ) === false ) { - break; - } - } - } else { - for ( ; i < length; ) { - if ( callback.call( obj[ i ], i, obj[ i++ ] ) === false ) { - break; - } - } - } - } - - return obj; - }, - - // Use native String.trim function wherever possible - trim: core_trim && !core_trim.call("\uFEFF\xA0") ? - function( text ) { - return text == null ? - "" : - core_trim.call( text ); - } : - - // Otherwise use our own trimming functionality - function( text ) { - return text == null ? - "" : - ( text + "" ).replace( rtrim, "" ); - }, - - // results is for internal usage only - makeArray: function( arr, results ) { - var type, - ret = results || []; - - if ( arr != null ) { - // The window, strings (and functions) also have 'length' - // Tweaked logic slightly to handle Blackberry 4.7 RegExp issues #6930 - type = jQuery.type( arr ); - - if ( arr.length == null || type === "string" || type === "function" || type === "regexp" || jQuery.isWindow( arr ) ) { - core_push.call( ret, arr ); - } else { - jQuery.merge( ret, arr ); - } - } - - return ret; - }, - - inArray: function( elem, arr, i ) { - var len; - - if ( arr ) { - if ( core_indexOf ) { - return core_indexOf.call( arr, elem, i ); - } - - len = arr.length; - i = i ? i < 0 ? Math.max( 0, len + i ) : i : 0; - - for ( ; i < len; i++ ) { - // Skip accessing in sparse arrays - if ( i in arr && arr[ i ] === elem ) { - return i; - } - } - } - - return -1; - }, - - merge: function( first, second ) { - var l = second.length, - i = first.length, - j = 0; - - if ( typeof l === "number" ) { - for ( ; j < l; j++ ) { - first[ i++ ] = second[ j ]; - } - - } else { - while ( second[j] !== undefined ) { - first[ i++ ] = second[ j++ ]; - } - } - - first.length = i; - - return first; - }, - - grep: function( elems, callback, inv ) { - var retVal, - ret = [], - i = 0, - length = elems.length; - inv = !!inv; - - // Go through the array, only saving the items - // that pass the validator function - for ( ; i < length; i++ ) { - retVal = !!callback( elems[ i ], i ); - if ( inv !== retVal ) { - ret.push( elems[ i ] ); - } - } - - return ret; - }, - - // arg is for internal usage only - map: function( elems, callback, arg ) { - var value, key, - ret = [], - i = 0, - length = elems.length, - // jquery objects are treated as arrays - isArray = elems instanceof jQuery || length !== undefined && typeof length === "number" && ( ( length > 0 && elems[ 0 ] && elems[ length -1 ] ) || length === 0 || jQuery.isArray( elems ) ) ; - - // Go through the array, translating each of the items to their - if ( isArray ) { - for ( ; i < length; i++ ) { - value = callback( elems[ i ], i, arg ); - - if ( value != null ) { - ret[ ret.length ] = value; - } - } - - // Go through every key on the object, - } else { - for ( key in elems ) { - value = callback( elems[ key ], key, arg ); - - if ( value != null ) { - ret[ ret.length ] = value; - } - } - } - - // Flatten any nested arrays - return ret.concat.apply( [], ret ); - }, - - // A global GUID counter for objects - guid: 1, - - // Bind a function to a context, optionally partially applying any - // arguments. - proxy: function( fn, context ) { - var tmp, args, proxy; - - if ( typeof context === "string" ) { - tmp = fn[ context ]; - context = fn; - fn = tmp; - } - - // Quick check to determine if target is callable, in the spec - // this throws a TypeError, but we will just return undefined. - if ( !jQuery.isFunction( fn ) ) { - return undefined; - } - - // Simulated bind - args = core_slice.call( arguments, 2 ); - proxy = function() { - return fn.apply( context, args.concat( core_slice.call( arguments ) ) ); - }; - - // Set the guid of unique handler to the same of original handler, so it can be removed - proxy.guid = fn.guid = fn.guid || jQuery.guid++; - - return proxy; - }, - - // Multifunctional method to get and set values of a collection - // The value/s can optionally be executed if it's a function - access: function( elems, fn, key, value, chainable, emptyGet, pass ) { - var exec, - bulk = key == null, - i = 0, - length = elems.length; - - // Sets many values - if ( key && typeof key === "object" ) { - for ( i in key ) { - jQuery.access( elems, fn, i, key[i], 1, emptyGet, value ); - } - chainable = 1; - - // Sets one value - } else if ( value !== undefined ) { - // Optionally, function values get executed if exec is true - exec = pass === undefined && jQuery.isFunction( value ); - - if ( bulk ) { - // Bulk operations only iterate when executing function values - if ( exec ) { - exec = fn; - fn = function( elem, key, value ) { - return exec.call( jQuery( elem ), value ); - }; - - // Otherwise they run against the entire set - } else { - fn.call( elems, value ); - fn = null; - } - } - - if ( fn ) { - for (; i < length; i++ ) { - fn( elems[i], key, exec ? value.call( elems[i], i, fn( elems[i], key ) ) : value, pass ); - } - } - - chainable = 1; - } - - return chainable ? - elems : - - // Gets - bulk ? - fn.call( elems ) : - length ? fn( elems[0], key ) : emptyGet; - }, - - now: function() { - return ( new Date() ).getTime(); - } -}); - -jQuery.ready.promise = function( obj ) { - if ( !readyList ) { - - readyList = jQuery.Deferred(); - - // Catch cases where $(document).ready() is called after the browser event has already occurred. - // we once tried to use readyState "interactive" here, but it caused issues like the one - // discovered by ChrisS here: http://bugs.jquery.com/ticket/12282#comment:15 - if ( document.readyState === "complete" ) { - // Handle it asynchronously to allow scripts the opportunity to delay ready - setTimeout( jQuery.ready, 1 ); - - // Standards-based browsers support DOMContentLoaded - } else if ( document.addEventListener ) { - // Use the handy event callback - document.addEventListener( "DOMContentLoaded", DOMContentLoaded, false ); - - // A fallback to window.onload, that will always work - window.addEventListener( "load", jQuery.ready, false ); - - // If IE event model is used - } else { - // Ensure firing before onload, maybe late but safe also for iframes - document.attachEvent( "onreadystatechange", DOMContentLoaded ); - - // A fallback to window.onload, that will always work - window.attachEvent( "onload", jQuery.ready ); - - // If IE and not a frame - // continually check to see if the document is ready - var top = false; - - try { - top = window.frameElement == null && document.documentElement; - } catch(e) {} - - if ( top && top.doScroll ) { - (function doScrollCheck() { - if ( !jQuery.isReady ) { - - try { - // Use the trick by Diego Perini - // http://javascript.nwbox.com/IEContentLoaded/ - top.doScroll("left"); - } catch(e) { - return setTimeout( doScrollCheck, 50 ); - } - - // and execute any waiting functions - jQuery.ready(); - } - })(); - } - } - } - return readyList.promise( obj ); -}; - -// Populate the class2type map -jQuery.each("Boolean Number String Function Array Date RegExp Object".split(" "), function(i, name) { - class2type[ "[object " + name + "]" ] = name.toLowerCase(); -}); - -// All jQuery objects should point back to these -rootjQuery = jQuery(document); -// String to Object options format cache -var optionsCache = {}; - -// Convert String-formatted options into Object-formatted ones and store in cache -function createOptions( options ) { - var object = optionsCache[ options ] = {}; - jQuery.each( options.split( core_rspace ), function( _, flag ) { - object[ flag ] = true; - }); - return object; -} - -/* - * Create a callback list using the following parameters: - * - * options: an optional list of space-separated options that will change how - * the callback list behaves or a more traditional option object - * - * By default a callback list will act like an event callback list and can be - * "fired" multiple times. - * - * Possible options: - * - * once: will ensure the callback list can only be fired once (like a Deferred) - * - * memory: will keep track of previous values and will call any callback added - * after the list has been fired right away with the latest "memorized" - * values (like a Deferred) - * - * unique: will ensure a callback can only be added once (no duplicate in the list) - * - * stopOnFalse: interrupt callings when a callback returns false - * - */ -jQuery.Callbacks = function( options ) { - - // Convert options from String-formatted to Object-formatted if needed - // (we check in cache first) - options = typeof options === "string" ? - ( optionsCache[ options ] || createOptions( options ) ) : - jQuery.extend( {}, options ); - - var // Last fire value (for non-forgettable lists) - memory, - // Flag to know if list was already fired - fired, - // Flag to know if list is currently firing - firing, - // First callback to fire (used internally by add and fireWith) - firingStart, - // End of the loop when firing - firingLength, - // Index of currently firing callback (modified by remove if needed) - firingIndex, - // Actual callback list - list = [], - // Stack of fire calls for repeatable lists - stack = !options.once && [], - // Fire callbacks - fire = function( data ) { - memory = options.memory && data; - fired = true; - firingIndex = firingStart || 0; - firingStart = 0; - firingLength = list.length; - firing = true; - for ( ; list && firingIndex < firingLength; firingIndex++ ) { - if ( list[ firingIndex ].apply( data[ 0 ], data[ 1 ] ) === false && options.stopOnFalse ) { - memory = false; // To prevent further calls using add - break; - } - } - firing = false; - if ( list ) { - if ( stack ) { - if ( stack.length ) { - fire( stack.shift() ); - } - } else if ( memory ) { - list = []; - } else { - self.disable(); - } - } - }, - // Actual Callbacks object - self = { - // Add a callback or a collection of callbacks to the list - add: function() { - if ( list ) { - // First, we save the current length - var start = list.length; - (function add( args ) { - jQuery.each( args, function( _, arg ) { - var type = jQuery.type( arg ); - if ( type === "function" ) { - if ( !options.unique || !self.has( arg ) ) { - list.push( arg ); - } - } else if ( arg && arg.length && type !== "string" ) { - // Inspect recursively - add( arg ); - } - }); - })( arguments ); - // Do we need to add the callbacks to the - // current firing batch? - if ( firing ) { - firingLength = list.length; - // With memory, if we're not firing then - // we should call right away - } else if ( memory ) { - firingStart = start; - fire( memory ); - } - } - return this; - }, - // Remove a callback from the list - remove: function() { - if ( list ) { - jQuery.each( arguments, function( _, arg ) { - var index; - while( ( index = jQuery.inArray( arg, list, index ) ) > -1 ) { - list.splice( index, 1 ); - // Handle firing indexes - if ( firing ) { - if ( index <= firingLength ) { - firingLength--; - } - if ( index <= firingIndex ) { - firingIndex--; - } - } - } - }); - } - return this; - }, - // Control if a given callback is in the list - has: function( fn ) { - return jQuery.inArray( fn, list ) > -1; - }, - // Remove all callbacks from the list - empty: function() { - list = []; - return this; - }, - // Have the list do nothing anymore - disable: function() { - list = stack = memory = undefined; - return this; - }, - // Is it disabled? - disabled: function() { - return !list; - }, - // Lock the list in its current state - lock: function() { - stack = undefined; - if ( !memory ) { - self.disable(); - } - return this; - }, - // Is it locked? - locked: function() { - return !stack; - }, - // Call all callbacks with the given context and arguments - fireWith: function( context, args ) { - args = args || []; - args = [ context, args.slice ? args.slice() : args ]; - if ( list && ( !fired || stack ) ) { - if ( firing ) { - stack.push( args ); - } else { - fire( args ); - } - } - return this; - }, - // Call all the callbacks with the given arguments - fire: function() { - self.fireWith( this, arguments ); - return this; - }, - // To know if the callbacks have already been called at least once - fired: function() { - return !!fired; - } - }; - - return self; -}; -jQuery.extend({ - - Deferred: function( func ) { - var tuples = [ - // action, add listener, listener list, final state - [ "resolve", "done", jQuery.Callbacks("once memory"), "resolved" ], - [ "reject", "fail", jQuery.Callbacks("once memory"), "rejected" ], - [ "notify", "progress", jQuery.Callbacks("memory") ] - ], - state = "pending", - promise = { - state: function() { - return state; - }, - always: function() { - deferred.done( arguments ).fail( arguments ); - return this; - }, - then: function( /* fnDone, fnFail, fnProgress */ ) { - var fns = arguments; - return jQuery.Deferred(function( newDefer ) { - jQuery.each( tuples, function( i, tuple ) { - var action = tuple[ 0 ], - fn = fns[ i ]; - // deferred[ done | fail | progress ] for forwarding actions to newDefer - deferred[ tuple[1] ]( jQuery.isFunction( fn ) ? - function() { - var returned = fn.apply( this, arguments ); - if ( returned && jQuery.isFunction( returned.promise ) ) { - returned.promise() - .done( newDefer.resolve ) - .fail( newDefer.reject ) - .progress( newDefer.notify ); - } else { - newDefer[ action + "With" ]( this === deferred ? newDefer : this, [ returned ] ); - } - } : - newDefer[ action ] - ); - }); - fns = null; - }).promise(); - }, - // Get a promise for this deferred - // If obj is provided, the promise aspect is added to the object - promise: function( obj ) { - return obj != null ? jQuery.extend( obj, promise ) : promise; - } - }, - deferred = {}; - - // Keep pipe for back-compat - promise.pipe = promise.then; - - // Add list-specific methods - jQuery.each( tuples, function( i, tuple ) { - var list = tuple[ 2 ], - stateString = tuple[ 3 ]; - - // promise[ done | fail | progress ] = list.add - promise[ tuple[1] ] = list.add; - - // Handle state - if ( stateString ) { - list.add(function() { - // state = [ resolved | rejected ] - state = stateString; - - // [ reject_list | resolve_list ].disable; progress_list.lock - }, tuples[ i ^ 1 ][ 2 ].disable, tuples[ 2 ][ 2 ].lock ); - } - - // deferred[ resolve | reject | notify ] = list.fire - deferred[ tuple[0] ] = list.fire; - deferred[ tuple[0] + "With" ] = list.fireWith; - }); - - // Make the deferred a promise - promise.promise( deferred ); - - // Call given func if any - if ( func ) { - func.call( deferred, deferred ); - } - - // All done! - return deferred; - }, - - // Deferred helper - when: function( subordinate /* , ..., subordinateN */ ) { - var i = 0, - resolveValues = core_slice.call( arguments ), - length = resolveValues.length, - - // the count of uncompleted subordinates - remaining = length !== 1 || ( subordinate && jQuery.isFunction( subordinate.promise ) ) ? length : 0, - - // the master Deferred. If resolveValues consist of only a single Deferred, just use that. - deferred = remaining === 1 ? subordinate : jQuery.Deferred(), - - // Update function for both resolve and progress values - updateFunc = function( i, contexts, values ) { - return function( value ) { - contexts[ i ] = this; - values[ i ] = arguments.length > 1 ? core_slice.call( arguments ) : value; - if( values === progressValues ) { - deferred.notifyWith( contexts, values ); - } else if ( !( --remaining ) ) { - deferred.resolveWith( contexts, values ); - } - }; - }, - - progressValues, progressContexts, resolveContexts; - - // add listeners to Deferred subordinates; treat others as resolved - if ( length > 1 ) { - progressValues = new Array( length ); - progressContexts = new Array( length ); - resolveContexts = new Array( length ); - for ( ; i < length; i++ ) { - if ( resolveValues[ i ] && jQuery.isFunction( resolveValues[ i ].promise ) ) { - resolveValues[ i ].promise() - .done( updateFunc( i, resolveContexts, resolveValues ) ) - .fail( deferred.reject ) - .progress( updateFunc( i, progressContexts, progressValues ) ); - } else { - --remaining; - } - } - } - - // if we're not waiting on anything, resolve the master - if ( !remaining ) { - deferred.resolveWith( resolveContexts, resolveValues ); - } - - return deferred.promise(); - } -}); -jQuery.support = (function() { - - var support, - all, - a, - select, - opt, - input, - fragment, - eventName, - i, - isSupported, - clickFn, - div = document.createElement("div"); - - // Setup - div.setAttribute( "className", "t" ); - div.innerHTML = "
a"; - - // Support tests won't run in some limited or non-browser environments - all = div.getElementsByTagName("*"); - a = div.getElementsByTagName("a")[ 0 ]; - if ( !all || !a || !all.length ) { - return {}; - } - - // First batch of tests - select = document.createElement("select"); - opt = select.appendChild( document.createElement("option") ); - input = div.getElementsByTagName("input")[ 0 ]; - - a.style.cssText = "top:1px;float:left;opacity:.5"; - support = { - // IE strips leading whitespace when .innerHTML is used - leadingWhitespace: ( div.firstChild.nodeType === 3 ), - - // Make sure that tbody elements aren't automatically inserted - // IE will insert them into empty tables - tbody: !div.getElementsByTagName("tbody").length, - - // Make sure that link elements get serialized correctly by innerHTML - // This requires a wrapper element in IE - htmlSerialize: !!div.getElementsByTagName("link").length, - - // Get the style information from getAttribute - // (IE uses .cssText instead) - style: /top/.test( a.getAttribute("style") ), - - // Make sure that URLs aren't manipulated - // (IE normalizes it by default) - hrefNormalized: ( a.getAttribute("href") === "/a" ), - - // Make sure that element opacity exists - // (IE uses filter instead) - // Use a regex to work around a WebKit issue. See #5145 - opacity: /^0.5/.test( a.style.opacity ), - - // Verify style float existence - // (IE uses styleFloat instead of cssFloat) - cssFloat: !!a.style.cssFloat, - - // Make sure that if no value is specified for a checkbox - // that it defaults to "on". - // (WebKit defaults to "" instead) - checkOn: ( input.value === "on" ), - - // Make sure that a selected-by-default option has a working selected property. - // (WebKit defaults to false instead of true, IE too, if it's in an optgroup) - optSelected: opt.selected, - - // Test setAttribute on camelCase class. If it works, we need attrFixes when doing get/setAttribute (ie6/7) - getSetAttribute: div.className !== "t", - - // Tests for enctype support on a form (#6743) - enctype: !!document.createElement("form").enctype, - - // Makes sure cloning an html5 element does not cause problems - // Where outerHTML is undefined, this still works - html5Clone: document.createElement("nav").cloneNode( true ).outerHTML !== "<:nav>", - - // jQuery.support.boxModel DEPRECATED in 1.8 since we don't support Quirks Mode - boxModel: ( document.compatMode === "CSS1Compat" ), - - // Will be defined later - submitBubbles: true, - changeBubbles: true, - focusinBubbles: false, - deleteExpando: true, - noCloneEvent: true, - inlineBlockNeedsLayout: false, - shrinkWrapBlocks: false, - reliableMarginRight: true, - boxSizingReliable: true, - pixelPosition: false - }; - - // Make sure checked status is properly cloned - input.checked = true; - support.noCloneChecked = input.cloneNode( true ).checked; - - // Make sure that the options inside disabled selects aren't marked as disabled - // (WebKit marks them as disabled) - select.disabled = true; - support.optDisabled = !opt.disabled; - - // Test to see if it's possible to delete an expando from an element - // Fails in Internet Explorer - try { - delete div.test; - } catch( e ) { - support.deleteExpando = false; - } - - if ( !div.addEventListener && div.attachEvent && div.fireEvent ) { - div.attachEvent( "onclick", clickFn = function() { - // Cloning a node shouldn't copy over any - // bound event handlers (IE does this) - support.noCloneEvent = false; - }); - div.cloneNode( true ).fireEvent("onclick"); - div.detachEvent( "onclick", clickFn ); - } - - // Check if a radio maintains its value - // after being appended to the DOM - input = document.createElement("input"); - input.value = "t"; - input.setAttribute( "type", "radio" ); - support.radioValue = input.value === "t"; - - input.setAttribute( "checked", "checked" ); - - // #11217 - WebKit loses check when the name is after the checked attribute - input.setAttribute( "name", "t" ); - - div.appendChild( input ); - fragment = document.createDocumentFragment(); - fragment.appendChild( div.lastChild ); - - // WebKit doesn't clone checked state correctly in fragments - support.checkClone = fragment.cloneNode( true ).cloneNode( true ).lastChild.checked; - - // Check if a disconnected checkbox will retain its checked - // value of true after appended to the DOM (IE6/7) - support.appendChecked = input.checked; - - fragment.removeChild( input ); - fragment.appendChild( div ); - - // Technique from Juriy Zaytsev - // http://perfectionkills.com/detecting-event-support-without-browser-sniffing/ - // We only care about the case where non-standard event systems - // are used, namely in IE. Short-circuiting here helps us to - // avoid an eval call (in setAttribute) which can cause CSP - // to go haywire. See: https://developer.mozilla.org/en/Security/CSP - if ( div.attachEvent ) { - for ( i in { - submit: true, - change: true, - focusin: true - }) { - eventName = "on" + i; - isSupported = ( eventName in div ); - if ( !isSupported ) { - div.setAttribute( eventName, "return;" ); - isSupported = ( typeof div[ eventName ] === "function" ); - } - support[ i + "Bubbles" ] = isSupported; - } - } - - // Run tests that need a body at doc ready - jQuery(function() { - var container, div, tds, marginDiv, - divReset = "padding:0;margin:0;border:0;display:block;overflow:hidden;", - body = document.getElementsByTagName("body")[0]; - - if ( !body ) { - // Return for frameset docs that don't have a body - return; - } - - container = document.createElement("div"); - container.style.cssText = "visibility:hidden;border:0;width:0;height:0;position:static;top:0;margin-top:1px"; - body.insertBefore( container, body.firstChild ); - - // Construct the test element - div = document.createElement("div"); - container.appendChild( div ); - - // Check if table cells still have offsetWidth/Height when they are set - // to display:none and there are still other visible table cells in a - // table row; if so, offsetWidth/Height are not reliable for use when - // determining if an element has been hidden directly using - // display:none (it is still safe to use offsets if a parent element is - // hidden; don safety goggles and see bug #4512 for more information). - // (only IE 8 fails this test) - div.innerHTML = "
t
"; - tds = div.getElementsByTagName("td"); - tds[ 0 ].style.cssText = "padding:0;margin:0;border:0;display:none"; - isSupported = ( tds[ 0 ].offsetHeight === 0 ); - - tds[ 0 ].style.display = ""; - tds[ 1 ].style.display = "none"; - - // Check if empty table cells still have offsetWidth/Height - // (IE <= 8 fail this test) - support.reliableHiddenOffsets = isSupported && ( tds[ 0 ].offsetHeight === 0 ); - - // Check box-sizing and margin behavior - div.innerHTML = ""; - div.style.cssText = "box-sizing:border-box;-moz-box-sizing:border-box;-webkit-box-sizing:border-box;padding:1px;border:1px;display:block;width:4px;margin-top:1%;position:absolute;top:1%;"; - support.boxSizing = ( div.offsetWidth === 4 ); - support.doesNotIncludeMarginInBodyOffset = ( body.offsetTop !== 1 ); - - // NOTE: To any future maintainer, we've window.getComputedStyle - // because jsdom on node.js will break without it. - if ( window.getComputedStyle ) { - support.pixelPosition = ( window.getComputedStyle( div, null ) || {} ).top !== "1%"; - support.boxSizingReliable = ( window.getComputedStyle( div, null ) || { width: "4px" } ).width === "4px"; - - // Check if div with explicit width and no margin-right incorrectly - // gets computed margin-right based on width of container. For more - // info see bug #3333 - // Fails in WebKit before Feb 2011 nightlies - // WebKit Bug 13343 - getComputedStyle returns wrong value for margin-right - marginDiv = document.createElement("div"); - marginDiv.style.cssText = div.style.cssText = divReset; - marginDiv.style.marginRight = marginDiv.style.width = "0"; - div.style.width = "1px"; - div.appendChild( marginDiv ); - support.reliableMarginRight = - !parseFloat( ( window.getComputedStyle( marginDiv, null ) || {} ).marginRight ); - } - - if ( typeof div.style.zoom !== "undefined" ) { - // Check if natively block-level elements act like inline-block - // elements when setting their display to 'inline' and giving - // them layout - // (IE < 8 does this) - div.innerHTML = ""; - div.style.cssText = divReset + "width:1px;padding:1px;display:inline;zoom:1"; - support.inlineBlockNeedsLayout = ( div.offsetWidth === 3 ); - - // Check if elements with layout shrink-wrap their children - // (IE 6 does this) - div.style.display = "block"; - div.style.overflow = "visible"; - div.innerHTML = "
"; - div.firstChild.style.width = "5px"; - support.shrinkWrapBlocks = ( div.offsetWidth !== 3 ); - - container.style.zoom = 1; - } - - // Null elements to avoid leaks in IE - body.removeChild( container ); - container = div = tds = marginDiv = null; - }); - - // Null elements to avoid leaks in IE - fragment.removeChild( div ); - all = a = select = opt = input = fragment = div = null; - - return support; -})(); -var rbrace = /(?:\{[\s\S]*\}|\[[\s\S]*\])$/, - rmultiDash = /([A-Z])/g; - -jQuery.extend({ - cache: {}, - - deletedIds: [], - - // Remove at next major release (1.9/2.0) - uuid: 0, - - // Unique for each copy of jQuery on the page - // Non-digits removed to match rinlinejQuery - expando: "jQuery" + ( jQuery.fn.jquery + Math.random() ).replace( /\D/g, "" ), - - // The following elements throw uncatchable exceptions if you - // attempt to add expando properties to them. - noData: { - "embed": true, - // Ban all objects except for Flash (which handle expandos) - "object": "clsid:D27CDB6E-AE6D-11cf-96B8-444553540000", - "applet": true - }, - - hasData: function( elem ) { - elem = elem.nodeType ? jQuery.cache[ elem[jQuery.expando] ] : elem[ jQuery.expando ]; - return !!elem && !isEmptyDataObject( elem ); - }, - - data: function( elem, name, data, pvt /* Internal Use Only */ ) { - if ( !jQuery.acceptData( elem ) ) { - return; - } - - var thisCache, ret, - internalKey = jQuery.expando, - getByName = typeof name === "string", - - // We have to handle DOM nodes and JS objects differently because IE6-7 - // can't GC object references properly across the DOM-JS boundary - isNode = elem.nodeType, - - // Only DOM nodes need the global jQuery cache; JS object data is - // attached directly to the object so GC can occur automatically - cache = isNode ? jQuery.cache : elem, - - // Only defining an ID for JS objects if its cache already exists allows - // the code to shortcut on the same path as a DOM node with no cache - id = isNode ? elem[ internalKey ] : elem[ internalKey ] && internalKey; - - // Avoid doing any more work than we need to when trying to get data on an - // object that has no data at all - if ( (!id || !cache[id] || (!pvt && !cache[id].data)) && getByName && data === undefined ) { - return; - } - - if ( !id ) { - // Only DOM nodes need a new unique ID for each element since their data - // ends up in the global cache - if ( isNode ) { - elem[ internalKey ] = id = jQuery.deletedIds.pop() || jQuery.guid++; - } else { - id = internalKey; - } - } - - if ( !cache[ id ] ) { - cache[ id ] = {}; - - // Avoids exposing jQuery metadata on plain JS objects when the object - // is serialized using JSON.stringify - if ( !isNode ) { - cache[ id ].toJSON = jQuery.noop; - } - } - - // An object can be passed to jQuery.data instead of a key/value pair; this gets - // shallow copied over onto the existing cache - if ( typeof name === "object" || typeof name === "function" ) { - if ( pvt ) { - cache[ id ] = jQuery.extend( cache[ id ], name ); - } else { - cache[ id ].data = jQuery.extend( cache[ id ].data, name ); - } - } - - thisCache = cache[ id ]; - - // jQuery data() is stored in a separate object inside the object's internal data - // cache in order to avoid key collisions between internal data and user-defined - // data. - if ( !pvt ) { - if ( !thisCache.data ) { - thisCache.data = {}; - } - - thisCache = thisCache.data; - } - - if ( data !== undefined ) { - thisCache[ jQuery.camelCase( name ) ] = data; - } - - // Check for both converted-to-camel and non-converted data property names - // If a data property was specified - if ( getByName ) { - - // First Try to find as-is property data - ret = thisCache[ name ]; - - // Test for null|undefined property data - if ( ret == null ) { - - // Try to find the camelCased property - ret = thisCache[ jQuery.camelCase( name ) ]; - } - } else { - ret = thisCache; - } - - return ret; - }, - - removeData: function( elem, name, pvt /* Internal Use Only */ ) { - if ( !jQuery.acceptData( elem ) ) { - return; - } - - var thisCache, i, l, - - isNode = elem.nodeType, - - // See jQuery.data for more information - cache = isNode ? jQuery.cache : elem, - id = isNode ? elem[ jQuery.expando ] : jQuery.expando; - - // If there is already no cache entry for this object, there is no - // purpose in continuing - if ( !cache[ id ] ) { - return; - } - - if ( name ) { - - thisCache = pvt ? cache[ id ] : cache[ id ].data; - - if ( thisCache ) { - - // Support array or space separated string names for data keys - if ( !jQuery.isArray( name ) ) { - - // try the string as a key before any manipulation - if ( name in thisCache ) { - name = [ name ]; - } else { - - // split the camel cased version by spaces unless a key with the spaces exists - name = jQuery.camelCase( name ); - if ( name in thisCache ) { - name = [ name ]; - } else { - name = name.split(" "); - } - } - } - - for ( i = 0, l = name.length; i < l; i++ ) { - delete thisCache[ name[i] ]; - } - - // If there is no data left in the cache, we want to continue - // and let the cache object itself get destroyed - if ( !( pvt ? isEmptyDataObject : jQuery.isEmptyObject )( thisCache ) ) { - return; - } - } - } - - // See jQuery.data for more information - if ( !pvt ) { - delete cache[ id ].data; - - // Don't destroy the parent cache unless the internal data object - // had been the only thing left in it - if ( !isEmptyDataObject( cache[ id ] ) ) { - return; - } - } - - // Destroy the cache - if ( isNode ) { - jQuery.cleanData( [ elem ], true ); - - // Use delete when supported for expandos or `cache` is not a window per isWindow (#10080) - } else if ( jQuery.support.deleteExpando || cache != cache.window ) { - delete cache[ id ]; - - // When all else fails, null - } else { - cache[ id ] = null; - } - }, - - // For internal use only. - _data: function( elem, name, data ) { - return jQuery.data( elem, name, data, true ); - }, - - // A method for determining if a DOM node can handle the data expando - acceptData: function( elem ) { - var noData = elem.nodeName && jQuery.noData[ elem.nodeName.toLowerCase() ]; - - // nodes accept data unless otherwise specified; rejection can be conditional - return !noData || noData !== true && elem.getAttribute("classid") === noData; - } -}); - -jQuery.fn.extend({ - data: function( key, value ) { - var parts, part, attr, name, l, - elem = this[0], - i = 0, - data = null; - - // Gets all values - if ( key === undefined ) { - if ( this.length ) { - data = jQuery.data( elem ); - - if ( elem.nodeType === 1 && !jQuery._data( elem, "parsedAttrs" ) ) { - attr = elem.attributes; - for ( l = attr.length; i < l; i++ ) { - name = attr[i].name; - - if ( !name.indexOf( "data-" ) ) { - name = jQuery.camelCase( name.substring(5) ); - - dataAttr( elem, name, data[ name ] ); - } - } - jQuery._data( elem, "parsedAttrs", true ); - } - } - - return data; - } - - // Sets multiple values - if ( typeof key === "object" ) { - return this.each(function() { - jQuery.data( this, key ); - }); - } - - parts = key.split( ".", 2 ); - parts[1] = parts[1] ? "." + parts[1] : ""; - part = parts[1] + "!"; - - return jQuery.access( this, function( value ) { - - if ( value === undefined ) { - data = this.triggerHandler( "getData" + part, [ parts[0] ] ); - - // Try to fetch any internally stored data first - if ( data === undefined && elem ) { - data = jQuery.data( elem, key ); - data = dataAttr( elem, key, data ); - } - - return data === undefined && parts[1] ? - this.data( parts[0] ) : - data; - } - - parts[1] = value; - this.each(function() { - var self = jQuery( this ); - - self.triggerHandler( "setData" + part, parts ); - jQuery.data( this, key, value ); - self.triggerHandler( "changeData" + part, parts ); - }); - }, null, value, arguments.length > 1, null, false ); - }, - - removeData: function( key ) { - return this.each(function() { - jQuery.removeData( this, key ); - }); - } -}); - -function dataAttr( elem, key, data ) { - // If nothing was found internally, try to fetch any - // data from the HTML5 data-* attribute - if ( data === undefined && elem.nodeType === 1 ) { - - var name = "data-" + key.replace( rmultiDash, "-$1" ).toLowerCase(); - - data = elem.getAttribute( name ); - - if ( typeof data === "string" ) { - try { - data = data === "true" ? true : - data === "false" ? false : - data === "null" ? null : - // Only convert to a number if it doesn't change the string - +data + "" === data ? +data : - rbrace.test( data ) ? jQuery.parseJSON( data ) : - data; - } catch( e ) {} - - // Make sure we set the data so it isn't changed later - jQuery.data( elem, key, data ); - - } else { - data = undefined; - } - } - - return data; -} - -// checks a cache object for emptiness -function isEmptyDataObject( obj ) { - var name; - for ( name in obj ) { - - // if the public data object is empty, the private is still empty - if ( name === "data" && jQuery.isEmptyObject( obj[name] ) ) { - continue; - } - if ( name !== "toJSON" ) { - return false; - } - } - - return true; -} -jQuery.extend({ - queue: function( elem, type, data ) { - var queue; - - if ( elem ) { - type = ( type || "fx" ) + "queue"; - queue = jQuery._data( elem, type ); - - // Speed up dequeue by getting out quickly if this is just a lookup - if ( data ) { - if ( !queue || jQuery.isArray(data) ) { - queue = jQuery._data( elem, type, jQuery.makeArray(data) ); - } else { - queue.push( data ); - } - } - return queue || []; - } - }, - - dequeue: function( elem, type ) { - type = type || "fx"; - - var queue = jQuery.queue( elem, type ), - startLength = queue.length, - fn = queue.shift(), - hooks = jQuery._queueHooks( elem, type ), - next = function() { - jQuery.dequeue( elem, type ); - }; - - // If the fx queue is dequeued, always remove the progress sentinel - if ( fn === "inprogress" ) { - fn = queue.shift(); - startLength--; - } - - if ( fn ) { - - // Add a progress sentinel to prevent the fx queue from being - // automatically dequeued - if ( type === "fx" ) { - queue.unshift( "inprogress" ); - } - - // clear up the last queue stop function - delete hooks.stop; - fn.call( elem, next, hooks ); - } - - if ( !startLength && hooks ) { - hooks.empty.fire(); - } - }, - - // not intended for public consumption - generates a queueHooks object, or returns the current one - _queueHooks: function( elem, type ) { - var key = type + "queueHooks"; - return jQuery._data( elem, key ) || jQuery._data( elem, key, { - empty: jQuery.Callbacks("once memory").add(function() { - jQuery.removeData( elem, type + "queue", true ); - jQuery.removeData( elem, key, true ); - }) - }); - } -}); - -jQuery.fn.extend({ - queue: function( type, data ) { - var setter = 2; - - if ( typeof type !== "string" ) { - data = type; - type = "fx"; - setter--; - } - - if ( arguments.length < setter ) { - return jQuery.queue( this[0], type ); - } - - return data === undefined ? - this : - this.each(function() { - var queue = jQuery.queue( this, type, data ); - - // ensure a hooks for this queue - jQuery._queueHooks( this, type ); - - if ( type === "fx" && queue[0] !== "inprogress" ) { - jQuery.dequeue( this, type ); - } - }); - }, - dequeue: function( type ) { - return this.each(function() { - jQuery.dequeue( this, type ); - }); - }, - // Based off of the plugin by Clint Helfers, with permission. - // http://blindsignals.com/index.php/2009/07/jquery-delay/ - delay: function( time, type ) { - time = jQuery.fx ? jQuery.fx.speeds[ time ] || time : time; - type = type || "fx"; - - return this.queue( type, function( next, hooks ) { - var timeout = setTimeout( next, time ); - hooks.stop = function() { - clearTimeout( timeout ); - }; - }); - }, - clearQueue: function( type ) { - return this.queue( type || "fx", [] ); - }, - // Get a promise resolved when queues of a certain type - // are emptied (fx is the type by default) - promise: function( type, obj ) { - var tmp, - count = 1, - defer = jQuery.Deferred(), - elements = this, - i = this.length, - resolve = function() { - if ( !( --count ) ) { - defer.resolveWith( elements, [ elements ] ); - } - }; - - if ( typeof type !== "string" ) { - obj = type; - type = undefined; - } - type = type || "fx"; - - while( i-- ) { - tmp = jQuery._data( elements[ i ], type + "queueHooks" ); - if ( tmp && tmp.empty ) { - count++; - tmp.empty.add( resolve ); - } - } - resolve(); - return defer.promise( obj ); - } -}); -var nodeHook, boolHook, fixSpecified, - rclass = /[\t\r\n]/g, - rreturn = /\r/g, - rtype = /^(?:button|input)$/i, - rfocusable = /^(?:button|input|object|select|textarea)$/i, - rclickable = /^a(?:rea|)$/i, - rboolean = /^(?:autofocus|autoplay|async|checked|controls|defer|disabled|hidden|loop|multiple|open|readonly|required|scoped|selected)$/i, - getSetAttribute = jQuery.support.getSetAttribute; - -jQuery.fn.extend({ - attr: function( name, value ) { - return jQuery.access( this, jQuery.attr, name, value, arguments.length > 1 ); - }, - - removeAttr: function( name ) { - return this.each(function() { - jQuery.removeAttr( this, name ); - }); - }, - - prop: function( name, value ) { - return jQuery.access( this, jQuery.prop, name, value, arguments.length > 1 ); - }, - - removeProp: function( name ) { - name = jQuery.propFix[ name ] || name; - return this.each(function() { - // try/catch handles cases where IE balks (such as removing a property on window) - try { - this[ name ] = undefined; - delete this[ name ]; - } catch( e ) {} - }); - }, - - addClass: function( value ) { - var classNames, i, l, elem, - setClass, c, cl; - - if ( jQuery.isFunction( value ) ) { - return this.each(function( j ) { - jQuery( this ).addClass( value.call(this, j, this.className) ); - }); - } - - if ( value && typeof value === "string" ) { - classNames = value.split( core_rspace ); - - for ( i = 0, l = this.length; i < l; i++ ) { - elem = this[ i ]; - - if ( elem.nodeType === 1 ) { - if ( !elem.className && classNames.length === 1 ) { - elem.className = value; - - } else { - setClass = " " + elem.className + " "; - - for ( c = 0, cl = classNames.length; c < cl; c++ ) { - if ( setClass.indexOf( " " + classNames[ c ] + " " ) < 0 ) { - setClass += classNames[ c ] + " "; - } - } - elem.className = jQuery.trim( setClass ); - } - } - } - } - - return this; - }, - - removeClass: function( value ) { - var removes, className, elem, c, cl, i, l; - - if ( jQuery.isFunction( value ) ) { - return this.each(function( j ) { - jQuery( this ).removeClass( value.call(this, j, this.className) ); - }); - } - if ( (value && typeof value === "string") || value === undefined ) { - removes = ( value || "" ).split( core_rspace ); - - for ( i = 0, l = this.length; i < l; i++ ) { - elem = this[ i ]; - if ( elem.nodeType === 1 && elem.className ) { - - className = (" " + elem.className + " ").replace( rclass, " " ); - - // loop over each item in the removal list - for ( c = 0, cl = removes.length; c < cl; c++ ) { - // Remove until there is nothing to remove, - while ( className.indexOf(" " + removes[ c ] + " ") >= 0 ) { - className = className.replace( " " + removes[ c ] + " " , " " ); - } - } - elem.className = value ? jQuery.trim( className ) : ""; - } - } - } - - return this; - }, - - toggleClass: function( value, stateVal ) { - var type = typeof value, - isBool = typeof stateVal === "boolean"; - - if ( jQuery.isFunction( value ) ) { - return this.each(function( i ) { - jQuery( this ).toggleClass( value.call(this, i, this.className, stateVal), stateVal ); - }); - } - - return this.each(function() { - if ( type === "string" ) { - // toggle individual class names - var className, - i = 0, - self = jQuery( this ), - state = stateVal, - classNames = value.split( core_rspace ); - - while ( (className = classNames[ i++ ]) ) { - // check each className given, space separated list - state = isBool ? state : !self.hasClass( className ); - self[ state ? "addClass" : "removeClass" ]( className ); - } - - } else if ( type === "undefined" || type === "boolean" ) { - if ( this.className ) { - // store className if set - jQuery._data( this, "__className__", this.className ); - } - - // toggle whole className - this.className = this.className || value === false ? "" : jQuery._data( this, "__className__" ) || ""; - } - }); - }, - - hasClass: function( selector ) { - var className = " " + selector + " ", - i = 0, - l = this.length; - for ( ; i < l; i++ ) { - if ( this[i].nodeType === 1 && (" " + this[i].className + " ").replace(rclass, " ").indexOf( className ) >= 0 ) { - return true; - } - } - - return false; - }, - - val: function( value ) { - var hooks, ret, isFunction, - elem = this[0]; - - if ( !arguments.length ) { - if ( elem ) { - hooks = jQuery.valHooks[ elem.type ] || jQuery.valHooks[ elem.nodeName.toLowerCase() ]; - - if ( hooks && "get" in hooks && (ret = hooks.get( elem, "value" )) !== undefined ) { - return ret; - } - - ret = elem.value; - - return typeof ret === "string" ? - // handle most common string cases - ret.replace(rreturn, "") : - // handle cases where value is null/undef or number - ret == null ? "" : ret; - } - - return; - } - - isFunction = jQuery.isFunction( value ); - - return this.each(function( i ) { - var val, - self = jQuery(this); - - if ( this.nodeType !== 1 ) { - return; - } - - if ( isFunction ) { - val = value.call( this, i, self.val() ); - } else { - val = value; - } - - // Treat null/undefined as ""; convert numbers to string - if ( val == null ) { - val = ""; - } else if ( typeof val === "number" ) { - val += ""; - } else if ( jQuery.isArray( val ) ) { - val = jQuery.map(val, function ( value ) { - return value == null ? "" : value + ""; - }); - } - - hooks = jQuery.valHooks[ this.type ] || jQuery.valHooks[ this.nodeName.toLowerCase() ]; - - // If set returns undefined, fall back to normal setting - if ( !hooks || !("set" in hooks) || hooks.set( this, val, "value" ) === undefined ) { - this.value = val; - } - }); - } -}); - -jQuery.extend({ - valHooks: { - option: { - get: function( elem ) { - // attributes.value is undefined in Blackberry 4.7 but - // uses .value. See #6932 - var val = elem.attributes.value; - return !val || val.specified ? elem.value : elem.text; - } - }, - select: { - get: function( elem ) { - var value, option, - options = elem.options, - index = elem.selectedIndex, - one = elem.type === "select-one" || index < 0, - values = one ? null : [], - max = one ? index + 1 : options.length, - i = index < 0 ? - max : - one ? index : 0; - - // Loop through all the selected options - for ( ; i < max; i++ ) { - option = options[ i ]; - - // oldIE doesn't update selected after form reset (#2551) - if ( ( option.selected || i === index ) && - // Don't return options that are disabled or in a disabled optgroup - ( jQuery.support.optDisabled ? !option.disabled : option.getAttribute("disabled") === null ) && - ( !option.parentNode.disabled || !jQuery.nodeName( option.parentNode, "optgroup" ) ) ) { - - // Get the specific value for the option - value = jQuery( option ).val(); - - // We don't need an array for one selects - if ( one ) { - return value; - } - - // Multi-Selects return an array - values.push( value ); - } - } - - return values; - }, - - set: function( elem, value ) { - var values = jQuery.makeArray( value ); - - jQuery(elem).find("option").each(function() { - this.selected = jQuery.inArray( jQuery(this).val(), values ) >= 0; - }); - - if ( !values.length ) { - elem.selectedIndex = -1; - } - return values; - } - } - }, - - // Unused in 1.8, left in so attrFn-stabbers won't die; remove in 1.9 - attrFn: {}, - - attr: function( elem, name, value, pass ) { - var ret, hooks, notxml, - nType = elem.nodeType; - - // don't get/set attributes on text, comment and attribute nodes - if ( !elem || nType === 3 || nType === 8 || nType === 2 ) { - return; - } - - if ( pass && jQuery.isFunction( jQuery.fn[ name ] ) ) { - return jQuery( elem )[ name ]( value ); - } - - // Fallback to prop when attributes are not supported - if ( typeof elem.getAttribute === "undefined" ) { - return jQuery.prop( elem, name, value ); - } - - notxml = nType !== 1 || !jQuery.isXMLDoc( elem ); - - // All attributes are lowercase - // Grab necessary hook if one is defined - if ( notxml ) { - name = name.toLowerCase(); - hooks = jQuery.attrHooks[ name ] || ( rboolean.test( name ) ? boolHook : nodeHook ); - } - - if ( value !== undefined ) { - - if ( value === null ) { - jQuery.removeAttr( elem, name ); - return; - - } else if ( hooks && "set" in hooks && notxml && (ret = hooks.set( elem, value, name )) !== undefined ) { - return ret; - - } else { - elem.setAttribute( name, value + "" ); - return value; - } - - } else if ( hooks && "get" in hooks && notxml && (ret = hooks.get( elem, name )) !== null ) { - return ret; - - } else { - - ret = elem.getAttribute( name ); - - // Non-existent attributes return null, we normalize to undefined - return ret === null ? - undefined : - ret; - } - }, - - removeAttr: function( elem, value ) { - var propName, attrNames, name, isBool, - i = 0; - - if ( value && elem.nodeType === 1 ) { - - attrNames = value.split( core_rspace ); - - for ( ; i < attrNames.length; i++ ) { - name = attrNames[ i ]; - - if ( name ) { - propName = jQuery.propFix[ name ] || name; - isBool = rboolean.test( name ); - - // See #9699 for explanation of this approach (setting first, then removal) - // Do not do this for boolean attributes (see #10870) - if ( !isBool ) { - jQuery.attr( elem, name, "" ); - } - elem.removeAttribute( getSetAttribute ? name : propName ); - - // Set corresponding property to false for boolean attributes - if ( isBool && propName in elem ) { - elem[ propName ] = false; - } - } - } - } - }, - - attrHooks: { - type: { - set: function( elem, value ) { - // We can't allow the type property to be changed (since it causes problems in IE) - if ( rtype.test( elem.nodeName ) && elem.parentNode ) { - jQuery.error( "type property can't be changed" ); - } else if ( !jQuery.support.radioValue && value === "radio" && jQuery.nodeName(elem, "input") ) { - // Setting the type on a radio button after the value resets the value in IE6-9 - // Reset value to it's default in case type is set after value - // This is for element creation - var val = elem.value; - elem.setAttribute( "type", value ); - if ( val ) { - elem.value = val; - } - return value; - } - } - }, - // Use the value property for back compat - // Use the nodeHook for button elements in IE6/7 (#1954) - value: { - get: function( elem, name ) { - if ( nodeHook && jQuery.nodeName( elem, "button" ) ) { - return nodeHook.get( elem, name ); - } - return name in elem ? - elem.value : - null; - }, - set: function( elem, value, name ) { - if ( nodeHook && jQuery.nodeName( elem, "button" ) ) { - return nodeHook.set( elem, value, name ); - } - // Does not return so that setAttribute is also used - elem.value = value; - } - } - }, - - propFix: { - tabindex: "tabIndex", - readonly: "readOnly", - "for": "htmlFor", - "class": "className", - maxlength: "maxLength", - cellspacing: "cellSpacing", - cellpadding: "cellPadding", - rowspan: "rowSpan", - colspan: "colSpan", - usemap: "useMap", - frameborder: "frameBorder", - contenteditable: "contentEditable" - }, - - prop: function( elem, name, value ) { - var ret, hooks, notxml, - nType = elem.nodeType; - - // don't get/set properties on text, comment and attribute nodes - if ( !elem || nType === 3 || nType === 8 || nType === 2 ) { - return; - } - - notxml = nType !== 1 || !jQuery.isXMLDoc( elem ); - - if ( notxml ) { - // Fix name and attach hooks - name = jQuery.propFix[ name ] || name; - hooks = jQuery.propHooks[ name ]; - } - - if ( value !== undefined ) { - if ( hooks && "set" in hooks && (ret = hooks.set( elem, value, name )) !== undefined ) { - return ret; - - } else { - return ( elem[ name ] = value ); - } - - } else { - if ( hooks && "get" in hooks && (ret = hooks.get( elem, name )) !== null ) { - return ret; - - } else { - return elem[ name ]; - } - } - }, - - propHooks: { - tabIndex: { - get: function( elem ) { - // elem.tabIndex doesn't always return the correct value when it hasn't been explicitly set - // http://fluidproject.org/blog/2008/01/09/getting-setting-and-removing-tabindex-values-with-javascript/ - var attributeNode = elem.getAttributeNode("tabindex"); - - return attributeNode && attributeNode.specified ? - parseInt( attributeNode.value, 10 ) : - rfocusable.test( elem.nodeName ) || rclickable.test( elem.nodeName ) && elem.href ? - 0 : - undefined; - } - } - } -}); - -// Hook for boolean attributes -boolHook = { - get: function( elem, name ) { - // Align boolean attributes with corresponding properties - // Fall back to attribute presence where some booleans are not supported - var attrNode, - property = jQuery.prop( elem, name ); - return property === true || typeof property !== "boolean" && ( attrNode = elem.getAttributeNode(name) ) && attrNode.nodeValue !== false ? - name.toLowerCase() : - undefined; - }, - set: function( elem, value, name ) { - var propName; - if ( value === false ) { - // Remove boolean attributes when set to false - jQuery.removeAttr( elem, name ); - } else { - // value is true since we know at this point it's type boolean and not false - // Set boolean attributes to the same name and set the DOM property - propName = jQuery.propFix[ name ] || name; - if ( propName in elem ) { - // Only set the IDL specifically if it already exists on the element - elem[ propName ] = true; - } - - elem.setAttribute( name, name.toLowerCase() ); - } - return name; - } -}; - -// IE6/7 do not support getting/setting some attributes with get/setAttribute -if ( !getSetAttribute ) { - - fixSpecified = { - name: true, - id: true, - coords: true - }; - - // Use this for any attribute in IE6/7 - // This fixes almost every IE6/7 issue - nodeHook = jQuery.valHooks.button = { - get: function( elem, name ) { - var ret; - ret = elem.getAttributeNode( name ); - return ret && ( fixSpecified[ name ] ? ret.value !== "" : ret.specified ) ? - ret.value : - undefined; - }, - set: function( elem, value, name ) { - // Set the existing or create a new attribute node - var ret = elem.getAttributeNode( name ); - if ( !ret ) { - ret = document.createAttribute( name ); - elem.setAttributeNode( ret ); - } - return ( ret.value = value + "" ); - } - }; - - // Set width and height to auto instead of 0 on empty string( Bug #8150 ) - // This is for removals - jQuery.each([ "width", "height" ], function( i, name ) { - jQuery.attrHooks[ name ] = jQuery.extend( jQuery.attrHooks[ name ], { - set: function( elem, value ) { - if ( value === "" ) { - elem.setAttribute( name, "auto" ); - return value; - } - } - }); - }); - - // Set contenteditable to false on removals(#10429) - // Setting to empty string throws an error as an invalid value - jQuery.attrHooks.contenteditable = { - get: nodeHook.get, - set: function( elem, value, name ) { - if ( value === "" ) { - value = "false"; - } - nodeHook.set( elem, value, name ); - } - }; -} - - -// Some attributes require a special call on IE -if ( !jQuery.support.hrefNormalized ) { - jQuery.each([ "href", "src", "width", "height" ], function( i, name ) { - jQuery.attrHooks[ name ] = jQuery.extend( jQuery.attrHooks[ name ], { - get: function( elem ) { - var ret = elem.getAttribute( name, 2 ); - return ret === null ? undefined : ret; - } - }); - }); -} - -if ( !jQuery.support.style ) { - jQuery.attrHooks.style = { - get: function( elem ) { - // Return undefined in the case of empty string - // Normalize to lowercase since IE uppercases css property names - return elem.style.cssText.toLowerCase() || undefined; - }, - set: function( elem, value ) { - return ( elem.style.cssText = value + "" ); - } - }; -} - -// Safari mis-reports the default selected property of an option -// Accessing the parent's selectedIndex property fixes it -if ( !jQuery.support.optSelected ) { - jQuery.propHooks.selected = jQuery.extend( jQuery.propHooks.selected, { - get: function( elem ) { - var parent = elem.parentNode; - - if ( parent ) { - parent.selectedIndex; - - // Make sure that it also works with optgroups, see #5701 - if ( parent.parentNode ) { - parent.parentNode.selectedIndex; - } - } - return null; - } - }); -} - -// IE6/7 call enctype encoding -if ( !jQuery.support.enctype ) { - jQuery.propFix.enctype = "encoding"; -} - -// Radios and checkboxes getter/setter -if ( !jQuery.support.checkOn ) { - jQuery.each([ "radio", "checkbox" ], function() { - jQuery.valHooks[ this ] = { - get: function( elem ) { - // Handle the case where in Webkit "" is returned instead of "on" if a value isn't specified - return elem.getAttribute("value") === null ? "on" : elem.value; - } - }; - }); -} -jQuery.each([ "radio", "checkbox" ], function() { - jQuery.valHooks[ this ] = jQuery.extend( jQuery.valHooks[ this ], { - set: function( elem, value ) { - if ( jQuery.isArray( value ) ) { - return ( elem.checked = jQuery.inArray( jQuery(elem).val(), value ) >= 0 ); - } - } - }); -}); -var rformElems = /^(?:textarea|input|select)$/i, - rtypenamespace = /^([^\.]*|)(?:\.(.+)|)$/, - rhoverHack = /(?:^|\s)hover(\.\S+|)\b/, - rkeyEvent = /^key/, - rmouseEvent = /^(?:mouse|contextmenu)|click/, - rfocusMorph = /^(?:focusinfocus|focusoutblur)$/, - hoverHack = function( events ) { - return jQuery.event.special.hover ? events : events.replace( rhoverHack, "mouseenter$1 mouseleave$1" ); - }; - -/* - * Helper functions for managing events -- not part of the public interface. - * Props to Dean Edwards' addEvent library for many of the ideas. - */ -jQuery.event = { - - add: function( elem, types, handler, data, selector ) { - - var elemData, eventHandle, events, - t, tns, type, namespaces, handleObj, - handleObjIn, handlers, special; - - // Don't attach events to noData or text/comment nodes (allow plain objects tho) - if ( elem.nodeType === 3 || elem.nodeType === 8 || !types || !handler || !(elemData = jQuery._data( elem )) ) { - return; - } - - // Caller can pass in an object of custom data in lieu of the handler - if ( handler.handler ) { - handleObjIn = handler; - handler = handleObjIn.handler; - selector = handleObjIn.selector; - } - - // Make sure that the handler has a unique ID, used to find/remove it later - if ( !handler.guid ) { - handler.guid = jQuery.guid++; - } - - // Init the element's event structure and main handler, if this is the first - events = elemData.events; - if ( !events ) { - elemData.events = events = {}; - } - eventHandle = elemData.handle; - if ( !eventHandle ) { - elemData.handle = eventHandle = function( e ) { - // Discard the second event of a jQuery.event.trigger() and - // when an event is called after a page has unloaded - return typeof jQuery !== "undefined" && (!e || jQuery.event.triggered !== e.type) ? - jQuery.event.dispatch.apply( eventHandle.elem, arguments ) : - undefined; - }; - // Add elem as a property of the handle fn to prevent a memory leak with IE non-native events - eventHandle.elem = elem; - } - - // Handle multiple events separated by a space - // jQuery(...).bind("mouseover mouseout", fn); - types = jQuery.trim( hoverHack(types) ).split( " " ); - for ( t = 0; t < types.length; t++ ) { - - tns = rtypenamespace.exec( types[t] ) || []; - type = tns[1]; - namespaces = ( tns[2] || "" ).split( "." ).sort(); - - // If event changes its type, use the special event handlers for the changed type - special = jQuery.event.special[ type ] || {}; - - // If selector defined, determine special event api type, otherwise given type - type = ( selector ? special.delegateType : special.bindType ) || type; - - // Update special based on newly reset type - special = jQuery.event.special[ type ] || {}; - - // handleObj is passed to all event handlers - handleObj = jQuery.extend({ - type: type, - origType: tns[1], - data: data, - handler: handler, - guid: handler.guid, - selector: selector, - needsContext: selector && jQuery.expr.match.needsContext.test( selector ), - namespace: namespaces.join(".") - }, handleObjIn ); - - // Init the event handler queue if we're the first - handlers = events[ type ]; - if ( !handlers ) { - handlers = events[ type ] = []; - handlers.delegateCount = 0; - - // Only use addEventListener/attachEvent if the special events handler returns false - if ( !special.setup || special.setup.call( elem, data, namespaces, eventHandle ) === false ) { - // Bind the global event handler to the element - if ( elem.addEventListener ) { - elem.addEventListener( type, eventHandle, false ); - - } else if ( elem.attachEvent ) { - elem.attachEvent( "on" + type, eventHandle ); - } - } - } - - if ( special.add ) { - special.add.call( elem, handleObj ); - - if ( !handleObj.handler.guid ) { - handleObj.handler.guid = handler.guid; - } - } - - // Add to the element's handler list, delegates in front - if ( selector ) { - handlers.splice( handlers.delegateCount++, 0, handleObj ); - } else { - handlers.push( handleObj ); - } - - // Keep track of which events have ever been used, for event optimization - jQuery.event.global[ type ] = true; - } - - // Nullify elem to prevent memory leaks in IE - elem = null; - }, - - global: {}, - - // Detach an event or set of events from an element - remove: function( elem, types, handler, selector, mappedTypes ) { - - var t, tns, type, origType, namespaces, origCount, - j, events, special, eventType, handleObj, - elemData = jQuery.hasData( elem ) && jQuery._data( elem ); - - if ( !elemData || !(events = elemData.events) ) { - return; - } - - // Once for each type.namespace in types; type may be omitted - types = jQuery.trim( hoverHack( types || "" ) ).split(" "); - for ( t = 0; t < types.length; t++ ) { - tns = rtypenamespace.exec( types[t] ) || []; - type = origType = tns[1]; - namespaces = tns[2]; - - // Unbind all events (on this namespace, if provided) for the element - if ( !type ) { - for ( type in events ) { - jQuery.event.remove( elem, type + types[ t ], handler, selector, true ); - } - continue; - } - - special = jQuery.event.special[ type ] || {}; - type = ( selector? special.delegateType : special.bindType ) || type; - eventType = events[ type ] || []; - origCount = eventType.length; - namespaces = namespaces ? new RegExp("(^|\\.)" + namespaces.split(".").sort().join("\\.(?:.*\\.|)") + "(\\.|$)") : null; - - // Remove matching events - for ( j = 0; j < eventType.length; j++ ) { - handleObj = eventType[ j ]; - - if ( ( mappedTypes || origType === handleObj.origType ) && - ( !handler || handler.guid === handleObj.guid ) && - ( !namespaces || namespaces.test( handleObj.namespace ) ) && - ( !selector || selector === handleObj.selector || selector === "**" && handleObj.selector ) ) { - eventType.splice( j--, 1 ); - - if ( handleObj.selector ) { - eventType.delegateCount--; - } - if ( special.remove ) { - special.remove.call( elem, handleObj ); - } - } - } - - // Remove generic event handler if we removed something and no more handlers exist - // (avoids potential for endless recursion during removal of special event handlers) - if ( eventType.length === 0 && origCount !== eventType.length ) { - if ( !special.teardown || special.teardown.call( elem, namespaces, elemData.handle ) === false ) { - jQuery.removeEvent( elem, type, elemData.handle ); - } - - delete events[ type ]; - } - } - - // Remove the expando if it's no longer used - if ( jQuery.isEmptyObject( events ) ) { - delete elemData.handle; - - // removeData also checks for emptiness and clears the expando if empty - // so use it instead of delete - jQuery.removeData( elem, "events", true ); - } - }, - - // Events that are safe to short-circuit if no handlers are attached. - // Native DOM events should not be added, they may have inline handlers. - customEvent: { - "getData": true, - "setData": true, - "changeData": true - }, - - trigger: function( event, data, elem, onlyHandlers ) { - // Don't do events on text and comment nodes - if ( elem && (elem.nodeType === 3 || elem.nodeType === 8) ) { - return; - } - - // Event object or event type - var cache, exclusive, i, cur, old, ontype, special, handle, eventPath, bubbleType, - type = event.type || event, - namespaces = []; - - // focus/blur morphs to focusin/out; ensure we're not firing them right now - if ( rfocusMorph.test( type + jQuery.event.triggered ) ) { - return; - } - - if ( type.indexOf( "!" ) >= 0 ) { - // Exclusive events trigger only for the exact event (no namespaces) - type = type.slice(0, -1); - exclusive = true; - } - - if ( type.indexOf( "." ) >= 0 ) { - // Namespaced trigger; create a regexp to match event type in handle() - namespaces = type.split("."); - type = namespaces.shift(); - namespaces.sort(); - } - - if ( (!elem || jQuery.event.customEvent[ type ]) && !jQuery.event.global[ type ] ) { - // No jQuery handlers for this event type, and it can't have inline handlers - return; - } - - // Caller can pass in an Event, Object, or just an event type string - event = typeof event === "object" ? - // jQuery.Event object - event[ jQuery.expando ] ? event : - // Object literal - new jQuery.Event( type, event ) : - // Just the event type (string) - new jQuery.Event( type ); - - event.type = type; - event.isTrigger = true; - event.exclusive = exclusive; - event.namespace = namespaces.join( "." ); - event.namespace_re = event.namespace? new RegExp("(^|\\.)" + namespaces.join("\\.(?:.*\\.|)") + "(\\.|$)") : null; - ontype = type.indexOf( ":" ) < 0 ? "on" + type : ""; - - // Handle a global trigger - if ( !elem ) { - - // TODO: Stop taunting the data cache; remove global events and always attach to document - cache = jQuery.cache; - for ( i in cache ) { - if ( cache[ i ].events && cache[ i ].events[ type ] ) { - jQuery.event.trigger( event, data, cache[ i ].handle.elem, true ); - } - } - return; - } - - // Clean up the event in case it is being reused - event.result = undefined; - if ( !event.target ) { - event.target = elem; - } - - // Clone any incoming data and prepend the event, creating the handler arg list - data = data != null ? jQuery.makeArray( data ) : []; - data.unshift( event ); - - // Allow special events to draw outside the lines - special = jQuery.event.special[ type ] || {}; - if ( special.trigger && special.trigger.apply( elem, data ) === false ) { - return; - } - - // Determine event propagation path in advance, per W3C events spec (#9951) - // Bubble up to document, then to window; watch for a global ownerDocument var (#9724) - eventPath = [[ elem, special.bindType || type ]]; - if ( !onlyHandlers && !special.noBubble && !jQuery.isWindow( elem ) ) { - - bubbleType = special.delegateType || type; - cur = rfocusMorph.test( bubbleType + type ) ? elem : elem.parentNode; - for ( old = elem; cur; cur = cur.parentNode ) { - eventPath.push([ cur, bubbleType ]); - old = cur; - } - - // Only add window if we got to document (e.g., not plain obj or detached DOM) - if ( old === (elem.ownerDocument || document) ) { - eventPath.push([ old.defaultView || old.parentWindow || window, bubbleType ]); - } - } - - // Fire handlers on the event path - for ( i = 0; i < eventPath.length && !event.isPropagationStopped(); i++ ) { - - cur = eventPath[i][0]; - event.type = eventPath[i][1]; - - handle = ( jQuery._data( cur, "events" ) || {} )[ event.type ] && jQuery._data( cur, "handle" ); - if ( handle ) { - handle.apply( cur, data ); - } - // Note that this is a bare JS function and not a jQuery handler - handle = ontype && cur[ ontype ]; - if ( handle && jQuery.acceptData( cur ) && handle.apply && handle.apply( cur, data ) === false ) { - event.preventDefault(); - } - } - event.type = type; - - // If nobody prevented the default action, do it now - if ( !onlyHandlers && !event.isDefaultPrevented() ) { - - if ( (!special._default || special._default.apply( elem.ownerDocument, data ) === false) && - !(type === "click" && jQuery.nodeName( elem, "a" )) && jQuery.acceptData( elem ) ) { - - // Call a native DOM method on the target with the same name name as the event. - // Can't use an .isFunction() check here because IE6/7 fails that test. - // Don't do default actions on window, that's where global variables be (#6170) - // IE<9 dies on focus/blur to hidden element (#1486) - if ( ontype && elem[ type ] && ((type !== "focus" && type !== "blur") || event.target.offsetWidth !== 0) && !jQuery.isWindow( elem ) ) { - - // Don't re-trigger an onFOO event when we call its FOO() method - old = elem[ ontype ]; - - if ( old ) { - elem[ ontype ] = null; - } - - // Prevent re-triggering of the same event, since we already bubbled it above - jQuery.event.triggered = type; - elem[ type ](); - jQuery.event.triggered = undefined; - - if ( old ) { - elem[ ontype ] = old; - } - } - } - } - - return event.result; - }, - - dispatch: function( event ) { - - // Make a writable jQuery.Event from the native event object - event = jQuery.event.fix( event || window.event ); - - var i, j, cur, ret, selMatch, matched, matches, handleObj, sel, related, - handlers = ( (jQuery._data( this, "events" ) || {} )[ event.type ] || []), - delegateCount = handlers.delegateCount, - args = core_slice.call( arguments ), - run_all = !event.exclusive && !event.namespace, - special = jQuery.event.special[ event.type ] || {}, - handlerQueue = []; - - // Use the fix-ed jQuery.Event rather than the (read-only) native event - args[0] = event; - event.delegateTarget = this; - - // Call the preDispatch hook for the mapped type, and let it bail if desired - if ( special.preDispatch && special.preDispatch.call( this, event ) === false ) { - return; - } - - // Determine handlers that should run if there are delegated events - // Avoid non-left-click bubbling in Firefox (#3861) - if ( delegateCount && !(event.button && event.type === "click") ) { - - for ( cur = event.target; cur != this; cur = cur.parentNode || this ) { - - // Don't process clicks (ONLY) on disabled elements (#6911, #8165, #11382, #11764) - if ( cur.disabled !== true || event.type !== "click" ) { - selMatch = {}; - matches = []; - for ( i = 0; i < delegateCount; i++ ) { - handleObj = handlers[ i ]; - sel = handleObj.selector; - - if ( selMatch[ sel ] === undefined ) { - selMatch[ sel ] = handleObj.needsContext ? - jQuery( sel, this ).index( cur ) >= 0 : - jQuery.find( sel, this, null, [ cur ] ).length; - } - if ( selMatch[ sel ] ) { - matches.push( handleObj ); - } - } - if ( matches.length ) { - handlerQueue.push({ elem: cur, matches: matches }); - } - } - } - } - - // Add the remaining (directly-bound) handlers - if ( handlers.length > delegateCount ) { - handlerQueue.push({ elem: this, matches: handlers.slice( delegateCount ) }); - } - - // Run delegates first; they may want to stop propagation beneath us - for ( i = 0; i < handlerQueue.length && !event.isPropagationStopped(); i++ ) { - matched = handlerQueue[ i ]; - event.currentTarget = matched.elem; - - for ( j = 0; j < matched.matches.length && !event.isImmediatePropagationStopped(); j++ ) { - handleObj = matched.matches[ j ]; - - // Triggered event must either 1) be non-exclusive and have no namespace, or - // 2) have namespace(s) a subset or equal to those in the bound event (both can have no namespace). - if ( run_all || (!event.namespace && !handleObj.namespace) || event.namespace_re && event.namespace_re.test( handleObj.namespace ) ) { - - event.data = handleObj.data; - event.handleObj = handleObj; - - ret = ( (jQuery.event.special[ handleObj.origType ] || {}).handle || handleObj.handler ) - .apply( matched.elem, args ); - - if ( ret !== undefined ) { - event.result = ret; - if ( ret === false ) { - event.preventDefault(); - event.stopPropagation(); - } - } - } - } - } - - // Call the postDispatch hook for the mapped type - if ( special.postDispatch ) { - special.postDispatch.call( this, event ); - } - - return event.result; - }, - - // Includes some event props shared by KeyEvent and MouseEvent - // *** attrChange attrName relatedNode srcElement are not normalized, non-W3C, deprecated, will be removed in 1.8 *** - props: "attrChange attrName relatedNode srcElement altKey bubbles cancelable ctrlKey currentTarget eventPhase metaKey relatedTarget shiftKey target timeStamp view which".split(" "), - - fixHooks: {}, - - keyHooks: { - props: "char charCode key keyCode".split(" "), - filter: function( event, original ) { - - // Add which for key events - if ( event.which == null ) { - event.which = original.charCode != null ? original.charCode : original.keyCode; - } - - return event; - } - }, - - mouseHooks: { - props: "button buttons clientX clientY fromElement offsetX offsetY pageX pageY screenX screenY toElement".split(" "), - filter: function( event, original ) { - var eventDoc, doc, body, - button = original.button, - fromElement = original.fromElement; - - // Calculate pageX/Y if missing and clientX/Y available - if ( event.pageX == null && original.clientX != null ) { - eventDoc = event.target.ownerDocument || document; - doc = eventDoc.documentElement; - body = eventDoc.body; - - event.pageX = original.clientX + ( doc && doc.scrollLeft || body && body.scrollLeft || 0 ) - ( doc && doc.clientLeft || body && body.clientLeft || 0 ); - event.pageY = original.clientY + ( doc && doc.scrollTop || body && body.scrollTop || 0 ) - ( doc && doc.clientTop || body && body.clientTop || 0 ); - } - - // Add relatedTarget, if necessary - if ( !event.relatedTarget && fromElement ) { - event.relatedTarget = fromElement === event.target ? original.toElement : fromElement; - } - - // Add which for click: 1 === left; 2 === middle; 3 === right - // Note: button is not normalized, so don't use it - if ( !event.which && button !== undefined ) { - event.which = ( button & 1 ? 1 : ( button & 2 ? 3 : ( button & 4 ? 2 : 0 ) ) ); - } - - return event; - } - }, - - fix: function( event ) { - if ( event[ jQuery.expando ] ) { - return event; - } - - // Create a writable copy of the event object and normalize some properties - var i, prop, - originalEvent = event, - fixHook = jQuery.event.fixHooks[ event.type ] || {}, - copy = fixHook.props ? this.props.concat( fixHook.props ) : this.props; - - event = jQuery.Event( originalEvent ); - - for ( i = copy.length; i; ) { - prop = copy[ --i ]; - event[ prop ] = originalEvent[ prop ]; - } - - // Fix target property, if necessary (#1925, IE 6/7/8 & Safari2) - if ( !event.target ) { - event.target = originalEvent.srcElement || document; - } - - // Target should not be a text node (#504, Safari) - if ( event.target.nodeType === 3 ) { - event.target = event.target.parentNode; - } - - // For mouse/key events, metaKey==false if it's undefined (#3368, #11328; IE6/7/8) - event.metaKey = !!event.metaKey; - - return fixHook.filter? fixHook.filter( event, originalEvent ) : event; - }, - - special: { - load: { - // Prevent triggered image.load events from bubbling to window.load - noBubble: true - }, - - focus: { - delegateType: "focusin" - }, - blur: { - delegateType: "focusout" - }, - - beforeunload: { - setup: function( data, namespaces, eventHandle ) { - // We only want to do this special case on windows - if ( jQuery.isWindow( this ) ) { - this.onbeforeunload = eventHandle; - } - }, - - teardown: function( namespaces, eventHandle ) { - if ( this.onbeforeunload === eventHandle ) { - this.onbeforeunload = null; - } - } - } - }, - - simulate: function( type, elem, event, bubble ) { - // Piggyback on a donor event to simulate a different one. - // Fake originalEvent to avoid donor's stopPropagation, but if the - // simulated event prevents default then we do the same on the donor. - var e = jQuery.extend( - new jQuery.Event(), - event, - { type: type, - isSimulated: true, - originalEvent: {} - } - ); - if ( bubble ) { - jQuery.event.trigger( e, null, elem ); - } else { - jQuery.event.dispatch.call( elem, e ); - } - if ( e.isDefaultPrevented() ) { - event.preventDefault(); - } - } -}; - -// Some plugins are using, but it's undocumented/deprecated and will be removed. -// The 1.7 special event interface should provide all the hooks needed now. -jQuery.event.handle = jQuery.event.dispatch; - -jQuery.removeEvent = document.removeEventListener ? - function( elem, type, handle ) { - if ( elem.removeEventListener ) { - elem.removeEventListener( type, handle, false ); - } - } : - function( elem, type, handle ) { - var name = "on" + type; - - if ( elem.detachEvent ) { - - // #8545, #7054, preventing memory leaks for custom events in IE6-8 - // detachEvent needed property on element, by name of that event, to properly expose it to GC - if ( typeof elem[ name ] === "undefined" ) { - elem[ name ] = null; - } - - elem.detachEvent( name, handle ); - } - }; - -jQuery.Event = function( src, props ) { - // Allow instantiation without the 'new' keyword - if ( !(this instanceof jQuery.Event) ) { - return new jQuery.Event( src, props ); - } - - // Event object - if ( src && src.type ) { - this.originalEvent = src; - this.type = src.type; - - // Events bubbling up the document may have been marked as prevented - // by a handler lower down the tree; reflect the correct value. - this.isDefaultPrevented = ( src.defaultPrevented || src.returnValue === false || - src.getPreventDefault && src.getPreventDefault() ) ? returnTrue : returnFalse; - - // Event type - } else { - this.type = src; - } - - // Put explicitly provided properties onto the event object - if ( props ) { - jQuery.extend( this, props ); - } - - // Create a timestamp if incoming event doesn't have one - this.timeStamp = src && src.timeStamp || jQuery.now(); - - // Mark it as fixed - this[ jQuery.expando ] = true; -}; - -function returnFalse() { - return false; -} -function returnTrue() { - return true; -} - -// jQuery.Event is based on DOM3 Events as specified by the ECMAScript Language Binding -// http://www.w3.org/TR/2003/WD-DOM-Level-3-Events-20030331/ecma-script-binding.html -jQuery.Event.prototype = { - preventDefault: function() { - this.isDefaultPrevented = returnTrue; - - var e = this.originalEvent; - if ( !e ) { - return; - } - - // if preventDefault exists run it on the original event - if ( e.preventDefault ) { - e.preventDefault(); - - // otherwise set the returnValue property of the original event to false (IE) - } else { - e.returnValue = false; - } - }, - stopPropagation: function() { - this.isPropagationStopped = returnTrue; - - var e = this.originalEvent; - if ( !e ) { - return; - } - // if stopPropagation exists run it on the original event - if ( e.stopPropagation ) { - e.stopPropagation(); - } - // otherwise set the cancelBubble property of the original event to true (IE) - e.cancelBubble = true; - }, - stopImmediatePropagation: function() { - this.isImmediatePropagationStopped = returnTrue; - this.stopPropagation(); - }, - isDefaultPrevented: returnFalse, - isPropagationStopped: returnFalse, - isImmediatePropagationStopped: returnFalse -}; - -// Create mouseenter/leave events using mouseover/out and event-time checks -jQuery.each({ - mouseenter: "mouseover", - mouseleave: "mouseout" -}, function( orig, fix ) { - jQuery.event.special[ orig ] = { - delegateType: fix, - bindType: fix, - - handle: function( event ) { - var ret, - target = this, - related = event.relatedTarget, - handleObj = event.handleObj, - selector = handleObj.selector; - - // For mousenter/leave call the handler if related is outside the target. - // NB: No relatedTarget if the mouse left/entered the browser window - if ( !related || (related !== target && !jQuery.contains( target, related )) ) { - event.type = handleObj.origType; - ret = handleObj.handler.apply( this, arguments ); - event.type = fix; - } - return ret; - } - }; -}); - -// IE submit delegation -if ( !jQuery.support.submitBubbles ) { - - jQuery.event.special.submit = { - setup: function() { - // Only need this for delegated form submit events - if ( jQuery.nodeName( this, "form" ) ) { - return false; - } - - // Lazy-add a submit handler when a descendant form may potentially be submitted - jQuery.event.add( this, "click._submit keypress._submit", function( e ) { - // Node name check avoids a VML-related crash in IE (#9807) - var elem = e.target, - form = jQuery.nodeName( elem, "input" ) || jQuery.nodeName( elem, "button" ) ? elem.form : undefined; - if ( form && !jQuery._data( form, "_submit_attached" ) ) { - jQuery.event.add( form, "submit._submit", function( event ) { - event._submit_bubble = true; - }); - jQuery._data( form, "_submit_attached", true ); - } - }); - // return undefined since we don't need an event listener - }, - - postDispatch: function( event ) { - // If form was submitted by the user, bubble the event up the tree - if ( event._submit_bubble ) { - delete event._submit_bubble; - if ( this.parentNode && !event.isTrigger ) { - jQuery.event.simulate( "submit", this.parentNode, event, true ); - } - } - }, - - teardown: function() { - // Only need this for delegated form submit events - if ( jQuery.nodeName( this, "form" ) ) { - return false; - } - - // Remove delegated handlers; cleanData eventually reaps submit handlers attached above - jQuery.event.remove( this, "._submit" ); - } - }; -} - -// IE change delegation and checkbox/radio fix -if ( !jQuery.support.changeBubbles ) { - - jQuery.event.special.change = { - - setup: function() { - - if ( rformElems.test( this.nodeName ) ) { - // IE doesn't fire change on a check/radio until blur; trigger it on click - // after a propertychange. Eat the blur-change in special.change.handle. - // This still fires onchange a second time for check/radio after blur. - if ( this.type === "checkbox" || this.type === "radio" ) { - jQuery.event.add( this, "propertychange._change", function( event ) { - if ( event.originalEvent.propertyName === "checked" ) { - this._just_changed = true; - } - }); - jQuery.event.add( this, "click._change", function( event ) { - if ( this._just_changed && !event.isTrigger ) { - this._just_changed = false; - } - // Allow triggered, simulated change events (#11500) - jQuery.event.simulate( "change", this, event, true ); - }); - } - return false; - } - // Delegated event; lazy-add a change handler on descendant inputs - jQuery.event.add( this, "beforeactivate._change", function( e ) { - var elem = e.target; - - if ( rformElems.test( elem.nodeName ) && !jQuery._data( elem, "_change_attached" ) ) { - jQuery.event.add( elem, "change._change", function( event ) { - if ( this.parentNode && !event.isSimulated && !event.isTrigger ) { - jQuery.event.simulate( "change", this.parentNode, event, true ); - } - }); - jQuery._data( elem, "_change_attached", true ); - } - }); - }, - - handle: function( event ) { - var elem = event.target; - - // Swallow native change events from checkbox/radio, we already triggered them above - if ( this !== elem || event.isSimulated || event.isTrigger || (elem.type !== "radio" && elem.type !== "checkbox") ) { - return event.handleObj.handler.apply( this, arguments ); - } - }, - - teardown: function() { - jQuery.event.remove( this, "._change" ); - - return !rformElems.test( this.nodeName ); - } - }; -} - -// Create "bubbling" focus and blur events -if ( !jQuery.support.focusinBubbles ) { - jQuery.each({ focus: "focusin", blur: "focusout" }, function( orig, fix ) { - - // Attach a single capturing handler while someone wants focusin/focusout - var attaches = 0, - handler = function( event ) { - jQuery.event.simulate( fix, event.target, jQuery.event.fix( event ), true ); - }; - - jQuery.event.special[ fix ] = { - setup: function() { - if ( attaches++ === 0 ) { - document.addEventListener( orig, handler, true ); - } - }, - teardown: function() { - if ( --attaches === 0 ) { - document.removeEventListener( orig, handler, true ); - } - } - }; - }); -} - -jQuery.fn.extend({ - - on: function( types, selector, data, fn, /*INTERNAL*/ one ) { - var origFn, type; - - // Types can be a map of types/handlers - if ( typeof types === "object" ) { - // ( types-Object, selector, data ) - if ( typeof selector !== "string" ) { // && selector != null - // ( types-Object, data ) - data = data || selector; - selector = undefined; - } - for ( type in types ) { - this.on( type, selector, data, types[ type ], one ); - } - return this; - } - - if ( data == null && fn == null ) { - // ( types, fn ) - fn = selector; - data = selector = undefined; - } else if ( fn == null ) { - if ( typeof selector === "string" ) { - // ( types, selector, fn ) - fn = data; - data = undefined; - } else { - // ( types, data, fn ) - fn = data; - data = selector; - selector = undefined; - } - } - if ( fn === false ) { - fn = returnFalse; - } else if ( !fn ) { - return this; - } - - if ( one === 1 ) { - origFn = fn; - fn = function( event ) { - // Can use an empty set, since event contains the info - jQuery().off( event ); - return origFn.apply( this, arguments ); - }; - // Use same guid so caller can remove using origFn - fn.guid = origFn.guid || ( origFn.guid = jQuery.guid++ ); - } - return this.each( function() { - jQuery.event.add( this, types, fn, data, selector ); - }); - }, - one: function( types, selector, data, fn ) { - return this.on( types, selector, data, fn, 1 ); - }, - off: function( types, selector, fn ) { - var handleObj, type; - if ( types && types.preventDefault && types.handleObj ) { - // ( event ) dispatched jQuery.Event - handleObj = types.handleObj; - jQuery( types.delegateTarget ).off( - handleObj.namespace ? handleObj.origType + "." + handleObj.namespace : handleObj.origType, - handleObj.selector, - handleObj.handler - ); - return this; - } - if ( typeof types === "object" ) { - // ( types-object [, selector] ) - for ( type in types ) { - this.off( type, selector, types[ type ] ); - } - return this; - } - if ( selector === false || typeof selector === "function" ) { - // ( types [, fn] ) - fn = selector; - selector = undefined; - } - if ( fn === false ) { - fn = returnFalse; - } - return this.each(function() { - jQuery.event.remove( this, types, fn, selector ); - }); - }, - - bind: function( types, data, fn ) { - return this.on( types, null, data, fn ); - }, - unbind: function( types, fn ) { - return this.off( types, null, fn ); - }, - - live: function( types, data, fn ) { - jQuery( this.context ).on( types, this.selector, data, fn ); - return this; - }, - die: function( types, fn ) { - jQuery( this.context ).off( types, this.selector || "**", fn ); - return this; - }, - - delegate: function( selector, types, data, fn ) { - return this.on( types, selector, data, fn ); - }, - undelegate: function( selector, types, fn ) { - // ( namespace ) or ( selector, types [, fn] ) - return arguments.length === 1 ? this.off( selector, "**" ) : this.off( types, selector || "**", fn ); - }, - - trigger: function( type, data ) { - return this.each(function() { - jQuery.event.trigger( type, data, this ); - }); - }, - triggerHandler: function( type, data ) { - if ( this[0] ) { - return jQuery.event.trigger( type, data, this[0], true ); - } - }, - - toggle: function( fn ) { - // Save reference to arguments for access in closure - var args = arguments, - guid = fn.guid || jQuery.guid++, - i = 0, - toggler = function( event ) { - // Figure out which function to execute - var lastToggle = ( jQuery._data( this, "lastToggle" + fn.guid ) || 0 ) % i; - jQuery._data( this, "lastToggle" + fn.guid, lastToggle + 1 ); - - // Make sure that clicks stop - event.preventDefault(); - - // and execute the function - return args[ lastToggle ].apply( this, arguments ) || false; - }; - - // link all the functions, so any of them can unbind this click handler - toggler.guid = guid; - while ( i < args.length ) { - args[ i++ ].guid = guid; - } - - return this.click( toggler ); - }, - - hover: function( fnOver, fnOut ) { - return this.mouseenter( fnOver ).mouseleave( fnOut || fnOver ); - } -}); - -jQuery.each( ("blur focus focusin focusout load resize scroll unload click dblclick " + - "mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave " + - "change select submit keydown keypress keyup error contextmenu").split(" "), function( i, name ) { - - // Handle event binding - jQuery.fn[ name ] = function( data, fn ) { - if ( fn == null ) { - fn = data; - data = null; - } - - return arguments.length > 0 ? - this.on( name, null, data, fn ) : - this.trigger( name ); - }; - - if ( rkeyEvent.test( name ) ) { - jQuery.event.fixHooks[ name ] = jQuery.event.keyHooks; - } - - if ( rmouseEvent.test( name ) ) { - jQuery.event.fixHooks[ name ] = jQuery.event.mouseHooks; - } -}); -/*! - * Sizzle CSS Selector Engine - * Copyright 2012 jQuery Foundation and other contributors - * Released under the MIT license - * http://sizzlejs.com/ - */ -(function( window, undefined ) { - -var cachedruns, - assertGetIdNotName, - Expr, - getText, - isXML, - contains, - compile, - sortOrder, - hasDuplicate, - outermostContext, - - baseHasDuplicate = true, - strundefined = "undefined", - - expando = ( "sizcache" + Math.random() ).replace( ".", "" ), - - Token = String, - document = window.document, - docElem = document.documentElement, - dirruns = 0, - done = 0, - pop = [].pop, - push = [].push, - slice = [].slice, - // Use a stripped-down indexOf if a native one is unavailable - indexOf = [].indexOf || function( elem ) { - var i = 0, - len = this.length; - for ( ; i < len; i++ ) { - if ( this[i] === elem ) { - return i; - } - } - return -1; - }, - - // Augment a function for special use by Sizzle - markFunction = function( fn, value ) { - fn[ expando ] = value == null || value; - return fn; - }, - - createCache = function() { - var cache = {}, - keys = []; - - return markFunction(function( key, value ) { - // Only keep the most recent entries - if ( keys.push( key ) > Expr.cacheLength ) { - delete cache[ keys.shift() ]; - } - - // Retrieve with (key + " ") to avoid collision with native Object.prototype properties (see Issue #157) - return (cache[ key + " " ] = value); - }, cache ); - }, - - classCache = createCache(), - tokenCache = createCache(), - compilerCache = createCache(), - - // Regex - - // Whitespace characters http://www.w3.org/TR/css3-selectors/#whitespace - whitespace = "[\\x20\\t\\r\\n\\f]", - // http://www.w3.org/TR/css3-syntax/#characters - characterEncoding = "(?:\\\\.|[-\\w]|[^\\x00-\\xa0])+", - - // Loosely modeled on CSS identifier characters - // An unquoted value should be a CSS identifier (http://www.w3.org/TR/css3-selectors/#attribute-selectors) - // Proper syntax: http://www.w3.org/TR/CSS21/syndata.html#value-def-identifier - identifier = characterEncoding.replace( "w", "w#" ), - - // Acceptable operators http://www.w3.org/TR/selectors/#attribute-selectors - operators = "([*^$|!~]?=)", - attributes = "\\[" + whitespace + "*(" + characterEncoding + ")" + whitespace + - "*(?:" + operators + whitespace + "*(?:(['\"])((?:\\\\.|[^\\\\])*?)\\3|(" + identifier + ")|)|)" + whitespace + "*\\]", - - // Prefer arguments not in parens/brackets, - // then attribute selectors and non-pseudos (denoted by :), - // then anything else - // These preferences are here to reduce the number of selectors - // needing tokenize in the PSEUDO preFilter - pseudos = ":(" + characterEncoding + ")(?:\\((?:(['\"])((?:\\\\.|[^\\\\])*?)\\2|([^()[\\]]*|(?:(?:" + attributes + ")|[^:]|\\\\.)*|.*))\\)|)", - - // For matchExpr.POS and matchExpr.needsContext - pos = ":(even|odd|eq|gt|lt|nth|first|last)(?:\\(" + whitespace + - "*((?:-\\d)?\\d*)" + whitespace + "*\\)|)(?=[^-]|$)", - - // Leading and non-escaped trailing whitespace, capturing some non-whitespace characters preceding the latter - rtrim = new RegExp( "^" + whitespace + "+|((?:^|[^\\\\])(?:\\\\.)*)" + whitespace + "+$", "g" ), - - rcomma = new RegExp( "^" + whitespace + "*," + whitespace + "*" ), - rcombinators = new RegExp( "^" + whitespace + "*([\\x20\\t\\r\\n\\f>+~])" + whitespace + "*" ), - rpseudo = new RegExp( pseudos ), - - // Easily-parseable/retrievable ID or TAG or CLASS selectors - rquickExpr = /^(?:#([\w\-]+)|(\w+)|\.([\w\-]+))$/, - - rnot = /^:not/, - rsibling = /[\x20\t\r\n\f]*[+~]/, - rendsWithNot = /:not\($/, - - rheader = /h\d/i, - rinputs = /input|select|textarea|button/i, - - rbackslash = /\\(?!\\)/g, - - matchExpr = { - "ID": new RegExp( "^#(" + characterEncoding + ")" ), - "CLASS": new RegExp( "^\\.(" + characterEncoding + ")" ), - "NAME": new RegExp( "^\\[name=['\"]?(" + characterEncoding + ")['\"]?\\]" ), - "TAG": new RegExp( "^(" + characterEncoding.replace( "w", "w*" ) + ")" ), - "ATTR": new RegExp( "^" + attributes ), - "PSEUDO": new RegExp( "^" + pseudos ), - "POS": new RegExp( pos, "i" ), - "CHILD": new RegExp( "^:(only|nth|first|last)-child(?:\\(" + whitespace + - "*(even|odd|(([+-]|)(\\d*)n|)" + whitespace + "*(?:([+-]|)" + whitespace + - "*(\\d+)|))" + whitespace + "*\\)|)", "i" ), - // For use in libraries implementing .is() - "needsContext": new RegExp( "^" + whitespace + "*[>+~]|" + pos, "i" ) - }, - - // Support - - // Used for testing something on an element - assert = function( fn ) { - var div = document.createElement("div"); - - try { - return fn( div ); - } catch (e) { - return false; - } finally { - // release memory in IE - div = null; - } - }, - - // Check if getElementsByTagName("*") returns only elements - assertTagNameNoComments = assert(function( div ) { - div.appendChild( document.createComment("") ); - return !div.getElementsByTagName("*").length; - }), - - // Check if getAttribute returns normalized href attributes - assertHrefNotNormalized = assert(function( div ) { - div.innerHTML = ""; - return div.firstChild && typeof div.firstChild.getAttribute !== strundefined && - div.firstChild.getAttribute("href") === "#"; - }), - - // Check if attributes should be retrieved by attribute nodes - assertAttributes = assert(function( div ) { - div.innerHTML = ""; - var type = typeof div.lastChild.getAttribute("multiple"); - // IE8 returns a string for some attributes even when not present - return type !== "boolean" && type !== "string"; - }), - - // Check if getElementsByClassName can be trusted - assertUsableClassName = assert(function( div ) { - // Opera can't find a second classname (in 9.6) - div.innerHTML = ""; - if ( !div.getElementsByClassName || !div.getElementsByClassName("e").length ) { - return false; - } - - // Safari 3.2 caches class attributes and doesn't catch changes - div.lastChild.className = "e"; - return div.getElementsByClassName("e").length === 2; - }), - - // Check if getElementById returns elements by name - // Check if getElementsByName privileges form controls or returns elements by ID - assertUsableName = assert(function( div ) { - // Inject content - div.id = expando + 0; - div.innerHTML = "
"; - docElem.insertBefore( div, docElem.firstChild ); - - // Test - var pass = document.getElementsByName && - // buggy browsers will return fewer than the correct 2 - document.getElementsByName( expando ).length === 2 + - // buggy browsers will return more than the correct 0 - document.getElementsByName( expando + 0 ).length; - assertGetIdNotName = !document.getElementById( expando ); - - // Cleanup - docElem.removeChild( div ); - - return pass; - }); - -// If slice is not available, provide a backup -try { - slice.call( docElem.childNodes, 0 )[0].nodeType; -} catch ( e ) { - slice = function( i ) { - var elem, - results = []; - for ( ; (elem = this[i]); i++ ) { - results.push( elem ); - } - return results; - }; -} - -function Sizzle( selector, context, results, seed ) { - results = results || []; - context = context || document; - var match, elem, xml, m, - nodeType = context.nodeType; - - if ( !selector || typeof selector !== "string" ) { - return results; - } - - if ( nodeType !== 1 && nodeType !== 9 ) { - return []; - } - - xml = isXML( context ); - - if ( !xml && !seed ) { - if ( (match = rquickExpr.exec( selector )) ) { - // Speed-up: Sizzle("#ID") - if ( (m = match[1]) ) { - if ( nodeType === 9 ) { - elem = context.getElementById( m ); - // Check parentNode to catch when Blackberry 4.6 returns - // nodes that are no longer in the document #6963 - if ( elem && elem.parentNode ) { - // Handle the case where IE, Opera, and Webkit return items - // by name instead of ID - if ( elem.id === m ) { - results.push( elem ); - return results; - } - } else { - return results; - } - } else { - // Context is not a document - if ( context.ownerDocument && (elem = context.ownerDocument.getElementById( m )) && - contains( context, elem ) && elem.id === m ) { - results.push( elem ); - return results; - } - } - - // Speed-up: Sizzle("TAG") - } else if ( match[2] ) { - push.apply( results, slice.call(context.getElementsByTagName( selector ), 0) ); - return results; - - // Speed-up: Sizzle(".CLASS") - } else if ( (m = match[3]) && assertUsableClassName && context.getElementsByClassName ) { - push.apply( results, slice.call(context.getElementsByClassName( m ), 0) ); - return results; - } - } - } - - // All others - return select( selector.replace( rtrim, "$1" ), context, results, seed, xml ); -} - -Sizzle.matches = function( expr, elements ) { - return Sizzle( expr, null, null, elements ); -}; - -Sizzle.matchesSelector = function( elem, expr ) { - return Sizzle( expr, null, null, [ elem ] ).length > 0; -}; - -// Returns a function to use in pseudos for input types -function createInputPseudo( type ) { - return function( elem ) { - var name = elem.nodeName.toLowerCase(); - return name === "input" && elem.type === type; - }; -} - -// Returns a function to use in pseudos for buttons -function createButtonPseudo( type ) { - return function( elem ) { - var name = elem.nodeName.toLowerCase(); - return (name === "input" || name === "button") && elem.type === type; - }; -} - -// Returns a function to use in pseudos for positionals -function createPositionalPseudo( fn ) { - return markFunction(function( argument ) { - argument = +argument; - return markFunction(function( seed, matches ) { - var j, - matchIndexes = fn( [], seed.length, argument ), - i = matchIndexes.length; - - // Match elements found at the specified indexes - while ( i-- ) { - if ( seed[ (j = matchIndexes[i]) ] ) { - seed[j] = !(matches[j] = seed[j]); - } - } - }); - }); -} - -/** - * Utility function for retrieving the text value of an array of DOM nodes - * @param {Array|Element} elem - */ -getText = Sizzle.getText = function( elem ) { - var node, - ret = "", - i = 0, - nodeType = elem.nodeType; - - if ( nodeType ) { - if ( nodeType === 1 || nodeType === 9 || nodeType === 11 ) { - // Use textContent for elements - // innerText usage removed for consistency of new lines (see #11153) - if ( typeof elem.textContent === "string" ) { - return elem.textContent; - } else { - // Traverse its children - for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) { - ret += getText( elem ); - } - } - } else if ( nodeType === 3 || nodeType === 4 ) { - return elem.nodeValue; - } - // Do not include comment or processing instruction nodes - } else { - - // If no nodeType, this is expected to be an array - for ( ; (node = elem[i]); i++ ) { - // Do not traverse comment nodes - ret += getText( node ); - } - } - return ret; -}; - -isXML = Sizzle.isXML = function( elem ) { - // documentElement is verified for cases where it doesn't yet exist - // (such as loading iframes in IE - #4833) - var documentElement = elem && (elem.ownerDocument || elem).documentElement; - return documentElement ? documentElement.nodeName !== "HTML" : false; -}; - -// Element contains another -contains = Sizzle.contains = docElem.contains ? - function( a, b ) { - var adown = a.nodeType === 9 ? a.documentElement : a, - bup = b && b.parentNode; - return a === bup || !!( bup && bup.nodeType === 1 && adown.contains && adown.contains(bup) ); - } : - docElem.compareDocumentPosition ? - function( a, b ) { - return b && !!( a.compareDocumentPosition( b ) & 16 ); - } : - function( a, b ) { - while ( (b = b.parentNode) ) { - if ( b === a ) { - return true; - } - } - return false; - }; - -Sizzle.attr = function( elem, name ) { - var val, - xml = isXML( elem ); - - if ( !xml ) { - name = name.toLowerCase(); - } - if ( (val = Expr.attrHandle[ name ]) ) { - return val( elem ); - } - if ( xml || assertAttributes ) { - return elem.getAttribute( name ); - } - val = elem.getAttributeNode( name ); - return val ? - typeof elem[ name ] === "boolean" ? - elem[ name ] ? name : null : - val.specified ? val.value : null : - null; -}; - -Expr = Sizzle.selectors = { - - // Can be adjusted by the user - cacheLength: 50, - - createPseudo: markFunction, - - match: matchExpr, - - // IE6/7 return a modified href - attrHandle: assertHrefNotNormalized ? - {} : - { - "href": function( elem ) { - return elem.getAttribute( "href", 2 ); - }, - "type": function( elem ) { - return elem.getAttribute("type"); - } - }, - - find: { - "ID": assertGetIdNotName ? - function( id, context, xml ) { - if ( typeof context.getElementById !== strundefined && !xml ) { - var m = context.getElementById( id ); - // Check parentNode to catch when Blackberry 4.6 returns - // nodes that are no longer in the document #6963 - return m && m.parentNode ? [m] : []; - } - } : - function( id, context, xml ) { - if ( typeof context.getElementById !== strundefined && !xml ) { - var m = context.getElementById( id ); - - return m ? - m.id === id || typeof m.getAttributeNode !== strundefined && m.getAttributeNode("id").value === id ? - [m] : - undefined : - []; - } - }, - - "TAG": assertTagNameNoComments ? - function( tag, context ) { - if ( typeof context.getElementsByTagName !== strundefined ) { - return context.getElementsByTagName( tag ); - } - } : - function( tag, context ) { - var results = context.getElementsByTagName( tag ); - - // Filter out possible comments - if ( tag === "*" ) { - var elem, - tmp = [], - i = 0; - - for ( ; (elem = results[i]); i++ ) { - if ( elem.nodeType === 1 ) { - tmp.push( elem ); - } - } - - return tmp; - } - return results; - }, - - "NAME": assertUsableName && function( tag, context ) { - if ( typeof context.getElementsByName !== strundefined ) { - return context.getElementsByName( name ); - } - }, - - "CLASS": assertUsableClassName && function( className, context, xml ) { - if ( typeof context.getElementsByClassName !== strundefined && !xml ) { - return context.getElementsByClassName( className ); - } - } - }, - - relative: { - ">": { dir: "parentNode", first: true }, - " ": { dir: "parentNode" }, - "+": { dir: "previousSibling", first: true }, - "~": { dir: "previousSibling" } - }, - - preFilter: { - "ATTR": function( match ) { - match[1] = match[1].replace( rbackslash, "" ); - - // Move the given value to match[3] whether quoted or unquoted - match[3] = ( match[4] || match[5] || "" ).replace( rbackslash, "" ); - - if ( match[2] === "~=" ) { - match[3] = " " + match[3] + " "; - } - - return match.slice( 0, 4 ); - }, - - "CHILD": function( match ) { - /* matches from matchExpr["CHILD"] - 1 type (only|nth|...) - 2 argument (even|odd|\d*|\d*n([+-]\d+)?|...) - 3 xn-component of xn+y argument ([+-]?\d*n|) - 4 sign of xn-component - 5 x of xn-component - 6 sign of y-component - 7 y of y-component - */ - match[1] = match[1].toLowerCase(); - - if ( match[1] === "nth" ) { - // nth-child requires argument - if ( !match[2] ) { - Sizzle.error( match[0] ); - } - - // numeric x and y parameters for Expr.filter.CHILD - // remember that false/true cast respectively to 0/1 - match[3] = +( match[3] ? match[4] + (match[5] || 1) : 2 * ( match[2] === "even" || match[2] === "odd" ) ); - match[4] = +( ( match[6] + match[7] ) || match[2] === "odd" ); - - // other types prohibit arguments - } else if ( match[2] ) { - Sizzle.error( match[0] ); - } - - return match; - }, - - "PSEUDO": function( match ) { - var unquoted, excess; - if ( matchExpr["CHILD"].test( match[0] ) ) { - return null; - } - - if ( match[3] ) { - match[2] = match[3]; - } else if ( (unquoted = match[4]) ) { - // Only check arguments that contain a pseudo - if ( rpseudo.test(unquoted) && - // Get excess from tokenize (recursively) - (excess = tokenize( unquoted, true )) && - // advance to the next closing parenthesis - (excess = unquoted.indexOf( ")", unquoted.length - excess ) - unquoted.length) ) { - - // excess is a negative index - unquoted = unquoted.slice( 0, excess ); - match[0] = match[0].slice( 0, excess ); - } - match[2] = unquoted; - } - - // Return only captures needed by the pseudo filter method (type and argument) - return match.slice( 0, 3 ); - } - }, - - filter: { - "ID": assertGetIdNotName ? - function( id ) { - id = id.replace( rbackslash, "" ); - return function( elem ) { - return elem.getAttribute("id") === id; - }; - } : - function( id ) { - id = id.replace( rbackslash, "" ); - return function( elem ) { - var node = typeof elem.getAttributeNode !== strundefined && elem.getAttributeNode("id"); - return node && node.value === id; - }; - }, - - "TAG": function( nodeName ) { - if ( nodeName === "*" ) { - return function() { return true; }; - } - nodeName = nodeName.replace( rbackslash, "" ).toLowerCase(); - - return function( elem ) { - return elem.nodeName && elem.nodeName.toLowerCase() === nodeName; - }; - }, - - "CLASS": function( className ) { - var pattern = classCache[ expando ][ className + " " ]; - - return pattern || - (pattern = new RegExp( "(^|" + whitespace + ")" + className + "(" + whitespace + "|$)" )) && - classCache( className, function( elem ) { - return pattern.test( elem.className || (typeof elem.getAttribute !== strundefined && elem.getAttribute("class")) || "" ); - }); - }, - - "ATTR": function( name, operator, check ) { - return function( elem, context ) { - var result = Sizzle.attr( elem, name ); - - if ( result == null ) { - return operator === "!="; - } - if ( !operator ) { - return true; - } - - result += ""; - - return operator === "=" ? result === check : - operator === "!=" ? result !== check : - operator === "^=" ? check && result.indexOf( check ) === 0 : - operator === "*=" ? check && result.indexOf( check ) > -1 : - operator === "$=" ? check && result.substr( result.length - check.length ) === check : - operator === "~=" ? ( " " + result + " " ).indexOf( check ) > -1 : - operator === "|=" ? result === check || result.substr( 0, check.length + 1 ) === check + "-" : - false; - }; - }, - - "CHILD": function( type, argument, first, last ) { - - if ( type === "nth" ) { - return function( elem ) { - var node, diff, - parent = elem.parentNode; - - if ( first === 1 && last === 0 ) { - return true; - } - - if ( parent ) { - diff = 0; - for ( node = parent.firstChild; node; node = node.nextSibling ) { - if ( node.nodeType === 1 ) { - diff++; - if ( elem === node ) { - break; - } - } - } - } - - // Incorporate the offset (or cast to NaN), then check against cycle size - diff -= last; - return diff === first || ( diff % first === 0 && diff / first >= 0 ); - }; - } - - return function( elem ) { - var node = elem; - - switch ( type ) { - case "only": - case "first": - while ( (node = node.previousSibling) ) { - if ( node.nodeType === 1 ) { - return false; - } - } - - if ( type === "first" ) { - return true; - } - - node = elem; - - /* falls through */ - case "last": - while ( (node = node.nextSibling) ) { - if ( node.nodeType === 1 ) { - return false; - } - } - - return true; - } - }; - }, - - "PSEUDO": function( pseudo, argument ) { - // pseudo-class names are case-insensitive - // http://www.w3.org/TR/selectors/#pseudo-classes - // Prioritize by case sensitivity in case custom pseudos are added with uppercase letters - // Remember that setFilters inherits from pseudos - var args, - fn = Expr.pseudos[ pseudo ] || Expr.setFilters[ pseudo.toLowerCase() ] || - Sizzle.error( "unsupported pseudo: " + pseudo ); - - // The user may use createPseudo to indicate that - // arguments are needed to create the filter function - // just as Sizzle does - if ( fn[ expando ] ) { - return fn( argument ); - } - - // But maintain support for old signatures - if ( fn.length > 1 ) { - args = [ pseudo, pseudo, "", argument ]; - return Expr.setFilters.hasOwnProperty( pseudo.toLowerCase() ) ? - markFunction(function( seed, matches ) { - var idx, - matched = fn( seed, argument ), - i = matched.length; - while ( i-- ) { - idx = indexOf.call( seed, matched[i] ); - seed[ idx ] = !( matches[ idx ] = matched[i] ); - } - }) : - function( elem ) { - return fn( elem, 0, args ); - }; - } - - return fn; - } - }, - - pseudos: { - "not": markFunction(function( selector ) { - // Trim the selector passed to compile - // to avoid treating leading and trailing - // spaces as combinators - var input = [], - results = [], - matcher = compile( selector.replace( rtrim, "$1" ) ); - - return matcher[ expando ] ? - markFunction(function( seed, matches, context, xml ) { - var elem, - unmatched = matcher( seed, null, xml, [] ), - i = seed.length; - - // Match elements unmatched by `matcher` - while ( i-- ) { - if ( (elem = unmatched[i]) ) { - seed[i] = !(matches[i] = elem); - } - } - }) : - function( elem, context, xml ) { - input[0] = elem; - matcher( input, null, xml, results ); - return !results.pop(); - }; - }), - - "has": markFunction(function( selector ) { - return function( elem ) { - return Sizzle( selector, elem ).length > 0; - }; - }), - - "contains": markFunction(function( text ) { - return function( elem ) { - return ( elem.textContent || elem.innerText || getText( elem ) ).indexOf( text ) > -1; - }; - }), - - "enabled": function( elem ) { - return elem.disabled === false; - }, - - "disabled": function( elem ) { - return elem.disabled === true; - }, - - "checked": function( elem ) { - // In CSS3, :checked should return both checked and selected elements - // http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked - var nodeName = elem.nodeName.toLowerCase(); - return (nodeName === "input" && !!elem.checked) || (nodeName === "option" && !!elem.selected); - }, - - "selected": function( elem ) { - // Accessing this property makes selected-by-default - // options in Safari work properly - if ( elem.parentNode ) { - elem.parentNode.selectedIndex; - } - - return elem.selected === true; - }, - - "parent": function( elem ) { - return !Expr.pseudos["empty"]( elem ); - }, - - "empty": function( elem ) { - // http://www.w3.org/TR/selectors/#empty-pseudo - // :empty is only affected by element nodes and content nodes(including text(3), cdata(4)), - // not comment, processing instructions, or others - // Thanks to Diego Perini for the nodeName shortcut - // Greater than "@" means alpha characters (specifically not starting with "#" or "?") - var nodeType; - elem = elem.firstChild; - while ( elem ) { - if ( elem.nodeName > "@" || (nodeType = elem.nodeType) === 3 || nodeType === 4 ) { - return false; - } - elem = elem.nextSibling; - } - return true; - }, - - "header": function( elem ) { - return rheader.test( elem.nodeName ); - }, - - "text": function( elem ) { - var type, attr; - // IE6 and 7 will map elem.type to 'text' for new HTML5 types (search, etc) - // use getAttribute instead to test this case - return elem.nodeName.toLowerCase() === "input" && - (type = elem.type) === "text" && - ( (attr = elem.getAttribute("type")) == null || attr.toLowerCase() === type ); - }, - - // Input types - "radio": createInputPseudo("radio"), - "checkbox": createInputPseudo("checkbox"), - "file": createInputPseudo("file"), - "password": createInputPseudo("password"), - "image": createInputPseudo("image"), - - "submit": createButtonPseudo("submit"), - "reset": createButtonPseudo("reset"), - - "button": function( elem ) { - var name = elem.nodeName.toLowerCase(); - return name === "input" && elem.type === "button" || name === "button"; - }, - - "input": function( elem ) { - return rinputs.test( elem.nodeName ); - }, - - "focus": function( elem ) { - var doc = elem.ownerDocument; - return elem === doc.activeElement && (!doc.hasFocus || doc.hasFocus()) && !!(elem.type || elem.href || ~elem.tabIndex); - }, - - "active": function( elem ) { - return elem === elem.ownerDocument.activeElement; - }, - - // Positional types - "first": createPositionalPseudo(function() { - return [ 0 ]; - }), - - "last": createPositionalPseudo(function( matchIndexes, length ) { - return [ length - 1 ]; - }), - - "eq": createPositionalPseudo(function( matchIndexes, length, argument ) { - return [ argument < 0 ? argument + length : argument ]; - }), - - "even": createPositionalPseudo(function( matchIndexes, length ) { - for ( var i = 0; i < length; i += 2 ) { - matchIndexes.push( i ); - } - return matchIndexes; - }), - - "odd": createPositionalPseudo(function( matchIndexes, length ) { - for ( var i = 1; i < length; i += 2 ) { - matchIndexes.push( i ); - } - return matchIndexes; - }), - - "lt": createPositionalPseudo(function( matchIndexes, length, argument ) { - for ( var i = argument < 0 ? argument + length : argument; --i >= 0; ) { - matchIndexes.push( i ); - } - return matchIndexes; - }), - - "gt": createPositionalPseudo(function( matchIndexes, length, argument ) { - for ( var i = argument < 0 ? argument + length : argument; ++i < length; ) { - matchIndexes.push( i ); - } - return matchIndexes; - }) - } -}; - -function siblingCheck( a, b, ret ) { - if ( a === b ) { - return ret; - } - - var cur = a.nextSibling; - - while ( cur ) { - if ( cur === b ) { - return -1; - } - - cur = cur.nextSibling; - } - - return 1; -} - -sortOrder = docElem.compareDocumentPosition ? - function( a, b ) { - if ( a === b ) { - hasDuplicate = true; - return 0; - } - - return ( !a.compareDocumentPosition || !b.compareDocumentPosition ? - a.compareDocumentPosition : - a.compareDocumentPosition(b) & 4 - ) ? -1 : 1; - } : - function( a, b ) { - // The nodes are identical, we can exit early - if ( a === b ) { - hasDuplicate = true; - return 0; - - // Fallback to using sourceIndex (in IE) if it's available on both nodes - } else if ( a.sourceIndex && b.sourceIndex ) { - return a.sourceIndex - b.sourceIndex; - } - - var al, bl, - ap = [], - bp = [], - aup = a.parentNode, - bup = b.parentNode, - cur = aup; - - // If the nodes are siblings (or identical) we can do a quick check - if ( aup === bup ) { - return siblingCheck( a, b ); - - // If no parents were found then the nodes are disconnected - } else if ( !aup ) { - return -1; - - } else if ( !bup ) { - return 1; - } - - // Otherwise they're somewhere else in the tree so we need - // to build up a full list of the parentNodes for comparison - while ( cur ) { - ap.unshift( cur ); - cur = cur.parentNode; - } - - cur = bup; - - while ( cur ) { - bp.unshift( cur ); - cur = cur.parentNode; - } - - al = ap.length; - bl = bp.length; - - // Start walking down the tree looking for a discrepancy - for ( var i = 0; i < al && i < bl; i++ ) { - if ( ap[i] !== bp[i] ) { - return siblingCheck( ap[i], bp[i] ); - } - } - - // We ended someplace up the tree so do a sibling check - return i === al ? - siblingCheck( a, bp[i], -1 ) : - siblingCheck( ap[i], b, 1 ); - }; - -// Always assume the presence of duplicates if sort doesn't -// pass them to our comparison function (as in Google Chrome). -[0, 0].sort( sortOrder ); -baseHasDuplicate = !hasDuplicate; - -// Document sorting and removing duplicates -Sizzle.uniqueSort = function( results ) { - var elem, - duplicates = [], - i = 1, - j = 0; - - hasDuplicate = baseHasDuplicate; - results.sort( sortOrder ); - - if ( hasDuplicate ) { - for ( ; (elem = results[i]); i++ ) { - if ( elem === results[ i - 1 ] ) { - j = duplicates.push( i ); - } - } - while ( j-- ) { - results.splice( duplicates[ j ], 1 ); - } - } - - return results; -}; - -Sizzle.error = function( msg ) { - throw new Error( "Syntax error, unrecognized expression: " + msg ); -}; - -function tokenize( selector, parseOnly ) { - var matched, match, tokens, type, - soFar, groups, preFilters, - cached = tokenCache[ expando ][ selector + " " ]; - - if ( cached ) { - return parseOnly ? 0 : cached.slice( 0 ); - } - - soFar = selector; - groups = []; - preFilters = Expr.preFilter; - - while ( soFar ) { - - // Comma and first run - if ( !matched || (match = rcomma.exec( soFar )) ) { - if ( match ) { - // Don't consume trailing commas as valid - soFar = soFar.slice( match[0].length ) || soFar; - } - groups.push( tokens = [] ); - } - - matched = false; - - // Combinators - if ( (match = rcombinators.exec( soFar )) ) { - tokens.push( matched = new Token( match.shift() ) ); - soFar = soFar.slice( matched.length ); - - // Cast descendant combinators to space - matched.type = match[0].replace( rtrim, " " ); - } - - // Filters - for ( type in Expr.filter ) { - if ( (match = matchExpr[ type ].exec( soFar )) && (!preFilters[ type ] || - (match = preFilters[ type ]( match ))) ) { - - tokens.push( matched = new Token( match.shift() ) ); - soFar = soFar.slice( matched.length ); - matched.type = type; - matched.matches = match; - } - } - - if ( !matched ) { - break; - } - } - - // Return the length of the invalid excess - // if we're just parsing - // Otherwise, throw an error or return tokens - return parseOnly ? - soFar.length : - soFar ? - Sizzle.error( selector ) : - // Cache the tokens - tokenCache( selector, groups ).slice( 0 ); -} - -function addCombinator( matcher, combinator, base ) { - var dir = combinator.dir, - checkNonElements = base && combinator.dir === "parentNode", - doneName = done++; - - return combinator.first ? - // Check against closest ancestor/preceding element - function( elem, context, xml ) { - while ( (elem = elem[ dir ]) ) { - if ( checkNonElements || elem.nodeType === 1 ) { - return matcher( elem, context, xml ); - } - } - } : - - // Check against all ancestor/preceding elements - function( elem, context, xml ) { - // We can't set arbitrary data on XML nodes, so they don't benefit from dir caching - if ( !xml ) { - var cache, - dirkey = dirruns + " " + doneName + " ", - cachedkey = dirkey + cachedruns; - while ( (elem = elem[ dir ]) ) { - if ( checkNonElements || elem.nodeType === 1 ) { - if ( (cache = elem[ expando ]) === cachedkey ) { - return elem.sizset; - } else if ( typeof cache === "string" && cache.indexOf(dirkey) === 0 ) { - if ( elem.sizset ) { - return elem; - } - } else { - elem[ expando ] = cachedkey; - if ( matcher( elem, context, xml ) ) { - elem.sizset = true; - return elem; - } - elem.sizset = false; - } - } - } - } else { - while ( (elem = elem[ dir ]) ) { - if ( checkNonElements || elem.nodeType === 1 ) { - if ( matcher( elem, context, xml ) ) { - return elem; - } - } - } - } - }; -} - -function elementMatcher( matchers ) { - return matchers.length > 1 ? - function( elem, context, xml ) { - var i = matchers.length; - while ( i-- ) { - if ( !matchers[i]( elem, context, xml ) ) { - return false; - } - } - return true; - } : - matchers[0]; -} - -function condense( unmatched, map, filter, context, xml ) { - var elem, - newUnmatched = [], - i = 0, - len = unmatched.length, - mapped = map != null; - - for ( ; i < len; i++ ) { - if ( (elem = unmatched[i]) ) { - if ( !filter || filter( elem, context, xml ) ) { - newUnmatched.push( elem ); - if ( mapped ) { - map.push( i ); - } - } - } - } - - return newUnmatched; -} - -function setMatcher( preFilter, selector, matcher, postFilter, postFinder, postSelector ) { - if ( postFilter && !postFilter[ expando ] ) { - postFilter = setMatcher( postFilter ); - } - if ( postFinder && !postFinder[ expando ] ) { - postFinder = setMatcher( postFinder, postSelector ); - } - return markFunction(function( seed, results, context, xml ) { - var temp, i, elem, - preMap = [], - postMap = [], - preexisting = results.length, - - // Get initial elements from seed or context - elems = seed || multipleContexts( selector || "*", context.nodeType ? [ context ] : context, [] ), - - // Prefilter to get matcher input, preserving a map for seed-results synchronization - matcherIn = preFilter && ( seed || !selector ) ? - condense( elems, preMap, preFilter, context, xml ) : - elems, - - matcherOut = matcher ? - // If we have a postFinder, or filtered seed, or non-seed postFilter or preexisting results, - postFinder || ( seed ? preFilter : preexisting || postFilter ) ? - - // ...intermediate processing is necessary - [] : - - // ...otherwise use results directly - results : - matcherIn; - - // Find primary matches - if ( matcher ) { - matcher( matcherIn, matcherOut, context, xml ); - } - - // Apply postFilter - if ( postFilter ) { - temp = condense( matcherOut, postMap ); - postFilter( temp, [], context, xml ); - - // Un-match failing elements by moving them back to matcherIn - i = temp.length; - while ( i-- ) { - if ( (elem = temp[i]) ) { - matcherOut[ postMap[i] ] = !(matcherIn[ postMap[i] ] = elem); - } - } - } - - if ( seed ) { - if ( postFinder || preFilter ) { - if ( postFinder ) { - // Get the final matcherOut by condensing this intermediate into postFinder contexts - temp = []; - i = matcherOut.length; - while ( i-- ) { - if ( (elem = matcherOut[i]) ) { - // Restore matcherIn since elem is not yet a final match - temp.push( (matcherIn[i] = elem) ); - } - } - postFinder( null, (matcherOut = []), temp, xml ); - } - - // Move matched elements from seed to results to keep them synchronized - i = matcherOut.length; - while ( i-- ) { - if ( (elem = matcherOut[i]) && - (temp = postFinder ? indexOf.call( seed, elem ) : preMap[i]) > -1 ) { - - seed[temp] = !(results[temp] = elem); - } - } - } - - // Add elements to results, through postFinder if defined - } else { - matcherOut = condense( - matcherOut === results ? - matcherOut.splice( preexisting, matcherOut.length ) : - matcherOut - ); - if ( postFinder ) { - postFinder( null, results, matcherOut, xml ); - } else { - push.apply( results, matcherOut ); - } - } - }); -} - -function matcherFromTokens( tokens ) { - var checkContext, matcher, j, - len = tokens.length, - leadingRelative = Expr.relative[ tokens[0].type ], - implicitRelative = leadingRelative || Expr.relative[" "], - i = leadingRelative ? 1 : 0, - - // The foundational matcher ensures that elements are reachable from top-level context(s) - matchContext = addCombinator( function( elem ) { - return elem === checkContext; - }, implicitRelative, true ), - matchAnyContext = addCombinator( function( elem ) { - return indexOf.call( checkContext, elem ) > -1; - }, implicitRelative, true ), - matchers = [ function( elem, context, xml ) { - return ( !leadingRelative && ( xml || context !== outermostContext ) ) || ( - (checkContext = context).nodeType ? - matchContext( elem, context, xml ) : - matchAnyContext( elem, context, xml ) ); - } ]; - - for ( ; i < len; i++ ) { - if ( (matcher = Expr.relative[ tokens[i].type ]) ) { - matchers = [ addCombinator( elementMatcher( matchers ), matcher ) ]; - } else { - matcher = Expr.filter[ tokens[i].type ].apply( null, tokens[i].matches ); - - // Return special upon seeing a positional matcher - if ( matcher[ expando ] ) { - // Find the next relative operator (if any) for proper handling - j = ++i; - for ( ; j < len; j++ ) { - if ( Expr.relative[ tokens[j].type ] ) { - break; - } - } - return setMatcher( - i > 1 && elementMatcher( matchers ), - i > 1 && tokens.slice( 0, i - 1 ).join("").replace( rtrim, "$1" ), - matcher, - i < j && matcherFromTokens( tokens.slice( i, j ) ), - j < len && matcherFromTokens( (tokens = tokens.slice( j )) ), - j < len && tokens.join("") - ); - } - matchers.push( matcher ); - } - } - - return elementMatcher( matchers ); -} - -function matcherFromGroupMatchers( elementMatchers, setMatchers ) { - var bySet = setMatchers.length > 0, - byElement = elementMatchers.length > 0, - superMatcher = function( seed, context, xml, results, expandContext ) { - var elem, j, matcher, - setMatched = [], - matchedCount = 0, - i = "0", - unmatched = seed && [], - outermost = expandContext != null, - contextBackup = outermostContext, - // We must always have either seed elements or context - elems = seed || byElement && Expr.find["TAG"]( "*", expandContext && context.parentNode || context ), - // Nested matchers should use non-integer dirruns - dirrunsUnique = (dirruns += contextBackup == null ? 1 : Math.E); - - if ( outermost ) { - outermostContext = context !== document && context; - cachedruns = superMatcher.el; - } - - // Add elements passing elementMatchers directly to results - for ( ; (elem = elems[i]) != null; i++ ) { - if ( byElement && elem ) { - for ( j = 0; (matcher = elementMatchers[j]); j++ ) { - if ( matcher( elem, context, xml ) ) { - results.push( elem ); - break; - } - } - if ( outermost ) { - dirruns = dirrunsUnique; - cachedruns = ++superMatcher.el; - } - } - - // Track unmatched elements for set filters - if ( bySet ) { - // They will have gone through all possible matchers - if ( (elem = !matcher && elem) ) { - matchedCount--; - } - - // Lengthen the array for every element, matched or not - if ( seed ) { - unmatched.push( elem ); - } - } - } - - // Apply set filters to unmatched elements - matchedCount += i; - if ( bySet && i !== matchedCount ) { - for ( j = 0; (matcher = setMatchers[j]); j++ ) { - matcher( unmatched, setMatched, context, xml ); - } - - if ( seed ) { - // Reintegrate element matches to eliminate the need for sorting - if ( matchedCount > 0 ) { - while ( i-- ) { - if ( !(unmatched[i] || setMatched[i]) ) { - setMatched[i] = pop.call( results ); - } - } - } - - // Discard index placeholder values to get only actual matches - setMatched = condense( setMatched ); - } - - // Add matches to results - push.apply( results, setMatched ); - - // Seedless set matches succeeding multiple successful matchers stipulate sorting - if ( outermost && !seed && setMatched.length > 0 && - ( matchedCount + setMatchers.length ) > 1 ) { - - Sizzle.uniqueSort( results ); - } - } - - // Override manipulation of globals by nested matchers - if ( outermost ) { - dirruns = dirrunsUnique; - outermostContext = contextBackup; - } - - return unmatched; - }; - - superMatcher.el = 0; - return bySet ? - markFunction( superMatcher ) : - superMatcher; -} - -compile = Sizzle.compile = function( selector, group /* Internal Use Only */ ) { - var i, - setMatchers = [], - elementMatchers = [], - cached = compilerCache[ expando ][ selector + " " ]; - - if ( !cached ) { - // Generate a function of recursive functions that can be used to check each element - if ( !group ) { - group = tokenize( selector ); - } - i = group.length; - while ( i-- ) { - cached = matcherFromTokens( group[i] ); - if ( cached[ expando ] ) { - setMatchers.push( cached ); - } else { - elementMatchers.push( cached ); - } - } - - // Cache the compiled function - cached = compilerCache( selector, matcherFromGroupMatchers( elementMatchers, setMatchers ) ); - } - return cached; -}; - -function multipleContexts( selector, contexts, results ) { - var i = 0, - len = contexts.length; - for ( ; i < len; i++ ) { - Sizzle( selector, contexts[i], results ); - } - return results; -} - -function select( selector, context, results, seed, xml ) { - var i, tokens, token, type, find, - match = tokenize( selector ), - j = match.length; - - if ( !seed ) { - // Try to minimize operations if there is only one group - if ( match.length === 1 ) { - - // Take a shortcut and set the context if the root selector is an ID - tokens = match[0] = match[0].slice( 0 ); - if ( tokens.length > 2 && (token = tokens[0]).type === "ID" && - context.nodeType === 9 && !xml && - Expr.relative[ tokens[1].type ] ) { - - context = Expr.find["ID"]( token.matches[0].replace( rbackslash, "" ), context, xml )[0]; - if ( !context ) { - return results; - } - - selector = selector.slice( tokens.shift().length ); - } - - // Fetch a seed set for right-to-left matching - for ( i = matchExpr["POS"].test( selector ) ? -1 : tokens.length - 1; i >= 0; i-- ) { - token = tokens[i]; - - // Abort if we hit a combinator - if ( Expr.relative[ (type = token.type) ] ) { - break; - } - if ( (find = Expr.find[ type ]) ) { - // Search, expanding context for leading sibling combinators - if ( (seed = find( - token.matches[0].replace( rbackslash, "" ), - rsibling.test( tokens[0].type ) && context.parentNode || context, - xml - )) ) { - - // If seed is empty or no tokens remain, we can return early - tokens.splice( i, 1 ); - selector = seed.length && tokens.join(""); - if ( !selector ) { - push.apply( results, slice.call( seed, 0 ) ); - return results; - } - - break; - } - } - } - } - } - - // Compile and execute a filtering function - // Provide `match` to avoid retokenization if we modified the selector above - compile( selector, match )( - seed, - context, - xml, - results, - rsibling.test( selector ) - ); - return results; -} - -if ( document.querySelectorAll ) { - (function() { - var disconnectedMatch, - oldSelect = select, - rescape = /'|\\/g, - rattributeQuotes = /\=[\x20\t\r\n\f]*([^'"\]]*)[\x20\t\r\n\f]*\]/g, - - // qSa(:focus) reports false when true (Chrome 21), no need to also add to buggyMatches since matches checks buggyQSA - // A support test would require too much code (would include document ready) - rbuggyQSA = [ ":focus" ], - - // matchesSelector(:active) reports false when true (IE9/Opera 11.5) - // A support test would require too much code (would include document ready) - // just skip matchesSelector for :active - rbuggyMatches = [ ":active" ], - matches = docElem.matchesSelector || - docElem.mozMatchesSelector || - docElem.webkitMatchesSelector || - docElem.oMatchesSelector || - docElem.msMatchesSelector; - - // Build QSA regex - // Regex strategy adopted from Diego Perini - assert(function( div ) { - // Select is set to empty string on purpose - // This is to test IE's treatment of not explictly - // setting a boolean content attribute, - // since its presence should be enough - // http://bugs.jquery.com/ticket/12359 - div.innerHTML = ""; - - // IE8 - Some boolean attributes are not treated correctly - if ( !div.querySelectorAll("[selected]").length ) { - rbuggyQSA.push( "\\[" + whitespace + "*(?:checked|disabled|ismap|multiple|readonly|selected|value)" ); - } - - // Webkit/Opera - :checked should return selected option elements - // http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked - // IE8 throws error here (do not put tests after this one) - if ( !div.querySelectorAll(":checked").length ) { - rbuggyQSA.push(":checked"); - } - }); - - assert(function( div ) { - - // Opera 10-12/IE9 - ^= $= *= and empty values - // Should not select anything - div.innerHTML = "

"; - if ( div.querySelectorAll("[test^='']").length ) { - rbuggyQSA.push( "[*^$]=" + whitespace + "*(?:\"\"|'')" ); - } - - // FF 3.5 - :enabled/:disabled and hidden elements (hidden elements are still enabled) - // IE8 throws error here (do not put tests after this one) - div.innerHTML = ""; - if ( !div.querySelectorAll(":enabled").length ) { - rbuggyQSA.push(":enabled", ":disabled"); - } - }); - - // rbuggyQSA always contains :focus, so no need for a length check - rbuggyQSA = /* rbuggyQSA.length && */ new RegExp( rbuggyQSA.join("|") ); - - select = function( selector, context, results, seed, xml ) { - // Only use querySelectorAll when not filtering, - // when this is not xml, - // and when no QSA bugs apply - if ( !seed && !xml && !rbuggyQSA.test( selector ) ) { - var groups, i, - old = true, - nid = expando, - newContext = context, - newSelector = context.nodeType === 9 && selector; - - // qSA works strangely on Element-rooted queries - // We can work around this by specifying an extra ID on the root - // and working up from there (Thanks to Andrew Dupont for the technique) - // IE 8 doesn't work on object elements - if ( context.nodeType === 1 && context.nodeName.toLowerCase() !== "object" ) { - groups = tokenize( selector ); - - if ( (old = context.getAttribute("id")) ) { - nid = old.replace( rescape, "\\$&" ); - } else { - context.setAttribute( "id", nid ); - } - nid = "[id='" + nid + "'] "; - - i = groups.length; - while ( i-- ) { - groups[i] = nid + groups[i].join(""); - } - newContext = rsibling.test( selector ) && context.parentNode || context; - newSelector = groups.join(","); - } - - if ( newSelector ) { - try { - push.apply( results, slice.call( newContext.querySelectorAll( - newSelector - ), 0 ) ); - return results; - } catch(qsaError) { - } finally { - if ( !old ) { - context.removeAttribute("id"); - } - } - } - } - - return oldSelect( selector, context, results, seed, xml ); - }; - - if ( matches ) { - assert(function( div ) { - // Check to see if it's possible to do matchesSelector - // on a disconnected node (IE 9) - disconnectedMatch = matches.call( div, "div" ); - - // This should fail with an exception - // Gecko does not error, returns false instead - try { - matches.call( div, "[test!='']:sizzle" ); - rbuggyMatches.push( "!=", pseudos ); - } catch ( e ) {} - }); - - // rbuggyMatches always contains :active and :focus, so no need for a length check - rbuggyMatches = /* rbuggyMatches.length && */ new RegExp( rbuggyMatches.join("|") ); - - Sizzle.matchesSelector = function( elem, expr ) { - // Make sure that attribute selectors are quoted - expr = expr.replace( rattributeQuotes, "='$1']" ); - - // rbuggyMatches always contains :active, so no need for an existence check - if ( !isXML( elem ) && !rbuggyMatches.test( expr ) && !rbuggyQSA.test( expr ) ) { - try { - var ret = matches.call( elem, expr ); - - // IE 9's matchesSelector returns false on disconnected nodes - if ( ret || disconnectedMatch || - // As well, disconnected nodes are said to be in a document - // fragment in IE 9 - elem.document && elem.document.nodeType !== 11 ) { - return ret; - } - } catch(e) {} - } - - return Sizzle( expr, null, null, [ elem ] ).length > 0; - }; - } - })(); -} - -// Deprecated -Expr.pseudos["nth"] = Expr.pseudos["eq"]; - -// Back-compat -function setFilters() {} -Expr.filters = setFilters.prototype = Expr.pseudos; -Expr.setFilters = new setFilters(); - -// Override sizzle attribute retrieval -Sizzle.attr = jQuery.attr; -jQuery.find = Sizzle; -jQuery.expr = Sizzle.selectors; -jQuery.expr[":"] = jQuery.expr.pseudos; -jQuery.unique = Sizzle.uniqueSort; -jQuery.text = Sizzle.getText; -jQuery.isXMLDoc = Sizzle.isXML; -jQuery.contains = Sizzle.contains; - - -})( window ); -var runtil = /Until$/, - rparentsprev = /^(?:parents|prev(?:Until|All))/, - isSimple = /^.[^:#\[\.,]*$/, - rneedsContext = jQuery.expr.match.needsContext, - // methods guaranteed to produce a unique set when starting from a unique set - guaranteedUnique = { - children: true, - contents: true, - next: true, - prev: true - }; - -jQuery.fn.extend({ - find: function( selector ) { - var i, l, length, n, r, ret, - self = this; - - if ( typeof selector !== "string" ) { - return jQuery( selector ).filter(function() { - for ( i = 0, l = self.length; i < l; i++ ) { - if ( jQuery.contains( self[ i ], this ) ) { - return true; - } - } - }); - } - - ret = this.pushStack( "", "find", selector ); - - for ( i = 0, l = this.length; i < l; i++ ) { - length = ret.length; - jQuery.find( selector, this[i], ret ); - - if ( i > 0 ) { - // Make sure that the results are unique - for ( n = length; n < ret.length; n++ ) { - for ( r = 0; r < length; r++ ) { - if ( ret[r] === ret[n] ) { - ret.splice(n--, 1); - break; - } - } - } - } - } - - return ret; - }, - - has: function( target ) { - var i, - targets = jQuery( target, this ), - len = targets.length; - - return this.filter(function() { - for ( i = 0; i < len; i++ ) { - if ( jQuery.contains( this, targets[i] ) ) { - return true; - } - } - }); - }, - - not: function( selector ) { - return this.pushStack( winnow(this, selector, false), "not", selector); - }, - - filter: function( selector ) { - return this.pushStack( winnow(this, selector, true), "filter", selector ); - }, - - is: function( selector ) { - return !!selector && ( - typeof selector === "string" ? - // If this is a positional/relative selector, check membership in the returned set - // so $("p:first").is("p:last") won't return true for a doc with two "p". - rneedsContext.test( selector ) ? - jQuery( selector, this.context ).index( this[0] ) >= 0 : - jQuery.filter( selector, this ).length > 0 : - this.filter( selector ).length > 0 ); - }, - - closest: function( selectors, context ) { - var cur, - i = 0, - l = this.length, - ret = [], - pos = rneedsContext.test( selectors ) || typeof selectors !== "string" ? - jQuery( selectors, context || this.context ) : - 0; - - for ( ; i < l; i++ ) { - cur = this[i]; - - while ( cur && cur.ownerDocument && cur !== context && cur.nodeType !== 11 ) { - if ( pos ? pos.index(cur) > -1 : jQuery.find.matchesSelector(cur, selectors) ) { - ret.push( cur ); - break; - } - cur = cur.parentNode; - } - } - - ret = ret.length > 1 ? jQuery.unique( ret ) : ret; - - return this.pushStack( ret, "closest", selectors ); - }, - - // Determine the position of an element within - // the matched set of elements - index: function( elem ) { - - // No argument, return index in parent - if ( !elem ) { - return ( this[0] && this[0].parentNode ) ? this.prevAll().length : -1; - } - - // index in selector - if ( typeof elem === "string" ) { - return jQuery.inArray( this[0], jQuery( elem ) ); - } - - // Locate the position of the desired element - return jQuery.inArray( - // If it receives a jQuery object, the first element is used - elem.jquery ? elem[0] : elem, this ); - }, - - add: function( selector, context ) { - var set = typeof selector === "string" ? - jQuery( selector, context ) : - jQuery.makeArray( selector && selector.nodeType ? [ selector ] : selector ), - all = jQuery.merge( this.get(), set ); - - return this.pushStack( isDisconnected( set[0] ) || isDisconnected( all[0] ) ? - all : - jQuery.unique( all ) ); - }, - - addBack: function( selector ) { - return this.add( selector == null ? - this.prevObject : this.prevObject.filter(selector) - ); - } -}); - -jQuery.fn.andSelf = jQuery.fn.addBack; - -// A painfully simple check to see if an element is disconnected -// from a document (should be improved, where feasible). -function isDisconnected( node ) { - return !node || !node.parentNode || node.parentNode.nodeType === 11; -} - -function sibling( cur, dir ) { - do { - cur = cur[ dir ]; - } while ( cur && cur.nodeType !== 1 ); - - return cur; -} - -jQuery.each({ - parent: function( elem ) { - var parent = elem.parentNode; - return parent && parent.nodeType !== 11 ? parent : null; - }, - parents: function( elem ) { - return jQuery.dir( elem, "parentNode" ); - }, - parentsUntil: function( elem, i, until ) { - return jQuery.dir( elem, "parentNode", until ); - }, - next: function( elem ) { - return sibling( elem, "nextSibling" ); - }, - prev: function( elem ) { - return sibling( elem, "previousSibling" ); - }, - nextAll: function( elem ) { - return jQuery.dir( elem, "nextSibling" ); - }, - prevAll: function( elem ) { - return jQuery.dir( elem, "previousSibling" ); - }, - nextUntil: function( elem, i, until ) { - return jQuery.dir( elem, "nextSibling", until ); - }, - prevUntil: function( elem, i, until ) { - return jQuery.dir( elem, "previousSibling", until ); - }, - siblings: function( elem ) { - return jQuery.sibling( ( elem.parentNode || {} ).firstChild, elem ); - }, - children: function( elem ) { - return jQuery.sibling( elem.firstChild ); - }, - contents: function( elem ) { - return jQuery.nodeName( elem, "iframe" ) ? - elem.contentDocument || elem.contentWindow.document : - jQuery.merge( [], elem.childNodes ); - } -}, function( name, fn ) { - jQuery.fn[ name ] = function( until, selector ) { - var ret = jQuery.map( this, fn, until ); - - if ( !runtil.test( name ) ) { - selector = until; - } - - if ( selector && typeof selector === "string" ) { - ret = jQuery.filter( selector, ret ); - } - - ret = this.length > 1 && !guaranteedUnique[ name ] ? jQuery.unique( ret ) : ret; - - if ( this.length > 1 && rparentsprev.test( name ) ) { - ret = ret.reverse(); - } - - return this.pushStack( ret, name, core_slice.call( arguments ).join(",") ); - }; -}); - -jQuery.extend({ - filter: function( expr, elems, not ) { - if ( not ) { - expr = ":not(" + expr + ")"; - } - - return elems.length === 1 ? - jQuery.find.matchesSelector(elems[0], expr) ? [ elems[0] ] : [] : - jQuery.find.matches(expr, elems); - }, - - dir: function( elem, dir, until ) { - var matched = [], - cur = elem[ dir ]; - - while ( cur && cur.nodeType !== 9 && (until === undefined || cur.nodeType !== 1 || !jQuery( cur ).is( until )) ) { - if ( cur.nodeType === 1 ) { - matched.push( cur ); - } - cur = cur[dir]; - } - return matched; - }, - - sibling: function( n, elem ) { - var r = []; - - for ( ; n; n = n.nextSibling ) { - if ( n.nodeType === 1 && n !== elem ) { - r.push( n ); - } - } - - return r; - } -}); - -// Implement the identical functionality for filter and not -function winnow( elements, qualifier, keep ) { - - // Can't pass null or undefined to indexOf in Firefox 4 - // Set to 0 to skip string check - qualifier = qualifier || 0; - - if ( jQuery.isFunction( qualifier ) ) { - return jQuery.grep(elements, function( elem, i ) { - var retVal = !!qualifier.call( elem, i, elem ); - return retVal === keep; - }); - - } else if ( qualifier.nodeType ) { - return jQuery.grep(elements, function( elem, i ) { - return ( elem === qualifier ) === keep; - }); - - } else if ( typeof qualifier === "string" ) { - var filtered = jQuery.grep(elements, function( elem ) { - return elem.nodeType === 1; - }); - - if ( isSimple.test( qualifier ) ) { - return jQuery.filter(qualifier, filtered, !keep); - } else { - qualifier = jQuery.filter( qualifier, filtered ); - } - } - - return jQuery.grep(elements, function( elem, i ) { - return ( jQuery.inArray( elem, qualifier ) >= 0 ) === keep; - }); -} -function createSafeFragment( document ) { - var list = nodeNames.split( "|" ), - safeFrag = document.createDocumentFragment(); - - if ( safeFrag.createElement ) { - while ( list.length ) { - safeFrag.createElement( - list.pop() - ); - } - } - return safeFrag; -} - -var nodeNames = "abbr|article|aside|audio|bdi|canvas|data|datalist|details|figcaption|figure|footer|" + - "header|hgroup|mark|meter|nav|output|progress|section|summary|time|video", - rinlinejQuery = / jQuery\d+="(?:null|\d+)"/g, - rleadingWhitespace = /^\s+/, - rxhtmlTag = /<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/gi, - rtagName = /<([\w:]+)/, - rtbody = /
", "
" ], - tr: [ 2, "", "
" ], - td: [ 3, "", "
" ], - col: [ 2, "", "
" ], - area: [ 1, "", "" ], - _default: [ 0, "", "" ] - }, - safeFragment = createSafeFragment( document ), - fragmentDiv = safeFragment.appendChild( document.createElement("div") ); - -wrapMap.optgroup = wrapMap.option; -wrapMap.tbody = wrapMap.tfoot = wrapMap.colgroup = wrapMap.caption = wrapMap.thead; -wrapMap.th = wrapMap.td; - -// IE6-8 can't serialize link, script, style, or any html5 (NoScope) tags, -// unless wrapped in a div with non-breaking characters in front of it. -if ( !jQuery.support.htmlSerialize ) { - wrapMap._default = [ 1, "X
", "
" ]; -} - -jQuery.fn.extend({ - text: function( value ) { - return jQuery.access( this, function( value ) { - return value === undefined ? - jQuery.text( this ) : - this.empty().append( ( this[0] && this[0].ownerDocument || document ).createTextNode( value ) ); - }, null, value, arguments.length ); - }, - - wrapAll: function( html ) { - if ( jQuery.isFunction( html ) ) { - return this.each(function(i) { - jQuery(this).wrapAll( html.call(this, i) ); - }); - } - - if ( this[0] ) { - // The elements to wrap the target around - var wrap = jQuery( html, this[0].ownerDocument ).eq(0).clone(true); - - if ( this[0].parentNode ) { - wrap.insertBefore( this[0] ); - } - - wrap.map(function() { - var elem = this; - - while ( elem.firstChild && elem.firstChild.nodeType === 1 ) { - elem = elem.firstChild; - } - - return elem; - }).append( this ); - } - - return this; - }, - - wrapInner: function( html ) { - if ( jQuery.isFunction( html ) ) { - return this.each(function(i) { - jQuery(this).wrapInner( html.call(this, i) ); - }); - } - - return this.each(function() { - var self = jQuery( this ), - contents = self.contents(); - - if ( contents.length ) { - contents.wrapAll( html ); - - } else { - self.append( html ); - } - }); - }, - - wrap: function( html ) { - var isFunction = jQuery.isFunction( html ); - - return this.each(function(i) { - jQuery( this ).wrapAll( isFunction ? html.call(this, i) : html ); - }); - }, - - unwrap: function() { - return this.parent().each(function() { - if ( !jQuery.nodeName( this, "body" ) ) { - jQuery( this ).replaceWith( this.childNodes ); - } - }).end(); - }, - - append: function() { - return this.domManip(arguments, true, function( elem ) { - if ( this.nodeType === 1 || this.nodeType === 11 ) { - this.appendChild( elem ); - } - }); - }, - - prepend: function() { - return this.domManip(arguments, true, function( elem ) { - if ( this.nodeType === 1 || this.nodeType === 11 ) { - this.insertBefore( elem, this.firstChild ); - } - }); - }, - - before: function() { - if ( !isDisconnected( this[0] ) ) { - return this.domManip(arguments, false, function( elem ) { - this.parentNode.insertBefore( elem, this ); - }); - } - - if ( arguments.length ) { - var set = jQuery.clean( arguments ); - return this.pushStack( jQuery.merge( set, this ), "before", this.selector ); - } - }, - - after: function() { - if ( !isDisconnected( this[0] ) ) { - return this.domManip(arguments, false, function( elem ) { - this.parentNode.insertBefore( elem, this.nextSibling ); - }); - } - - if ( arguments.length ) { - var set = jQuery.clean( arguments ); - return this.pushStack( jQuery.merge( this, set ), "after", this.selector ); - } - }, - - // keepData is for internal use only--do not document - remove: function( selector, keepData ) { - var elem, - i = 0; - - for ( ; (elem = this[i]) != null; i++ ) { - if ( !selector || jQuery.filter( selector, [ elem ] ).length ) { - if ( !keepData && elem.nodeType === 1 ) { - jQuery.cleanData( elem.getElementsByTagName("*") ); - jQuery.cleanData( [ elem ] ); - } - - if ( elem.parentNode ) { - elem.parentNode.removeChild( elem ); - } - } - } - - return this; - }, - - empty: function() { - var elem, - i = 0; - - for ( ; (elem = this[i]) != null; i++ ) { - // Remove element nodes and prevent memory leaks - if ( elem.nodeType === 1 ) { - jQuery.cleanData( elem.getElementsByTagName("*") ); - } - - // Remove any remaining nodes - while ( elem.firstChild ) { - elem.removeChild( elem.firstChild ); - } - } - - return this; - }, - - clone: function( dataAndEvents, deepDataAndEvents ) { - dataAndEvents = dataAndEvents == null ? false : dataAndEvents; - deepDataAndEvents = deepDataAndEvents == null ? dataAndEvents : deepDataAndEvents; - - return this.map( function () { - return jQuery.clone( this, dataAndEvents, deepDataAndEvents ); - }); - }, - - html: function( value ) { - return jQuery.access( this, function( value ) { - var elem = this[0] || {}, - i = 0, - l = this.length; - - if ( value === undefined ) { - return elem.nodeType === 1 ? - elem.innerHTML.replace( rinlinejQuery, "" ) : - undefined; - } - - // See if we can take a shortcut and just use innerHTML - if ( typeof value === "string" && !rnoInnerhtml.test( value ) && - ( jQuery.support.htmlSerialize || !rnoshimcache.test( value ) ) && - ( jQuery.support.leadingWhitespace || !rleadingWhitespace.test( value ) ) && - !wrapMap[ ( rtagName.exec( value ) || ["", ""] )[1].toLowerCase() ] ) { - - value = value.replace( rxhtmlTag, "<$1>" ); - - try { - for (; i < l; i++ ) { - // Remove element nodes and prevent memory leaks - elem = this[i] || {}; - if ( elem.nodeType === 1 ) { - jQuery.cleanData( elem.getElementsByTagName( "*" ) ); - elem.innerHTML = value; - } - } - - elem = 0; - - // If using innerHTML throws an exception, use the fallback method - } catch(e) {} - } - - if ( elem ) { - this.empty().append( value ); - } - }, null, value, arguments.length ); - }, - - replaceWith: function( value ) { - if ( !isDisconnected( this[0] ) ) { - // Make sure that the elements are removed from the DOM before they are inserted - // this can help fix replacing a parent with child elements - if ( jQuery.isFunction( value ) ) { - return this.each(function(i) { - var self = jQuery(this), old = self.html(); - self.replaceWith( value.call( this, i, old ) ); - }); - } - - if ( typeof value !== "string" ) { - value = jQuery( value ).detach(); - } - - return this.each(function() { - var next = this.nextSibling, - parent = this.parentNode; - - jQuery( this ).remove(); - - if ( next ) { - jQuery(next).before( value ); - } else { - jQuery(parent).append( value ); - } - }); - } - - return this.length ? - this.pushStack( jQuery(jQuery.isFunction(value) ? value() : value), "replaceWith", value ) : - this; - }, - - detach: function( selector ) { - return this.remove( selector, true ); - }, - - domManip: function( args, table, callback ) { - - // Flatten any nested arrays - args = [].concat.apply( [], args ); - - var results, first, fragment, iNoClone, - i = 0, - value = args[0], - scripts = [], - l = this.length; - - // We can't cloneNode fragments that contain checked, in WebKit - if ( !jQuery.support.checkClone && l > 1 && typeof value === "string" && rchecked.test( value ) ) { - return this.each(function() { - jQuery(this).domManip( args, table, callback ); - }); - } - - if ( jQuery.isFunction(value) ) { - return this.each(function(i) { - var self = jQuery(this); - args[0] = value.call( this, i, table ? self.html() : undefined ); - self.domManip( args, table, callback ); - }); - } - - if ( this[0] ) { - results = jQuery.buildFragment( args, this, scripts ); - fragment = results.fragment; - first = fragment.firstChild; - - if ( fragment.childNodes.length === 1 ) { - fragment = first; - } - - if ( first ) { - table = table && jQuery.nodeName( first, "tr" ); - - // Use the original fragment for the last item instead of the first because it can end up - // being emptied incorrectly in certain situations (#8070). - // Fragments from the fragment cache must always be cloned and never used in place. - for ( iNoClone = results.cacheable || l - 1; i < l; i++ ) { - callback.call( - table && jQuery.nodeName( this[i], "table" ) ? - findOrAppend( this[i], "tbody" ) : - this[i], - i === iNoClone ? - fragment : - jQuery.clone( fragment, true, true ) - ); - } - } - - // Fix #11809: Avoid leaking memory - fragment = first = null; - - if ( scripts.length ) { - jQuery.each( scripts, function( i, elem ) { - if ( elem.src ) { - if ( jQuery.ajax ) { - jQuery.ajax({ - url: elem.src, - type: "GET", - dataType: "script", - async: false, - global: false, - "throws": true - }); - } else { - jQuery.error("no ajax"); - } - } else { - jQuery.globalEval( ( elem.text || elem.textContent || elem.innerHTML || "" ).replace( rcleanScript, "" ) ); - } - - if ( elem.parentNode ) { - elem.parentNode.removeChild( elem ); - } - }); - } - } - - return this; - } -}); - -function findOrAppend( elem, tag ) { - return elem.getElementsByTagName( tag )[0] || elem.appendChild( elem.ownerDocument.createElement( tag ) ); -} - -function cloneCopyEvent( src, dest ) { - - if ( dest.nodeType !== 1 || !jQuery.hasData( src ) ) { - return; - } - - var type, i, l, - oldData = jQuery._data( src ), - curData = jQuery._data( dest, oldData ), - events = oldData.events; - - if ( events ) { - delete curData.handle; - curData.events = {}; - - for ( type in events ) { - for ( i = 0, l = events[ type ].length; i < l; i++ ) { - jQuery.event.add( dest, type, events[ type ][ i ] ); - } - } - } - - // make the cloned public data object a copy from the original - if ( curData.data ) { - curData.data = jQuery.extend( {}, curData.data ); - } -} - -function cloneFixAttributes( src, dest ) { - var nodeName; - - // We do not need to do anything for non-Elements - if ( dest.nodeType !== 1 ) { - return; - } - - // clearAttributes removes the attributes, which we don't want, - // but also removes the attachEvent events, which we *do* want - if ( dest.clearAttributes ) { - dest.clearAttributes(); - } - - // mergeAttributes, in contrast, only merges back on the - // original attributes, not the events - if ( dest.mergeAttributes ) { - dest.mergeAttributes( src ); - } - - nodeName = dest.nodeName.toLowerCase(); - - if ( nodeName === "object" ) { - // IE6-10 improperly clones children of object elements using classid. - // IE10 throws NoModificationAllowedError if parent is null, #12132. - if ( dest.parentNode ) { - dest.outerHTML = src.outerHTML; - } - - // This path appears unavoidable for IE9. When cloning an object - // element in IE9, the outerHTML strategy above is not sufficient. - // If the src has innerHTML and the destination does not, - // copy the src.innerHTML into the dest.innerHTML. #10324 - if ( jQuery.support.html5Clone && (src.innerHTML && !jQuery.trim(dest.innerHTML)) ) { - dest.innerHTML = src.innerHTML; - } - - } else if ( nodeName === "input" && rcheckableType.test( src.type ) ) { - // IE6-8 fails to persist the checked state of a cloned checkbox - // or radio button. Worse, IE6-7 fail to give the cloned element - // a checked appearance if the defaultChecked value isn't also set - - dest.defaultChecked = dest.checked = src.checked; - - // IE6-7 get confused and end up setting the value of a cloned - // checkbox/radio button to an empty string instead of "on" - if ( dest.value !== src.value ) { - dest.value = src.value; - } - - // IE6-8 fails to return the selected option to the default selected - // state when cloning options - } else if ( nodeName === "option" ) { - dest.selected = src.defaultSelected; - - // IE6-8 fails to set the defaultValue to the correct value when - // cloning other types of input fields - } else if ( nodeName === "input" || nodeName === "textarea" ) { - dest.defaultValue = src.defaultValue; - - // IE blanks contents when cloning scripts - } else if ( nodeName === "script" && dest.text !== src.text ) { - dest.text = src.text; - } - - // Event data gets referenced instead of copied if the expando - // gets copied too - dest.removeAttribute( jQuery.expando ); -} - -jQuery.buildFragment = function( args, context, scripts ) { - var fragment, cacheable, cachehit, - first = args[ 0 ]; - - // Set context from what may come in as undefined or a jQuery collection or a node - // Updated to fix #12266 where accessing context[0] could throw an exception in IE9/10 & - // also doubles as fix for #8950 where plain objects caused createDocumentFragment exception - context = context || document; - context = !context.nodeType && context[0] || context; - context = context.ownerDocument || context; - - // Only cache "small" (1/2 KB) HTML strings that are associated with the main document - // Cloning options loses the selected state, so don't cache them - // IE 6 doesn't like it when you put or elements in a fragment - // Also, WebKit does not clone 'checked' attributes on cloneNode, so don't cache - // Lastly, IE6,7,8 will not correctly reuse cached fragments that were created from unknown elems #10501 - if ( args.length === 1 && typeof first === "string" && first.length < 512 && context === document && - first.charAt(0) === "<" && !rnocache.test( first ) && - (jQuery.support.checkClone || !rchecked.test( first )) && - (jQuery.support.html5Clone || !rnoshimcache.test( first )) ) { - - // Mark cacheable and look for a hit - cacheable = true; - fragment = jQuery.fragments[ first ]; - cachehit = fragment !== undefined; - } - - if ( !fragment ) { - fragment = context.createDocumentFragment(); - jQuery.clean( args, context, fragment, scripts ); - - // Update the cache, but only store false - // unless this is a second parsing of the same content - if ( cacheable ) { - jQuery.fragments[ first ] = cachehit && fragment; - } - } - - return { fragment: fragment, cacheable: cacheable }; -}; - -jQuery.fragments = {}; - -jQuery.each({ - appendTo: "append", - prependTo: "prepend", - insertBefore: "before", - insertAfter: "after", - replaceAll: "replaceWith" -}, function( name, original ) { - jQuery.fn[ name ] = function( selector ) { - var elems, - i = 0, - ret = [], - insert = jQuery( selector ), - l = insert.length, - parent = this.length === 1 && this[0].parentNode; - - if ( (parent == null || parent && parent.nodeType === 11 && parent.childNodes.length === 1) && l === 1 ) { - insert[ original ]( this[0] ); - return this; - } else { - for ( ; i < l; i++ ) { - elems = ( i > 0 ? this.clone(true) : this ).get(); - jQuery( insert[i] )[ original ]( elems ); - ret = ret.concat( elems ); - } - - return this.pushStack( ret, name, insert.selector ); - } - }; -}); - -function getAll( elem ) { - if ( typeof elem.getElementsByTagName !== "undefined" ) { - return elem.getElementsByTagName( "*" ); - - } else if ( typeof elem.querySelectorAll !== "undefined" ) { - return elem.querySelectorAll( "*" ); - - } else { - return []; - } -} - -// Used in clean, fixes the defaultChecked property -function fixDefaultChecked( elem ) { - if ( rcheckableType.test( elem.type ) ) { - elem.defaultChecked = elem.checked; - } -} - -jQuery.extend({ - clone: function( elem, dataAndEvents, deepDataAndEvents ) { - var srcElements, - destElements, - i, - clone; - - if ( jQuery.support.html5Clone || jQuery.isXMLDoc(elem) || !rnoshimcache.test( "<" + elem.nodeName + ">" ) ) { - clone = elem.cloneNode( true ); - - // IE<=8 does not properly clone detached, unknown element nodes - } else { - fragmentDiv.innerHTML = elem.outerHTML; - fragmentDiv.removeChild( clone = fragmentDiv.firstChild ); - } - - if ( (!jQuery.support.noCloneEvent || !jQuery.support.noCloneChecked) && - (elem.nodeType === 1 || elem.nodeType === 11) && !jQuery.isXMLDoc(elem) ) { - // IE copies events bound via attachEvent when using cloneNode. - // Calling detachEvent on the clone will also remove the events - // from the original. In order to get around this, we use some - // proprietary methods to clear the events. Thanks to MooTools - // guys for this hotness. - - cloneFixAttributes( elem, clone ); - - // Using Sizzle here is crazy slow, so we use getElementsByTagName instead - srcElements = getAll( elem ); - destElements = getAll( clone ); - - // Weird iteration because IE will replace the length property - // with an element if you are cloning the body and one of the - // elements on the page has a name or id of "length" - for ( i = 0; srcElements[i]; ++i ) { - // Ensure that the destination node is not null; Fixes #9587 - if ( destElements[i] ) { - cloneFixAttributes( srcElements[i], destElements[i] ); - } - } - } - - // Copy the events from the original to the clone - if ( dataAndEvents ) { - cloneCopyEvent( elem, clone ); - - if ( deepDataAndEvents ) { - srcElements = getAll( elem ); - destElements = getAll( clone ); - - for ( i = 0; srcElements[i]; ++i ) { - cloneCopyEvent( srcElements[i], destElements[i] ); - } - } - } - - srcElements = destElements = null; - - // Return the cloned set - return clone; - }, - - clean: function( elems, context, fragment, scripts ) { - var i, j, elem, tag, wrap, depth, div, hasBody, tbody, len, handleScript, jsTags, - safe = context === document && safeFragment, - ret = []; - - // Ensure that context is a document - if ( !context || typeof context.createDocumentFragment === "undefined" ) { - context = document; - } - - // Use the already-created safe fragment if context permits - for ( i = 0; (elem = elems[i]) != null; i++ ) { - if ( typeof elem === "number" ) { - elem += ""; - } - - if ( !elem ) { - continue; - } - - // Convert html string into DOM nodes - if ( typeof elem === "string" ) { - if ( !rhtml.test( elem ) ) { - elem = context.createTextNode( elem ); - } else { - // Ensure a safe container in which to render the html - safe = safe || createSafeFragment( context ); - div = context.createElement("div"); - safe.appendChild( div ); - - // Fix "XHTML"-style tags in all browsers - elem = elem.replace(rxhtmlTag, "<$1>"); - - // Go to html and back, then peel off extra wrappers - tag = ( rtagName.exec( elem ) || ["", ""] )[1].toLowerCase(); - wrap = wrapMap[ tag ] || wrapMap._default; - depth = wrap[0]; - div.innerHTML = wrap[1] + elem + wrap[2]; - - // Move to the right depth - while ( depth-- ) { - div = div.lastChild; - } - - // Remove IE's autoinserted from table fragments - if ( !jQuery.support.tbody ) { - - // String was a , *may* have spurious - hasBody = rtbody.test(elem); - tbody = tag === "table" && !hasBody ? - div.firstChild && div.firstChild.childNodes : - - // String was a bare or - wrap[1] === "
" && !hasBody ? - div.childNodes : - []; - - for ( j = tbody.length - 1; j >= 0 ; --j ) { - if ( jQuery.nodeName( tbody[ j ], "tbody" ) && !tbody[ j ].childNodes.length ) { - tbody[ j ].parentNode.removeChild( tbody[ j ] ); - } - } - } - - // IE completely kills leading whitespace when innerHTML is used - if ( !jQuery.support.leadingWhitespace && rleadingWhitespace.test( elem ) ) { - div.insertBefore( context.createTextNode( rleadingWhitespace.exec(elem)[0] ), div.firstChild ); - } - - elem = div.childNodes; - - // Take out of fragment container (we need a fresh div each time) - div.parentNode.removeChild( div ); - } - } - - if ( elem.nodeType ) { - ret.push( elem ); - } else { - jQuery.merge( ret, elem ); - } - } - - // Fix #11356: Clear elements from safeFragment - if ( div ) { - elem = div = safe = null; - } - - // Reset defaultChecked for any radios and checkboxes - // about to be appended to the DOM in IE 6/7 (#8060) - if ( !jQuery.support.appendChecked ) { - for ( i = 0; (elem = ret[i]) != null; i++ ) { - if ( jQuery.nodeName( elem, "input" ) ) { - fixDefaultChecked( elem ); - } else if ( typeof elem.getElementsByTagName !== "undefined" ) { - jQuery.grep( elem.getElementsByTagName("input"), fixDefaultChecked ); - } - } - } - - // Append elements to a provided document fragment - if ( fragment ) { - // Special handling of each script element - handleScript = function( elem ) { - // Check if we consider it executable - if ( !elem.type || rscriptType.test( elem.type ) ) { - // Detach the script and store it in the scripts array (if provided) or the fragment - // Return truthy to indicate that it has been handled - return scripts ? - scripts.push( elem.parentNode ? elem.parentNode.removeChild( elem ) : elem ) : - fragment.appendChild( elem ); - } - }; - - for ( i = 0; (elem = ret[i]) != null; i++ ) { - // Check if we're done after handling an executable script - if ( !( jQuery.nodeName( elem, "script" ) && handleScript( elem ) ) ) { - // Append to fragment and handle embedded scripts - fragment.appendChild( elem ); - if ( typeof elem.getElementsByTagName !== "undefined" ) { - // handleScript alters the DOM, so use jQuery.merge to ensure snapshot iteration - jsTags = jQuery.grep( jQuery.merge( [], elem.getElementsByTagName("script") ), handleScript ); - - // Splice the scripts into ret after their former ancestor and advance our index beyond them - ret.splice.apply( ret, [i + 1, 0].concat( jsTags ) ); - i += jsTags.length; - } - } - } - } - - return ret; - }, - - cleanData: function( elems, /* internal */ acceptData ) { - var data, id, elem, type, - i = 0, - internalKey = jQuery.expando, - cache = jQuery.cache, - deleteExpando = jQuery.support.deleteExpando, - special = jQuery.event.special; - - for ( ; (elem = elems[i]) != null; i++ ) { - - if ( acceptData || jQuery.acceptData( elem ) ) { - - id = elem[ internalKey ]; - data = id && cache[ id ]; - - if ( data ) { - if ( data.events ) { - for ( type in data.events ) { - if ( special[ type ] ) { - jQuery.event.remove( elem, type ); - - // This is a shortcut to avoid jQuery.event.remove's overhead - } else { - jQuery.removeEvent( elem, type, data.handle ); - } - } - } - - // Remove cache only if it was not already removed by jQuery.event.remove - if ( cache[ id ] ) { - - delete cache[ id ]; - - // IE does not allow us to delete expando properties from nodes, - // nor does it have a removeAttribute function on Document nodes; - // we must handle all of these cases - if ( deleteExpando ) { - delete elem[ internalKey ]; - - } else if ( elem.removeAttribute ) { - elem.removeAttribute( internalKey ); - - } else { - elem[ internalKey ] = null; - } - - jQuery.deletedIds.push( id ); - } - } - } - } - } -}); -// Limit scope pollution from any deprecated API -(function() { - -var matched, browser; - -// Use of jQuery.browser is frowned upon. -// More details: http://api.jquery.com/jQuery.browser -// jQuery.uaMatch maintained for back-compat -jQuery.uaMatch = function( ua ) { - ua = ua.toLowerCase(); - - var match = /(chrome)[ \/]([\w.]+)/.exec( ua ) || - /(webkit)[ \/]([\w.]+)/.exec( ua ) || - /(opera)(?:.*version|)[ \/]([\w.]+)/.exec( ua ) || - /(msie) ([\w.]+)/.exec( ua ) || - ua.indexOf("compatible") < 0 && /(mozilla)(?:.*? rv:([\w.]+)|)/.exec( ua ) || - []; - - return { - browser: match[ 1 ] || "", - version: match[ 2 ] || "0" - }; -}; - -matched = jQuery.uaMatch( navigator.userAgent ); -browser = {}; - -if ( matched.browser ) { - browser[ matched.browser ] = true; - browser.version = matched.version; -} - -// Chrome is Webkit, but Webkit is also Safari. -if ( browser.chrome ) { - browser.webkit = true; -} else if ( browser.webkit ) { - browser.safari = true; -} - -jQuery.browser = browser; - -jQuery.sub = function() { - function jQuerySub( selector, context ) { - return new jQuerySub.fn.init( selector, context ); - } - jQuery.extend( true, jQuerySub, this ); - jQuerySub.superclass = this; - jQuerySub.fn = jQuerySub.prototype = this(); - jQuerySub.fn.constructor = jQuerySub; - jQuerySub.sub = this.sub; - jQuerySub.fn.init = function init( selector, context ) { - if ( context && context instanceof jQuery && !(context instanceof jQuerySub) ) { - context = jQuerySub( context ); - } - - return jQuery.fn.init.call( this, selector, context, rootjQuerySub ); - }; - jQuerySub.fn.init.prototype = jQuerySub.fn; - var rootjQuerySub = jQuerySub(document); - return jQuerySub; -}; - -})(); -var curCSS, iframe, iframeDoc, - ralpha = /alpha\([^)]*\)/i, - ropacity = /opacity=([^)]*)/, - rposition = /^(top|right|bottom|left)$/, - // swappable if display is none or starts with table except "table", "table-cell", or "table-caption" - // see here for display values: https://developer.mozilla.org/en-US/docs/CSS/display - rdisplayswap = /^(none|table(?!-c[ea]).+)/, - rmargin = /^margin/, - rnumsplit = new RegExp( "^(" + core_pnum + ")(.*)$", "i" ), - rnumnonpx = new RegExp( "^(" + core_pnum + ")(?!px)[a-z%]+$", "i" ), - rrelNum = new RegExp( "^([-+])=(" + core_pnum + ")", "i" ), - elemdisplay = { BODY: "block" }, - - cssShow = { position: "absolute", visibility: "hidden", display: "block" }, - cssNormalTransform = { - letterSpacing: 0, - fontWeight: 400 - }, - - cssExpand = [ "Top", "Right", "Bottom", "Left" ], - cssPrefixes = [ "Webkit", "O", "Moz", "ms" ], - - eventsToggle = jQuery.fn.toggle; - -// return a css property mapped to a potentially vendor prefixed property -function vendorPropName( style, name ) { - - // shortcut for names that are not vendor prefixed - if ( name in style ) { - return name; - } - - // check for vendor prefixed names - var capName = name.charAt(0).toUpperCase() + name.slice(1), - origName = name, - i = cssPrefixes.length; - - while ( i-- ) { - name = cssPrefixes[ i ] + capName; - if ( name in style ) { - return name; - } - } - - return origName; -} - -function isHidden( elem, el ) { - elem = el || elem; - return jQuery.css( elem, "display" ) === "none" || !jQuery.contains( elem.ownerDocument, elem ); -} - -function showHide( elements, show ) { - var elem, display, - values = [], - index = 0, - length = elements.length; - - for ( ; index < length; index++ ) { - elem = elements[ index ]; - if ( !elem.style ) { - continue; - } - values[ index ] = jQuery._data( elem, "olddisplay" ); - if ( show ) { - // Reset the inline display of this element to learn if it is - // being hidden by cascaded rules or not - if ( !values[ index ] && elem.style.display === "none" ) { - elem.style.display = ""; - } - - // Set elements which have been overridden with display: none - // in a stylesheet to whatever the default browser style is - // for such an element - if ( elem.style.display === "" && isHidden( elem ) ) { - values[ index ] = jQuery._data( elem, "olddisplay", css_defaultDisplay(elem.nodeName) ); - } - } else { - display = curCSS( elem, "display" ); - - if ( !values[ index ] && display !== "none" ) { - jQuery._data( elem, "olddisplay", display ); - } - } - } - - // Set the display of most of the elements in a second loop - // to avoid the constant reflow - for ( index = 0; index < length; index++ ) { - elem = elements[ index ]; - if ( !elem.style ) { - continue; - } - if ( !show || elem.style.display === "none" || elem.style.display === "" ) { - elem.style.display = show ? values[ index ] || "" : "none"; - } - } - - return elements; -} - -jQuery.fn.extend({ - css: function( name, value ) { - return jQuery.access( this, function( elem, name, value ) { - return value !== undefined ? - jQuery.style( elem, name, value ) : - jQuery.css( elem, name ); - }, name, value, arguments.length > 1 ); - }, - show: function() { - return showHide( this, true ); - }, - hide: function() { - return showHide( this ); - }, - toggle: function( state, fn2 ) { - var bool = typeof state === "boolean"; - - if ( jQuery.isFunction( state ) && jQuery.isFunction( fn2 ) ) { - return eventsToggle.apply( this, arguments ); - } - - return this.each(function() { - if ( bool ? state : isHidden( this ) ) { - jQuery( this ).show(); - } else { - jQuery( this ).hide(); - } - }); - } -}); - -jQuery.extend({ - // Add in style property hooks for overriding the default - // behavior of getting and setting a style property - cssHooks: { - opacity: { - get: function( elem, computed ) { - if ( computed ) { - // We should always get a number back from opacity - var ret = curCSS( elem, "opacity" ); - return ret === "" ? "1" : ret; - - } - } - } - }, - - // Exclude the following css properties to add px - cssNumber: { - "fillOpacity": true, - "fontWeight": true, - "lineHeight": true, - "opacity": true, - "orphans": true, - "widows": true, - "zIndex": true, - "zoom": true - }, - - // Add in properties whose names you wish to fix before - // setting or getting the value - cssProps: { - // normalize float css property - "float": jQuery.support.cssFloat ? "cssFloat" : "styleFloat" - }, - - // Get and set the style property on a DOM Node - style: function( elem, name, value, extra ) { - // Don't set styles on text and comment nodes - if ( !elem || elem.nodeType === 3 || elem.nodeType === 8 || !elem.style ) { - return; - } - - // Make sure that we're working with the right name - var ret, type, hooks, - origName = jQuery.camelCase( name ), - style = elem.style; - - name = jQuery.cssProps[ origName ] || ( jQuery.cssProps[ origName ] = vendorPropName( style, origName ) ); - - // gets hook for the prefixed version - // followed by the unprefixed version - hooks = jQuery.cssHooks[ name ] || jQuery.cssHooks[ origName ]; - - // Check if we're setting a value - if ( value !== undefined ) { - type = typeof value; - - // convert relative number strings (+= or -=) to relative numbers. #7345 - if ( type === "string" && (ret = rrelNum.exec( value )) ) { - value = ( ret[1] + 1 ) * ret[2] + parseFloat( jQuery.css( elem, name ) ); - // Fixes bug #9237 - type = "number"; - } - - // Make sure that NaN and null values aren't set. See: #7116 - if ( value == null || type === "number" && isNaN( value ) ) { - return; - } - - // If a number was passed in, add 'px' to the (except for certain CSS properties) - if ( type === "number" && !jQuery.cssNumber[ origName ] ) { - value += "px"; - } - - // If a hook was provided, use that value, otherwise just set the specified value - if ( !hooks || !("set" in hooks) || (value = hooks.set( elem, value, extra )) !== undefined ) { - // Wrapped to prevent IE from throwing errors when 'invalid' values are provided - // Fixes bug #5509 - try { - style[ name ] = value; - } catch(e) {} - } - - } else { - // If a hook was provided get the non-computed value from there - if ( hooks && "get" in hooks && (ret = hooks.get( elem, false, extra )) !== undefined ) { - return ret; - } - - // Otherwise just get the value from the style object - return style[ name ]; - } - }, - - css: function( elem, name, numeric, extra ) { - var val, num, hooks, - origName = jQuery.camelCase( name ); - - // Make sure that we're working with the right name - name = jQuery.cssProps[ origName ] || ( jQuery.cssProps[ origName ] = vendorPropName( elem.style, origName ) ); - - // gets hook for the prefixed version - // followed by the unprefixed version - hooks = jQuery.cssHooks[ name ] || jQuery.cssHooks[ origName ]; - - // If a hook was provided get the computed value from there - if ( hooks && "get" in hooks ) { - val = hooks.get( elem, true, extra ); - } - - // Otherwise, if a way to get the computed value exists, use that - if ( val === undefined ) { - val = curCSS( elem, name ); - } - - //convert "normal" to computed value - if ( val === "normal" && name in cssNormalTransform ) { - val = cssNormalTransform[ name ]; - } - - // Return, converting to number if forced or a qualifier was provided and val looks numeric - if ( numeric || extra !== undefined ) { - num = parseFloat( val ); - return numeric || jQuery.isNumeric( num ) ? num || 0 : val; - } - return val; - }, - - // A method for quickly swapping in/out CSS properties to get correct calculations - swap: function( elem, options, callback ) { - var ret, name, - old = {}; - - // Remember the old values, and insert the new ones - for ( name in options ) { - old[ name ] = elem.style[ name ]; - elem.style[ name ] = options[ name ]; - } - - ret = callback.call( elem ); - - // Revert the old values - for ( name in options ) { - elem.style[ name ] = old[ name ]; - } - - return ret; - } -}); - -// NOTE: To any future maintainer, we've window.getComputedStyle -// because jsdom on node.js will break without it. -if ( window.getComputedStyle ) { - curCSS = function( elem, name ) { - var ret, width, minWidth, maxWidth, - computed = window.getComputedStyle( elem, null ), - style = elem.style; - - if ( computed ) { - - // getPropertyValue is only needed for .css('filter') in IE9, see #12537 - ret = computed.getPropertyValue( name ) || computed[ name ]; - - if ( ret === "" && !jQuery.contains( elem.ownerDocument, elem ) ) { - ret = jQuery.style( elem, name ); - } - - // A tribute to the "awesome hack by Dean Edwards" - // Chrome < 17 and Safari 5.0 uses "computed value" instead of "used value" for margin-right - // Safari 5.1.7 (at least) returns percentage for a larger set of values, but width seems to be reliably pixels - // this is against the CSSOM draft spec: http://dev.w3.org/csswg/cssom/#resolved-values - if ( rnumnonpx.test( ret ) && rmargin.test( name ) ) { - width = style.width; - minWidth = style.minWidth; - maxWidth = style.maxWidth; - - style.minWidth = style.maxWidth = style.width = ret; - ret = computed.width; - - style.width = width; - style.minWidth = minWidth; - style.maxWidth = maxWidth; - } - } - - return ret; - }; -} else if ( document.documentElement.currentStyle ) { - curCSS = function( elem, name ) { - var left, rsLeft, - ret = elem.currentStyle && elem.currentStyle[ name ], - style = elem.style; - - // Avoid setting ret to empty string here - // so we don't default to auto - if ( ret == null && style && style[ name ] ) { - ret = style[ name ]; - } - - // From the awesome hack by Dean Edwards - // http://erik.eae.net/archives/2007/07/27/18.54.15/#comment-102291 - - // If we're not dealing with a regular pixel number - // but a number that has a weird ending, we need to convert it to pixels - // but not position css attributes, as those are proportional to the parent element instead - // and we can't measure the parent instead because it might trigger a "stacking dolls" problem - if ( rnumnonpx.test( ret ) && !rposition.test( name ) ) { - - // Remember the original values - left = style.left; - rsLeft = elem.runtimeStyle && elem.runtimeStyle.left; - - // Put in the new values to get a computed value out - if ( rsLeft ) { - elem.runtimeStyle.left = elem.currentStyle.left; - } - style.left = name === "fontSize" ? "1em" : ret; - ret = style.pixelLeft + "px"; - - // Revert the changed values - style.left = left; - if ( rsLeft ) { - elem.runtimeStyle.left = rsLeft; - } - } - - return ret === "" ? "auto" : ret; - }; -} - -function setPositiveNumber( elem, value, subtract ) { - var matches = rnumsplit.exec( value ); - return matches ? - Math.max( 0, matches[ 1 ] - ( subtract || 0 ) ) + ( matches[ 2 ] || "px" ) : - value; -} - -function augmentWidthOrHeight( elem, name, extra, isBorderBox ) { - var i = extra === ( isBorderBox ? "border" : "content" ) ? - // If we already have the right measurement, avoid augmentation - 4 : - // Otherwise initialize for horizontal or vertical properties - name === "width" ? 1 : 0, - - val = 0; - - for ( ; i < 4; i += 2 ) { - // both box models exclude margin, so add it if we want it - if ( extra === "margin" ) { - // we use jQuery.css instead of curCSS here - // because of the reliableMarginRight CSS hook! - val += jQuery.css( elem, extra + cssExpand[ i ], true ); - } - - // From this point on we use curCSS for maximum performance (relevant in animations) - if ( isBorderBox ) { - // border-box includes padding, so remove it if we want content - if ( extra === "content" ) { - val -= parseFloat( curCSS( elem, "padding" + cssExpand[ i ] ) ) || 0; - } - - // at this point, extra isn't border nor margin, so remove border - if ( extra !== "margin" ) { - val -= parseFloat( curCSS( elem, "border" + cssExpand[ i ] + "Width" ) ) || 0; - } - } else { - // at this point, extra isn't content, so add padding - val += parseFloat( curCSS( elem, "padding" + cssExpand[ i ] ) ) || 0; - - // at this point, extra isn't content nor padding, so add border - if ( extra !== "padding" ) { - val += parseFloat( curCSS( elem, "border" + cssExpand[ i ] + "Width" ) ) || 0; - } - } - } - - return val; -} - -function getWidthOrHeight( elem, name, extra ) { - - // Start with offset property, which is equivalent to the border-box value - var val = name === "width" ? elem.offsetWidth : elem.offsetHeight, - valueIsBorderBox = true, - isBorderBox = jQuery.support.boxSizing && jQuery.css( elem, "boxSizing" ) === "border-box"; - - // some non-html elements return undefined for offsetWidth, so check for null/undefined - // svg - https://bugzilla.mozilla.org/show_bug.cgi?id=649285 - // MathML - https://bugzilla.mozilla.org/show_bug.cgi?id=491668 - if ( val <= 0 || val == null ) { - // Fall back to computed then uncomputed css if necessary - val = curCSS( elem, name ); - if ( val < 0 || val == null ) { - val = elem.style[ name ]; - } - - // Computed unit is not pixels. Stop here and return. - if ( rnumnonpx.test(val) ) { - return val; - } - - // we need the check for style in case a browser which returns unreliable values - // for getComputedStyle silently falls back to the reliable elem.style - valueIsBorderBox = isBorderBox && ( jQuery.support.boxSizingReliable || val === elem.style[ name ] ); - - // Normalize "", auto, and prepare for extra - val = parseFloat( val ) || 0; - } - - // use the active box-sizing model to add/subtract irrelevant styles - return ( val + - augmentWidthOrHeight( - elem, - name, - extra || ( isBorderBox ? "border" : "content" ), - valueIsBorderBox - ) - ) + "px"; -} - - -// Try to determine the default display value of an element -function css_defaultDisplay( nodeName ) { - if ( elemdisplay[ nodeName ] ) { - return elemdisplay[ nodeName ]; - } - - var elem = jQuery( "<" + nodeName + ">" ).appendTo( document.body ), - display = elem.css("display"); - elem.remove(); - - // If the simple way fails, - // get element's real default display by attaching it to a temp iframe - if ( display === "none" || display === "" ) { - // Use the already-created iframe if possible - iframe = document.body.appendChild( - iframe || jQuery.extend( document.createElement("iframe"), { - frameBorder: 0, - width: 0, - height: 0 - }) - ); - - // Create a cacheable copy of the iframe document on first call. - // IE and Opera will allow us to reuse the iframeDoc without re-writing the fake HTML - // document to it; WebKit & Firefox won't allow reusing the iframe document. - if ( !iframeDoc || !iframe.createElement ) { - iframeDoc = ( iframe.contentWindow || iframe.contentDocument ).document; - iframeDoc.write(""); - iframeDoc.close(); - } - - elem = iframeDoc.body.appendChild( iframeDoc.createElement(nodeName) ); - - display = curCSS( elem, "display" ); - document.body.removeChild( iframe ); - } - - // Store the correct default display - elemdisplay[ nodeName ] = display; - - return display; -} - -jQuery.each([ "height", "width" ], function( i, name ) { - jQuery.cssHooks[ name ] = { - get: function( elem, computed, extra ) { - if ( computed ) { - // certain elements can have dimension info if we invisibly show them - // however, it must have a current display style that would benefit from this - if ( elem.offsetWidth === 0 && rdisplayswap.test( curCSS( elem, "display" ) ) ) { - return jQuery.swap( elem, cssShow, function() { - return getWidthOrHeight( elem, name, extra ); - }); - } else { - return getWidthOrHeight( elem, name, extra ); - } - } - }, - - set: function( elem, value, extra ) { - return setPositiveNumber( elem, value, extra ? - augmentWidthOrHeight( - elem, - name, - extra, - jQuery.support.boxSizing && jQuery.css( elem, "boxSizing" ) === "border-box" - ) : 0 - ); - } - }; -}); - -if ( !jQuery.support.opacity ) { - jQuery.cssHooks.opacity = { - get: function( elem, computed ) { - // IE uses filters for opacity - return ropacity.test( (computed && elem.currentStyle ? elem.currentStyle.filter : elem.style.filter) || "" ) ? - ( 0.01 * parseFloat( RegExp.$1 ) ) + "" : - computed ? "1" : ""; - }, - - set: function( elem, value ) { - var style = elem.style, - currentStyle = elem.currentStyle, - opacity = jQuery.isNumeric( value ) ? "alpha(opacity=" + value * 100 + ")" : "", - filter = currentStyle && currentStyle.filter || style.filter || ""; - - // IE has trouble with opacity if it does not have layout - // Force it by setting the zoom level - style.zoom = 1; - - // if setting opacity to 1, and no other filters exist - attempt to remove filter attribute #6652 - if ( value >= 1 && jQuery.trim( filter.replace( ralpha, "" ) ) === "" && - style.removeAttribute ) { - - // Setting style.filter to null, "" & " " still leave "filter:" in the cssText - // if "filter:" is present at all, clearType is disabled, we want to avoid this - // style.removeAttribute is IE Only, but so apparently is this code path... - style.removeAttribute( "filter" ); - - // if there there is no filter style applied in a css rule, we are done - if ( currentStyle && !currentStyle.filter ) { - return; - } - } - - // otherwise, set new filter values - style.filter = ralpha.test( filter ) ? - filter.replace( ralpha, opacity ) : - filter + " " + opacity; - } - }; -} - -// These hooks cannot be added until DOM ready because the support test -// for it is not run until after DOM ready -jQuery(function() { - if ( !jQuery.support.reliableMarginRight ) { - jQuery.cssHooks.marginRight = { - get: function( elem, computed ) { - // WebKit Bug 13343 - getComputedStyle returns wrong value for margin-right - // Work around by temporarily setting element display to inline-block - return jQuery.swap( elem, { "display": "inline-block" }, function() { - if ( computed ) { - return curCSS( elem, "marginRight" ); - } - }); - } - }; - } - - // Webkit bug: https://bugs.webkit.org/show_bug.cgi?id=29084 - // getComputedStyle returns percent when specified for top/left/bottom/right - // rather than make the css module depend on the offset module, we just check for it here - if ( !jQuery.support.pixelPosition && jQuery.fn.position ) { - jQuery.each( [ "top", "left" ], function( i, prop ) { - jQuery.cssHooks[ prop ] = { - get: function( elem, computed ) { - if ( computed ) { - var ret = curCSS( elem, prop ); - // if curCSS returns percentage, fallback to offset - return rnumnonpx.test( ret ) ? jQuery( elem ).position()[ prop ] + "px" : ret; - } - } - }; - }); - } - -}); - -if ( jQuery.expr && jQuery.expr.filters ) { - jQuery.expr.filters.hidden = function( elem ) { - return ( elem.offsetWidth === 0 && elem.offsetHeight === 0 ) || (!jQuery.support.reliableHiddenOffsets && ((elem.style && elem.style.display) || curCSS( elem, "display" )) === "none"); - }; - - jQuery.expr.filters.visible = function( elem ) { - return !jQuery.expr.filters.hidden( elem ); - }; -} - -// These hooks are used by animate to expand properties -jQuery.each({ - margin: "", - padding: "", - border: "Width" -}, function( prefix, suffix ) { - jQuery.cssHooks[ prefix + suffix ] = { - expand: function( value ) { - var i, - - // assumes a single number if not a string - parts = typeof value === "string" ? value.split(" ") : [ value ], - expanded = {}; - - for ( i = 0; i < 4; i++ ) { - expanded[ prefix + cssExpand[ i ] + suffix ] = - parts[ i ] || parts[ i - 2 ] || parts[ 0 ]; - } - - return expanded; - } - }; - - if ( !rmargin.test( prefix ) ) { - jQuery.cssHooks[ prefix + suffix ].set = setPositiveNumber; - } -}); -var r20 = /%20/g, - rbracket = /\[\]$/, - rCRLF = /\r?\n/g, - rinput = /^(?:color|date|datetime|datetime-local|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i, - rselectTextarea = /^(?:select|textarea)/i; - -jQuery.fn.extend({ - serialize: function() { - return jQuery.param( this.serializeArray() ); - }, - serializeArray: function() { - return this.map(function(){ - return this.elements ? jQuery.makeArray( this.elements ) : this; - }) - .filter(function(){ - return this.name && !this.disabled && - ( this.checked || rselectTextarea.test( this.nodeName ) || - rinput.test( this.type ) ); - }) - .map(function( i, elem ){ - var val = jQuery( this ).val(); - - return val == null ? - null : - jQuery.isArray( val ) ? - jQuery.map( val, function( val, i ){ - return { name: elem.name, value: val.replace( rCRLF, "\r\n" ) }; - }) : - { name: elem.name, value: val.replace( rCRLF, "\r\n" ) }; - }).get(); - } -}); - -//Serialize an array of form elements or a set of -//key/values into a query string -jQuery.param = function( a, traditional ) { - var prefix, - s = [], - add = function( key, value ) { - // If value is a function, invoke it and return its value - value = jQuery.isFunction( value ) ? value() : ( value == null ? "" : value ); - s[ s.length ] = encodeURIComponent( key ) + "=" + encodeURIComponent( value ); - }; - - // Set traditional to true for jQuery <= 1.3.2 behavior. - if ( traditional === undefined ) { - traditional = jQuery.ajaxSettings && jQuery.ajaxSettings.traditional; - } - - // If an array was passed in, assume that it is an array of form elements. - if ( jQuery.isArray( a ) || ( a.jquery && !jQuery.isPlainObject( a ) ) ) { - // Serialize the form elements - jQuery.each( a, function() { - add( this.name, this.value ); - }); - - } else { - // If traditional, encode the "old" way (the way 1.3.2 or older - // did it), otherwise encode params recursively. - for ( prefix in a ) { - buildParams( prefix, a[ prefix ], traditional, add ); - } - } - - // Return the resulting serialization - return s.join( "&" ).replace( r20, "+" ); -}; - -function buildParams( prefix, obj, traditional, add ) { - var name; - - if ( jQuery.isArray( obj ) ) { - // Serialize array item. - jQuery.each( obj, function( i, v ) { - if ( traditional || rbracket.test( prefix ) ) { - // Treat each array item as a scalar. - add( prefix, v ); - - } else { - // If array item is non-scalar (array or object), encode its - // numeric index to resolve deserialization ambiguity issues. - // Note that rack (as of 1.0.0) can't currently deserialize - // nested arrays properly, and attempting to do so may cause - // a server error. Possible fixes are to modify rack's - // deserialization algorithm or to provide an option or flag - // to force array serialization to be shallow. - buildParams( prefix + "[" + ( typeof v === "object" ? i : "" ) + "]", v, traditional, add ); - } - }); - - } else if ( !traditional && jQuery.type( obj ) === "object" ) { - // Serialize object item. - for ( name in obj ) { - buildParams( prefix + "[" + name + "]", obj[ name ], traditional, add ); - } - - } else { - // Serialize scalar item. - add( prefix, obj ); - } -} -var - // Document location - ajaxLocParts, - ajaxLocation, - - rhash = /#.*$/, - rheaders = /^(.*?):[ \t]*([^\r\n]*)\r?$/mg, // IE leaves an \r character at EOL - // #7653, #8125, #8152: local protocol detection - rlocalProtocol = /^(?:about|app|app\-storage|.+\-extension|file|res|widget):$/, - rnoContent = /^(?:GET|HEAD)$/, - rprotocol = /^\/\//, - rquery = /\?/, - rscript = /)<[^<]*)*<\/script>/gi, - rts = /([?&])_=[^&]*/, - rurl = /^([\w\+\.\-]+:)(?:\/\/([^\/?#:]*)(?::(\d+)|)|)/, - - // Keep a copy of the old load method - _load = jQuery.fn.load, - - /* Prefilters - * 1) They are useful to introduce custom dataTypes (see ajax/jsonp.js for an example) - * 2) These are called: - * - BEFORE asking for a transport - * - AFTER param serialization (s.data is a string if s.processData is true) - * 3) key is the dataType - * 4) the catchall symbol "*" can be used - * 5) execution will start with transport dataType and THEN continue down to "*" if needed - */ - prefilters = {}, - - /* Transports bindings - * 1) key is the dataType - * 2) the catchall symbol "*" can be used - * 3) selection will start with transport dataType and THEN go to "*" if needed - */ - transports = {}, - - // Avoid comment-prolog char sequence (#10098); must appease lint and evade compression - allTypes = ["*/"] + ["*"]; - -// #8138, IE may throw an exception when accessing -// a field from window.location if document.domain has been set -try { - ajaxLocation = location.href; -} catch( e ) { - // Use the href attribute of an A element - // since IE will modify it given document.location - ajaxLocation = document.createElement( "a" ); - ajaxLocation.href = ""; - ajaxLocation = ajaxLocation.href; -} - -// Segment location into parts -ajaxLocParts = rurl.exec( ajaxLocation.toLowerCase() ) || []; - -// Base "constructor" for jQuery.ajaxPrefilter and jQuery.ajaxTransport -function addToPrefiltersOrTransports( structure ) { - - // dataTypeExpression is optional and defaults to "*" - return function( dataTypeExpression, func ) { - - if ( typeof dataTypeExpression !== "string" ) { - func = dataTypeExpression; - dataTypeExpression = "*"; - } - - var dataType, list, placeBefore, - dataTypes = dataTypeExpression.toLowerCase().split( core_rspace ), - i = 0, - length = dataTypes.length; - - if ( jQuery.isFunction( func ) ) { - // For each dataType in the dataTypeExpression - for ( ; i < length; i++ ) { - dataType = dataTypes[ i ]; - // We control if we're asked to add before - // any existing element - placeBefore = /^\+/.test( dataType ); - if ( placeBefore ) { - dataType = dataType.substr( 1 ) || "*"; - } - list = structure[ dataType ] = structure[ dataType ] || []; - // then we add to the structure accordingly - list[ placeBefore ? "unshift" : "push" ]( func ); - } - } - }; -} - -// Base inspection function for prefilters and transports -function inspectPrefiltersOrTransports( structure, options, originalOptions, jqXHR, - dataType /* internal */, inspected /* internal */ ) { - - dataType = dataType || options.dataTypes[ 0 ]; - inspected = inspected || {}; - - inspected[ dataType ] = true; - - var selection, - list = structure[ dataType ], - i = 0, - length = list ? list.length : 0, - executeOnly = ( structure === prefilters ); - - for ( ; i < length && ( executeOnly || !selection ); i++ ) { - selection = list[ i ]( options, originalOptions, jqXHR ); - // If we got redirected to another dataType - // we try there if executing only and not done already - if ( typeof selection === "string" ) { - if ( !executeOnly || inspected[ selection ] ) { - selection = undefined; - } else { - options.dataTypes.unshift( selection ); - selection = inspectPrefiltersOrTransports( - structure, options, originalOptions, jqXHR, selection, inspected ); - } - } - } - // If we're only executing or nothing was selected - // we try the catchall dataType if not done already - if ( ( executeOnly || !selection ) && !inspected[ "*" ] ) { - selection = inspectPrefiltersOrTransports( - structure, options, originalOptions, jqXHR, "*", inspected ); - } - // unnecessary when only executing (prefilters) - // but it'll be ignored by the caller in that case - return selection; -} - -// A special extend for ajax options -// that takes "flat" options (not to be deep extended) -// Fixes #9887 -function ajaxExtend( target, src ) { - var key, deep, - flatOptions = jQuery.ajaxSettings.flatOptions || {}; - for ( key in src ) { - if ( src[ key ] !== undefined ) { - ( flatOptions[ key ] ? target : ( deep || ( deep = {} ) ) )[ key ] = src[ key ]; - } - } - if ( deep ) { - jQuery.extend( true, target, deep ); - } -} - -jQuery.fn.load = function( url, params, callback ) { - if ( typeof url !== "string" && _load ) { - return _load.apply( this, arguments ); - } - - // Don't do a request if no elements are being requested - if ( !this.length ) { - return this; - } - - var selector, type, response, - self = this, - off = url.indexOf(" "); - - if ( off >= 0 ) { - selector = url.slice( off, url.length ); - url = url.slice( 0, off ); - } - - // If it's a function - if ( jQuery.isFunction( params ) ) { - - // We assume that it's the callback - callback = params; - params = undefined; - - // Otherwise, build a param string - } else if ( params && typeof params === "object" ) { - type = "POST"; - } - - // Request the remote document - jQuery.ajax({ - url: url, - - // if "type" variable is undefined, then "GET" method will be used - type: type, - dataType: "html", - data: params, - complete: function( jqXHR, status ) { - if ( callback ) { - self.each( callback, response || [ jqXHR.responseText, status, jqXHR ] ); - } - } - }).done(function( responseText ) { - - // Save response for use in complete callback - response = arguments; - - // See if a selector was specified - self.html( selector ? - - // Create a dummy div to hold the results - jQuery("
") - - // inject the contents of the document in, removing the scripts - // to avoid any 'Permission Denied' errors in IE - .append( responseText.replace( rscript, "" ) ) - - // Locate the specified elements - .find( selector ) : - - // If not, just inject the full result - responseText ); - - }); - - return this; -}; - -// Attach a bunch of functions for handling common AJAX events -jQuery.each( "ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split( " " ), function( i, o ){ - jQuery.fn[ o ] = function( f ){ - return this.on( o, f ); - }; -}); - -jQuery.each( [ "get", "post" ], function( i, method ) { - jQuery[ method ] = function( url, data, callback, type ) { - // shift arguments if data argument was omitted - if ( jQuery.isFunction( data ) ) { - type = type || callback; - callback = data; - data = undefined; - } - - return jQuery.ajax({ - type: method, - url: url, - data: data, - success: callback, - dataType: type - }); - }; -}); - -jQuery.extend({ - - getScript: function( url, callback ) { - return jQuery.get( url, undefined, callback, "script" ); - }, - - getJSON: function( url, data, callback ) { - return jQuery.get( url, data, callback, "json" ); - }, - - // Creates a full fledged settings object into target - // with both ajaxSettings and settings fields. - // If target is omitted, writes into ajaxSettings. - ajaxSetup: function( target, settings ) { - if ( settings ) { - // Building a settings object - ajaxExtend( target, jQuery.ajaxSettings ); - } else { - // Extending ajaxSettings - settings = target; - target = jQuery.ajaxSettings; - } - ajaxExtend( target, settings ); - return target; - }, - - ajaxSettings: { - url: ajaxLocation, - isLocal: rlocalProtocol.test( ajaxLocParts[ 1 ] ), - global: true, - type: "GET", - contentType: "application/x-www-form-urlencoded; charset=UTF-8", - processData: true, - async: true, - /* - timeout: 0, - data: null, - dataType: null, - username: null, - password: null, - cache: null, - throws: false, - traditional: false, - headers: {}, - */ - - accepts: { - xml: "application/xml, text/xml", - html: "text/html", - text: "text/plain", - json: "application/json, text/javascript", - "*": allTypes - }, - - contents: { - xml: /xml/, - html: /html/, - json: /json/ - }, - - responseFields: { - xml: "responseXML", - text: "responseText" - }, - - // List of data converters - // 1) key format is "source_type destination_type" (a single space in-between) - // 2) the catchall symbol "*" can be used for source_type - converters: { - - // Convert anything to text - "* text": window.String, - - // Text to html (true = no transformation) - "text html": true, - - // Evaluate text as a json expression - "text json": jQuery.parseJSON, - - // Parse text as xml - "text xml": jQuery.parseXML - }, - - // For options that shouldn't be deep extended: - // you can add your own custom options here if - // and when you create one that shouldn't be - // deep extended (see ajaxExtend) - flatOptions: { - context: true, - url: true - } - }, - - ajaxPrefilter: addToPrefiltersOrTransports( prefilters ), - ajaxTransport: addToPrefiltersOrTransports( transports ), - - // Main method - ajax: function( url, options ) { - - // If url is an object, simulate pre-1.5 signature - if ( typeof url === "object" ) { - options = url; - url = undefined; - } - - // Force options to be an object - options = options || {}; - - var // ifModified key - ifModifiedKey, - // Response headers - responseHeadersString, - responseHeaders, - // transport - transport, - // timeout handle - timeoutTimer, - // Cross-domain detection vars - parts, - // To know if global events are to be dispatched - fireGlobals, - // Loop variable - i, - // Create the final options object - s = jQuery.ajaxSetup( {}, options ), - // Callbacks context - callbackContext = s.context || s, - // Context for global events - // It's the callbackContext if one was provided in the options - // and if it's a DOM node or a jQuery collection - globalEventContext = callbackContext !== s && - ( callbackContext.nodeType || callbackContext instanceof jQuery ) ? - jQuery( callbackContext ) : jQuery.event, - // Deferreds - deferred = jQuery.Deferred(), - completeDeferred = jQuery.Callbacks( "once memory" ), - // Status-dependent callbacks - statusCode = s.statusCode || {}, - // Headers (they are sent all at once) - requestHeaders = {}, - requestHeadersNames = {}, - // The jqXHR state - state = 0, - // Default abort message - strAbort = "canceled", - // Fake xhr - jqXHR = { - - readyState: 0, - - // Caches the header - setRequestHeader: function( name, value ) { - if ( !state ) { - var lname = name.toLowerCase(); - name = requestHeadersNames[ lname ] = requestHeadersNames[ lname ] || name; - requestHeaders[ name ] = value; - } - return this; - }, - - // Raw string - getAllResponseHeaders: function() { - return state === 2 ? responseHeadersString : null; - }, - - // Builds headers hashtable if needed - getResponseHeader: function( key ) { - var match; - if ( state === 2 ) { - if ( !responseHeaders ) { - responseHeaders = {}; - while( ( match = rheaders.exec( responseHeadersString ) ) ) { - responseHeaders[ match[1].toLowerCase() ] = match[ 2 ]; - } - } - match = responseHeaders[ key.toLowerCase() ]; - } - return match === undefined ? null : match; - }, - - // Overrides response content-type header - overrideMimeType: function( type ) { - if ( !state ) { - s.mimeType = type; - } - return this; - }, - - // Cancel the request - abort: function( statusText ) { - statusText = statusText || strAbort; - if ( transport ) { - transport.abort( statusText ); - } - done( 0, statusText ); - return this; - } - }; - - // Callback for when everything is done - // It is defined here because jslint complains if it is declared - // at the end of the function (which would be more logical and readable) - function done( status, nativeStatusText, responses, headers ) { - var isSuccess, success, error, response, modified, - statusText = nativeStatusText; - - // Called once - if ( state === 2 ) { - return; - } - - // State is "done" now - state = 2; - - // Clear timeout if it exists - if ( timeoutTimer ) { - clearTimeout( timeoutTimer ); - } - - // Dereference transport for early garbage collection - // (no matter how long the jqXHR object will be used) - transport = undefined; - - // Cache response headers - responseHeadersString = headers || ""; - - // Set readyState - jqXHR.readyState = status > 0 ? 4 : 0; - - // Get response data - if ( responses ) { - response = ajaxHandleResponses( s, jqXHR, responses ); - } - - // If successful, handle type chaining - if ( status >= 200 && status < 300 || status === 304 ) { - - // Set the If-Modified-Since and/or If-None-Match header, if in ifModified mode. - if ( s.ifModified ) { - - modified = jqXHR.getResponseHeader("Last-Modified"); - if ( modified ) { - jQuery.lastModified[ ifModifiedKey ] = modified; - } - modified = jqXHR.getResponseHeader("Etag"); - if ( modified ) { - jQuery.etag[ ifModifiedKey ] = modified; - } - } - - // If not modified - if ( status === 304 ) { - - statusText = "notmodified"; - isSuccess = true; - - // If we have data - } else { - - isSuccess = ajaxConvert( s, response ); - statusText = isSuccess.state; - success = isSuccess.data; - error = isSuccess.error; - isSuccess = !error; - } - } else { - // We extract error from statusText - // then normalize statusText and status for non-aborts - error = statusText; - if ( !statusText || status ) { - statusText = "error"; - if ( status < 0 ) { - status = 0; - } - } - } - - // Set data for the fake xhr object - jqXHR.status = status; - jqXHR.statusText = ( nativeStatusText || statusText ) + ""; - - // Success/Error - if ( isSuccess ) { - deferred.resolveWith( callbackContext, [ success, statusText, jqXHR ] ); - } else { - deferred.rejectWith( callbackContext, [ jqXHR, statusText, error ] ); - } - - // Status-dependent callbacks - jqXHR.statusCode( statusCode ); - statusCode = undefined; - - if ( fireGlobals ) { - globalEventContext.trigger( "ajax" + ( isSuccess ? "Success" : "Error" ), - [ jqXHR, s, isSuccess ? success : error ] ); - } - - // Complete - completeDeferred.fireWith( callbackContext, [ jqXHR, statusText ] ); - - if ( fireGlobals ) { - globalEventContext.trigger( "ajaxComplete", [ jqXHR, s ] ); - // Handle the global AJAX counter - if ( !( --jQuery.active ) ) { - jQuery.event.trigger( "ajaxStop" ); - } - } - } - - // Attach deferreds - deferred.promise( jqXHR ); - jqXHR.success = jqXHR.done; - jqXHR.error = jqXHR.fail; - jqXHR.complete = completeDeferred.add; - - // Status-dependent callbacks - jqXHR.statusCode = function( map ) { - if ( map ) { - var tmp; - if ( state < 2 ) { - for ( tmp in map ) { - statusCode[ tmp ] = [ statusCode[tmp], map[tmp] ]; - } - } else { - tmp = map[ jqXHR.status ]; - jqXHR.always( tmp ); - } - } - return this; - }; - - // Remove hash character (#7531: and string promotion) - // Add protocol if not provided (#5866: IE7 issue with protocol-less urls) - // We also use the url parameter if available - s.url = ( ( url || s.url ) + "" ).replace( rhash, "" ).replace( rprotocol, ajaxLocParts[ 1 ] + "//" ); - - // Extract dataTypes list - s.dataTypes = jQuery.trim( s.dataType || "*" ).toLowerCase().split( core_rspace ); - - // A cross-domain request is in order when we have a protocol:host:port mismatch - if ( s.crossDomain == null ) { - parts = rurl.exec( s.url.toLowerCase() ); - s.crossDomain = !!( parts && - ( parts[ 1 ] !== ajaxLocParts[ 1 ] || parts[ 2 ] !== ajaxLocParts[ 2 ] || - ( parts[ 3 ] || ( parts[ 1 ] === "http:" ? 80 : 443 ) ) != - ( ajaxLocParts[ 3 ] || ( ajaxLocParts[ 1 ] === "http:" ? 80 : 443 ) ) ) - ); - } - - // Convert data if not already a string - if ( s.data && s.processData && typeof s.data !== "string" ) { - s.data = jQuery.param( s.data, s.traditional ); - } - - // Apply prefilters - inspectPrefiltersOrTransports( prefilters, s, options, jqXHR ); - - // If request was aborted inside a prefilter, stop there - if ( state === 2 ) { - return jqXHR; - } - - // We can fire global events as of now if asked to - fireGlobals = s.global; - - // Uppercase the type - s.type = s.type.toUpperCase(); - - // Determine if request has content - s.hasContent = !rnoContent.test( s.type ); - - // Watch for a new set of requests - if ( fireGlobals && jQuery.active++ === 0 ) { - jQuery.event.trigger( "ajaxStart" ); - } - - // More options handling for requests with no content - if ( !s.hasContent ) { - - // If data is available, append data to url - if ( s.data ) { - s.url += ( rquery.test( s.url ) ? "&" : "?" ) + s.data; - // #9682: remove data so that it's not used in an eventual retry - delete s.data; - } - - // Get ifModifiedKey before adding the anti-cache parameter - ifModifiedKey = s.url; - - // Add anti-cache in url if needed - if ( s.cache === false ) { - - var ts = jQuery.now(), - // try replacing _= if it is there - ret = s.url.replace( rts, "$1_=" + ts ); - - // if nothing was replaced, add timestamp to the end - s.url = ret + ( ( ret === s.url ) ? ( rquery.test( s.url ) ? "&" : "?" ) + "_=" + ts : "" ); - } - } - - // Set the correct header, if data is being sent - if ( s.data && s.hasContent && s.contentType !== false || options.contentType ) { - jqXHR.setRequestHeader( "Content-Type", s.contentType ); - } - - // Set the If-Modified-Since and/or If-None-Match header, if in ifModified mode. - if ( s.ifModified ) { - ifModifiedKey = ifModifiedKey || s.url; - if ( jQuery.lastModified[ ifModifiedKey ] ) { - jqXHR.setRequestHeader( "If-Modified-Since", jQuery.lastModified[ ifModifiedKey ] ); - } - if ( jQuery.etag[ ifModifiedKey ] ) { - jqXHR.setRequestHeader( "If-None-Match", jQuery.etag[ ifModifiedKey ] ); - } - } - - // Set the Accepts header for the server, depending on the dataType - jqXHR.setRequestHeader( - "Accept", - s.dataTypes[ 0 ] && s.accepts[ s.dataTypes[0] ] ? - s.accepts[ s.dataTypes[0] ] + ( s.dataTypes[ 0 ] !== "*" ? ", " + allTypes + "; q=0.01" : "" ) : - s.accepts[ "*" ] - ); - - // Check for headers option - for ( i in s.headers ) { - jqXHR.setRequestHeader( i, s.headers[ i ] ); - } - - // Allow custom headers/mimetypes and early abort - if ( s.beforeSend && ( s.beforeSend.call( callbackContext, jqXHR, s ) === false || state === 2 ) ) { - // Abort if not done already and return - return jqXHR.abort(); - - } - - // aborting is no longer a cancellation - strAbort = "abort"; - - // Install callbacks on deferreds - for ( i in { success: 1, error: 1, complete: 1 } ) { - jqXHR[ i ]( s[ i ] ); - } - - // Get transport - transport = inspectPrefiltersOrTransports( transports, s, options, jqXHR ); - - // If no transport, we auto-abort - if ( !transport ) { - done( -1, "No Transport" ); - } else { - jqXHR.readyState = 1; - // Send global event - if ( fireGlobals ) { - globalEventContext.trigger( "ajaxSend", [ jqXHR, s ] ); - } - // Timeout - if ( s.async && s.timeout > 0 ) { - timeoutTimer = setTimeout( function(){ - jqXHR.abort( "timeout" ); - }, s.timeout ); - } - - try { - state = 1; - transport.send( requestHeaders, done ); - } catch (e) { - // Propagate exception as error if not done - if ( state < 2 ) { - done( -1, e ); - // Simply rethrow otherwise - } else { - throw e; - } - } - } - - return jqXHR; - }, - - // Counter for holding the number of active queries - active: 0, - - // Last-Modified header cache for next request - lastModified: {}, - etag: {} - -}); - -/* Handles responses to an ajax request: - * - sets all responseXXX fields accordingly - * - finds the right dataType (mediates between content-type and expected dataType) - * - returns the corresponding response - */ -function ajaxHandleResponses( s, jqXHR, responses ) { - - var ct, type, finalDataType, firstDataType, - contents = s.contents, - dataTypes = s.dataTypes, - responseFields = s.responseFields; - - // Fill responseXXX fields - for ( type in responseFields ) { - if ( type in responses ) { - jqXHR[ responseFields[type] ] = responses[ type ]; - } - } - - // Remove auto dataType and get content-type in the process - while( dataTypes[ 0 ] === "*" ) { - dataTypes.shift(); - if ( ct === undefined ) { - ct = s.mimeType || jqXHR.getResponseHeader( "content-type" ); - } - } - - // Check if we're dealing with a known content-type - if ( ct ) { - for ( type in contents ) { - if ( contents[ type ] && contents[ type ].test( ct ) ) { - dataTypes.unshift( type ); - break; - } - } - } - - // Check to see if we have a response for the expected dataType - if ( dataTypes[ 0 ] in responses ) { - finalDataType = dataTypes[ 0 ]; - } else { - // Try convertible dataTypes - for ( type in responses ) { - if ( !dataTypes[ 0 ] || s.converters[ type + " " + dataTypes[0] ] ) { - finalDataType = type; - break; - } - if ( !firstDataType ) { - firstDataType = type; - } - } - // Or just use first one - finalDataType = finalDataType || firstDataType; - } - - // If we found a dataType - // We add the dataType to the list if needed - // and return the corresponding response - if ( finalDataType ) { - if ( finalDataType !== dataTypes[ 0 ] ) { - dataTypes.unshift( finalDataType ); - } - return responses[ finalDataType ]; - } -} - -// Chain conversions given the request and the original response -function ajaxConvert( s, response ) { - - var conv, conv2, current, tmp, - // Work with a copy of dataTypes in case we need to modify it for conversion - dataTypes = s.dataTypes.slice(), - prev = dataTypes[ 0 ], - converters = {}, - i = 0; - - // Apply the dataFilter if provided - if ( s.dataFilter ) { - response = s.dataFilter( response, s.dataType ); - } - - // Create converters map with lowercased keys - if ( dataTypes[ 1 ] ) { - for ( conv in s.converters ) { - converters[ conv.toLowerCase() ] = s.converters[ conv ]; - } - } - - // Convert to each sequential dataType, tolerating list modification - for ( ; (current = dataTypes[++i]); ) { - - // There's only work to do if current dataType is non-auto - if ( current !== "*" ) { - - // Convert response if prev dataType is non-auto and differs from current - if ( prev !== "*" && prev !== current ) { - - // Seek a direct converter - conv = converters[ prev + " " + current ] || converters[ "* " + current ]; - - // If none found, seek a pair - if ( !conv ) { - for ( conv2 in converters ) { - - // If conv2 outputs current - tmp = conv2.split(" "); - if ( tmp[ 1 ] === current ) { - - // If prev can be converted to accepted input - conv = converters[ prev + " " + tmp[ 0 ] ] || - converters[ "* " + tmp[ 0 ] ]; - if ( conv ) { - // Condense equivalence converters - if ( conv === true ) { - conv = converters[ conv2 ]; - - // Otherwise, insert the intermediate dataType - } else if ( converters[ conv2 ] !== true ) { - current = tmp[ 0 ]; - dataTypes.splice( i--, 0, current ); - } - - break; - } - } - } - } - - // Apply converter (if not an equivalence) - if ( conv !== true ) { - - // Unless errors are allowed to bubble, catch and return them - if ( conv && s["throws"] ) { - response = conv( response ); - } else { - try { - response = conv( response ); - } catch ( e ) { - return { state: "parsererror", error: conv ? e : "No conversion from " + prev + " to " + current }; - } - } - } - } - - // Update prev for next iteration - prev = current; - } - } - - return { state: "success", data: response }; -} -var oldCallbacks = [], - rquestion = /\?/, - rjsonp = /(=)\?(?=&|$)|\?\?/, - nonce = jQuery.now(); - -// Default jsonp settings -jQuery.ajaxSetup({ - jsonp: "callback", - jsonpCallback: function() { - var callback = oldCallbacks.pop() || ( jQuery.expando + "_" + ( nonce++ ) ); - this[ callback ] = true; - return callback; - } -}); - -// Detect, normalize options and install callbacks for jsonp requests -jQuery.ajaxPrefilter( "json jsonp", function( s, originalSettings, jqXHR ) { - - var callbackName, overwritten, responseContainer, - data = s.data, - url = s.url, - hasCallback = s.jsonp !== false, - replaceInUrl = hasCallback && rjsonp.test( url ), - replaceInData = hasCallback && !replaceInUrl && typeof data === "string" && - !( s.contentType || "" ).indexOf("application/x-www-form-urlencoded") && - rjsonp.test( data ); - - // Handle iff the expected data type is "jsonp" or we have a parameter to set - if ( s.dataTypes[ 0 ] === "jsonp" || replaceInUrl || replaceInData ) { - - // Get callback name, remembering preexisting value associated with it - callbackName = s.jsonpCallback = jQuery.isFunction( s.jsonpCallback ) ? - s.jsonpCallback() : - s.jsonpCallback; - overwritten = window[ callbackName ]; - - // Insert callback into url or form data - if ( replaceInUrl ) { - s.url = url.replace( rjsonp, "$1" + callbackName ); - } else if ( replaceInData ) { - s.data = data.replace( rjsonp, "$1" + callbackName ); - } else if ( hasCallback ) { - s.url += ( rquestion.test( url ) ? "&" : "?" ) + s.jsonp + "=" + callbackName; - } - - // Use data converter to retrieve json after script execution - s.converters["script json"] = function() { - if ( !responseContainer ) { - jQuery.error( callbackName + " was not called" ); - } - return responseContainer[ 0 ]; - }; - - // force json dataType - s.dataTypes[ 0 ] = "json"; - - // Install callback - window[ callbackName ] = function() { - responseContainer = arguments; - }; - - // Clean-up function (fires after converters) - jqXHR.always(function() { - // Restore preexisting value - window[ callbackName ] = overwritten; - - // Save back as free - if ( s[ callbackName ] ) { - // make sure that re-using the options doesn't screw things around - s.jsonpCallback = originalSettings.jsonpCallback; - - // save the callback name for future use - oldCallbacks.push( callbackName ); - } - - // Call if it was a function and we have a response - if ( responseContainer && jQuery.isFunction( overwritten ) ) { - overwritten( responseContainer[ 0 ] ); - } - - responseContainer = overwritten = undefined; - }); - - // Delegate to script - return "script"; - } -}); -// Install script dataType -jQuery.ajaxSetup({ - accepts: { - script: "text/javascript, application/javascript, application/ecmascript, application/x-ecmascript" - }, - contents: { - script: /javascript|ecmascript/ - }, - converters: { - "text script": function( text ) { - jQuery.globalEval( text ); - return text; - } - } -}); - -// Handle cache's special case and global -jQuery.ajaxPrefilter( "script", function( s ) { - if ( s.cache === undefined ) { - s.cache = false; - } - if ( s.crossDomain ) { - s.type = "GET"; - s.global = false; - } -}); - -// Bind script tag hack transport -jQuery.ajaxTransport( "script", function(s) { - - // This transport only deals with cross domain requests - if ( s.crossDomain ) { - - var script, - head = document.head || document.getElementsByTagName( "head" )[0] || document.documentElement; - - return { - - send: function( _, callback ) { - - script = document.createElement( "script" ); - - script.async = "async"; - - if ( s.scriptCharset ) { - script.charset = s.scriptCharset; - } - - script.src = s.url; - - // Attach handlers for all browsers - script.onload = script.onreadystatechange = function( _, isAbort ) { - - if ( isAbort || !script.readyState || /loaded|complete/.test( script.readyState ) ) { - - // Handle memory leak in IE - script.onload = script.onreadystatechange = null; - - // Remove the script - if ( head && script.parentNode ) { - head.removeChild( script ); - } - - // Dereference the script - script = undefined; - - // Callback if not abort - if ( !isAbort ) { - callback( 200, "success" ); - } - } - }; - // Use insertBefore instead of appendChild to circumvent an IE6 bug. - // This arises when a base node is used (#2709 and #4378). - head.insertBefore( script, head.firstChild ); - }, - - abort: function() { - if ( script ) { - script.onload( 0, 1 ); - } - } - }; - } -}); -var xhrCallbacks, - // #5280: Internet Explorer will keep connections alive if we don't abort on unload - xhrOnUnloadAbort = window.ActiveXObject ? function() { - // Abort all pending requests - for ( var key in xhrCallbacks ) { - xhrCallbacks[ key ]( 0, 1 ); - } - } : false, - xhrId = 0; - -// Functions to create xhrs -function createStandardXHR() { - try { - return new window.XMLHttpRequest(); - } catch( e ) {} -} - -function createActiveXHR() { - try { - return new window.ActiveXObject( "Microsoft.XMLHTTP" ); - } catch( e ) {} -} - -// Create the request object -// (This is still attached to ajaxSettings for backward compatibility) -jQuery.ajaxSettings.xhr = window.ActiveXObject ? - /* Microsoft failed to properly - * implement the XMLHttpRequest in IE7 (can't request local files), - * so we use the ActiveXObject when it is available - * Additionally XMLHttpRequest can be disabled in IE7/IE8 so - * we need a fallback. - */ - function() { - return !this.isLocal && createStandardXHR() || createActiveXHR(); - } : - // For all other browsers, use the standard XMLHttpRequest object - createStandardXHR; - -// Determine support properties -(function( xhr ) { - jQuery.extend( jQuery.support, { - ajax: !!xhr, - cors: !!xhr && ( "withCredentials" in xhr ) - }); -})( jQuery.ajaxSettings.xhr() ); - -// Create transport if the browser can provide an xhr -if ( jQuery.support.ajax ) { - - jQuery.ajaxTransport(function( s ) { - // Cross domain only allowed if supported through XMLHttpRequest - if ( !s.crossDomain || jQuery.support.cors ) { - - var callback; - - return { - send: function( headers, complete ) { - - // Get a new xhr - var handle, i, - xhr = s.xhr(); - - // Open the socket - // Passing null username, generates a login popup on Opera (#2865) - if ( s.username ) { - xhr.open( s.type, s.url, s.async, s.username, s.password ); - } else { - xhr.open( s.type, s.url, s.async ); - } - - // Apply custom fields if provided - if ( s.xhrFields ) { - for ( i in s.xhrFields ) { - xhr[ i ] = s.xhrFields[ i ]; - } - } - - // Override mime type if needed - if ( s.mimeType && xhr.overrideMimeType ) { - xhr.overrideMimeType( s.mimeType ); - } - - // X-Requested-With header - // For cross-domain requests, seeing as conditions for a preflight are - // akin to a jigsaw puzzle, we simply never set it to be sure. - // (it can always be set on a per-request basis or even using ajaxSetup) - // For same-domain requests, won't change header if already provided. - if ( !s.crossDomain && !headers["X-Requested-With"] ) { - headers[ "X-Requested-With" ] = "XMLHttpRequest"; - } - - // Need an extra try/catch for cross domain requests in Firefox 3 - try { - for ( i in headers ) { - xhr.setRequestHeader( i, headers[ i ] ); - } - } catch( _ ) {} - - // Do send the request - // This may raise an exception which is actually - // handled in jQuery.ajax (so no try/catch here) - xhr.send( ( s.hasContent && s.data ) || null ); - - // Listener - callback = function( _, isAbort ) { - - var status, - statusText, - responseHeaders, - responses, - xml; - - // Firefox throws exceptions when accessing properties - // of an xhr when a network error occurred - // http://helpful.knobs-dials.com/index.php/Component_returned_failure_code:_0x80040111_(NS_ERROR_NOT_AVAILABLE) - try { - - // Was never called and is aborted or complete - if ( callback && ( isAbort || xhr.readyState === 4 ) ) { - - // Only called once - callback = undefined; - - // Do not keep as active anymore - if ( handle ) { - xhr.onreadystatechange = jQuery.noop; - if ( xhrOnUnloadAbort ) { - delete xhrCallbacks[ handle ]; - } - } - - // If it's an abort - if ( isAbort ) { - // Abort it manually if needed - if ( xhr.readyState !== 4 ) { - xhr.abort(); - } - } else { - status = xhr.status; - responseHeaders = xhr.getAllResponseHeaders(); - responses = {}; - xml = xhr.responseXML; - - // Construct response list - if ( xml && xml.documentElement /* #4958 */ ) { - responses.xml = xml; - } - - // When requesting binary data, IE6-9 will throw an exception - // on any attempt to access responseText (#11426) - try { - responses.text = xhr.responseText; - } catch( e ) { - } - - // Firefox throws an exception when accessing - // statusText for faulty cross-domain requests - try { - statusText = xhr.statusText; - } catch( e ) { - // We normalize with Webkit giving an empty statusText - statusText = ""; - } - - // Filter status for non standard behaviors - - // If the request is local and we have data: assume a success - // (success with no data won't get notified, that's the best we - // can do given current implementations) - if ( !status && s.isLocal && !s.crossDomain ) { - status = responses.text ? 200 : 404; - // IE - #1450: sometimes returns 1223 when it should be 204 - } else if ( status === 1223 ) { - status = 204; - } - } - } - } catch( firefoxAccessException ) { - if ( !isAbort ) { - complete( -1, firefoxAccessException ); - } - } - - // Call complete if needed - if ( responses ) { - complete( status, statusText, responses, responseHeaders ); - } - }; - - if ( !s.async ) { - // if we're in sync mode we fire the callback - callback(); - } else if ( xhr.readyState === 4 ) { - // (IE6 & IE7) if it's in cache and has been - // retrieved directly we need to fire the callback - setTimeout( callback, 0 ); - } else { - handle = ++xhrId; - if ( xhrOnUnloadAbort ) { - // Create the active xhrs callbacks list if needed - // and attach the unload handler - if ( !xhrCallbacks ) { - xhrCallbacks = {}; - jQuery( window ).unload( xhrOnUnloadAbort ); - } - // Add to list of active xhrs callbacks - xhrCallbacks[ handle ] = callback; - } - xhr.onreadystatechange = callback; - } - }, - - abort: function() { - if ( callback ) { - callback(0,1); - } - } - }; - } - }); -} -var fxNow, timerId, - rfxtypes = /^(?:toggle|show|hide)$/, - rfxnum = new RegExp( "^(?:([-+])=|)(" + core_pnum + ")([a-z%]*)$", "i" ), - rrun = /queueHooks$/, - animationPrefilters = [ defaultPrefilter ], - tweeners = { - "*": [function( prop, value ) { - var end, unit, - tween = this.createTween( prop, value ), - parts = rfxnum.exec( value ), - target = tween.cur(), - start = +target || 0, - scale = 1, - maxIterations = 20; - - if ( parts ) { - end = +parts[2]; - unit = parts[3] || ( jQuery.cssNumber[ prop ] ? "" : "px" ); - - // We need to compute starting value - if ( unit !== "px" && start ) { - // Iteratively approximate from a nonzero starting point - // Prefer the current property, because this process will be trivial if it uses the same units - // Fallback to end or a simple constant - start = jQuery.css( tween.elem, prop, true ) || end || 1; - - do { - // If previous iteration zeroed out, double until we get *something* - // Use a string for doubling factor so we don't accidentally see scale as unchanged below - scale = scale || ".5"; - - // Adjust and apply - start = start / scale; - jQuery.style( tween.elem, prop, start + unit ); - - // Update scale, tolerating zero or NaN from tween.cur() - // And breaking the loop if scale is unchanged or perfect, or if we've just had enough - } while ( scale !== (scale = tween.cur() / target) && scale !== 1 && --maxIterations ); - } - - tween.unit = unit; - tween.start = start; - // If a +=/-= token was provided, we're doing a relative animation - tween.end = parts[1] ? start + ( parts[1] + 1 ) * end : end; - } - return tween; - }] - }; - -// Animations created synchronously will run synchronously -function createFxNow() { - setTimeout(function() { - fxNow = undefined; - }, 0 ); - return ( fxNow = jQuery.now() ); -} - -function createTweens( animation, props ) { - jQuery.each( props, function( prop, value ) { - var collection = ( tweeners[ prop ] || [] ).concat( tweeners[ "*" ] ), - index = 0, - length = collection.length; - for ( ; index < length; index++ ) { - if ( collection[ index ].call( animation, prop, value ) ) { - - // we're done with this property - return; - } - } - }); -} - -function Animation( elem, properties, options ) { - var result, - index = 0, - tweenerIndex = 0, - length = animationPrefilters.length, - deferred = jQuery.Deferred().always( function() { - // don't match elem in the :animated selector - delete tick.elem; - }), - tick = function() { - var currentTime = fxNow || createFxNow(), - remaining = Math.max( 0, animation.startTime + animation.duration - currentTime ), - // archaic crash bug won't allow us to use 1 - ( 0.5 || 0 ) (#12497) - temp = remaining / animation.duration || 0, - percent = 1 - temp, - index = 0, - length = animation.tweens.length; - - for ( ; index < length ; index++ ) { - animation.tweens[ index ].run( percent ); - } - - deferred.notifyWith( elem, [ animation, percent, remaining ]); - - if ( percent < 1 && length ) { - return remaining; - } else { - deferred.resolveWith( elem, [ animation ] ); - return false; - } - }, - animation = deferred.promise({ - elem: elem, - props: jQuery.extend( {}, properties ), - opts: jQuery.extend( true, { specialEasing: {} }, options ), - originalProperties: properties, - originalOptions: options, - startTime: fxNow || createFxNow(), - duration: options.duration, - tweens: [], - createTween: function( prop, end, easing ) { - var tween = jQuery.Tween( elem, animation.opts, prop, end, - animation.opts.specialEasing[ prop ] || animation.opts.easing ); - animation.tweens.push( tween ); - return tween; - }, - stop: function( gotoEnd ) { - var index = 0, - // if we are going to the end, we want to run all the tweens - // otherwise we skip this part - length = gotoEnd ? animation.tweens.length : 0; - - for ( ; index < length ; index++ ) { - animation.tweens[ index ].run( 1 ); - } - - // resolve when we played the last frame - // otherwise, reject - if ( gotoEnd ) { - deferred.resolveWith( elem, [ animation, gotoEnd ] ); - } else { - deferred.rejectWith( elem, [ animation, gotoEnd ] ); - } - return this; - } - }), - props = animation.props; - - propFilter( props, animation.opts.specialEasing ); - - for ( ; index < length ; index++ ) { - result = animationPrefilters[ index ].call( animation, elem, props, animation.opts ); - if ( result ) { - return result; - } - } - - createTweens( animation, props ); - - if ( jQuery.isFunction( animation.opts.start ) ) { - animation.opts.start.call( elem, animation ); - } - - jQuery.fx.timer( - jQuery.extend( tick, { - anim: animation, - queue: animation.opts.queue, - elem: elem - }) - ); - - // attach callbacks from options - return animation.progress( animation.opts.progress ) - .done( animation.opts.done, animation.opts.complete ) - .fail( animation.opts.fail ) - .always( animation.opts.always ); -} - -function propFilter( props, specialEasing ) { - var index, name, easing, value, hooks; - - // camelCase, specialEasing and expand cssHook pass - for ( index in props ) { - name = jQuery.camelCase( index ); - easing = specialEasing[ name ]; - value = props[ index ]; - if ( jQuery.isArray( value ) ) { - easing = value[ 1 ]; - value = props[ index ] = value[ 0 ]; - } - - if ( index !== name ) { - props[ name ] = value; - delete props[ index ]; - } - - hooks = jQuery.cssHooks[ name ]; - if ( hooks && "expand" in hooks ) { - value = hooks.expand( value ); - delete props[ name ]; - - // not quite $.extend, this wont overwrite keys already present. - // also - reusing 'index' from above because we have the correct "name" - for ( index in value ) { - if ( !( index in props ) ) { - props[ index ] = value[ index ]; - specialEasing[ index ] = easing; - } - } - } else { - specialEasing[ name ] = easing; - } - } -} - -jQuery.Animation = jQuery.extend( Animation, { - - tweener: function( props, callback ) { - if ( jQuery.isFunction( props ) ) { - callback = props; - props = [ "*" ]; - } else { - props = props.split(" "); - } - - var prop, - index = 0, - length = props.length; - - for ( ; index < length ; index++ ) { - prop = props[ index ]; - tweeners[ prop ] = tweeners[ prop ] || []; - tweeners[ prop ].unshift( callback ); - } - }, - - prefilter: function( callback, prepend ) { - if ( prepend ) { - animationPrefilters.unshift( callback ); - } else { - animationPrefilters.push( callback ); - } - } -}); - -function defaultPrefilter( elem, props, opts ) { - var index, prop, value, length, dataShow, toggle, tween, hooks, oldfire, - anim = this, - style = elem.style, - orig = {}, - handled = [], - hidden = elem.nodeType && isHidden( elem ); - - // handle queue: false promises - if ( !opts.queue ) { - hooks = jQuery._queueHooks( elem, "fx" ); - if ( hooks.unqueued == null ) { - hooks.unqueued = 0; - oldfire = hooks.empty.fire; - hooks.empty.fire = function() { - if ( !hooks.unqueued ) { - oldfire(); - } - }; - } - hooks.unqueued++; - - anim.always(function() { - // doing this makes sure that the complete handler will be called - // before this completes - anim.always(function() { - hooks.unqueued--; - if ( !jQuery.queue( elem, "fx" ).length ) { - hooks.empty.fire(); - } - }); - }); - } - - // height/width overflow pass - if ( elem.nodeType === 1 && ( "height" in props || "width" in props ) ) { - // Make sure that nothing sneaks out - // Record all 3 overflow attributes because IE does not - // change the overflow attribute when overflowX and - // overflowY are set to the same value - opts.overflow = [ style.overflow, style.overflowX, style.overflowY ]; - - // Set display property to inline-block for height/width - // animations on inline elements that are having width/height animated - if ( jQuery.css( elem, "display" ) === "inline" && - jQuery.css( elem, "float" ) === "none" ) { - - // inline-level elements accept inline-block; - // block-level elements need to be inline with layout - if ( !jQuery.support.inlineBlockNeedsLayout || css_defaultDisplay( elem.nodeName ) === "inline" ) { - style.display = "inline-block"; - - } else { - style.zoom = 1; - } - } - } - - if ( opts.overflow ) { - style.overflow = "hidden"; - if ( !jQuery.support.shrinkWrapBlocks ) { - anim.done(function() { - style.overflow = opts.overflow[ 0 ]; - style.overflowX = opts.overflow[ 1 ]; - style.overflowY = opts.overflow[ 2 ]; - }); - } - } - - - // show/hide pass - for ( index in props ) { - value = props[ index ]; - if ( rfxtypes.exec( value ) ) { - delete props[ index ]; - toggle = toggle || value === "toggle"; - if ( value === ( hidden ? "hide" : "show" ) ) { - continue; - } - handled.push( index ); - } - } - - length = handled.length; - if ( length ) { - dataShow = jQuery._data( elem, "fxshow" ) || jQuery._data( elem, "fxshow", {} ); - if ( "hidden" in dataShow ) { - hidden = dataShow.hidden; - } - - // store state if its toggle - enables .stop().toggle() to "reverse" - if ( toggle ) { - dataShow.hidden = !hidden; - } - if ( hidden ) { - jQuery( elem ).show(); - } else { - anim.done(function() { - jQuery( elem ).hide(); - }); - } - anim.done(function() { - var prop; - jQuery.removeData( elem, "fxshow", true ); - for ( prop in orig ) { - jQuery.style( elem, prop, orig[ prop ] ); - } - }); - for ( index = 0 ; index < length ; index++ ) { - prop = handled[ index ]; - tween = anim.createTween( prop, hidden ? dataShow[ prop ] : 0 ); - orig[ prop ] = dataShow[ prop ] || jQuery.style( elem, prop ); - - if ( !( prop in dataShow ) ) { - dataShow[ prop ] = tween.start; - if ( hidden ) { - tween.end = tween.start; - tween.start = prop === "width" || prop === "height" ? 1 : 0; - } - } - } - } -} - -function Tween( elem, options, prop, end, easing ) { - return new Tween.prototype.init( elem, options, prop, end, easing ); -} -jQuery.Tween = Tween; - -Tween.prototype = { - constructor: Tween, - init: function( elem, options, prop, end, easing, unit ) { - this.elem = elem; - this.prop = prop; - this.easing = easing || "swing"; - this.options = options; - this.start = this.now = this.cur(); - this.end = end; - this.unit = unit || ( jQuery.cssNumber[ prop ] ? "" : "px" ); - }, - cur: function() { - var hooks = Tween.propHooks[ this.prop ]; - - return hooks && hooks.get ? - hooks.get( this ) : - Tween.propHooks._default.get( this ); - }, - run: function( percent ) { - var eased, - hooks = Tween.propHooks[ this.prop ]; - - if ( this.options.duration ) { - this.pos = eased = jQuery.easing[ this.easing ]( - percent, this.options.duration * percent, 0, 1, this.options.duration - ); - } else { - this.pos = eased = percent; - } - this.now = ( this.end - this.start ) * eased + this.start; - - if ( this.options.step ) { - this.options.step.call( this.elem, this.now, this ); - } - - if ( hooks && hooks.set ) { - hooks.set( this ); - } else { - Tween.propHooks._default.set( this ); - } - return this; - } -}; - -Tween.prototype.init.prototype = Tween.prototype; - -Tween.propHooks = { - _default: { - get: function( tween ) { - var result; - - if ( tween.elem[ tween.prop ] != null && - (!tween.elem.style || tween.elem.style[ tween.prop ] == null) ) { - return tween.elem[ tween.prop ]; - } - - // passing any value as a 4th parameter to .css will automatically - // attempt a parseFloat and fallback to a string if the parse fails - // so, simple values such as "10px" are parsed to Float. - // complex values such as "rotate(1rad)" are returned as is. - result = jQuery.css( tween.elem, tween.prop, false, "" ); - // Empty strings, null, undefined and "auto" are converted to 0. - return !result || result === "auto" ? 0 : result; - }, - set: function( tween ) { - // use step hook for back compat - use cssHook if its there - use .style if its - // available and use plain properties where available - if ( jQuery.fx.step[ tween.prop ] ) { - jQuery.fx.step[ tween.prop ]( tween ); - } else if ( tween.elem.style && ( tween.elem.style[ jQuery.cssProps[ tween.prop ] ] != null || jQuery.cssHooks[ tween.prop ] ) ) { - jQuery.style( tween.elem, tween.prop, tween.now + tween.unit ); - } else { - tween.elem[ tween.prop ] = tween.now; - } - } - } -}; - -// Remove in 2.0 - this supports IE8's panic based approach -// to setting things on disconnected nodes - -Tween.propHooks.scrollTop = Tween.propHooks.scrollLeft = { - set: function( tween ) { - if ( tween.elem.nodeType && tween.elem.parentNode ) { - tween.elem[ tween.prop ] = tween.now; - } - } -}; - -jQuery.each([ "toggle", "show", "hide" ], function( i, name ) { - var cssFn = jQuery.fn[ name ]; - jQuery.fn[ name ] = function( speed, easing, callback ) { - return speed == null || typeof speed === "boolean" || - // special check for .toggle( handler, handler, ... ) - ( !i && jQuery.isFunction( speed ) && jQuery.isFunction( easing ) ) ? - cssFn.apply( this, arguments ) : - this.animate( genFx( name, true ), speed, easing, callback ); - }; -}); - -jQuery.fn.extend({ - fadeTo: function( speed, to, easing, callback ) { - - // show any hidden elements after setting opacity to 0 - return this.filter( isHidden ).css( "opacity", 0 ).show() - - // animate to the value specified - .end().animate({ opacity: to }, speed, easing, callback ); - }, - animate: function( prop, speed, easing, callback ) { - var empty = jQuery.isEmptyObject( prop ), - optall = jQuery.speed( speed, easing, callback ), - doAnimation = function() { - // Operate on a copy of prop so per-property easing won't be lost - var anim = Animation( this, jQuery.extend( {}, prop ), optall ); - - // Empty animations resolve immediately - if ( empty ) { - anim.stop( true ); - } - }; - - return empty || optall.queue === false ? - this.each( doAnimation ) : - this.queue( optall.queue, doAnimation ); - }, - stop: function( type, clearQueue, gotoEnd ) { - var stopQueue = function( hooks ) { - var stop = hooks.stop; - delete hooks.stop; - stop( gotoEnd ); - }; - - if ( typeof type !== "string" ) { - gotoEnd = clearQueue; - clearQueue = type; - type = undefined; - } - if ( clearQueue && type !== false ) { - this.queue( type || "fx", [] ); - } - - return this.each(function() { - var dequeue = true, - index = type != null && type + "queueHooks", - timers = jQuery.timers, - data = jQuery._data( this ); - - if ( index ) { - if ( data[ index ] && data[ index ].stop ) { - stopQueue( data[ index ] ); - } - } else { - for ( index in data ) { - if ( data[ index ] && data[ index ].stop && rrun.test( index ) ) { - stopQueue( data[ index ] ); - } - } - } - - for ( index = timers.length; index--; ) { - if ( timers[ index ].elem === this && (type == null || timers[ index ].queue === type) ) { - timers[ index ].anim.stop( gotoEnd ); - dequeue = false; - timers.splice( index, 1 ); - } - } - - // start the next in the queue if the last step wasn't forced - // timers currently will call their complete callbacks, which will dequeue - // but only if they were gotoEnd - if ( dequeue || !gotoEnd ) { - jQuery.dequeue( this, type ); - } - }); - } -}); - -// Generate parameters to create a standard animation -function genFx( type, includeWidth ) { - var which, - attrs = { height: type }, - i = 0; - - // if we include width, step value is 1 to do all cssExpand values, - // if we don't include width, step value is 2 to skip over Left and Right - includeWidth = includeWidth? 1 : 0; - for( ; i < 4 ; i += 2 - includeWidth ) { - which = cssExpand[ i ]; - attrs[ "margin" + which ] = attrs[ "padding" + which ] = type; - } - - if ( includeWidth ) { - attrs.opacity = attrs.width = type; - } - - return attrs; -} - -// Generate shortcuts for custom animations -jQuery.each({ - slideDown: genFx("show"), - slideUp: genFx("hide"), - slideToggle: genFx("toggle"), - fadeIn: { opacity: "show" }, - fadeOut: { opacity: "hide" }, - fadeToggle: { opacity: "toggle" } -}, function( name, props ) { - jQuery.fn[ name ] = function( speed, easing, callback ) { - return this.animate( props, speed, easing, callback ); - }; -}); - -jQuery.speed = function( speed, easing, fn ) { - var opt = speed && typeof speed === "object" ? jQuery.extend( {}, speed ) : { - complete: fn || !fn && easing || - jQuery.isFunction( speed ) && speed, - duration: speed, - easing: fn && easing || easing && !jQuery.isFunction( easing ) && easing - }; - - opt.duration = jQuery.fx.off ? 0 : typeof opt.duration === "number" ? opt.duration : - opt.duration in jQuery.fx.speeds ? jQuery.fx.speeds[ opt.duration ] : jQuery.fx.speeds._default; - - // normalize opt.queue - true/undefined/null -> "fx" - if ( opt.queue == null || opt.queue === true ) { - opt.queue = "fx"; - } - - // Queueing - opt.old = opt.complete; - - opt.complete = function() { - if ( jQuery.isFunction( opt.old ) ) { - opt.old.call( this ); - } - - if ( opt.queue ) { - jQuery.dequeue( this, opt.queue ); - } - }; - - return opt; -}; - -jQuery.easing = { - linear: function( p ) { - return p; - }, - swing: function( p ) { - return 0.5 - Math.cos( p*Math.PI ) / 2; - } -}; - -jQuery.timers = []; -jQuery.fx = Tween.prototype.init; -jQuery.fx.tick = function() { - var timer, - timers = jQuery.timers, - i = 0; - - fxNow = jQuery.now(); - - for ( ; i < timers.length; i++ ) { - timer = timers[ i ]; - // Checks the timer has not already been removed - if ( !timer() && timers[ i ] === timer ) { - timers.splice( i--, 1 ); - } - } - - if ( !timers.length ) { - jQuery.fx.stop(); - } - fxNow = undefined; -}; - -jQuery.fx.timer = function( timer ) { - if ( timer() && jQuery.timers.push( timer ) && !timerId ) { - timerId = setInterval( jQuery.fx.tick, jQuery.fx.interval ); - } -}; - -jQuery.fx.interval = 13; - -jQuery.fx.stop = function() { - clearInterval( timerId ); - timerId = null; -}; - -jQuery.fx.speeds = { - slow: 600, - fast: 200, - // Default speed - _default: 400 -}; - -// Back Compat <1.8 extension point -jQuery.fx.step = {}; - -if ( jQuery.expr && jQuery.expr.filters ) { - jQuery.expr.filters.animated = function( elem ) { - return jQuery.grep(jQuery.timers, function( fn ) { - return elem === fn.elem; - }).length; - }; -} -var rroot = /^(?:body|html)$/i; - -jQuery.fn.offset = function( options ) { - if ( arguments.length ) { - return options === undefined ? - this : - this.each(function( i ) { - jQuery.offset.setOffset( this, options, i ); - }); - } - - var docElem, body, win, clientTop, clientLeft, scrollTop, scrollLeft, - box = { top: 0, left: 0 }, - elem = this[ 0 ], - doc = elem && elem.ownerDocument; - - if ( !doc ) { - return; - } - - if ( (body = doc.body) === elem ) { - return jQuery.offset.bodyOffset( elem ); - } - - docElem = doc.documentElement; - - // Make sure it's not a disconnected DOM node - if ( !jQuery.contains( docElem, elem ) ) { - return box; - } - - // If we don't have gBCR, just use 0,0 rather than error - // BlackBerry 5, iOS 3 (original iPhone) - if ( typeof elem.getBoundingClientRect !== "undefined" ) { - box = elem.getBoundingClientRect(); - } - win = getWindow( doc ); - clientTop = docElem.clientTop || body.clientTop || 0; - clientLeft = docElem.clientLeft || body.clientLeft || 0; - scrollTop = win.pageYOffset || docElem.scrollTop; - scrollLeft = win.pageXOffset || docElem.scrollLeft; - return { - top: box.top + scrollTop - clientTop, - left: box.left + scrollLeft - clientLeft - }; -}; - -jQuery.offset = { - - bodyOffset: function( body ) { - var top = body.offsetTop, - left = body.offsetLeft; - - if ( jQuery.support.doesNotIncludeMarginInBodyOffset ) { - top += parseFloat( jQuery.css(body, "marginTop") ) || 0; - left += parseFloat( jQuery.css(body, "marginLeft") ) || 0; - } - - return { top: top, left: left }; - }, - - setOffset: function( elem, options, i ) { - var position = jQuery.css( elem, "position" ); - - // set position first, in-case top/left are set even on static elem - if ( position === "static" ) { - elem.style.position = "relative"; - } - - var curElem = jQuery( elem ), - curOffset = curElem.offset(), - curCSSTop = jQuery.css( elem, "top" ), - curCSSLeft = jQuery.css( elem, "left" ), - calculatePosition = ( position === "absolute" || position === "fixed" ) && jQuery.inArray("auto", [curCSSTop, curCSSLeft]) > -1, - props = {}, curPosition = {}, curTop, curLeft; - - // need to be able to calculate position if either top or left is auto and position is either absolute or fixed - if ( calculatePosition ) { - curPosition = curElem.position(); - curTop = curPosition.top; - curLeft = curPosition.left; - } else { - curTop = parseFloat( curCSSTop ) || 0; - curLeft = parseFloat( curCSSLeft ) || 0; - } - - if ( jQuery.isFunction( options ) ) { - options = options.call( elem, i, curOffset ); - } - - if ( options.top != null ) { - props.top = ( options.top - curOffset.top ) + curTop; - } - if ( options.left != null ) { - props.left = ( options.left - curOffset.left ) + curLeft; - } - - if ( "using" in options ) { - options.using.call( elem, props ); - } else { - curElem.css( props ); - } - } -}; - - -jQuery.fn.extend({ - - position: function() { - if ( !this[0] ) { - return; - } - - var elem = this[0], - - // Get *real* offsetParent - offsetParent = this.offsetParent(), - - // Get correct offsets - offset = this.offset(), - parentOffset = rroot.test(offsetParent[0].nodeName) ? { top: 0, left: 0 } : offsetParent.offset(); - - // Subtract element margins - // note: when an element has margin: auto the offsetLeft and marginLeft - // are the same in Safari causing offset.left to incorrectly be 0 - offset.top -= parseFloat( jQuery.css(elem, "marginTop") ) || 0; - offset.left -= parseFloat( jQuery.css(elem, "marginLeft") ) || 0; - - // Add offsetParent borders - parentOffset.top += parseFloat( jQuery.css(offsetParent[0], "borderTopWidth") ) || 0; - parentOffset.left += parseFloat( jQuery.css(offsetParent[0], "borderLeftWidth") ) || 0; - - // Subtract the two offsets - return { - top: offset.top - parentOffset.top, - left: offset.left - parentOffset.left - }; - }, - - offsetParent: function() { - return this.map(function() { - var offsetParent = this.offsetParent || document.body; - while ( offsetParent && (!rroot.test(offsetParent.nodeName) && jQuery.css(offsetParent, "position") === "static") ) { - offsetParent = offsetParent.offsetParent; - } - return offsetParent || document.body; - }); - } -}); - - -// Create scrollLeft and scrollTop methods -jQuery.each( {scrollLeft: "pageXOffset", scrollTop: "pageYOffset"}, function( method, prop ) { - var top = /Y/.test( prop ); - - jQuery.fn[ method ] = function( val ) { - return jQuery.access( this, function( elem, method, val ) { - var win = getWindow( elem ); - - if ( val === undefined ) { - return win ? (prop in win) ? win[ prop ] : - win.document.documentElement[ method ] : - elem[ method ]; - } - - if ( win ) { - win.scrollTo( - !top ? val : jQuery( win ).scrollLeft(), - top ? val : jQuery( win ).scrollTop() - ); - - } else { - elem[ method ] = val; - } - }, method, val, arguments.length, null ); - }; -}); - -function getWindow( elem ) { - return jQuery.isWindow( elem ) ? - elem : - elem.nodeType === 9 ? - elem.defaultView || elem.parentWindow : - false; -} -// Create innerHeight, innerWidth, height, width, outerHeight and outerWidth methods -jQuery.each( { Height: "height", Width: "width" }, function( name, type ) { - jQuery.each( { padding: "inner" + name, content: type, "": "outer" + name }, function( defaultExtra, funcName ) { - // margin is only for outerHeight, outerWidth - jQuery.fn[ funcName ] = function( margin, value ) { - var chainable = arguments.length && ( defaultExtra || typeof margin !== "boolean" ), - extra = defaultExtra || ( margin === true || value === true ? "margin" : "border" ); - - return jQuery.access( this, function( elem, type, value ) { - var doc; - - if ( jQuery.isWindow( elem ) ) { - // As of 5/8/2012 this will yield incorrect results for Mobile Safari, but there - // isn't a whole lot we can do. See pull request at this URL for discussion: - // https://github.com/jquery/jquery/pull/764 - return elem.document.documentElement[ "client" + name ]; - } - - // Get document width or height - if ( elem.nodeType === 9 ) { - doc = elem.documentElement; - - // Either scroll[Width/Height] or offset[Width/Height] or client[Width/Height], whichever is greatest - // unfortunately, this causes bug #3838 in IE6/8 only, but there is currently no good, small way to fix it. - return Math.max( - elem.body[ "scroll" + name ], doc[ "scroll" + name ], - elem.body[ "offset" + name ], doc[ "offset" + name ], - doc[ "client" + name ] - ); - } - - return value === undefined ? - // Get width or height on the element, requesting but not forcing parseFloat - jQuery.css( elem, type, value, extra ) : - - // Set width or height on the element - jQuery.style( elem, type, value, extra ); - }, type, chainable ? margin : undefined, chainable, null ); - }; - }); -}); -// Expose jQuery to the global object -window.jQuery = window.$ = jQuery; - -// Expose jQuery as an AMD module, but only for AMD loaders that -// understand the issues with loading multiple versions of jQuery -// in a page that all might call define(). The loader will indicate -// they have special allowances for multiple jQuery versions by -// specifying define.amd.jQuery = true. Register as a named module, -// since jQuery can be concatenated with other files that may use define, -// but not use a proper concatenation script that understands anonymous -// AMD modules. A named AMD is safest and most robust way to register. -// Lowercase jquery is used because AMD module names are derived from -// file names, and jQuery is normally delivered in a lowercase file name. -// Do this after creating the global so that if an AMD module wants to call -// noConflict to hide this version of jQuery, it will work. -if ( typeof define === "function" && define.amd && define.amd.jQuery ) { - define( "jquery", [], function () { return jQuery; } ); -} - -})( window ); diff --git a/jquery.maphilight.min.js b/jquery.maphilight.min.js deleted file mode 100755 index d011413..0000000 --- a/jquery.maphilight.min.js +++ /dev/null @@ -1 +0,0 @@ -(function(f){var b,c,j,m,l,i,g,e,h,a,k;b=document.namespaces;has_canvas=!!document.createElement("canvas").getContext;if(!(has_canvas||b)){f.fn.maphilight=function(){return this};return}if(has_canvas){g=function(p,o,n){if(o<=1){p.style.opacity=o;window.setTimeout(g,10,p,o+0.1,10)}};e=function(n){return Math.max(0,Math.min(parseInt(n,16),255))};h=function(n,o){return"rgba("+e(n.substr(0,2))+","+e(n.substr(2,2))+","+e(n.substr(4,2))+","+o+")"};c=function(n){var o=f('').get(0);o.getContext("2d").clearRect(0,0,o.width,o.height);return o};j=function(q,n,t,p,o){var s,r=q.getContext("2d");r.beginPath();if(n=="rect"){r.rect(t[0],t[1],t[2]-t[0],t[3]-t[1])}else{if(n=="poly"){r.moveTo(t[0],t[1]);for(s=2;s').get(0)};j=function(o,r,s,v,n){var t,u,p,q;t='';u=(v.stroke?'strokeweight="'+v.strokeWidth+'" stroked="t" strokecolor="#'+v.strokeColor+'"':'stroked="f"');p='';if(r=="rect"){q=f('')}else{if(r=="poly"){q=f('')}else{if(r=="circ"){q=f('')}}}q.get(0).innerHTML=t+p;f(o).append(q)};m=function(n){f(n).find("[name=highlighted]").remove()}}l=function(o){var n,p=o.getAttribute("coords").split(",");for(n=0;n0)){return}if(v.hasClass("maphilighted")){var q=v.parent();v.insertBefore(q);q.remove()}s=f("
").css({display:"block",background:"url("+this.src+")",position:"relative",padding:0,width:this.width,height:this.height});if(z.wrapClass){if(z.wrapClass===true){s.addClass(f(this).attr("class"))}else{s.addClass(z.wrapClass)}}v.before(s).css("opacity",0).css(i).remove();if(f.browser.msie){v.css("filter","Alpha(opacity=0)")}s.append(v);u=c(this);f(u).css(i);u.height=this.height;u.width=this.width;y=function(C){var A,B;B=k(this,z);if(!B.neverOn&&!B.alwaysOn){A=l(this);j(u,A[0],A[1],B,"highlighted");if(B.groupBy&&f(this).attr(B.groupBy)){var D=this;r.find("area["+B.groupBy+"="+f(this).attr(B.groupBy)+"]").each(function(){if(this!=D){var F=k(this,z);if(!F.neverOn&&!F.alwaysOn){var E=l(this);j(u,E[0],E[1],F,"highlighted")}}})}}};if(z.alwaysOn){f(r).find("area[coords]").each(y)}else{f(r).find("area[coords]").each(function(){var A,B;B=k(this,z);if(B.alwaysOn){if(!w){w=c(v.get());f(w).css(i);w.width=v.width();w.height=v.height();v.before(w)}A=l(this);if(f.browser.msie){j(u,A[0],A[1],B,"")}else{j(w,A[0],A[1],B,"")}}});f(r).find("area[coords]").mouseover(y).mouseout(function(A){m(u)})}v.before(u);v.addClass("maphilighted")})};f.fn.maphilight.defaults={fill:true,fillColor:"000000",fillOpacity:0.2,stroke:true,strokeColor:"ff0000",strokeOpacity:1,strokeWidth:1,fade:true,alwaysOn:false,neverOn:false,groupBy:false,wrapClass:true}})(jQuery); \ No newline at end of file diff --git a/main.js b/main.js deleted file mode 100644 index 601fb13..0000000 --- a/main.js +++ /dev/null @@ -1,28 +0,0 @@ -function toggleDisplay(id) -{ - var elt = document.getElementById(id); - if (elt.style.display == 'none') { - elt.style.display = 'block'; - } else { - elt.style.display = 'none'; - } -} -function hideAll(cls) -{ - var testClass = new RegExp("(^|s)" + cls + "(s|$)"); - var tag = tag || "*"; - var elements = document.getElementsByTagName("div"); - var current; - var length = elements.length; - for(var i=0; i "Bool" -| TArrow (tt1,tt2) -> "(" ^ ty2s tt1 ^ "->" ^ ty2s tt2 ^ ")" -| TProd (tt1,tt2) -> "(" ^ ty2s tt1 ^ "*" ^ ty2s tt2 ^ ")" ;; - -let rec tm2s t = match t with -| Tvar y -> string_of_int y -| Tapp (t1, t2) -> "(" ^ tm2s t1 ^ " " ^ tm2s t2 ^ ")" -| Tabs (y, t0, t1) -> "(\\" ^ string_of_int y ^ ":" ^ ty2s t0 ^ ". " ^ tm2s t1 ^ ")" -| Tpair (t1, t2) -> "(" ^ tm2s t1 ^ "," ^ tm2s t2 ^ ")" -| Tfst t1 -> "fst " ^ tm2s t1 -| Tsnd t1 -> "snd " ^ tm2s t1 -| Tfalse -> "false" -| Ttrue -> "true" -| Tif (t0, t1, t2) -> "(if" ^ tm2s t0 ^ " then " ^ tm2s t1 ^ " else " ^ tm2s t2 ^ ")" - - -(* ---------------------------------------------------------------- *) - -let x = 0;; - -let witness e = match e with Ex_intro (x,y) -> x;; - -let tm_from (x:tm) = x;; - -let test t = - print_endline ("Checking " ^ (tm2s t) ^ "..."); - match type_check empty t with - None -> print_endline "No type" - | Some tt -> - print_endline ("Type: " ^ ty2s tt); - let d = type_checking_sound empty t tt in - let res = tm_from (witness (normalization t tt d)) in - print_endline ("Result: " ^ tm2s res); - print_newline ();; - -test (Tapp (Tabs (x, TBool, Tvar x) , Ttrue));; -test (Tapp (Tabs (x, TBool, Tvar x) , Tfalse));; diff --git a/slides.js b/slides.js deleted file mode 100644 index b7ef024..0000000 --- a/slides.js +++ /dev/null @@ -1,126 +0,0 @@ -/* Presentation mode for SF HTML - * - * This file implements simple slide functionality for the SF HTML - * files. When loaded in a page, it will tag some of the page elements - * as slide boundaries, giving each an id of the form - * "#slide-XX". Pressing left or right should trigger "slide mode", - * focusing the screen on the current slide, and then navigate between - * slides. Pressing escape brings the page back to normal. */ - -/* Which DOM elements to mark as slide boundaries */ -var slideSelector = 'h1.libtitle, h1.section, h2.section, h3.section, .quiz'; - -/* Whether or not we are in slide mode */ -var slideMode = false; - -/* Navigates between slides, using the current location hash to find - * the next slide to go to */ -function slideNavigate(direction) { - - function slideNumber(s) { - if (!s) return null; - var match = s.match(/slide-(.*)/); - if (match && match.length != 0) { - return parseInt(match[1]); - } - return null; - } - - var curSlide = slideNumber(location.hash); - var lastSlide = slideNumber($('.slide').last().attr('id')); - var nextSlide; - - /* We change the id of each slide element when the page loads, and - * then switch between slides based on the current hash. This is - * not entirely optimal, and can probably be made better. - * http://www.appelsiini.net/projects/viewport seems to be a nice choice. - */ - - if (direction == 'left') { - if (curSlide != null) { - if (curSlide > 0) { - nextSlide = curSlide - 1; - } else { - nextSlide = lastSlide; - } - } else { - nextSlide = 0; - } - } else if (direction == 'right') { - if (curSlide != null && curSlide < lastSlide) { - nextSlide = curSlide + 1; - } else { - nextSlide = 0; - } - } - - location.hash = '#slide-' + nextSlide; - - return false; -}; - -/* Force the browser to scroll back to the hash location */ -function refreshHash() { - var t = location.hash; - location.hash = ''; - location.hash = t; -} - -/* Activate slide mode. Inserts the right amount of spacing between - * slide boundaries, ensuring that only one slide appears on the - * screen at a time */ -function slideActivate() { - $('.slide').each(function (i, elt) { - if (i > 0) $(elt).css('margin-top', $(window).height()); - $(elt).css('height', '20px'); - }); - $('#main').css('padding-bottom', $(window).height()); - slideMode = true; - if (location.hash) { - refreshHash(); - } else { - location.hash = '#slide-0'; - } -} - -/* Deactivate slide mode. Removes the extra spacing between slides */ -function slideDeactivate() { - $('.slide').each(function (i, elt) { - $(elt).css('margin-top', 0); - $(elt).css('height', 0); - }); - $('#main').css('padding-bottom', 0); - refreshHash(); - slideMode = false; -} - -/* Set up appropriate input handlers */ -$(document).keydown(function (event) { - if (slideMode) { - if (event.keyCode == 37) { - slideNavigate('left'); - } else if (event.keyCode == 39) { - slideNavigate('right'); - } else if (event.keyCode == 27) { // escape - slideDeactivate(); - } else return true; - } else { - if (event.keyCode == 37 || event.keyCode == 39) { - slideActivate(); - return false; - } else { - return true; - } - } -}); - -/* Find slide boundaries and tag them */ -$(document).ready(function () { - $(slideSelector).each(function (i, elt) { - var mark = '
'; - $(mark).insertBefore($(elt)); - }); - if (location.hash) { - slideActivate(); - } -}); diff --git a/toc.html b/toc.html deleted file mode 100644 index d778185..0000000 --- a/toc.html +++ /dev/null @@ -1,1103 +0,0 @@ - - - - - -Table of contents - - - - -
- - - -
- -
-

Symbols: Special symbols

 -

Preface

 - -

Basics: Functional Programming in Coq

 - -

Induction: Proof by Induction

 - -

Lists: Working with Structured Data

 - -

Poly: Polymorphism and Higher-Order Functions

 - -

MoreCoq: More About Coq

 - -

Logic: Logic in Coq

 - -

Prop: Propositions and Evidence

 - -

MoreLogic

 - -

ProofObjects: Working with Explicit Evidence in Coq

 - -

MoreInd: More on Induction

 - -

Review1: Review Session for First Midterm

 - -

SfLib: Software Foundations Library

 - -

Imp: Simple Imperative Programs

 - -

ImpParser: Lexing and Parsing in Coq

 - -

ImpCEvalFun: Evaluation Function for Imp

 - -

Extraction: Extracting ML from Coq

 - -

Equiv: Program Equivalence

 - -

Hoare: Hoare Logic, Part I

 - -

Hoare2: Hoare Logic, Part II

 - -

Smallstep: Small-step Operational Semantics

 - -

Review2: Review Session for Second Midterm

 - -

Auto: More Automation

 - -

Types: Type Systems

 - -

Stlc: The Simply Typed Lambda-Calculus

 - -

StlcProp: Properties of STLC

 - -

MoreStlc: More on the Simply Typed Lambda-Calculus

 - -

Sub: Subtyping

 - -
-
This page has been generated by coqdoc -
- -
- - - \ No newline at end of file