diff --git a/common/css/sf.css b/common/css/sf.css index be9fcb10..12d4abc1 100644 --- a/common/css/sf.css +++ b/common/css/sf.css @@ -489,6 +489,9 @@ tr.infrulemiddle hr { color: rgb(0%,0%,0%); } +.nowrap { + white-space: nowrap; +} /* TOC */ diff --git a/common/css/slides.css b/common/css/slides.css index 0f1fc55a..b9d0327d 100644 --- a/common/css/slides.css +++ b/common/css/slides.css @@ -34,5 +34,7 @@ h1.libtitle { line-height: 34px; } - +body { + background: white; +} diff --git a/lf-current/Auto.html b/lf-current/Auto.html index c9afe73c..4a610637 100644 --- a/lf-current/Auto.html +++ b/lf-current/Auto.html @@ -35,7 +35,7 @@

Auto更多的自动化

Set Warnings "-notation-overridden,-parsing".
-Require Import Coq.omega.Omega.
+From Coq Require Import omega.Omega.
From LF Require Import Maps.
From LF Require Import Imp.
@@ -64,10 +64,10 @@

Auto更多的自动化

Ltac inv H := inversion H; subst; clear H.

-Theorem ceval_deterministic: c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic: c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2;
  generalize dependent st2;
@@ -105,7 +105,7 @@

Auto更多的自动化

-

auto 策略

+

auto 策略

@@ -113,7 +113,7 @@

Auto更多的自动化

-Example auto_example_1 : (P Q R: Prop),
+Example auto_example_1 : (P Q R: Prop),
  (PQ) → (QR) → PR.
Proof.
  intros P Q R H1 H2 H3.
@@ -126,7 +126,7 @@

Auto更多的自动化

-Example auto_example_1' : (P Q R: Prop),
+Example auto_example_1' : (P Q R: Prop),
  (PQ) → (QR) → PR.
Proof.
  auto.
@@ -156,7 +156,7 @@

Auto更多的自动化

-Example auto_example_2 : P Q R S T U : Prop,
+Example auto_example_2 : P Q R S T U : Prop,
  (PQ) →
  (PR) →
  (TR) →
@@ -174,7 +174,7 @@

Auto更多的自动化

-Example auto_example_3 : (P Q R S T U: Prop),
+Example auto_example_3 : (P Q R S T U: Prop),
  (PQ) →
  (QR) →
  (RS) →
@@ -197,7 +197,7 @@

Auto更多的自动化

-Example auto_example_4 : P Q R : Prop,
+Example auto_example_4 : P Q R : Prop,
  Q
  (QR) →
  P ∨ (QR).
@@ -209,9 +209,9 @@

Auto更多的自动化

-Lemma le_antisym : n m: nat, (nmmn) → n = m.
+Lemma le_antisym : n m: nat, (nmmn) → n = m.
Proof. intros. omega. Qed.

-Example auto_example_6 : n m p : nat,
+Example auto_example_6 : n m p : nat,
  (np → (nmmn)) →
  np
  n = m.
@@ -264,7 +264,7 @@

Auto更多的自动化

Hint Resolve le_antisym.

-Example auto_example_6' : n m p : nat,
+Example auto_example_6' : n m p : nat,
  (np → (nmmn)) →
  np
  n = m.
@@ -273,13 +273,13 @@

Auto更多的自动化

  auto. (* 从数据库中找出提示 *)
Qed.

Definition is_fortytwo x := (x = 42).

-Example auto_example_7: x,
+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,
+Example auto_example_7' : x,
  (x ≤ 42 ∧ 42 ≤ x) → is_fortytwo x.
Proof. auto. Qed.
@@ -289,10 +289,10 @@

Auto更多的自动化

-Theorem ceval_deterministic': c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic': c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -328,10 +328,10 @@

Auto更多的自动化

-Theorem ceval_deterministic'_alt: c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic'_alt: c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof with auto.
@@ -362,7 +362,7 @@

Auto更多的自动化

-

搜索前提

+

搜索前提

@@ -400,10 +400,10 @@

Auto更多的自动化

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.
+Theorem ceval_deterministic'': c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -440,7 +440,7 @@

Auto更多的自动化

  match goal with
    H1: ?E = true,
    H2: ?E = false
-    |- _rwinv H1 H2
+    ⊢ _rwinv H1 H2
  end.
@@ -456,10 +456,10 @@

Auto更多的自动化

-Theorem ceval_deterministic''': c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic''': c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -483,10 +483,10 @@

Auto更多的自动化

-Theorem ceval_deterministic'''': c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic'''': c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -505,14 +505,14 @@

Auto更多的自动化

Ltac find_eqn :=
  match goal with
-    H1: x, ?P x → ?L = ?R,
+    H1: x, ?P x → ?L = ?R,
    H2: ?P ?X
-    |- _rewrite (H1 X H2) in *
+    ⊢ _rewrite (H1 X H2) in *
  end.
-模式 x, ?P x ?L = ?R 会匹配任何任何形如 +模式 x, ?P x ?L = ?R 会匹配任何任何形如 “对于所有的 xx 的某些性质蕴含某些等式”的前提。 x 的性质被绑定为模式变量 P,而该等式的左式和右式会分别绑定为 LR。此前提的名字会被绑定为 H1。之后模式 ?P ?X @@ -544,10 +544,10 @@

Auto更多的自动化

-Theorem ceval_deterministic''''': c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic''''': c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -587,47 +587,47 @@

Auto更多的自动化

  (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'" :=
+Notation "'TEST' 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 : statecomstateProp :=
-  | E_Skip : st,
+  | E_Skip : st,
      ceval st SKIP st
-  | E_Ass : st a1 n X,
+  | E_Ass : st a1 n X,
      aeval st a1 = n
      ceval st (X ::= a1) (t_update st X n)
-  | E_Seq : c1 c2 st st' st'',
+  | 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,
+  | 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,
+      ceval st (TEST 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_WhileFalse : b1 st c1,
+      ceval st (TEST b1 THEN c1 ELSE c2 FI) st'
+  | E_WhileFalse : b1 st c1,
      beval st b1 = false
      ceval st (WHILE b1 DO c1 END) st
-  | E_WhileTrue : st st' st'' b1 c1,
+  | E_WhileTrue : 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,
+  | 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,
+  | 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''.

-Notation "c1 '/' st '\\' st'" := (ceval st c1 st')
-                                 (at level 40, st at level 39).
+Notation "st '=[' c ']⇒' st'" := (ceval st c st')
+                                 (at level 40).
@@ -636,10 +636,10 @@

Auto更多的自动化

-Theorem ceval_deterministic: c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic: c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -662,10 +662,10 @@

Auto更多的自动化

-Theorem ceval_deterministic': c st st1 st2,
-     c / st \\ st1
-     c / st \\ st2
-     st1 = st2.
+Theorem ceval_deterministic': c st st1 st2,
+    st =[ c ]⇒ st1
+    st =[ c ]⇒ st2
+    st1 = st2.
Proof.
  intros c st st1 st2 E1 E2.
  generalize dependent st2;
@@ -682,7 +682,7 @@

Auto更多的自动化

并为未来的修改做好准备。
-

变体 eapplyeauto

+

变体 eapplyeauto

@@ -693,16 +693,16 @@

Auto更多的自动化

Example ceval_example1:
-    (X ::= 2;;
-     IFB X ≤ 1
-       THEN Y ::= 3
-       ELSE Z ::= 4
-     FI)
-   / { --> 0 }
-   \\ { X --> 2 ; Z --> 4 }.
+  empty_st =[
+    X ::= 2;;
+    TEST X ≤ 1
+      THEN Y ::= 3
+      ELSE Z ::= 4
+    FI
+  ]⇒ (Z !-> 4 ; X !-> 2).
Proof.
  (* 我们补充了中间状态 st'... *)
-  apply E_Seq with { X --> 2 }.
+  apply E_Seq with (X !-> 2).
  - apply E_Ass. reflexivity.
  - apply E_IfFalse. reflexivity. apply E_Ass. reflexivity.
Qed.
@@ -716,10 +716,10 @@

Auto更多的自动化

-          E_Seq :  c1 c2 st st' st'',
-            c1 / st  \\ st' →
-            c2 / st' \\ st'' →
-            (c1 ;; c2) / st \\ st'' +          E_Seq : c1 c2 st st' st'',
+            st  =[ c1 ]⇒ st'  →
+            st' =[ c2 ]⇒ st'' →
+            st  =[ c1 ;; c2 ]⇒ st''
@@ -736,13 +736,13 @@

Auto更多的自动化

Example ceval'_example1:
-    (X ::= 2;;
-     IFB X ≤ 1
-       THEN Y ::= 3
-       ELSE Z ::= 4
-     FI)
-   / { --> 0 }
-   \\ { X --> 2 ; Z --> 4 }.
+  empty_st =[
+    X ::= 2;;
+    TEST X ≤ 1
+      THEN Y ::= 3
+      ELSE Z ::= 4
+    FI
+  ]⇒ (Z !-> 4 ; X !-> 2).
Proof.
  eapply E_Seq. (* 1 *)
  - apply E_Ass. (* 2 *)
@@ -765,21 +765,23 @@

Auto更多的自动化

4 处),我们观察到此子目标中出现的 ?st' 已经被替换成了在第一个子目标中给出的值。
- 我们目前学过的几个策略,包括 constructorauto 都有 - e... 开头的变体。例如,下面是一个使用了 eauto 的证明: + 我们目前学过的几个策略,包括 constructorauto 都有类似的变体。 + 例如,下面是一个使用了 eauto 的证明:
Hint Constructors ceval.
Hint Transparent state.
Hint Transparent total_map.

-Definition st12 := { X --> 1 ; Y --> 2 }.
-Definition st21 := { X --> 2 ; Y --> 1 }.

-Example eauto_example : s',
-  (IFB XY
-    THEN Z ::= Y - X
-    ELSE Y ::= X + Z
-  FI) / st21 \\ s'.
+Definition st12 := (Y !-> 2 ; X !-> 1).
+Definition st21 := (Y !-> 1 ; X !-> 2).

+Example eauto_example : s',
+  st21 =[
+    TEST XY
+      THEN Z ::= Y - X
+      ELSE Y ::= X + Z
+    FI
+  ]⇒ s'.
Proof. eauto. Qed.
@@ -793,6 +795,10 @@

Auto更多的自动化

Coq 专家倾向于主要使用 applyauto,只在普通的版本无法做这些工作时才使用 e 开头的变体。
+
+ +(* Sat Jan 26 15:14:46 UTC 2019 *)
+
diff --git a/lf-current/Auto.v b/lf-current/Auto.v index 8242f7f1..6673d10b 100644 --- a/lf-current/Auto.v +++ b/lf-current/Auto.v @@ -1,7 +1,7 @@ (** * Auto: 更多的自动化 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.omega.Omega. +From Coq Require Import omega.Omega. From LF Require Import Maps. From LF Require Import Imp. @@ -23,9 +23,9 @@ From LF Require Import Imp. Ltac inv H := inversion H; subst; clear H. Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2; generalize dependent st2; @@ -119,7 +119,6 @@ Proof. auto 6. Qed. - (** 在搜索当前目标的潜在证明时, [auto] 会同时考虑当前上下文中的前提, 以及一个包含其它引理或构造子的_'提示数据库'_。 某些关于相等关系和逻辑运算符的事实默认已经安装到提示数据库中了。 *) @@ -193,9 +192,9 @@ Proof. auto. Qed. (** 我们来初次尝试简化 [ceval_deterministic] 的证明脚本。 *) Theorem ceval_deterministic': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -228,9 +227,9 @@ Qed. 作为示范,下面是以上证明的另一个版本,它用到了 [Proof with auto]。 *) Theorem ceval_deterministic'_alt: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof with auto. intros c st st1 st2 E1 E2; generalize dependent st2; @@ -278,11 +277,10 @@ Qed. 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. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -326,9 +324,9 @@ Ltac find_rwinv := 把此策略添加到每一个归纳证明的情况中,就能把所有的矛盾情况都解决了。 *) Theorem ceval_deterministic''': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -349,9 +347,9 @@ Proof. 然后用它们进行 [rewrite] 改写,类似于这样: *) Theorem ceval_deterministic'''': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -389,11 +387,10 @@ Ltac find_eqn := - 我们可以把整体策略包装在 [repeat] 中,这样就可以一直进行有用的改写, 直到只剩下平凡的了。 *) - Theorem ceval_deterministic''''': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -426,7 +423,7 @@ 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'" := +Notation "'TEST' 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). @@ -444,11 +441,11 @@ Inductive ceval : state -> com -> state -> Prop := | 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' + ceval st (TEST 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' + ceval st (TEST b1 THEN c1 ELSE c2 FI) st' | E_WhileFalse : forall b1 st c1, beval st b1 = false -> ceval st (WHILE b1 DO c1 END) st @@ -467,16 +464,16 @@ Inductive ceval : state -> com -> state -> Prop := ceval st' (CRepeat c1 b1) st'' -> ceval st (CRepeat c1 b1) st''. -Notation "c1 '/' st '\\' st'" := (ceval st c1 st') - (at level 40, st at level 39). +Notation "st '=[' c ']=>' st'" := (ceval st c st') + (at level 40). (** 我们对确定性证明的第一次尝试并不成功:[E_RepeatEnd] 和 [E_RepeatLoop] 这两种情况并没有被之前的自动化处理。 *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -496,9 +493,9 @@ Qed. 的调用顺序就能修复这一点。 *) Theorem ceval_deterministic': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> - st1 = st2. + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. Proof. intros c st st1 st2 E1 E2. generalize dependent st2; @@ -521,29 +518,28 @@ End Repeat. 中的这个例子: *) Example ceval_example1: - (X ::= 2;; - IFB X <= 1 - THEN Y ::= 3 - ELSE Z ::= 4 - FI) - / { --> 0 } - \\ { X --> 2 ; Z --> 4 }. + empty_st =[ + X ::= 2;; + TEST X <= 1 + THEN Y ::= 3 + ELSE Z ::= 4 + FI + ]=> (Z !-> 4 ; X !-> 2). Proof. (* 我们补充了中间状态 [st']... *) - apply E_Seq with { X --> 2 }. + apply E_Seq with (X !-> 2). - apply E_Ass. reflexivity. - apply E_IfFalse. reflexivity. apply E_Ass. reflexivity. Qed. - (** 在证明的第一步,我们显式地提供了一个略长的表达式来帮助 Coq 为 [E_Seq] 构造子实例化一个“隐藏”的参数。需要它的原因在于 [E_Seq] 的定义... E_Seq : forall c1 c2 st st' st'', - c1 / st \\ st' -> - c2 / st' \\ st'' -> - (c1 ;; c2) / st \\ st'' + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> st'' 它是对 [st'] 的量化,而且并没有出现在结论中,因此将其结论与目标状态统一 并不能帮助 Coq 为此变量找到合适的值。如果我们忽略 [with],这一步就会失败 @@ -554,13 +550,13 @@ Qed. 这正是 [eapply] 策略所能做到的: *) Example ceval'_example1: - (X ::= 2;; - IFB X <= 1 - THEN Y ::= 3 - ELSE Z ::= 4 - FI) - / { --> 0 } - \\ { X --> 2 ; Z --> 4 }. + empty_st =[ + X ::= 2;; + TEST X <= 1 + THEN Y ::= 3 + ELSE Z ::= 4 + FI + ]=> (Z !-> 4 ; X !-> 2). Proof. eapply E_Seq. (* 1 *) - apply E_Ass. (* 2 *) @@ -578,21 +574,23 @@ Qed. 它会被后面 [3] 处的 [reflexivity] 步骤依次实例化。当我们开始着手第二个子目标时 ([4] 处),我们观察到此子目标中出现的 [?st'] 已经被替换成了在第一个子目标中给出的值。 *) -(** 我们目前学过的几个策略,包括 [exists]、[constructor] 和 [auto] 都有 - [e...] 开头的变体。例如,下面是一个使用了 [eauto] 的证明: *) +(** 我们目前学过的几个策略,包括 [exists]、[constructor] 和 [auto] 都有类似的变体。 + 例如,下面是一个使用了 [eauto] 的证明: *) Hint Constructors ceval. Hint Transparent state. Hint Transparent total_map. -Definition st12 := { X --> 1 ; Y --> 2 }. -Definition st21 := { X --> 2 ; Y --> 1 }. +Definition st12 := (Y !-> 2 ; X !-> 1). +Definition st21 := (Y !-> 1 ; X !-> 2). Example eauto_example : exists s', - (IFB X <= Y - THEN Z ::= Y - X - ELSE Y ::= X + Z - FI) / st21 \\ s'. + st21 =[ + TEST X <= Y + THEN Z ::= Y - X + ELSE Y ::= X + Z + FI + ]=> s'. Proof. eauto. Qed. (** [eauto] 的策略和 [auto] 一样,除了它会使用 [eapply] 而非 [apply]。 @@ -603,3 +601,4 @@ Proof. eauto. Qed. [e] 开头的变体。 *) +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/AutoTest.v b/lf-current/AutoTest.v index 8fbaf8a8..8a37742d 100644 --- a/lf-current/AutoTest.v +++ b/lf-current/AutoTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:05 UTC 2019 *) diff --git a/lf-current/Basics.html b/lf-current/Basics.html index 44d873d8..1d786475 100644 --- a/lf-current/Basics.html +++ b/lf-current/Basics.html @@ -34,7 +34,7 @@

BasicsCoq 函数式编程

-

引言

+

引言

@@ -65,14 +65,14 @@

BasicsCoq 函数式编程

-

数据与函数

+

数据与函数

-

枚举类型

+

枚举类型

@@ -91,7 +91,7 @@

BasicsCoq 函数式编程

-

一周七日

+

一周七日

@@ -190,7 +190,7 @@

BasicsCoq 函数式编程

-

作业提交指南

+

作业提交指南

@@ -259,7 +259,7 @@

BasicsCoq 函数式编程

-

布尔值

+

布尔值

@@ -343,7 +343,7 @@

BasicsCoq 函数式编程

-

练习:1 星 (nandb)

+

练习:1 星, standard (nandb)

移除“Admitted.”并补完以下函数的定义,然后确保下列每一个 Example 中的断言都能被 Coq 验证通过。(即仿照上文 orb 测试的模式补充证明。) 此函数应在两个输入中包含 false 时返回 true 。 @@ -366,7 +366,7 @@

BasicsCoq 函数式编程

-

练习:1 星 (andb3)

+

练习:1 星, standard (andb3)

与此前相同,完成下面的 andb3 函数。 此函数应在所有输入均为 true 时返回 true,否则返回 false
@@ -387,7 +387,7 @@

BasicsCoq 函数式编程

-

类型

+

类型

@@ -409,7 +409,7 @@

BasicsCoq 函数式编程

Check negb.
-(* ===> negb : bool -> bool *)
+(* ===> negb : bool -> bool *)
@@ -420,7 +420,7 @@

BasicsCoq 函数式编程

-

由旧类型构造新类型

+

由旧类型构造新类型

@@ -508,7 +508,7 @@

BasicsCoq 函数式编程

-

Tuples

+

Tuples

@@ -518,7 +518,7 @@

BasicsCoq 函数式编程

bit that resembles bool (using the constructors B0 and B1 for the two possible bit values), and then define the datatype nybble, which is essentially - a tuple of four bits. + a tuple of four bits.
@@ -536,7 +536,7 @@

BasicsCoq 函数式编程

all_zero function which tests a nybble to see if all its bits are O. Note that we are using underscore (_) as a _wildcard pattern_ to - avoid inventing variable names that will not be used. + avoid inventing variable names that will not be used.
@@ -552,7 +552,7 @@

BasicsCoq 函数式编程

-

模块

+

模块

@@ -569,7 +569,7 @@

BasicsCoq 函数式编程

-

数值

+

数值

@@ -844,7 +844,7 @@

BasicsCoq 函数式编程

-

练习:1 星 (factorial)

+

练习:1 星, standard (factorial)

回想一下标准的阶乘函数:
        factorial(0)  =  1
@@ -952,7 +952,7 @@ 

BasicsCoq 函数式编程

-

练习:1 星 (ltb)

+

练习:1 星, standard (ltb)

ltb 函数检查自然数间的小于关系,以布尔值表示。 利用前文定义的函数写出该定义,不要使用 Fixpoint 构造新的递归。 (只需前文中的一个函数即可实现定义,但亦可两者皆用。) @@ -973,7 +973,7 @@

BasicsCoq 函数式编程

-

基于化简的证明

+

基于化简的证明

@@ -990,7 +990,7 @@

BasicsCoq 函数式编程

-Theorem plus_O_n : n : nat, 0 + n = n.
+Theorem plus_O_n : n : nat, 0 + n = n.
Proof.
  intros n. simpl. reflexivity. Qed.
@@ -1009,7 +1009,7 @@

BasicsCoq 函数式编程

-Theorem plus_O_n' : n : nat, 0 + n = n.
+Theorem plus_O_n' : n : nat, 0 + n = n.
Proof.
  intros n. reflexivity. Qed.
@@ -1034,7 +1034,7 @@

BasicsCoq 函数式编程

- 其次,我们增加了量词 n:nat,因此我们的定理讨论了所有的 自然数 n。 + 其次,我们增加了量词 n:nat,因此我们的定理讨论了所有的 自然数 n。 在非形式化的证明中,为了证明这种形式的定理,我们通常会说“假设 存在一个任意自然数 n...”。而在形式化证明中,这是用 intros n 来实现的,它会将量词从证明目标转移到当前假设的上下文中。 @@ -1051,10 +1051,10 @@

BasicsCoq 函数式编程

-Theorem plus_1_l : n:nat, 1 + n = S n.
+Theorem plus_1_l : n:nat, 1 + n = S n.
Proof.
  intros n. reflexivity. Qed.

-Theorem mult_0_l : n:nat, 0 * n = 0.
+Theorem mult_0_l : n:nat, 0 * n = 0.
Proof.
  intros n. reflexivity. Qed.
@@ -1069,7 +1069,7 @@

BasicsCoq 函数式编程

-

基于改写的证明

+

基于改写的证明

@@ -1077,7 +1077,7 @@

BasicsCoq 函数式编程

-Theorem plus_id_example : n m:nat,
+Theorem plus_id_example : n m:nat,
  n = m
  n + n = m + m.
@@ -1123,12 +1123,12 @@

BasicsCoq 函数式编程

-

练习:1 星 (plus_id_exercise)

+

练习:1 星, standard (plus_id_exercise)

删除 "Admitted." 并补完证明。
-Theorem plus_id_exercise : n m o : nat,
+Theorem plus_id_exercise : n m o : nat,
  n = mm = on + m = m + o.
Proof.
  (* 请在此处解答 *) Admitted.
@@ -1152,7 +1152,7 @@

BasicsCoq 函数式编程

-Theorem mult_0_plus : n m : nat,
+Theorem mult_0_plus : n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
@@ -1161,11 +1161,11 @@

BasicsCoq 函数式编程

-

练习:2 星 (mult_S_1)

+

练习:2 星, standard (mult_S_1)

-Theorem mult_S_1 : n m : nat,
+Theorem mult_S_1 : n m : nat,
  m = S n
  m * (1 + n) = m * m.
Proof.
@@ -1176,7 +1176,7 @@

BasicsCoq 函数式编程

-

利用情况分析来证明

+

利用情况分析来证明

@@ -1187,7 +1187,7 @@

BasicsCoq 函数式编程

-Theorem plus_1_neq_0_firsttry : n : nat,
+Theorem plus_1_neq_0_firsttry : n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros n.
@@ -1213,7 +1213,7 @@

BasicsCoq 函数式编程

-Theorem plus_1_neq_0 : n : nat,
+Theorem plus_1_neq_0 : n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros n. destruct n as [| n'] eqn:E.
@@ -1284,7 +1284,7 @@

BasicsCoq 函数式编程

-Theorem negb_involutive : b : bool,
+Theorem negb_involutive : b : bool,
  negb (negb b) = b.
Proof.
  intros b. destruct b eqn:E.
@@ -1306,7 +1306,7 @@

BasicsCoq 函数式编程

-Theorem andb_commutative : b c, andb b c = andb c b.
+Theorem andb_commutative : b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  - destruct c eqn:Ec.
@@ -1328,7 +1328,7 @@

BasicsCoq 函数式编程

-Theorem andb_commutative' : b c, andb b c = andb c b.
+Theorem andb_commutative' : b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  { destruct c eqn:Ec.
@@ -1347,7 +1347,7 @@

BasicsCoq 函数式编程

Theorem andb3_exchange :
-   b c d, andb (andb b c) d = andb (andb b d) c.
+  b c d, andb (andb b c) d = andb (andb b d) c.
Proof.
  intros b c d. destruct b eqn:Eb.
  - destruct c eqn:Ec.
@@ -1388,7 +1388,7 @@

BasicsCoq 函数式编程

-Theorem plus_1_neq_0' : n : nat,
+Theorem plus_1_neq_0' : n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros [|n].
@@ -1402,7 +1402,7 @@

BasicsCoq 函数式编程

Theorem andb_commutative'' :
-   b c, andb b c = andb c b.
+  b c, andb b c = andb c b.
Proof.
  intros [] [].
  - reflexivity.
@@ -1413,12 +1413,12 @@

BasicsCoq 函数式编程

-

练习:2 星 (andb_true_elim2)

+

练习:2 星, standard (andb_true_elim2)

证明以下断言, 当使用 destruct 时请用标号标出情况(以及子情况)。
-Theorem andb_true_elim2 : b c : bool,
+Theorem andb_true_elim2 : b c : bool,
  andb b c = truec = true.
Proof.
  (* 请在此处解答 *) Admitted.
@@ -1428,11 +1428,11 @@

BasicsCoq 函数式编程

-

练习:1 星 (zero_nbeq_plus_1)

+

练习:1 星, standard (zero_nbeq_plus_1)

-Theorem zero_nbeq_plus_1 : n : nat,
+Theorem zero_nbeq_plus_1 : n : nat,
  0 =? (n + 1) = false.
Proof.
  (* 请在此处解答 *) Admitted.
@@ -1441,7 +1441,7 @@

BasicsCoq 函数式编程

-

关于记法的更多内容 (可选)

+

关于记法的更多内容 (可选)

@@ -1492,7 +1492,7 @@

BasicsCoq 函数式编程

-

不动点 Fixpoint 和结构化递归 (可选)

+

不动点 Fixpoint 和结构化递归 (可选)

@@ -1520,7 +1520,7 @@

BasicsCoq 函数式编程

-

练习:2 星, optional (decreasing)

+

练习:2 星, standard, 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 reject because @@ -1537,7 +1537,7 @@

BasicsCoq 函数式编程

-

更多练习

+

更多练习

@@ -1547,15 +1547,15 @@

BasicsCoq 函数式编程

-

练习:1 星 (indentity_fn_applied_twice)

+

练习:1 星, standard (indentity_fn_applied_twice)

用你学过的策略证明以下关于布尔函数的定理。
Theorem identity_fn_applied_twice :
-   (f : boolbool),
-  ( (x : bool), f x = x) →
-   (b : bool), f (f b) = b.
+  (f : boolbool),
+  ((x : bool), f x = x) →
+  (b : bool), f (f b) = b.
Proof.
  (* 请在此处解答 *) Admitted.
@@ -1564,7 +1564,7 @@

BasicsCoq 函数式编程

-

练习:1 星 (negation_fn_applied_twice)

+

练习:1 星, standard (negation_fn_applied_twice)

现在声明并证明定理 negation_fn_applied_twice,与上一个类似, 但是第二个前提说明函数 ff x = negb x 的性质。
@@ -1583,14 +1583,14 @@

BasicsCoq 函数式编程

-

练习:3 星, optional (andb_eq_orb)

+

练习:3 星, standard, optional (andb_eq_orb)

请证明下列定理。(提示:此定理的证明可能会有点棘手,取决于你如何证明它。 或许你需要先证明一到两个辅助引理。或者,你要记得未必要同时引入所有前提。)
Theorem andb_eq_orb :
-   (b c : bool),
+  (b c : bool),
  (andb b c = orb b c) →
  b = c.
Proof.
@@ -1601,7 +1601,7 @@

BasicsCoq 函数式编程

-

练习:3 星 (binary)

+

练习:3 星, standard (binary)

We can generalize our unary representation of natural numbers to the more efficient binary representation by treating a binary number as a sequence of constructors A and B (representing 0s @@ -1671,16 +1671,9 @@

BasicsCoq 函数式编程

-
-
- - NEW NAME: The next line is a temporary hack to allow - zero_nbeq_plus_1 to be used as a synonym for the "more - up-to-date" (i.e., consistent with the Coq library) name - zero_neqb_plus_1... -
-Notation zero_neqb_plus_1 := zero_nbeq_plus_1 (only parsing).
+ +(* Sat Jan 26 15:14:45 UTC 2019 *)
diff --git a/lf-current/Basics.v b/lf-current/Basics.v index e21b949a..ab27e2bd 100644 --- a/lf-current/Basics.v +++ b/lf-current/Basics.v @@ -6,7 +6,7 @@ ### 请勿公开发布习题解答 ### ############################## - (原因见 [Preface]。) + (原因见 [Preface]。) *) (* ################################################################# *) @@ -18,7 +18,6 @@ “函数式编程”中“函数式”一词的含义之一。程序与简单数学对象之间这种直接的联系, 同时支撑了对程序行为进行形式化证明的正确性以及非形式化论证的可靠性。 - 函数式编程中“函数式”一词的另一个含义是它强调把函数(或方法) 作为_'一等'_的值 —— 即,这类值可以作为参数传递给其它函数,可以作为结果返回, 也可以包含在数据结构中等等。这种将函数当做数据的方式, @@ -221,8 +220,9 @@ Proof. simpl. reflexivity. Qed. 我们会在练习中用它来表示留给你的部分。你的练习作业就是将 [Admitted] 替换为具体的证明。 *) -(** **** 练习:1 星 (nandb) *) -(** 移除“[Admitted.]”并补完以下函数的定义,然后确保下列每一个 [Example] +(** **** 练习:1 星, standard (nandb) + + 移除“[Admitted.]”并补完以下函数的定义,然后确保下列每一个 [Example] 中的断言都能被 Coq 验证通过。(即仿照上文 [orb] 测试的模式补充证明。) 此函数应在两个输入中包含 [false] 时返回 [true] 。 *) @@ -239,8 +239,9 @@ Example test_nandb4: (nandb true true) = false. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (andb3) *) -(** 与此前相同,完成下面的 [andb3] 函数。 +(** **** 练习:1 星, standard (andb3) + + 与此前相同,完成下面的 [andb3] 函数。 此函数应在所有输入均为 [true] 时返回 [true],否则返回 [false]。 *) Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool @@ -299,8 +300,9 @@ Inductive color : Type := 每个归纳定义的类型(如 [day]、[bool]、[rgb]、[color] 等)包含一个由构造子 (如 [red]、[primary]、[true]、[false]、[monday] 等)构建的 - _'构造子表达式'_ 的集合。 *) -(** [rgb] 和 [color] 的定义描述了如何构造这两个集合中的元素(即表达式): + _'构造子表达式'_ 的集合。 + + [rgb] 和 [color] 的定义描述了如何构造这两个集合中的元素(即表达式): - [red]、[green] 和 [blue] 是 [rgb] 的构造子; - [black]、[white] 和 [primary] 是 [color] 的构造子; @@ -343,7 +345,7 @@ Definition isred (c : color) : bool := a datatype [bit] that resembles [bool] (using the constructors [B0] and [B1] for the two possible bit values), and then define the datatype [nybble], which is essentially - a tuple of four bits.*) + a tuple of four bits. *) Inductive bit : Type := | B0 @@ -359,8 +361,7 @@ Check (bits B1 B0 B1 B0). Unwrapping can be done by pattern-matching, as in the [all_zero] function which tests a nybble to see if all its bits are O. Note that we are using underscore (_) as a _wildcard pattern_ to - avoid inventing variable names that will not be used.*) - + avoid inventing variable names that will not be used. *) Definition all_zero (nb : nybble) : bool := match nb with @@ -451,7 +452,6 @@ Inductive nat : Type := 它们只是我们能用来写下数字的两个不同的记号(以及一个说明了任何 [nat] 都能写成一串 [S] 后跟一个 [O] 的规则)。如果你喜欢,完全可以将同样的定义写成: *) - Inductive nat' : Type := | stop | tick (foo : nat'). @@ -578,8 +578,9 @@ Fixpoint exp (base power : nat) : nat := | S p => mult base (exp base p) end. -(** **** 练习:1 星 (factorial) *) -(** 回想一下标准的阶乘函数: +(** **** 练习:1 星, standard (factorial) + + 回想一下标准的阶乘函数: factorial(0) = 1 factorial(n) = n * factorial(n-1) (if n>0) @@ -663,8 +664,9 @@ Notation "x <=? y" := (leb x y) (at level 70) : nat_scope. Example test_leb3': (4 <=? 2) = false. Proof. simpl. reflexivity. Qed. -(** **** 练习:1 星 (ltb) *) -(** [ltb] 函数检查自然数间的小于关系,以布尔值表示。 +(** **** 练习:1 星, standard (ltb) + + [ltb] 函数检查自然数间的小于关系,以布尔值表示。 利用前文定义的函数写出该定义,不要使用 [Fixpoint] 构造新的递归。 (只需前文中的一个函数即可实现定义,但亦可两者皆用。) *) @@ -787,8 +789,9 @@ Proof. 若要从右往左改写,可以使用 [rewrite <-]。在上面的证明中试一试这种改变, 看看 Coq 的反应有何不同。) *) -(** **** 练习:1 星 (plus_id_exercise) *) -(** 删除 "[Admitted.]" 并补完证明。 *) +(** **** 练习:1 星, standard (plus_id_exercise) + + 删除 "[Admitted.]" 并补完证明。 *) Theorem plus_id_exercise : forall n m o : nat, n = m -> m = o -> n + m = m + o. @@ -814,15 +817,16 @@ Proof. rewrite -> plus_O_n. reflexivity. Qed. -(** **** 练习:2 星 (mult_S_1) *) +(** **** 练习:2 星, standard (mult_S_1) *) Theorem mult_S_1 : forall n m : nat, m = S n -> m * (1 + n) = m * m. Proof. (* 请在此处解答 *) Admitted. -(* (注意,该命题可用 [rewrite] 以外的策略证明,不过请使用 [rewrite] 来做练习。) *) -(** [] *) +(* (注意,该命题可用 [rewrite] 以外的策略证明,不过请使用 [rewrite] 来做练习。) + + [] *) (* ################################################################# *) (** * 利用情况分析来证明 *) @@ -878,7 +882,6 @@ Proof. documentation, as they can help keep you oriented when working with the subgoals.) - 第二行和第三行中的 [-] 符号叫做_'标号'_,它标明了每个生成的子目标所对应的证明部分。 (译注:此处的“标号”应理解为一个项目列表中每个 _'条目'_ 前的小标记,如 ‣ 或 •。) 标号后面的代码是一个子目标的完整证明。在本例中,每个子目标都简单地使用 @@ -904,7 +907,6 @@ Proof. [destruct] 策略可用于任何归纳定义的数据类型。比如,我们接下来会用它来证明 布尔值的取反是对合(Involutive)的 —— 即,取反是自身的逆运算。 *) - Theorem negb_involutive : forall b : bool, negb (negb b) = b. Proof. @@ -1004,8 +1006,9 @@ Proof. - reflexivity. Qed. -(** **** 练习:2 星 (andb_true_elim2) *) -(** 证明以下断言, 当使用 [destruct] 时请用标号标出情况(以及子情况)。 *) +(** **** 练习:2 星, standard (andb_true_elim2) + + 证明以下断言, 当使用 [destruct] 时请用标号标出情况(以及子情况)。 *) Theorem andb_true_elim2 : forall b c : bool, andb b c = true -> c = true. @@ -1013,7 +1016,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (zero_nbeq_plus_1) *) +(** **** 练习:1 星, standard (zero_nbeq_plus_1) *) Theorem zero_nbeq_plus_1 : forall n : nat, 0 =? (n + 1) = false. Proof. @@ -1076,8 +1079,9 @@ Fixpoint plus' (n : nat) (m : nat) : nat := 然而,由于 Coq 的“递减分析”不是非常精致, 因此有时必须用一点不同寻常的方式来编写函数。 *) -(** **** 练习:2 星, optional (decreasing) *) -(** To get a concrete sense of this, find a way to write a sensible +(** **** 练习:2 星, standard, 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 reject because of this restriction. (If you choose to turn in this optional @@ -1085,8 +1089,9 @@ Fixpoint plus' (n : nat) (m : nat) : nat := out your solution so that it doesn't cause Coq to reject the whole file!) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * 更多练习 *) @@ -1096,8 +1101,9 @@ Fixpoint plus' (n : nat) (m : nat) : nat := [make BasicsTest.vo] in a terminal and check its output to make sure you didn't miss anything. *) -(** **** 练习:1 星 (indentity_fn_applied_twice) *) -(** 用你学过的策略证明以下关于布尔函数的定理。 *) +(** **** 练习:1 星, standard (indentity_fn_applied_twice) + + 用你学过的策略证明以下关于布尔函数的定理。 *) Theorem identity_fn_applied_twice : forall (f : bool -> bool), @@ -1108,8 +1114,9 @@ Proof. (** [] *) -(** **** 练习:1 星 (negation_fn_applied_twice) *) -(** 现在声明并证明定理 [negation_fn_applied_twice],与上一个类似, +(** **** 练习:1 星, standard (negation_fn_applied_twice) + + 现在声明并证明定理 [negation_fn_applied_twice],与上一个类似, 但是第二个前提说明函数 [f] 有 [f x = negb x] 的性质。 *) (* 请在此处解答 *) @@ -1122,8 +1129,9 @@ From Coq Require Export String. Definition manual_grade_for_negation_fn_applied_twice : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, optional (andb_eq_orb) *) -(** 请证明下列定理。(提示:此定理的证明可能会有点棘手,取决于你如何证明它。 +(** **** 练习:3 星, standard, optional (andb_eq_orb) + + 请证明下列定理。(提示:此定理的证明可能会有点棘手,取决于你如何证明它。 或许你需要先证明一到两个辅助引理。或者,你要记得未必要同时引入所有前提。) *) Theorem andb_eq_orb : @@ -1135,8 +1143,9 @@ Proof. (** [] *) -(** **** 练习:3 星 (binary) *) -(** We can generalize our unary representation of natural numbers to +(** **** 练习:3 星, standard (binary) + + We can generalize our unary representation of natural numbers to the more efficient binary representation by treating a binary number as a sequence of constructors [A] and [B] (representing 0s and 1s), terminated by a [Z]. For comparison, in the unary @@ -1189,9 +1198,4 @@ Fixpoint bin_to_nat (m:bin) : nat Definition manual_grade_for_binary : option (nat*string) := None. (** [] *) -(** NEW NAME: The next line is a temporary hack to allow - [zero_nbeq_plus_1] to be used as a synonym for the "more - up-to-date" (i.e., consistent with the Coq library) name - [zero_neqb_plus_1]... *) -Notation zero_neqb_plus_1 := zero_nbeq_plus_1 (only parsing). - +(* Sat Jan 26 15:14:45 UTC 2019 *) diff --git a/lf-current/BasicsTest.v b/lf-current/BasicsTest.v index a363cfb1..e4bc6027 100644 --- a/lf-current/BasicsTest.v +++ b/lf-current/BasicsTest.v @@ -191,3 +191,5 @@ idtac "MANUAL". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:14:47 UTC 2019 *) diff --git a/lf-current/Bib.html b/lf-current/Bib.html index baf587cb..e4c6af6a 100644 --- a/lf-current/Bib.html +++ b/lf-current/Bib.html @@ -36,7 +36,7 @@

Bib参考文献

-

本卷中出现的引用

+

本卷中出现的引用

@@ -81,6 +81,10 @@

Bib参考文献

+
+
+ +(* Sat Jan 26 15:14:46 UTC 2019 *)
diff --git a/lf-current/Bib.v b/lf-current/Bib.v index 56c9d85d..a307c142 100644 --- a/lf-current/Bib.v +++ b/lf-current/Bib.v @@ -32,3 +32,4 @@ *) +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/BibTest.v b/lf-current/BibTest.v index d66c65a1..92479244 100644 --- a/lf-current/BibTest.v +++ b/lf-current/BibTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:05 UTC 2019 *) diff --git a/lf-current/Extraction.html b/lf-current/Extraction.html index 6bd783e9..ee0b54ae 100644 --- a/lf-current/Extraction.html +++ b/lf-current/Extraction.html @@ -36,7 +36,7 @@

Extraction从 Coq 中提取 ML

-

基本的提取方式

+

基本的提取方式

@@ -59,9 +59,9 @@

Extraction从 Coq 中提取 ML
-Require Import Coq.Arith.Arith.
-Require Import Coq.Init.Nat.
-Require Import Coq.Arith.EqNat.
+From Coq Require Import Arith.Arith.
+From Coq Require Import Init.Nat.
+From Coq Require Import Arith.EqNat.
From LF Require Import ImpCEvalFun.
@@ -80,7 +80,7 @@

Extraction从 Coq 中提取 ML
-

控制提取特定的类型

+

控制提取特定的类型

@@ -154,7 +154,7 @@

Extraction从 Coq 中提取 ML
-

一个完整的示例

+

一个完整的示例

@@ -193,8 +193,7 @@

Extraction从 Coq 中提取 MLFrom LF Require Import Imp.
From LF Require Import ImpParser.

From LF Require Import Maps.
-Definition empty_state := { --> 0 }.
-Extraction "imp.ml" empty_state ceval_step parse.
+Extraction "imp.ml" empty_st ceval_step parse.

@@ -212,7 +211,7 @@

Extraction从 Coq 中提取 ML
-

讨论

+

讨论

@@ -222,13 +221,17 @@

Extraction从 Coq 中提取 ML
-

更进一步

+

更进一步

有关提取的更多详情见软件基础第三卷已验证的函数式算法中的 Extract 一章。
+
+ +(* Sat Jan 26 15:14:46 UTC 2019 *)
+

diff --git a/lf-current/Extraction.v b/lf-current/Extraction.v index ba499373..520a73d8 100644 --- a/lf-current/Extraction.v +++ b/lf-current/Extraction.v @@ -14,9 +14,9 @@ Extraction Language OCaml. (** 现在我们将待提取的定义加载到 Coq 环境中。你可以直接写出定义, 也可以从其它模块中加载。 *) -Require Import Coq.Arith.Arith. -Require Import Coq.Init.Nat. -Require Import Coq.Arith.EqNat. +From Coq Require Import Arith.Arith. +From Coq Require Import Init.Nat. +From Coq Require Import Arith.EqNat. From LF Require Import ImpCEvalFun. (** 最后,我们来指定需要提取的定义,以及用于保存提取结果的文件名。 *) @@ -91,8 +91,7 @@ From LF Require Import Imp. From LF Require Import ImpParser. From LF Require Import Maps. -Definition empty_state := { --> 0 }. -Extraction "imp.ml" empty_state ceval_step parse. +Extraction "imp.ml" empty_st ceval_step parse. (** 现在我们来运行一下生成的 Imp 求值器。首先你应该阅览一下 [impdriver.ml](这并非从某个 Coq 源码提取而来,它是手写的。) @@ -116,3 +115,5 @@ Extraction "imp.ml" empty_state ceval_step parse. (** 有关提取的更多详情见_'软件基础'_第三卷_'已验证的函数式算法'_中的 Extract 一章。 *) + +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/ExtractionTest.v b/lf-current/ExtractionTest.v index f7cb4fb9..09813245 100644 --- a/lf-current/ExtractionTest.v +++ b/lf-current/ExtractionTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:03 UTC 2019 *) diff --git a/lf-current/Imp.html b/lf-current/Imp.html index f80b75fb..b8ca84d8 100644 --- a/lf-current/Imp.html +++ b/lf-current/Imp.html @@ -36,7 +36,7 @@

Imp简单的指令式程序

- 在本章中,我们会更加认真地看待如何用 Coq 来研究自身以外的有趣的东西。 + 在本章中,我们会更加认真地看待如何用 Coq 来研究其它东西。 我们的案例研究是一个名为 Imp 的简单的指令式编程语言, 它包含了传统主流语言(如 C 和 Java)的一小部分核心片段。下面是一个用 Imp 编写的常见数学函数: @@ -46,7 +46,7 @@

Imp简单的指令式程序        Z ::= X;;
       Y ::= 1;;
-       WHILE ! (Z = 0) DO
+       WHILE ~(Z = 0) DO
         Y ::= Y * Z;;
         Z ::= Z - 1
       END @@ -64,18 +64,19 @@

Imp简单的指令式程序 Set Warnings "-notation-overridden,-parsing".
-Require Import Coq.Bool.Bool.
-Require Import Coq.Init.Nat.
-Require Import Coq.Arith.Arith.
-Require Import Coq.Arith.EqNat.
-Require Import Coq.omega.Omega.
-Require Import Coq.Lists.List.
+From Coq Require Import Bool.Bool.
+From Coq Require Import Init.Nat.
+From Coq Require Import Arith.Arith.
+From Coq Require Import Arith.EqNat.
+From Coq Require Import omega.Omega.
+From Coq Require Import Lists.List.
+From Coq Require Import Strings.String.
Import ListNotations.

From LF Require Import Maps.

-

算术和布尔表达式

+

算术和布尔表达式

@@ -85,7 +86,7 @@

Imp简单的指令式程序
-

语法

+

语法

@@ -115,7 +116,7 @@

Imp简单的指令式程序 在本章中,我们省略了大部分从程序员实际编写的具体语法到其抽象语法树的翻译 - 例如,它会将字符串 "1+2*3" 翻译成如下 AST: + 例如,它会将字符串 "1 + 2 * 3" 翻译成如下 AST:
@@ -124,7 +125,7 @@

Imp简单的指令式程序

- 可选的章节 ImpParser 中开发了一个简单的词法分析器和解析器的实现, + 可选的章节 ImpParser 中开发了一个简单的词法分析器和解析器, 它可以进行这种翻译。你无需通过理解该章来理解本章, 但如果你没有上过涵盖这些技术的课程(例如编译器课程),可能想要略读一下该章节。
@@ -143,8 +144,8 @@

Imp简单的指令式程序false
        | a = a
        | a ≤ a
-        | not b
-        | b and b +        | ¬b
+        | b && b

@@ -157,7 +158,7 @@

Imp简单的指令式程序
  • BNF 是非形式化的 — 例如,它给出了表达式表面上的语法的建议 - (例如加法运算写作 + 且它是一个中缀符),而没有指定词法分析和解析的其它方面 + (例如加法运算符写作中缀的 +),而没有指定词法分析和解析的其它方面 (如 +-* 的相对优先级,用括号来明确子表达式的分组等)。 在实现编译器时,需要一些附加的信息(以及人类的智慧) 才能将此描述转换成形式化的定义。 @@ -170,14 +171,14 @@

    Imp简单的指令式程序 -
  • 另一方面 BNF 版本则更加清晰易读。它的非形式化使其更加灵活, +
  • 反之,BNF 版本则更加清晰易读。它的非形式化使其更加灵活, 在讨论和在黑板上书写时,它有很大的优势, 此时传达一般的概念要比精确定下所有细节更加重要。
    确实,存在很多种类似 BNF 的记法,人们可以随意使用它们, - 而无需关心具体使用了哪种 BNF 的形式,因为没有必要: + 而无需关心具体使用了哪种 BNF,因为没有必要: 大致的理解是非常重要的。
  • @@ -190,7 +191,7 @@

    Imp简单的指令式程序
    -

    求值

    +

    求值

    @@ -201,9 +202,9 @@

    Imp简单的指令式程序Fixpoint aeval (a : aexp) : nat :=
      match a with
      | ANum nn
    -  | APlus a1 a2 ⇒ (aeval a1) + (aeval a2)
    -  | AMinus a1 a2 ⇒ (aeval a1) - (aeval a2)
    -  | AMult a1 a2 ⇒ (aeval a1) * (aeval a2)
    +  | 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.
    @@ -230,28 +231,23 @@

    Imp简单的指令式程序
    -

    优化

    +

    优化

    我们尚未定义太多东西,不过从这些定义出发,已经能前进不少了。 假设我们定义了一个接收算术表达式并对它稍微进行化简的函数,即将所有的 - 0+e(如 (APlus (ANum 0) e)化简为 e。 + 0 + e(如 (APlus (ANum 0) e)化简为 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)
    +  | ANum nANum n
    +  | APlus (ANum 0) e2optimize_0plus e2
    +  | APlus e1 e2APlus (optimize_0plus e1) (optimize_0plus e2)
    +  | AMinus e1 e2AMinus (optimize_0plus e1) (optimize_0plus e2)
    +  | AMult e1 e2AMult (optimize_0plus e1) (optimize_0plus e2)
      end.
    @@ -277,8 +273,10 @@

    Imp简单的指令式程序
    -Theorem optimize_0plus_sound: a,
    +Theorem optimize_0plus_sound: a,
      aeval (optimize_0plus a) = aeval a.
    +
    +
    Proof.
      intros a. induction a.
      - (* ANum *) reflexivity.
    @@ -300,9 +298,10 @@

    Imp简单的指令式程序(* AMult *)
        simpl. rewrite IHa1. rewrite IHa2. reflexivity. Qed.

    +
    -

    Coq 自动化

    +

    Coq 自动化

    @@ -319,7 +318,7 @@

    Imp简单的指令式程序
    -

    泛策略

    +

    泛策略

    @@ -328,22 +327,22 @@

    Imp简单的指令式程序
    -

    try 泛策略

    +

    try 泛策略

    如果 T 是一个策略,那么 try T 是一个和 T 一样的策略,只是如果 - T 失败的话,try T 就会成功地什么也不做(而非失败)。 + T 失败的话,try T 就会成功地什么也不做(而非失败)。
    -Theorem silly1 : ae, aeval ae = aeval ae.
    -Proof. try reflexivity. (* 它和 reflexivity 做的一样 *) Qed.

    -Theorem silly2 : (P : Prop), PP.
    +Theorem silly1 : ae, aeval ae = aeval ae.
    +Proof. try reflexivity. (* 它和 reflexivity 做的一样。 *) Qed.

    +Theorem silly2 : (P : Prop), PP.
    Proof.
      intros P HP.
    -  try reflexivity. (* 和 reflexivity 失败时一样 *)
    -  apply HP. (* 我们仍然可以换种方式来结束此证明 *)
    +  try reflexivity. (* 和 reflexivity 失败时一样。 *)
    +  apply HP. (* 我们仍然可以换种方式来结束此证明。 *)
    Qed.
    @@ -353,7 +352,7 @@

    Imp简单的指令式程序
    -

    ; 泛策略(简单形式)

    +

    ; 泛策略(简单形式)

    @@ -365,10 +364,10 @@

    Imp简单的指令式程序
    -Lemma foo : n, 0 <=? n = true.
    +Lemma foo : n, 0 <=? n = true.
    Proof.
      intros.
    -  destruct n eqn:E.
    +  destruct n.
        (* 会产生两个执行过程相同的子目标...  *)
        - (* n=0 *) simpl. reflexivity.
        - (* n=Sn' *) simpl. reflexivity.
    @@ -380,7 +379,7 @@

    Imp简单的指令式程序
    -Lemma foo' : n, 0 <=? n = true.
    +Lemma foo' : n, 0 <=? n = true.
    Proof.
      intros.
      (* destruct 解构当前子目标 *)
    @@ -397,7 +396,7 @@

    Imp简单的指令式程序
    -Theorem optimize_0plus_sound': a,
    +Theorem optimize_0plus_sound': a,
      aeval (optimize_0plus a) = aeval a.
    Proof.
      intros a.
    @@ -493,7 +492,7 @@

    Imp简单的指令式程序
    -Theorem optimize_0plus_sound'': a,
    +Theorem optimize_0plus_sound'': a,
      aeval (optimize_0plus a) = aeval a.
    Proof.
      intros a.
    @@ -511,7 +510,7 @@

    Imp简单的指令式程序
    -

    ; 泛策略(一般形式)

    +

    ; 泛策略(一般形式)

    @@ -544,7 +543,7 @@

    Imp简单的指令式程序
    -

    repeat 泛策略

    +

    repeat 泛策略

    @@ -577,11 +576,11 @@

    Imp简单的指令式程序T 会永远循环(例如 repeat simpl 会一直循环,因为 simpl 总是会成功)。虽然 Coq 的主语言 Gallina 中的求值保证会终止, 然而策略却不会!然而这并不会影响 Coq 的逻辑一致性,因为 repeat - 和其它策略的工作就是指导 Coq 去构造证明;如果构造过程发散(即不终止), + 和其它策略的工作就是指导 Coq 去构造证明;如果构造过程发散(即不停机), 那就意味着我们构造证明失败,而非构造出了错误的证明。
    -

    练习:3 星 (optimize_0plus_b_sound)

    +

    练习:3 星, standard (optimize_0plus_b_sound)

    由于 optimize_0plus 变换不会改变 aexp 的值, 因此我们可以将它应用到所有出现在 bexp 中的 aexp 上而不改变 bexp 的值。请编写一个对 bexp 执行此变换的函数,并证明它的可靠性。 @@ -591,7 +590,7 @@

    Imp简单的指令式程序Fixpoint optimize_0plus_b (b : bexp) : bexp
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    -Theorem optimize_0plus_b_sound : b,
    +Theorem optimize_0plus_b_sound : b,
      beval (optimize_0plus_b b) = beval b.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -601,7 +600,7 @@

    Imp简单的指令式程序
    -

    练习:4 星, optional (optimizer)

    +

    练习:4 星, standard, optional (optimize)

    设计练习optimize_0plus 函数只是众多算术和布尔表达式优化的方法之一。 请编写一个更加聪明的优化器并证明它的正确性。(最容易的方法就是从小处着手: 一开始只添加单个简单的优化并证明它的正确性,然后逐渐增加其它更有趣的优化。) @@ -614,7 +613,7 @@

    Imp简单的指令式程序
    -

    定义新的策略记法

    +

    定义新的策略记法

    @@ -662,7 +661,7 @@

    Imp简单的指令式程序
    -

    omega 策略

    +

    omega 策略

    @@ -701,7 +700,7 @@

    Imp简单的指令式程序
    -Example silly_presburger_example : m n o p,
    +Example silly_presburger_example : m n o p,
      m + nn + oo + 3 = p + 3 →
      mp.
    Proof.
    @@ -710,11 +709,11 @@

    Imp简单的指令式程序
    -(注意本文件顶部 Require Import Coq.omega.Omega.。) +(注意本文件顶部 From Coq Require Import omega.Omega.。)
    -

    更多方便的策略

    +

    更多方便的策略

    @@ -729,14 +728,14 @@

    Imp简单的指令式程序 -
  • subst x:在上下文中查找假设 x = ee = x, +
  • subst x:对于变量 x,在上下文中查找假设 x = ee = x, 将整个上下文和当前目标中的所有 x 替换为 e 并清除该假设。
  • -
  • subst:替换掉所有形如 x = ee = x 的假设。 +
  • subst:替换掉所有形如 x = ee = x 的假设(其中 x 为变量)。
    @@ -773,11 +772,11 @@

    Imp简单的指令式程序

  • - 我们之后会看到它们的例子。 + 我们之后会看到所有它们的例子。

    -

    求值作为关系

    +

    求值作为关系

    @@ -803,9 +802,39 @@

    Imp简单的指令式程序E_AMult (e1 e2: aexp) (n1 n2: nat) :
          aevalR e1 n1
          aevalR e2 n2
    +      aevalR (AMult e1 e2) (n1 * n2).

    +Module TooHardToRead.

    +(* A small notational aside. We would previously have written the
    +   definition of aevalR like this, with explicit names for the
    +   hypotheses in each case: *)


    +Inductive aevalR : aexpnatProp :=
    +  | E_ANum n :
    +      aevalR (ANum n) n
    +  | E_APlus (e1 e2: aexp) (n1 n2: nat)
    +      (H1 : aevalR e1 n1)
    +      (H2 : aevalR e2 n2) :
    +      aevalR (APlus e1 e2) (n1 + n2)
    +  | E_AMinus (e1 e2: aexp) (n1 n2: nat)
    +      (H1 : aevalR e1 n1)
    +      (H2 : aevalR e2 n2) :
    +      aevalR (AMinus e1 e2) (n1 - n2)
    +  | E_AMult (e1 e2: aexp) (n1 n2: nat)
    +      (H1 : aevalR e1 n1)
    +      (H2 : aevalR e2 n2) :
          aevalR (AMult e1 e2) (n1 * n2).

    +
    +Instead, we've chosen to leave the hypotheses anonymous, just + giving their types. This style gives us less control over the + names that Coq chooses during proofs involving aevalR, but it + makes the definition itself quite a bit lighter. +
    +
    + +End TooHardToRead.
    +
    +
    如果 aevalR 有中缀记法的话会很方便。我们用 e \\ n 表示算术表达式 e 求值为 n。 @@ -830,22 +859,22 @@

    Imp简单的指令式程序
    -Reserved Notation "e '\\' n" (at level 50, left associativity).

    +Reserved Notation "e '\\' n" (at level 90, left associativity).

    Inductive aevalR : aexpnatProp :=
    -  | E_ANum n :
    +  | E_ANum (n : nat) :
          (ANum n) \\ n
    -  | E_APlus e1 e2 n1 n2 :
    +  | E_APlus (e1 e2 : aexp) (n1 n2 : nat) :
          (e1 \\ n1) → (e2 \\ n2) → (APlus e1 e2) \\ (n1 + n2)
    -  | E_AMinus 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 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.
    -

    推理规则的记法

    +

    推理规则的记法

    @@ -860,7 +889,7 @@

    Imp简单的指令式程序

    -      | E_APlus :  (e1 e2aexp) (n1 n2nat),
    +      | E_APlus : (e1 e2aexp) (n1 n2nat),
              aevalR e1 n1 →
              aevalR e2 n2 →
              aevalR (APlus e1 e2) (n1 + n2) @@ -964,10 +993,38 @@

    Imp简单的指令式程序 +
    + +

    练习:1 星, standard, optional (beval_rules)

    + 下面是 Coq 中 beval 函数的定义: + +
    + +
    +  Fixpoint beval (e : bexp) : bool :=
    +    match e with
    +    | BTrue       ⇒ true
    +    | BFalse      ⇒ false
    +    | BEq a1 a2   ⇒ (aeval a1) =? (aeval a2)
    +    | BLe a1 a2   ⇒ (aeval a1) <=? (aeval a2)
    +    | BNot b1     ⇒ negb (beval b1)
    +    | BAnd b1 b2  ⇒ andb (beval b1) (beval b2)
    +    end. +
    + +
    + 请用推理规则记法将布尔求值的定义写成关系的形式。
    +
    +(* 请在此处解答 *)

    +(* 请勿修改下面这一行: *)
    +Definition manual_grade_for_beval_rules : option (nat*string) := None.
    +
    + +
    -

    定义的等价关系

    +

    定义的等价关系

    @@ -975,13 +1032,13 @@

    Imp简单的指令式程序
    -Theorem aeval_iff_aevalR : a n,
    +Theorem aeval_iff_aevalR : a n,
      (a \\ n) ↔ aeval a = n.
    -
    -
    +
    +
    Proof.
     split.
    - - (* -> *)
    + - (* -> *)
       intros H.
       induction H; simpl.
       + (* E_ANum *)
    @@ -1019,12 +1076,12 @@

    Imp简单的指令式程序
    -Theorem aeval_iff_aevalR' : a n,
    +Theorem aeval_iff_aevalR' : a n,
      (a \\ n) ↔ aeval a = n.
    Proof.
      (* 课上已完成 *)
      split.
    -  - (* -> *)
    +  - (* -> *)
        intros H; induction H; subst; reflexivity.
      - (* <- *)
        generalize dependent n.
    @@ -1034,7 +1091,7 @@

    Imp简单的指令式程序
    -

    练习:3 星 (bevalR)

    +

    练习:3 星, standard (bevalR)

    用和 aevalR 同样的方式写出关系 bevalR,并证明它等价于 beval
    @@ -1042,7 +1099,7 @@

    Imp简单的指令式程序Inductive bevalR: bexpboolProp :=
    (* 请在此处解答 *)
    .

    -Lemma beval_iff_bevalR : b bv,
    +Lemma beval_iff_bevalR : b bv,
      bevalR b bvbeval b = bv.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1055,7 +1112,7 @@

    Imp简单的指令式程序
    -

    计算式定义与关系式定义

    +

    计算式定义与关系式定义

    @@ -1072,7 +1129,7 @@

    Imp简单的指令式程序
    -例如,假设我们想要用除法运算来扩展算术运算: +例如,假设我们想要用除法来扩展算术运算:
    @@ -1091,17 +1148,17 @@

    Imp简单的指令式程序 Reserved Notation "e '\\' n"
    -                  (at level 50, left associativity).

    +                  (at level 90, left associativity).

    Inductive aevalR : aexpnatProp :=
    -  | E_ANum : (n:nat),
    +  | E_ANum (n : nat) :
          (ANum n) \\ n
    -  | E_APlus : (a1 a2: aexp) (n1 n2 : nat),
    +  | 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),
    +  | 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),
    +  | 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),
    +  | E_ADiv (a1 a2 : aexp) (n1 n2 n3 : nat) :
          (a1 \\ n1) → (a2 \\ n2) → (n2 > 0) →
          (mult n2 n3 = n1) → (ADiv a1 a2) \\ n3

    @@ -1111,16 +1168,16 @@

    Imp简单的指令式程序
    -假设,我们转而想要用非确定性的数值生成器 any 来扩展算术运算, +假设我们想要用非确定性的数值生成器 any 来扩展算术运算, 该生成器会在求值时产生任何数。(注意,这不同于在所有可能的数值中作出 - 概率上的选择 — 我们没有为结果指定任何具体的分布,只是说了 + 概率上的选择 — 我们没有为结果指定任何具体的概率分布,只是说了 可能的结果。)
    -Reserved Notation "e '\\' n" (at level 50, left associativity).

    +Reserved Notation "e '\\' n" (at level 90, left associativity).

    Inductive aexp : Type :=
    -  | AAny (* <--- NEW *)
    +  | AAny (* <--- NEW *)
      | ANum (n : nat)
      | APlus (a1 a2 : aexp)
      | AMinus (a1 a2 : aexp)
    @@ -1134,15 +1191,15 @@

    Imp简单的指令式程序 Inductive aevalR : aexpnatProp :=
    -  | E_Any : (n:nat),
    -      AAny \\ n (* <--- new *)
    -  | E_ANum : (n:nat),
    +  | E_Any (n : nat) :
    +      AAny \\ n (* <--- NEW *)
    +  | E_ANum (n : nat) :
          (ANum n) \\ n
    -  | E_APlus : (a1 a2: aexp) (n1 n2 : nat),
    +  | 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),
    +  | 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),
    +  | 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.

    @@ -1151,7 +1208,7 @@

    Imp简单的指令式程序 这时你可能会问:默认情况下应该使用哪种风格? - 上面的例子表明关系式定义从根本上要比函数式的更加强大。 + 我们刚看到的例子表明关系式的定义反而比函数式的更加有用。 对于这种定义的东西不太容易用函数表达,或者确实不是函数的情况来说, 明显别无选择。但如果两种风格均可行呢? @@ -1180,7 +1237,7 @@

    Imp简单的指令式程序

    - 此外,函数还可以直“提取为”OCaml 或 Haskell 的可执行代码。 + 此外,函数还可以直接从 Gallina“提取”出 OCaml 或 Haskell 的可执行代码。
    最终,选择视具体情况而定,或者只是品味问题。确实,在大型的 Coq @@ -1189,7 +1246,7 @@

    Imp简单的指令式程序
    -

    带变量的表达式

    +

    带变量的表达式

    @@ -1198,7 +1255,7 @@

    Imp简单的指令式程序
    -

    状态

    +

    状态

    @@ -1222,7 +1279,7 @@

    Imp简单的指令式程序
    -

    语法

    +

    语法

    @@ -1232,7 +1289,7 @@

    Imp简单的指令式程序Inductive aexp : Type :=
      | ANum (n : nat)
    -  | AId (x : string) (* <----- 新增 *)
    +  | AId (x : string) (* <--- 新增 *)
      | APlus (a1 a2 : aexp)
      | AMinus (a1 a2 : aexp)
      | AMult (a1 a2 : aexp).
    @@ -1269,45 +1326,64 @@

    Imp简单的指令式程序
    -

    记法

    +

    记法

    要让 Imp 程序更易读写,我们引入了一些记法和隐式转换(Coercion)。
    - 在本章中你无需理解以下声明具体做了些什么。简言而之,Coq 中的 Coercion + 你无需理解以下声明具体做了些什么。简言而之,Coq 中的 Coercion 声明规定了一个函数(或构造子)可以被类型系统隐式地用于将一个输入类型的值 转换成输出类型的值。例如,AId 的转换声明在需要一个 aexp 时直接使用普通的字符串,该字符串会被隐式地用 AId 来包装。
    下列记法在具体的记法作用域中声明,以避免与其它符号相同的解释相冲突。 - 同样,你也暂时无需理解其中的细节。 + 同样,你暂时也无需理解其中的细节,但要意识到到我们为 +-*= + 等运算符定义了新的解释十分重要。
    -Coercion AId : string >-> aexp.
    -Coercion ANum : nat >-> aexp.
    -Definition bool_to_bexp (b: bool) : bexp :=
    +Coercion AId : string >-> aexp.
    +Coercion ANum : nat >-> aexp.

    +Definition bool_to_bexp (b : bool) : bexp :=
      if b then BTrue else BFalse.
    -Coercion bool_to_bexp : bool >-> bexp.

    -Bind Scope aexp_scope with aexp.
    -Infix "+" := APlus : aexp_scope.
    -Infix "-" := AMinus : aexp_scope.
    -Infix "*" := AMult : aexp_scope.
    -Bind Scope bexp_scope with bexp.
    -Infix "≤" := BLe : bexp_scope.
    -Infix "=" := BEq : bexp_scope.
    -Infix "&&" := BAnd : bexp_scope.
    -Notation "'!' b" := (BNot b) (at level 60) : bexp_scope.
    +Coercion bool_to_bexp : bool >-> bexp.

    +Bind Scope imp_scope with aexp.
    +Bind Scope imp_scope with bexp.
    +Delimit Scope imp_scope with imp.

    +Notation "x + y" := (APlus x y) (at level 50, left associativity) : imp_scope.
    +Notation "x - y" := (AMinus x y) (at level 50, left associativity) : imp_scope.
    +Notation "x * y" := (AMult x y) (at level 40, left associativity) : imp_scope.
    +Notation "x ≤ y" := (BLe x y) (at level 70, no associativity) : imp_scope.
    +Notation "x = y" := (BEq x y) (at level 70, no associativity) : imp_scope.
    +Notation "x && y" := (BAnd x y) (at level 40, left associativity) : imp_scope.
    +Notation "'¬' b" := (BNot b) (at level 75, right associativity) : imp_scope.
    现在我们可以用 3 + (X * 2) 来代替 APlus 3 (AMult X 2) 了,同样可以用 - true && !(X 4) 来代替 BAnd true (BNot (BLe X 4)) + true && !(X 4) 来代替 BAnd true (BNot (BLe X 4))。 +
    +
    + +Definition example_aexp := (3 + (X * 2))%imp : aexp.
    +Definition example_bexp := (true && ~(X ≤ 4))%imp : bexp.
    +
    + +
    +强制转换有一点不便之处,即它会略微提高人类推导表达式类型的难度。 + 如果你感到有点困惑,请用 Set Printing Coercions 来查看具体发生了什么。 +
    +
    + +Set Printing Coercions.

    +Print example_bexp.
    +(* ===> example_bexp = bool_to_bexp true && ~ (AId X <= ANum 4) *)

    +Unset Printing Coercions.
    -

    求值

    +

    求值

    @@ -1319,7 +1395,7 @@

    Imp简单的指令式程序Fixpoint aeval (st : state) (a : aexp) : nat :=
      match a with
      | ANum nn
    -  | AId xst x (* <----- 新增 *)
    +  | AId xst x (* <--- 新增 *)
      | 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)
    @@ -1336,42 +1412,39 @@

    Imp简单的指令式程序
    -我们为具体状态的全映射声明具体的记法,即使用 { --> 0 } 作为空状态。 +我们为具体状态的全映射声明具体的记法,即使用 (_ !-> 0) 作为空状态。
    -Notation "{ a --> x }" :=
    -  (t_update { --> 0 } a x) (at level 0).
    -Notation "{ a --> x ; b --> y }" :=
    -  (t_update ({ a --> x }) b y) (at level 0).
    -Notation "{ a --> x ; b --> y ; c --> z }" :=
    -  (t_update ({ a --> x ; b --> y }) c z) (at level 0).
    -Notation "{ a --> x ; b --> y ; c --> z ; d --> t }" :=
    -    (t_update ({ a --> x ; b --> y ; c --> z }) d t) (at level 0).
    -Notation "{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" :=
    -  (t_update ({ a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 0).
    -Notation "{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" :=
    -  (t_update ({ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 0).

    +Definition empty_st := (_ !-> 0).
    +
    + +
    +现在我们可以为“单例状态(singleton state)”添加新的记法了, + 即只有一个绑定到值的变量。 +
    +
    +Notation "a '!->' x" := (t_update empty_st a x) (at level 100).

    Example aexp1 :
    -  aeval { X --> 5 } (3 + (X * 2))
    +    aeval (X !-> 5) (3 + (X * 2))%imp
      = 13.
    -
    -
    +
    +
    Proof. reflexivity. Qed.

    Example bexp1 :
    -  beval { X --> 5 } (true && !(X ≤ 4))
    +    beval (X !-> 5) (true && ~(X ≤ 4))%imp
      = true.
    -
    -
    +
    +
    Proof. reflexivity. Qed.
    -

    指令

    +

    指令

    @@ -1380,23 +1453,22 @@

    Imp简单的指令式程序
    -

    语法

    +

    语法

    - 指令 c 可以用以下 BNF 文法非形式化地描述。(为了能够使用 Coq - 的记法机制来定义 Imp 语法,我们选择了这种略尴尬的具体语法。具体来说, - 我们使用了 IFB 来避免与表中库中的 if 记法相冲突。) + 指令 c 可以用以下 BNF 文法非形式化地描述。
    -     c ::= SKIP | x ::= a | c ;; c | IFB b THEN c ELSE c FI
    +     c ::= SKIP | x ::= a | c ;; c | TEST b THEN c ELSE c FI
             | WHILE b DO c END
    - + (为了能够使用 Coq 的记法机制来定义 Imp 语法,我们选择了这种略尴尬的具体语法。 + 具体来说,我们使用了 TEST 来避免与表中库中的 if 记法相冲突。)
    例如,下面是用 Imp 编写的阶乘: @@ -1406,7 +1478,7 @@

    Imp简单的指令式程序      Z ::= X;;
         Y ::= 1;;
    -     WHILE ! (Z = 0) DO
    +     WHILE ~(Z = 0) DO
           Y ::= Y * Z;;
           Z ::= Z - 1
         END @@ -1433,24 +1505,17 @@

    Imp简单的指令式程序
    -Bind Scope com_scope with com.
    +Bind Scope imp_scope with com.
    Notation "'SKIP'" :=
    -   CSkip : com_scope.
    +   CSkip : imp_scope.
    Notation "x '::=' a" :=
    -  (CAss x a) (at level 60) : com_scope.
    +  (CAss x a) (at level 60) : imp_scope.
    Notation "c1 ;; c2" :=
    -  (CSeq c1 c2) (at level 80, right associativity) : com_scope.
    +  (CSeq c1 c2) (at level 80, right associativity) : imp_scope.
    Notation "'WHILE' b 'DO' c 'END'" :=
    -  (CWhile b c) (at level 80, right associativity) : com_scope.
    -Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" :=
    -  (CIf c1 c2 c3) (at level 80, right associativity) : com_scope.
    -
    - -
    -以下声明可以让这些记法在模式匹配中使用。 -
    -
    -Open Scope com_scope.
    +  (CWhile b c) (at level 80, right associativity) : imp_scope.
    +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" :=
    +  (CIf c1 c2 c3) (at level 80, right associativity) : imp_scope.
    @@ -1459,16 +1524,113 @@

    Imp简单的指令式程序 Definition fact_in_coq : com :=
    -  Z ::= X;;
    +  (Z ::= X;;
      Y ::= 1;;
    -  WHILE ! (Z = 0) DO
    +  WHILE ~(Z = 0) DO
        Y ::= Y * Z;;
        Z ::= Z - 1
    -  END.
    +  END)%imp.

    -

    更多示例

    +

    脱糖记法

    + +
    + + Coq 为管理日益复杂的工作对象提供了丰富的特性,例如隐式转换和记法。 + 然而,过度使用它们会产生繁杂的语法。为了教学,我们通常会用以下命令来 + “关闭”这些特性以获得对事物更加本质的描述: + +
    + +
      +
    • Unset Printing Notations(用 Set Printing Notations 撤销) + +
    • +
    • Set Printing Coercions(用 Unset Printing Coercions 撤销) + +
    • +
    • Set Printing All(用 Unset Printing All 撤销) + +
    • +
    + 这些命令也可在证明过程中详述当前目标和上下文。 +
    +
    + +Unset Printing Notations.
    +Print fact_in_coq.
    +(* ===>
    +   fact_in_coq =
    +   CSeq (CAss Z X)
    +        (CSeq (CAss Y (S O))
    +              (CWhile (BNot (BEq Z O))
    +                      (CSeq (CAss Y (AMult Y Z))
    +                            (CAss Z (AMinus Z (S O))))))
    +        : com *)

    +Set Printing Notations.

    +Set Printing Coercions.
    +Print fact_in_coq.
    +(* ===>
    +   fact_in_coq =
    +   (Z ::= AId X;;
    +   Y ::= ANum 1;;
    +   WHILE ~ (AId Z = ANum 0) DO
    +     Y ::= AId Y * AId Z;;
    +     Z ::= AId Z - ANum 1
    +   END)%imp
    +       : com *)

    +Unset Printing Coercions.
    +
    + +
    +

    Locate 命令

    + +
    + +

    查询记法

    + +
    + + 当遇到未知记法时,可使用 Locate 后跟一个包含其符号的字符串 + 来查看其可能的解释。 +
    +
    +Locate "&&".
    +(* ===>
    +   Notation "x && y" := andb x y : bool_scope (default interpretation) *)


    +Locate ";;".
    +(* ===>
    +   Notation "c1 ;; c2" := CSeq c1 c2 : imp_scope (default interpretation) *)


    +Locate "WHILE".
    +(* ===>
    +   Notation "'WHILE' b 'DO' c 'END'" := CWhile b c : imp_scope
    +   (default interpretation) *)

    +
    + +
    +

    查询标识符

    + +
    + + 当以标示符使用 Locate 时,它会打印作用域中同名的所有值的完成路径。 + 它很适合解决由变量覆盖所引起的问题。 +
    +
    +Locate aexp.
    +(* ===>
    +   Inductive Top.aexp
    +   Inductive Top.AExp.aexp
    +     (shorter name to refer to it in current context is AExp.aexp)
    +   Inductive Top.aevalR_division.aexp
    +     (shorter name to refer to it in current context is aevalR_division.aexp)
    +   Inductive Top.aevalR_extended.aexp
    +     (shorter name to refer to it in current context is aevalR_extended.aexp)
    +*)

    +
    + +
    +

    更多示例

    @@ -1486,16 +1648,16 @@

    Imp简单的指令式程序
    -

    Loops

    +

    循环


    Definition subtract_slowly : com :=
    -  WHILE ! (X = 0) DO
    +  (WHILE ~(X = 0) DO
        subtract_slowly_body
    -  END.

    +  END)%imp.

    Definition subtract_3_from_5_slowly : com :=
      X ::= 3 ;;
      Z ::= 5 ;;
    @@ -1503,7 +1665,7 @@

    Imp简单的指令式程序
    -

    An infinite loop:

    +

    无限循环:

    @@ -1516,7 +1678,7 @@

    Imp简单的指令式程序
    -

    求值指令

    +

    求值指令

    @@ -1525,31 +1687,35 @@

    Imp简单的指令式程序
    -

    求值作为函数(失败的尝试)

    +

    求值作为函数(失败的尝试)

    下面是一次为指令定义求值函数的尝试,我们忽略了 WHILE 的情况。 +
    + + 为了在模式匹配中使用记法,我们需要以下声明。
    - +Open Scope imp_scope.
    Fixpoint ceval_fun_no_while (st : state) (c : com)
                              : state :=
      match c with
        | SKIP
            st
        | x ::= a1
    -        st & { x --> (aeval st a1) }
    +        (x !-> (aeval st a1) ; st)
        | c1 ;; c2
            let st' := ceval_fun_no_while st c1 in
            ceval_fun_no_while st' c2
    -    | IFB b THEN c1 ELSE c2 FI
    +    | TEST 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 (* 假装能用 *)
      end.
    +Close Scope imp_scope.
    @@ -1561,7 +1727,7 @@

    Imp简单的指令式程序 @@ -1585,7 +1751,7 @@

    Imp简单的指令式程序
    -

    求值作为一种关系

    +

    求值作为一种关系

    @@ -1599,12 +1765,12 @@

    Imp简单的指令式程序

    - 我们将使用记法 c / st \\ st' 来表示 ceval 这种关系:c / st \\ st' + 我们将使用记法 st =[ c ]⇒ st' 来表示 ceval 这种关系:st =[ c ]⇒ st' 表示在开始状态 st 下启动程序并在结束状态 st' 下产生结果。它可以读作: “c 将状态 st 变成 st'”。
    -

    操作语义

    +

    操作语义

    @@ -1619,7 +1785,7 @@

    Imp简单的指令式程序
    - SKIP / st \\ st + st =[ SKIP ]=> st
    @@ -1632,16 +1798,16 @@

    Imp简单的指令式程序

    - +
    x := a1 / st \\ st & { x --> n }st =[ x := a1 ]=> (x !-> n ; st)
    - + - + @@ -1649,7 +1815,7 @@

    Imp简单的指令式程序

    - +
    c1 / st \\ st'st  =[ c1 ]=> st'
    c2 / st' \\ st''st' =[ c2 ]=> st'' (E_Seq)  
    c1;;c2 / st \\ st''st =[ c1;;c2 ]=> st''
    @@ -1658,7 +1824,7 @@

    Imp简单的指令式程序

    - + @@ -1666,7 +1832,7 @@

    Imp简单的指令式程序

    - +
    c1 / st \\ st'st =[ c1 ]=> st' (E_IfTrue)  
    IF b1 THEN c1 ELSE c2 FI / st \\ st'st =[ TEST b1 THEN c1 ELSE c2 FI ]=> st'
    @@ -1675,7 +1841,7 @@

    Imp简单的指令式程序

    - + @@ -1683,7 +1849,7 @@

    Imp简单的指令式程序

    - +
    c2 / st \\ st'st =[ c2 ]=> st' (E_IfFalse)  
    IF b1 THEN c1 ELSE c2 FI / st \\ st'st =[ TEST b1 THEN c1 ELSE c2 FI ]=> st'
    @@ -1696,7 +1862,7 @@

    Imp简单的指令式程序

    - +
    WHILE b DO c END / st \\ stst =[ WHILE b DO c END ]=> st
    @@ -1705,11 +1871,11 @@

    Imp简单的指令式程序

    - + - + @@ -1717,7 +1883,7 @@

    Imp简单的指令式程序

    - +
    c / st \\ st'st =[ c ]=> st'
    WHILE b DO c END / st' \\ st''st' =[ WHILE b DO c END ]=> st'' (E_WhileTrue)  
    WHILE b DO c END / st \\ st''st  =[ WHILE b DO c END ]=> st''
    @@ -1727,36 +1893,36 @@

    Imp简单的指令式程序
    -Reserved Notation "c1 '/' st '\\' st'"
    -                  (at level 40, st at level 39).

    +Reserved Notation "st '=[' c ']⇒' st'"
    +                  (at level 40).

    Inductive ceval : comstatestateProp :=
    -  | E_Skip : st,
    -      SKIP / st \\ st
    -  | E_Ass : st a1 n x,
    +  | E_Skip : st,
    +      st =[ SKIP ]⇒ st
    +  | E_Ass : st a1 n x,
          aeval st a1 = n
    -      (x ::= a1) / st \\ 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,
    +      st =[ x ::= a1 ]⇒ (x !-> n ; st)
    +  | E_Seq : c1 c2 st st' st'',
    +      st =[ c1 ]⇒ st'
    +      st' =[ c2 ]⇒ st''
    +      st =[ c1 ;; c2 ]⇒ 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,
    +      st =[ c1 ]⇒ st'
    +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ 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_WhileFalse : b st c,
    +      st =[ c2 ]⇒ st'
    +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
    +  | E_WhileFalse : b st c,
          beval st b = false
    -      (WHILE b DO c END) / st \\ st
    -  | E_WhileTrue : st st' st'' b c,
    +      st =[ WHILE b DO c END ]⇒ st
    +  | E_WhileTrue : 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''
    +      st =[ c ]⇒ st'
    +      st' =[ WHILE b DO c END ]⇒ st''
    +      st =[ WHILE b DO c END ]⇒ st''

    -  where "c1 '/' st '\\' st'" := (ceval c1 st st').
    +  where "st =[ c ]⇒ st'" := (ceval c st st').
    @@ -1766,31 +1932,34 @@

    Imp简单的指令式程序 Example ceval_example1:
    -    (X ::= 2;;
    -     IFB X ≤ 1
    +  empty_st =[
    +     X ::= 2;;
    +     TEST X ≤ 1
           THEN Y ::= 3
           ELSE Z ::= 4
    -     FI)
    -   / { --> 0 } \\ { X --> 2 ; Z --> 4 }.
    +     FI
    +  ]⇒ (Z !-> 4 ; X !-> 2).
    Proof.
      (* 我们必须提供中间状态 *)
    -  apply E_Seq with { X --> 2 }.
    +  apply E_Seq with (X !-> 2).
      - (* 赋值指令 *)
        apply E_Ass. reflexivity.
      - (* if 指令 *)
        apply E_IfFalse.
    -      reflexivity.
    -      apply E_Ass. reflexivity. Qed.
    +    reflexivity.
    +    apply E_Ass. reflexivity.
    +Qed.

    -

    练习:2 星 (ceval_example2)

    +

    练习:2 星, standard (ceval_example2)

    Example ceval_example2:
    -  (X ::= 0;; Y ::= 1;; Z ::= 2) / { --> 0 } \\
    -  { X --> 0 ; Y --> 1 ; Z --> 2 }.
    +  empty_st =[
    +    X ::= 0;; Y ::= 1;; Z ::= 2
    +  ]⇒ (Z !-> 2 ; Y !-> 1 ; X !-> 0).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1799,7 +1968,7 @@

    Imp简单的指令式程序
    -

    练习:3 星, optional (pup_to_n)

    +

    练习:3 星, standard, optional (pup_to_n)

    写一个 Imp 程序对从 1X 进行求值(包括:将 1 + 2 + ... + X) 赋予变量 Y。 证明此程序对于 X = 2 会按预期执行(这可能比你预想的还要棘手)。
    @@ -1808,8 +1977,9 @@

    Imp简单的指令式程序Definition pup_to_n : com
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    Theorem pup_to_2_ceval :
    -  pup_to_n / { X --> 2 }
    -     \\ { X --> 2 ; Y --> 0 ; Y --> 2 ; X --> 1 ; Y --> 3 ; X --> 0 }.
    +  (X !-> 2) =[
    +    pup_to_n
    +  ]⇒ (X !-> 0 ; Y !-> 3 ; X !-> 1 ; Y !-> 2 ; Y !-> 0 ; X !-> 2).
    Proof.
      (* 请在此处解答 *) Admitted.

    @@ -1817,7 +1987,7 @@

    Imp简单的指令式程序
    -

    求值的确定性

    +

    求值的确定性

    @@ -1833,12 +2003,12 @@

    Imp简单的指令式程序
    -Theorem ceval_deterministic: c st st1 st2,
    -     c / st \\ st1
    -     c / st \\ st2
    +Theorem ceval_deterministic: c st st1 st2,
    +     st =[ c ]⇒ st1
    +     st =[ c ]⇒ st2
         st1 = st2.
    -
    -
    +
    +
    Proof.
      intros c st st1 st2 E1 E2.
      generalize dependent st2.
    @@ -1874,7 +2044,7 @@

    Imp简单的指令式程序
    -

    对 Imp 进行推理

    +

    对 Imp 进行推理

    @@ -1883,10 +2053,10 @@

    Imp简单的指令式程序
    -Theorem plus2_spec : st n st',
    +Theorem plus2_spec : st n st',
      st X = n
    -  plus2 / st \\ st'
    -  st' X = (n + 2).
    +  st =[ plus2 ]⇒ st'
    +  st' X = n + 2.
    Proof.
      intros st n st' HX Heval.
    @@ -1903,7 +2073,7 @@

    Imp简单的指令式程序
    -

    练习:3 星, recommended (XtimesYinZ_spec)

    +

    练习:3 星, standard, recommended (XtimesYinZ_spec)

    叙述并证明 XtimesYinZ 的规范(Specification)。
    @@ -1917,15 +2087,15 @@

    Imp简单的指令式程序
    -

    练习:3 星, recommended (loop_never_stops)

    +

    练习:3 星, standard, recommended (loop_never_stops)

    -Theorem loop_never_stops : st st',
    -  ~(loop / st \\ st').
    +Theorem loop_never_stops : st st',
    +  ~(st =[ loop ]⇒ st').
    Proof.
      intros st st' contra. unfold loop in contra.
    -  remember (WHILE true DO SKIP END) as loopdef
    +  remember (WHILE true DO SKIP END)%imp as loopdef
               eqn:Heqloopdef.
    @@ -1942,11 +2112,12 @@

    Imp简单的指令式程序
    -

    练习:3 星 (no_whiles_eqv)

    +

    练习:3 星, standard (no_whiles_eqv)

    考虑以下函数:
    +Open Scope imp_scope.
    Fixpoint no_whiles (c : com) : bool :=
      match c with
      | SKIP
    @@ -1955,11 +2126,12 @@

    Imp简单的指令式程序true
      | c1 ;; c2
          andb (no_whiles c1) (no_whiles c2)
    -  | IFB _ THEN ct ELSE cf FI
    +  | TEST _ THEN ct ELSE cf FI
          andb (no_whiles ct) (no_whiles cf)
      | WHILE _ DO _ END
          false
      end.
    +Close Scope imp_scope.

    @@ -1973,7 +2145,7 @@

    Imp简单的指令式程序(* 请在此处解答 *)
    .

    Theorem no_whiles_eqv:
    -    c, no_whiles c = trueno_whilesR c.
    +   c, no_whiles c = trueno_whilesR c.
    Proof.
      (* 请在此处解答 *) Admitted.

    @@ -1982,7 +2154,7 @@

    Imp简单的指令式程序
    -

    练习:4 星 (no_whiles_terminating)

    +

    练习:4 星, standard (no_whiles_terminating)

    不涉及 WHILE 循环的 Imp 程序一定会终止。请陈述并证明定理 no_whiles_terminating 来说明这一点。 按照你的偏好使用 no_whilesno_whilesR
    @@ -1996,11 +2168,11 @@

    Imp简单的指令式程序
    -

    附加练习

    +

    附加练习

    -

    练习:3 星 (stack_compiler)

    +

    练习:3 星, standard (stack_compiler)

    旧式惠普计算器的编程语言类似于 Forth 和 Postscript,而其抽象机器类似于 Java 虚拟机,即所有对算术表达式的求值都使用来进行。例如,表达式
    @@ -2076,12 +2248,12 @@ 

    Imp简单的指令式程序list nat
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    Example s_execute1 :
    -     s_execute { --> 0 } []
    +     s_execute empty_st []
           [SPush 5; SPush 3; SPush 1; SMinus]
       = [2; 5].
    (* 请在此处解答 *) Admitted.

    Example s_execute2 :
    -     s_execute { X --> 3 } [3;4]
    +     s_execute (X !-> 3) [3;4]
           [SPush 4; SLoad X; SMult; SPlus]
       = [15; 4].
    (* 请在此处解答 *) Admitted.
    @@ -2103,7 +2275,7 @@

    Imp简单的指令式程序 Example s_compile1 :
    -  s_compile (X - (2 * Y))
    +  s_compile (X - (2 * Y))%imp
      = [SLoad X; SPush 2; SLoad Y; SMult; SMinus].
    (* 请在此处解答 *) Admitted.

    @@ -2112,7 +2284,7 @@

    Imp简单的指令式程序
    -

    练习:4 星, advanced (stack_compiler_correct)

    +

    练习:4 星, advanced (stack_compiler_correct)

    现在我们将证明在之前练习中实现的编译器的正确性。记住当栈中的元素少于两个时, 规范并未指定 SPlusSMinusSMult 指令的行为。 (为了让正确性证明更加容易,你可能需要返回去修改你的实现!) @@ -2124,7 +2296,7 @@

    Imp简单的指令式程序
    -Theorem s_compile_correct : (st : state) (e : aexp),
    +Theorem s_compile_correct : (st : state) (e : aexp),
      s_execute st [] (s_compile e) = [ aeval st e ].
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -2134,7 +2306,7 @@

    Imp简单的指令式程序
    -

    练习:3 星, optional (short_circuit)

    +

    练习:3 星, standard, optional (short_circuit)

    大部分现代编程语言对布尔 and 运算提供了“短路求值”的方法:要对 BAnd b1 b2 进行求值,首先对 b1 求值。如果结果为 false,那么整个 BAnd 表达式的求值就是 false,而无需对 b2 求值。否则,b2 @@ -2159,7 +2331,7 @@

    Imp简单的指令式程序
    -

    练习:4 星, advanced (break_imp)

    +

    练习:4 星, advanced (break_imp)

    像 C 和 Java 这样的指令式语言通常会包含 break 或类似地语句来中断循环的执行。 在本练习中,我们考虑如何为 Imp 加上 break。首先,我们需要丰富语言的指令。
    @@ -2167,7 +2339,7 @@

    Imp简单的指令式程序Inductive com : Type :=
      | CSkip
    -  | CBreak (* <-- 新增 *)
    +  | CBreak (* <--- 新增 *)
      | CAss (x : string) (a : aexp)
      | CSeq (c1 c2 : com)
      | CIf (b : bexp) (c1 c2 : com)
    @@ -2182,7 +2354,7 @@

    Imp简单的指令式程序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'" :=
    +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" :=
      (CIf c1 c2 c3) (at level 80, right associativity).

    @@ -2202,8 +2374,8 @@

    Imp简单的指令式程序        X ::= 0;;
           Y ::= 1;;
    -       WHILE 0 ≠ Y DO
    -         WHILE TRUE DO
    +       WHILE ~(0 = YDO
    +         WHILE true DO
               BREAK
             END;;
             X ::= 1;;
    @@ -2224,19 +2396,19 @@

    Imp简单的指令式程序Inductive result : Type :=
      | SContinue
      | SBreak.

    -Reserved Notation "c1 '/' st '\\' s '/' st'"
    -                  (at level 40, st, s at level 39).
    +Reserved Notation "st '=[' c ']⇒' st' '/' s"
    +         (at level 40, st' at next level).

    -直觉上说,c / st \\ s / st' 表示如果 cst 状况下开始, +直觉上说,st =[ c ]⇒ st' / s 表示如果 cst 状况下开始, 它会在 st' 状态下终止,围绕它的最内层循环(或整个程序) 要么收到立即退出的信号(s = SBreak),要么继续正常执行(s = SContinue)。
    - “c / st \\ s / st'”关系的定义非常类似于之前我们为一般求值关系 - (c / st \\ st')给出的定义 — 我们只需要恰当地处理终止信号。 + “st =[ c ]⇒ st' / s”关系的定义非常类似于之前我们为一般求值关系 + (st =[ c ]⇒ st')给出的定义 — 我们只需要恰当地处理终止信号。
    @@ -2259,7 +2431,7 @@

    Imp简单的指令式程序 -
  • 若指令为 IFB b THEN c1 ELSE c2 FI 的形式,则按照 Imp 的原始语义更新状态, +
  • 若指令为 TEST b THEN c1 ELSE c2 FI 的形式,则按照 Imp 的原始语义更新状态, 除此之外我们还要从被选择执行的分支中传播信号。
    @@ -2290,11 +2462,11 @@

    Imp简单的指令式程序 Inductive ceval : comstateresultstateProp :=
    -  | E_Skip : st,
    -      CSkip / st \\ SContinue / st
    +  | E_Skip : st,
    +      st =[ CSkip ]⇒ st / SContinue
      (* 请在此处解答 *)

    -  where "c1 '/' st '\\' s '/' st'" := (ceval c1 st s st').
    +  where "st '=[' c ']⇒' st' '/' s" := (ceval c st s st').

  • @@ -2302,20 +2474,20 @@

    Imp简单的指令式程序
    -Theorem break_ignore : c st st' s,
    -     (BREAK;; c) / st \\ s / st'
    +Theorem break_ignore : c st st' s,
    +     st =[ BREAK;; c ]⇒ st' / s
         st = st'.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem while_continue : b c st st' s,
    -  (WHILE b DO c END) / st \\ s / st'
    +Theorem while_continue : b c st st' s,
    +  st =[ WHILE b DO c END ]⇒ st' / s
      s = SContinue.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem while_stops_on_break : b c st st',
    +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'.
    +  st =[ c ]⇒ st' / SBreak
    +  st =[ WHILE b DO c END ]⇒ st' / SContinue.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -2324,14 +2496,14 @@

    Imp简单的指令式程序
    -

    练习:3 星, advanced, optional (while_break_true)

    +

    练习:3 星, advanced, optional (while_break_true)

    -Theorem while_break_true : b c st st',
    -  (WHILE b DO c END) / st \\ SContinue / st'
    +Theorem while_break_true : b c st st',
    +  st =[ WHILE b DO c END ]⇒ st' / SContinue
      beval st' b = true
    -   st'', c / st'' \\ SBreak / st'.
    +  st'', st'' =[ c ]⇒ st' / SBreak.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -2340,13 +2512,13 @@

    Imp简单的指令式程序
    -

    练习:4 星, advanced, optional (ceval_deterministic)

    +

    练习:4 星, advanced, optional (ceval_deterministic)

    -Theorem ceval_deterministic: (c:com) st st1 st2 s1 s2,
    -     c / st \\ s1 / st1
    -     c / st \\ s2 / st2
    +Theorem ceval_deterministic: (c:com) st st1 st2 s1 s2,
    +     st =[ c ]⇒ st1 / s1
    +     st =[ c ]⇒ st2 / s2
         st1 = st2s1 = s2.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -2358,7 +2530,7 @@

    Imp简单的指令式程序
    -

    练习:4 星, optional (add_for_loop)

    +

    练习:4 星, standard, optional (add_for_loop)

    为该语言添加 C 风格的 for 循环指令,更新 ceval 的定义来定义 for 循环,按需添加 for 循环的情况使得本文件中的所有证明都被 Coq 所接受。 @@ -2376,6 +2548,10 @@

    Imp简单的指令式程序 +
    + +(* Sat Jan 26 15:14:46 UTC 2019 *)
    +

    diff --git a/lf-current/Imp.v b/lf-current/Imp.v index 3dd455f1..ae925d7e 100644 --- a/lf-current/Imp.v +++ b/lf-current/Imp.v @@ -1,13 +1,13 @@ (** * Imp: 简单的指令式程序 *) -(** 在本章中,我们会更加认真地看待如何用 Coq 来研究自身以外的有趣的东西。 +(** 在本章中,我们会更加认真地看待如何用 Coq 来研究其它东西。 我们的案例研究是一个名为 Imp 的_'简单的指令式编程语言'_, 它包含了传统主流语言(如 C 和 Java)的一小部分核心片段。下面是一个用 Imp 编写的常见数学函数: Z ::= X;; Y ::= 1;; - WHILE ! (Z = 0) DO + WHILE ~(Z = 0) DO Y ::= Y * Z;; Z ::= Z - 1 END @@ -19,12 +19,13 @@ _'霍尔逻辑(Hoare Logic)'_,它是一种广泛用于推理指令式程序的逻辑。 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Bool.Bool. -Require Import Coq.Init.Nat. -Require Import Coq.Arith.Arith. -Require Import Coq.Arith.EqNat. -Require Import Coq.omega.Omega. -Require Import Coq.Lists.List. +From Coq Require Import Bool.Bool. +From Coq Require Import Init.Nat. +From Coq Require Import Arith.Arith. +From Coq Require Import Arith.EqNat. +From Coq Require Import omega.Omega. +From Coq Require Import Lists.List. +From Coq Require Import Strings.String. Import ListNotations. From LF Require Import Maps. @@ -58,11 +59,11 @@ Inductive bexp : Type := | BAnd (b1 b2 : bexp). (** 在本章中,我们省略了大部分从程序员实际编写的具体语法到其抽象语法树的翻译 - -- 例如,它会将字符串 ["1+2*3"] 翻译成如下 AST: + -- 例如,它会将字符串 ["1 + 2 * 3"] 翻译成如下 AST: APlus (ANum 1) (AMult (ANum 2) (ANum 3)). - 可选的章节 [ImpParser] 中开发了一个简单的词法分析器和解析器的实现, + 可选的章节 [ImpParser] 中开发了一个简单的词法分析器和解析器, 它可以进行这种翻译。你_'无需'_通过理解该章来理解本章, 但如果你没有上过涵盖这些技术的课程(例如编译器课程),可能想要略读一下该章节。 *) @@ -77,26 +78,26 @@ Inductive bexp : Type := | false | a = a | a <= a - | not b - | b and b + | ~ b + | b && b *) (** 与前面的 Coq 版本相对比... - BNF 是非形式化的 -- 例如,它给出了表达式表面上的语法的建议 - (例如加法运算写作 [+] 且它是一个中缀符),而没有指定词法分析和解析的其它方面 + (例如加法运算符写作中缀的 [+]),而没有指定词法分析和解析的其它方面 (如 [+]、[-] 和 [*] 的相对优先级,用括号来明确子表达式的分组等)。 在实现编译器时,需要一些附加的信息(以及人类的智慧) 才能将此描述转换成形式化的定义。 Coq 版本则始终忽略了所有这些信息,只专注于抽象语法。 - - 另一方面 BNF 版本则更加清晰易读。它的非形式化使其更加灵活, + - 反之,BNF 版本则更加清晰易读。它的非形式化使其更加灵活, 在讨论和在黑板上书写时,它有很大的优势, 此时传达一般的概念要比精确定下所有细节更加重要。 确实,存在很多种类似 BNF 的记法,人们可以随意使用它们, - 而无需关心具体使用了哪种 BNF 的形式,因为没有必要: + 而无需关心具体使用了哪种 BNF,因为没有必要: 大致的理解是非常重要的。 适应这两种记法都很有必要:非形式化的用语人类之间的交流, @@ -110,9 +111,9 @@ Inductive bexp : Type := 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) + | 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: @@ -136,20 +137,15 @@ Fixpoint beval (b : bexp) : bool := (** 我们尚未定义太多东西,不过从这些定义出发,已经能前进不少了。 假设我们定义了一个接收算术表达式并对它稍微进行化简的函数,即将所有的 - [0+e](如 [(APlus (ANum 0) e])化简为 [e]。 *) + [0 + e](如 [(APlus (ANum 0) e])化简为 [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) + | 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. (** 要保证我们的优化是正确的,可以在某些示例中测试它并观察其输出出否正确。 *) @@ -209,16 +205,16 @@ Proof. (** *** [try] 泛策略 *) (** 如果 [T] 是一个策略,那么 [try T] 是一个和 [T] 一样的策略,只是如果 - [T] 失败的话,[try T] 就会_'成功地'_什么也不做(而非失败)。 *) + [T] 失败的话,[try T] 就会_'成功地'_什么也不做(而非失败)。*) Theorem silly1 : forall ae, aeval ae = aeval ae. -Proof. try reflexivity. (* 它和 [reflexivity] 做的一样 *) Qed. +Proof. try reflexivity. (* 它和 [reflexivity] 做的一样。 *) Qed. Theorem silly2 : forall (P : Prop), P -> P. Proof. intros P HP. - try reflexivity. (* 和 [reflexivity] 失败时一样 *) - apply HP. (* 我们仍然可以换种方式来结束此证明 *) + try reflexivity. (* 和 [reflexivity] 失败时一样。 *) + apply HP. (* 我们仍然可以换种方式来结束此证明。 *) Qed. (** 我们并没有真正的理由在像这样的手动证明中使用 [try],不过在连同 @@ -235,7 +231,7 @@ Qed. Lemma foo : forall n, 0 <=? n = true. Proof. intros. - destruct n eqn:E. + destruct n. (* 会产生两个执行过程相同的子目标... *) - (* n=0 *) simpl. reflexivity. - (* n=Sn' *) simpl. reflexivity. @@ -370,11 +366,12 @@ Qed. 那么重复 [T] 会永远循环(例如 [repeat simpl] 会一直循环,因为 [simpl] 总是会成功)。虽然 Coq 的主语言 Gallina 中的求值保证会终止, 然而策略却不会!然而这并不会影响 Coq 的逻辑一致性,因为 [repeat] - 和其它策略的工作就是指导 Coq 去构造证明;如果构造过程发散(即不终止), + 和其它策略的工作就是指导 Coq 去构造证明;如果构造过程发散(即不停机), 那就意味着我们构造证明失败,而非构造出了错误的证明。 *) -(** **** 练习:3 星 (optimize_0plus_b_sound) *) -(** 由于 [optimize_0plus] 变换不会改变 [aexp] 的值, +(** **** 练习:3 星, standard (optimize_0plus_b_sound) + + 由于 [optimize_0plus] 变换不会改变 [aexp] 的值, 因此我们可以将它应用到所有出现在 [bexp] 中的 [aexp] 上而不改变 [bexp] 的值。请编写一个对 [bexp] 执行此变换的函数,并证明它的可靠性。 利用我们刚学过的泛策略来构造一个尽可能优雅的证明。 *) @@ -388,13 +385,15 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, optional (optimizer) *) -(** _'设计练习'_:[optimize_0plus] 函数只是众多算术和布尔表达式优化的方法之一。 +(** **** 练习:4 星, standard, optional (optimize) + + _'设计练习'_:[optimize_0plus] 函数只是众多算术和布尔表达式优化的方法之一。 请编写一个更加聪明的优化器并证明它的正确性。(最容易的方法就是从小处着手: 一开始只添加单个简单的优化并证明它的正确性,然后逐渐增加其它更有趣的优化。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** 定义新的策略记法 *) @@ -449,7 +448,7 @@ Proof. intros. omega. Qed. -(** (注意本文件顶部 [Require Import Coq.omega.Omega.]。)*) +(** (注意本文件顶部 [From Coq Require Import omega.Omega.]。)*) (* ================================================================= *) (** ** 更多方便的策略 *) @@ -458,10 +457,10 @@ Qed. - [clear H]:从上下文中删除前提 [H]。 - - [subst x]:在上下文中查找假设 [x = e] 或 [e = x], + - [subst x]:对于变量 [x],在上下文中查找假设 [x = e] 或 [e = x], 将整个上下文和当前目标中的所有 [x] 替换为 [e] 并清除该假设。 - - [subst]:替换掉_'所有'_形如 [x = e] 或 [e = x] 的假设。 + - [subst]:替换掉_'所有'_形如 [x = e] 或 [e = x] 的假设(其中 [x] 为变量)。 - [rename... into...]:更改证明上下文中前提的名字。例如, 如果上下文中包含名为 [x] 的变量,那么 [rename x into y] @@ -477,7 +476,7 @@ Qed. 定义中查找可用于解决当前目标的构造子 [c]。如果找到了,那么其行为与 [apply c] 相同。 - 我们之后会看到它们的例子。 *) + 我们之后会看到所有它们的例子。 *) (* ################################################################# *) (** * 求值作为关系 *) @@ -505,6 +504,35 @@ Inductive aevalR : aexp -> nat -> Prop := aevalR e2 n2 -> aevalR (AMult e1 e2) (n1 * n2). +Module TooHardToRead. + +(* A small notational aside. We would previously have written the + definition of [aevalR] like this, with explicit names for the + hypotheses in each case: *) + +Inductive aevalR : aexp -> nat -> Prop := + | E_ANum n : + aevalR (ANum n) n + | E_APlus (e1 e2: aexp) (n1 n2: nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (APlus e1 e2) (n1 + n2) + | E_AMinus (e1 e2: aexp) (n1 n2: nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (AMinus e1 e2) (n1 - n2) + | E_AMult (e1 e2: aexp) (n1 n2: nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (AMult e1 e2) (n1 * n2). + +(** Instead, we've chosen to leave the hypotheses anonymous, just + giving their types. This style gives us less control over the + names that Coq chooses during proofs involving [aevalR], but it + makes the definition itself quite a bit lighter. *) + +End TooHardToRead. + (** 如果 [aevalR] 有中缀记法的话会很方便。我们用 [e \\ n] 表示算术表达式 [e] 求值为 [n]。 *) @@ -521,16 +549,16 @@ End aevalR_first_try. 具体做法是,我们先“保留”该记法,然后在给出定义的同时声明它的意义。*) -Reserved Notation "e '\\' n" (at level 50, left associativity). +Reserved Notation "e '\\' n" (at level 90, left associativity). Inductive aevalR : aexp -> nat -> Prop := - | E_ANum n : + | E_ANum (n : nat) : (ANum n) \\ n - | E_APlus e1 e2 n1 n2 : + | E_APlus (e1 e2 : aexp) (n1 n2 : nat) : (e1 \\ n1) -> (e2 \\ n2) -> (APlus e1 e2) \\ (n1 + n2) - | E_AMinus 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 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. @@ -554,7 +582,7 @@ Inductive aevalR : aexp -> nat -> Prop := e1 \\ n1 e2 \\ n2 - -------------------- (E_APlus) + -------------------- (E_APlus) APlus e1 e2 \\ n1+n2 *) @@ -588,6 +616,27 @@ Inductive aevalR : aexp -> nat -> Prop := AMult e1 e2 \\ n1*n2 *) +(** **** 练习:1 星, standard, optional (beval_rules) + + 下面是 Coq 中 [beval] 函数的定义: + + Fixpoint beval (e : bexp) : bool := + match e with + | BTrue => true + | BFalse => false + | BEq a1 a2 => (aeval a1) =? (aeval a2) + | BLe a1 a2 => (aeval a1) <=? (aeval a2) + | BNot b1 => negb (beval b1) + | BAnd b1 b2 => andb (beval b1) (beval b2) + end. + + 请用推理规则记法将布尔求值的定义写成关系的形式。 *) +(* 请在此处解答 *) + +(* 请勿修改下面这一行: *) +Definition manual_grade_for_beval_rules : option (nat*string) := None. +(** [] *) + (* ================================================================= *) (** ** 定义的等价关系 *) @@ -643,8 +692,9 @@ Proof. try apply IHa1; try apply IHa2; reflexivity. Qed. -(** **** 练习:3 星 (bevalR) *) -(** 用和 [aevalR] 同样的方式写出关系 [bevalR],并证明它等价于 [beval]。 *) +(** **** 练习:3 星, standard (bevalR) + + 用和 [aevalR] 同样的方式写出关系 [bevalR],并证明它等价于 [beval]。 *) Inductive bevalR: bexp -> bool -> Prop := (* 请在此处解答 *) @@ -668,31 +718,31 @@ End AExp. Module aevalR_division. -(** 例如,假设我们想要用除法运算来扩展算术运算: *) +(** 例如,假设我们想要用除法来扩展算术运算: *) Inductive aexp : Type := | ANum (n : nat) | APlus (a1 a2 : aexp) | AMinus (a1 a2 : aexp) | AMult (a1 a2 : aexp) - | ADiv (a1 a2 : aexp). (* <--- 新增 *) + | ADiv (a1 a2 : aexp). (* <--- 新增 *) (** 扩展 [aeval] 的定义来处理此讯算并不是很直观(我们要返回什么作为 [ADiv (ANum 5) (ANum 0)] 的结果?)。然而扩展 [aevalR] 却很直观。*) Reserved Notation "e '\\' n" - (at level 50, left associativity). + (at level 90, left associativity). Inductive aevalR : aexp -> nat -> Prop := - | E_ANum : forall (n:nat), + | E_ANum (n : nat) : (ANum n) \\ n - | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_APlus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (APlus a1 a2) \\ (n1 + n2) - | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_AMinus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (AMinus a1 a2) \\ (n1 - n2) - | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), + | E_AMult (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), + | E_ADiv (a1 a2 : aexp) (n1 n2 n3 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (n2 > 0) -> (mult n2 n3 = n1) -> (ADiv a1 a2) \\ n3 @@ -702,15 +752,15 @@ End aevalR_division. Module aevalR_extended. -(** 假设,我们转而想要用非确定性的数值生成器 [any] 来扩展算术运算, +(** 假设我们想要用非确定性的数值生成器 [any] 来扩展算术运算, 该生成器会在求值时产生任何数。(注意,这不同于在所有可能的数值中作出 - _'概率上的'_选择 -- 我们没有为结果指定任何具体的分布,只是说了 + _'概率上的'_选择 -- 我们没有为结果指定任何具体的概率分布,只是说了 _'可能的结果'_。) *) -Reserved Notation "e '\\' n" (at level 50, left associativity). +Reserved Notation "e '\\' n" (at level 90, left associativity). Inductive aexp : Type := - | AAny (* <--- NEW *) + | AAny (* <--- NEW *) | ANum (n : nat) | APlus (a1 a2 : aexp) | AMinus (a1 a2 : aexp) @@ -720,15 +770,15 @@ Inductive aexp : Type := 而扩展 [aevalR] 则无此问题... *) Inductive aevalR : aexp -> nat -> Prop := - | E_Any : forall (n:nat), - AAny \\ n (* <--- new *) - | E_ANum : forall (n:nat), + | E_Any (n : nat) : + AAny \\ n (* <--- NEW *) + | E_ANum (n : nat) : (ANum n) \\ n - | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_APlus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (APlus a1 a2) \\ (n1 + n2) - | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_AMinus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (AMinus a1 a2) \\ (n1 - n2) - | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), + | 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. @@ -736,7 +786,7 @@ where "a '\\' n" := (aevalR a n) : type_scope. End aevalR_extended. (** 这时你可能会问:默认情况下应该使用哪种风格? - 上面的例子表明关系式定义从根本上要比函数式的更加强大。 + 我们刚看到的例子表明关系式的定义反而比函数式的更加有用。 对于这种定义的东西不太容易用函数表达,或者确实_'不是'_函数的情况来说, 明显别无选择。但如果两种风格均可行呢? @@ -749,7 +799,7 @@ End aevalR_extended. 我们需要这些性质时必须显式地证明它们。 - 有了函数,我们还可以利用 Coq 的计算机制在证明过程中简化表达式。 - 此外,函数还可以直“提取为”OCaml 或 Haskell 的可执行代码。 *) + 此外,函数还可以直接从 Gallina“提取”出 OCaml 或 Haskell 的可执行代码。 *) (** 最终,选择视具体情况而定,或者只是品味问题。确实,在大型的 Coq 开发中,经常可以看到一个定义同时给出了函数式和关系式_'两种'_风格, @@ -784,7 +834,7 @@ Definition state := total_map nat. Inductive aexp : Type := | ANum (n : nat) - | AId (x : string) (* <----- 新增 *) + | AId (x : string) (* <--- 新增 *) | APlus (a1 a2 : aexp) | AMinus (a1 a2 : aexp) | AMult (a1 a2 : aexp). @@ -811,35 +861,53 @@ Inductive bexp : Type := | BAnd (b1 b2 : bexp). (* ================================================================= *) -(** ** 记法 *) -(** 要让 Imp 程序更易读写,我们引入了一些记法和隐式转换(Coercion)。 +(** ** 记法 + + 要让 Imp 程序更易读写,我们引入了一些记法和隐式转换(Coercion)。 - 在本章中你无需理解以下声明具体做了些什么。简言而之,Coq 中的 [Coercion] + 你无需理解以下声明具体做了些什么。简言而之,Coq 中的 [Coercion] 声明规定了一个函数(或构造子)可以被类型系统隐式地用于将一个输入类型的值 转换成输出类型的值。例如,[AId] 的转换声明在需要一个 [aexp] 时直接使用普通的字符串,该字符串会被隐式地用 [AId] 来包装。 *) (** 下列记法在具体的_'记法作用域'_中声明,以避免与其它符号相同的解释相冲突。 - 同样,你也暂时无需理解其中的细节。 *) + 同样,你暂时也无需理解其中的细节,但要意识到到我们为 [+]、[-]、[*]、[=]、[<=] + 等运算符定义了_'新的'_解释十分重要。 *) Coercion AId : string >-> aexp. Coercion ANum : nat >-> aexp. -Definition bool_to_bexp (b: bool) : bexp := + +Definition bool_to_bexp (b : bool) : bexp := if b then BTrue else BFalse. Coercion bool_to_bexp : bool >-> bexp. -Bind Scope aexp_scope with aexp. -Infix "+" := APlus : aexp_scope. -Infix "-" := AMinus : aexp_scope. -Infix "*" := AMult : aexp_scope. -Bind Scope bexp_scope with bexp. -Infix "<=" := BLe : bexp_scope. -Infix "=" := BEq : bexp_scope. -Infix "&&" := BAnd : bexp_scope. -Notation "'!' b" := (BNot b) (at level 60) : bexp_scope. +Bind Scope imp_scope with aexp. +Bind Scope imp_scope with bexp. +Delimit Scope imp_scope with imp. + +Notation "x + y" := (APlus x y) (at level 50, left associativity) : imp_scope. +Notation "x - y" := (AMinus x y) (at level 50, left associativity) : imp_scope. +Notation "x * y" := (AMult x y) (at level 40, left associativity) : imp_scope. +Notation "x <= y" := (BLe x y) (at level 70, no associativity) : imp_scope. +Notation "x = y" := (BEq x y) (at level 70, no associativity) : imp_scope. +Notation "x && y" := (BAnd x y) (at level 40, left associativity) : imp_scope. +Notation "'~' b" := (BNot b) (at level 75, right associativity) : imp_scope. (** 现在我们可以用 [3 + (X * 2)] 来代替 [APlus 3 (AMult X 2)] 了,同样可以用 - [true && !(X <= 4)] 来代替 [BAnd true (BNot (BLe X 4))] *) + [true && !(X <= 4)] 来代替 [BAnd true (BNot (BLe X 4))]。 *) + +Definition example_aexp := (3 + (X * 2))%imp : aexp. +Definition example_bexp := (true && ~(X <= 4))%imp : bexp. + +(** 强制转换有一点不便之处,即它会略微提高人类推导表达式类型的难度。 + 如果你感到有点困惑,请用 [Set Printing Coercions] 来查看具体发生了什么。 *) + +Set Printing Coercions. + +Print example_bexp. +(* ===> example_bexp = bool_to_bexp true && ~ (AId X <= ANum 4) *) + +Unset Printing Coercions. (* ================================================================= *) (** ** 求值 *) @@ -850,7 +918,7 @@ Notation "'!' b" := (BNot b) (at level 60) : bexp_scope. Fixpoint aeval (st : state) (a : aexp) : nat := match a with | ANum n => n - | AId x => st x (* <----- 新增 *) + | AId x => st x (* <--- 新增 *) | 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) @@ -866,28 +934,21 @@ Fixpoint beval (st : state) (b : bexp) : bool := | BAnd b1 b2 => andb (beval st b1) (beval st b2) end. -(** 我们为具体状态的全映射声明具体的记法,即使用 [{ --> 0 }] 作为空状态。 *) - -Notation "{ a --> x }" := - (t_update { --> 0 } a x) (at level 0). -Notation "{ a --> x ; b --> y }" := - (t_update ({ a --> x }) b y) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z }" := - (t_update ({ a --> x ; b --> y }) c z) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z ; d --> t }" := - (t_update ({ a --> x ; b --> y ; c --> z }) d t) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" := - (t_update ({ a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" := - (t_update ({ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 0). +(** 我们为具体状态的全映射声明具体的记法,即使用 [(_ !-> 0)] 作为空状态。 *) + +Definition empty_st := (_ !-> 0). + +(** 现在我们可以为“单例状态(singleton state)”添加新的记法了, + 即只有一个绑定到值的变量。 *) +Notation "a '!->' x" := (t_update empty_st a x) (at level 100). Example aexp1 : - aeval { X --> 5 } (3 + (X * 2)) + aeval (X !-> 5) (3 + (X * 2))%imp = 13. Proof. reflexivity. Qed. Example bexp1 : - beval { X --> 5 } (true && !(X <= 4)) + beval (X !-> 5) (true && ~(X <= 4))%imp = true. Proof. reflexivity. Qed. @@ -900,19 +961,18 @@ Proof. reflexivity. Qed. (* ================================================================= *) (** ** 语法 *) -(** 指令 [c] 可以用以下 BNF 文法非形式化地描述。(为了能够使用 Coq - 的记法机制来定义 Imp 语法,我们选择了这种略尴尬的具体语法。具体来说, - 我们使用了 [IFB] 来避免与表中库中的 [if] 记法相冲突。) +(** 指令 [c] 可以用以下 BNF 文法非形式化地描述。 - c ::= SKIP | x ::= a | c ;; c | IFB b THEN c ELSE c FI + c ::= SKIP | x ::= a | c ;; c | TEST b THEN c ELSE c FI | WHILE b DO c END -*) -(** + + (为了能够使用 Coq 的记法机制来定义 Imp 语法,我们选择了这种略尴尬的具体语法。 + 具体来说,我们使用了 [TEST] 来避免与表中库中的 [if] 记法相冲突。) 例如,下面是用 Imp 编写的阶乘: Z ::= X;; Y ::= 1;; - WHILE ! (Z = 0) DO + WHILE ~(Z = 0) DO Y ::= Y * Z;; Z ::= Z - 1 END @@ -930,30 +990,102 @@ Inductive com : Type := (** 至于表达式,我们可以用一些 [Notation] 声明来让 Imp 程序的读写更加方便。 *) -Bind Scope com_scope with com. +Bind Scope imp_scope with com. Notation "'SKIP'" := - CSkip : com_scope. + CSkip : imp_scope. Notation "x '::=' a" := - (CAss x a) (at level 60) : com_scope. + (CAss x a) (at level 60) : imp_scope. Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity) : com_scope. + (CSeq c1 c2) (at level 80, right associativity) : imp_scope. Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity) : com_scope. -Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := - (CIf c1 c2 c3) (at level 80, right associativity) : com_scope. - -(** 以下声明可以让这些记法在模式匹配中使用。 *) -Open Scope com_scope. + (CWhile b c) (at level 80, right associativity) : imp_scope. +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" := + (CIf c1 c2 c3) (at level 80, right associativity) : imp_scope. (** 例如,下面是个阶乘函数,写成 Coq 的形式化定义: *) Definition fact_in_coq : com := - Z ::= X;; + (Z ::= X;; Y ::= 1;; - WHILE ! (Z = 0) DO + WHILE ~(Z = 0) DO Y ::= Y * Z;; Z ::= Z - 1 - END. + END)%imp. + +(* ================================================================= *) +(** ** 脱糖记法 *) + +(** Coq 为管理日益复杂的工作对象提供了丰富的特性,例如隐式转换和记法。 + 然而,过度使用它们会产生繁杂的语法。为了教学,我们通常会用以下命令来 + “关闭”这些特性以获得对事物更加本质的描述: + + - [Unset Printing Notations](用 [Set Printing Notations] 撤销) + - [Set Printing Coercions](用 [Unset Printing Coercions] 撤销) + - [Set Printing All](用 [Unset Printing All] 撤销) + + 这些命令也可在证明过程中详述当前目标和上下文。 *) + +Unset Printing Notations. +Print fact_in_coq. +(* ===> + fact_in_coq = + CSeq (CAss Z X) + (CSeq (CAss Y (S O)) + (CWhile (BNot (BEq Z O)) + (CSeq (CAss Y (AMult Y Z)) + (CAss Z (AMinus Z (S O)))))) + : com *) +Set Printing Notations. + +Set Printing Coercions. +Print fact_in_coq. +(* ===> + fact_in_coq = + (Z ::= AId X;; + Y ::= ANum 1;; + WHILE ~ (AId Z = ANum 0) DO + Y ::= AId Y * AId Z;; + Z ::= AId Z - ANum 1 + END)%imp + : com *) +Unset Printing Coercions. + +(* ================================================================= *) +(** ** [Locate] 命令 *) + +(* ----------------------------------------------------------------- *) +(** *** 查询记法 *) + +(** 当遇到未知记法时,可使用 [Locate] 后跟一个包含其符号的_'字符串'_ + 来查看其可能的解释。 *) +Locate "&&". +(* ===> + Notation "x && y" := andb x y : bool_scope (default interpretation) *) + +Locate ";;". +(* ===> + Notation "c1 ;; c2" := CSeq c1 c2 : imp_scope (default interpretation) *) + +Locate "WHILE". +(* ===> + Notation "'WHILE' b 'DO' c 'END'" := CWhile b c : imp_scope + (default interpretation) *) + +(* ----------------------------------------------------------------- *) +(** *** 查询标识符 *) + +(** 当以标示符使用 [Locate] 时,它会打印作用域中同名的所有值的完成路径。 + 它很适合解决由变量覆盖所引起的问题。 *) +Locate aexp. +(* ===> + Inductive Top.aexp + Inductive Top.AExp.aexp + (shorter name to refer to it in current context is AExp.aexp) + Inductive Top.aevalR_division.aexp + (shorter name to refer to it in current context is aevalR_division.aexp) + Inductive Top.aevalR_extended.aexp + (shorter name to refer to it in current context is aevalR_extended.aexp) +*) (* ================================================================= *) (** ** 更多示例 *) @@ -971,12 +1103,12 @@ Definition subtract_slowly_body : com := X ::= X - 1. (* ----------------------------------------------------------------- *) -(** *** Loops *) +(** *** 循环 *) Definition subtract_slowly : com := - WHILE ! (X = 0) DO + (WHILE ~(X = 0) DO subtract_slowly_body - END. + END)%imp. Definition subtract_3_from_5_slowly : com := X ::= 3 ;; @@ -984,7 +1116,7 @@ Definition subtract_3_from_5_slowly : com := subtract_slowly. (* ----------------------------------------------------------------- *) -(** *** An infinite loop: *) +(** *** 无限循环: *) Definition loop : com := WHILE true DO @@ -1002,23 +1134,26 @@ Definition loop : com := (** 下面是一次为指令定义求值函数的尝试,我们忽略了 [WHILE] 的情况。 *) +(** 为了在模式匹配中使用记法,我们需要以下声明。 *) +Open Scope imp_scope. Fixpoint ceval_fun_no_while (st : state) (c : com) : state := match c with | SKIP => st | x ::= a1 => - st & { x --> (aeval st a1) } + (x !-> (aeval st a1) ; st) | c1 ;; c2 => let st' := ceval_fun_no_while st c1 in ceval_fun_no_while st' c2 - | IFB b THEN c1 ELSE c2 FI => + | TEST 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 (* 假装能用 *) end. +Close Scope imp_scope. (** 在 OCaml 或 Haskell 这类传统的函数式编程语言中,我们可以像下面这样添加 [WHILE] 的情况: @@ -1028,7 +1163,7 @@ Fixpoint ceval_fun_no_while (st : state) (c : com) ... | WHILE b DO c END => if (beval st b) - then ceval_fun st (c;; WHILE b DO c END) + then ceval_fun st (c ;; WHILE b DO c END) else st end. @@ -1059,7 +1194,7 @@ Fixpoint ceval_fun_no_while (st : state) (c : com) [any] 这样非确定性的特性,我们需要让求值的定义也是非确定性的 -- 即,它不仅会有不完全性,甚至还可以不是个函数! *) -(** 我们将使用记法 [c / st \\ st'] 来表示 [ceval] 这种关系:[c / st \\ st'] +(** 我们将使用记法 [st =[ c ]=> st'] 来表示 [ceval] 这种关系:[st =[ c ]=> st'] 表示在开始状态 [st] 下启动程序并在结束状态 [st'] 下产生结果。它可以读作: “[c] 将状态 [st] 变成 [st']”。 *) @@ -1068,111 +1203,116 @@ Fixpoint ceval_fun_no_while (st : state) (c : com) (** 下面是求值的非形式化定义,为了可读性表示成推理规则: - ---------------- (E_Skip) - SKIP / st \\ st + ----------------- (E_Skip) + st =[ SKIP ]=> st aeval st a1 = n - -------------------------------- (E_Ass) - x := a1 / st \\ st & { x --> n } + -------------------------------- (E_Ass) + st =[ x := a1 ]=> (x !-> n ; st) - c1 / st \\ st' - c2 / st' \\ st'' - ------------------- (E_Seq) - c1;;c2 / st \\ st'' + st =[ c1 ]=> st' + st' =[ c2 ]=> st'' + --------------------- (E_Seq) + st =[ c1;;c2 ]=> st'' beval st b1 = true - c1 / st \\ st' - ------------------------------------- (E_IfTrue) - IF b1 THEN c1 ELSE c2 FI / st \\ st' + st =[ c1 ]=> st' + --------------------------------------- (E_IfTrue) + st =[ TEST b1 THEN c1 ELSE c2 FI ]=> st' beval st b1 = false - c2 / st \\ st' - ------------------------------------- (E_IfFalse) - IF b1 THEN c1 ELSE c2 FI / st \\ st' + st =[ c2 ]=> st' + --------------------------------------- (E_IfFalse) + st =[ TEST b1 THEN c1 ELSE c2 FI ]=> st' beval st b = false - ------------------------------ (E_WhileFalse) - WHILE b DO c END / st \\ st + ----------------------------- (E_WhileFalse) + st =[ WHILE b DO c END ]=> st beval st b = true - c / st \\ st' - WHILE b DO c END / st' \\ st'' - --------------------------------- (E_WhileTrue) - WHILE b DO c END / st \\ st'' + st =[ c ]=> st' + st' =[ WHILE b DO c END ]=> st'' + -------------------------------- (E_WhileTrue) + st =[ WHILE b DO c END ]=> st'' *) (** 下面是它的形式化定义。请确保你理解了它是如何与以上推理规则相对应的。 *) -Reserved Notation "c1 '/' st '\\' st'" - (at level 40, st at level 39). +Reserved Notation "st '=[' c ']=>' st'" + (at level 40). Inductive ceval : com -> state -> state -> Prop := | E_Skip : forall st, - SKIP / st \\ st + st =[ SKIP ]=> st | E_Ass : forall st a1 n x, aeval st a1 = n -> - (x ::= a1) / st \\ st & { x --> n } + st =[ x ::= a1 ]=> (x !-> n ; st) | E_Seq : forall c1 c2 st st' st'', - c1 / st \\ st' -> - c2 / st' \\ st'' -> - (c1 ;; c2) / st \\ st'' + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> 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' + st =[ c1 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> 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' + st =[ c2 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' | E_WhileFalse : forall b st c, beval st b = false -> - (WHILE b DO c END) / st \\ st + st =[ WHILE b DO c END ]=> st | E_WhileTrue : 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'' + st =[ c ]=> st' -> + st' =[ WHILE b DO c END ]=> st'' -> + st =[ WHILE b DO c END ]=> st'' - where "c1 '/' st '\\' st'" := (ceval c1 st st'). + where "st =[ c ]=> st'" := (ceval c st st'). (** 将求值定义成关系而非函数的代价是,我们需要自己为某个程序求值成某种结束状态_'构造证明'_, 而不能只是交给 Coq 的计算机制去做了。 *) Example ceval_example1: - (X ::= 2;; - IFB X <= 1 + empty_st =[ + X ::= 2;; + TEST X <= 1 THEN Y ::= 3 ELSE Z ::= 4 - FI) - / { --> 0 } \\ { X --> 2 ; Z --> 4 }. + FI + ]=> (Z !-> 4 ; X !-> 2). Proof. (* 我们必须提供中间状态 *) - apply E_Seq with { X --> 2 }. + apply E_Seq with (X !-> 2). - (* 赋值指令 *) apply E_Ass. reflexivity. - (* if 指令 *) apply E_IfFalse. - reflexivity. - apply E_Ass. reflexivity. Qed. + reflexivity. + apply E_Ass. reflexivity. +Qed. -(** **** 练习:2 星 (ceval_example2) *) +(** **** 练习:2 星, standard (ceval_example2) *) Example ceval_example2: - (X ::= 0;; Y ::= 1;; Z ::= 2) / { --> 0 } \\ - { X --> 0 ; Y --> 1 ; Z --> 2 }. + empty_st =[ + X ::= 0;; Y ::= 1;; Z ::= 2 + ]=> (Z !-> 2 ; Y !-> 1 ; X !-> 0). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (pup_to_n) *) -(** 写一个 Imp 程序对从 [1] 到 [X] 进行求值(包括:将 [1 + 2 + ... + X]) 赋予变量 [Y]。 +(** **** 练习:3 星, standard, optional (pup_to_n) + + 写一个 Imp 程序对从 [1] 到 [X] 进行求值(包括:将 [1 + 2 + ... + X]) 赋予变量 [Y]。 证明此程序对于 [X] = [2] 会按预期执行(这可能比你预想的还要棘手)。 *) Definition pup_to_n : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Theorem pup_to_2_ceval : - pup_to_n / { X --> 2 } - \\ { X --> 2 ; Y --> 0 ; Y --> 2 ; X --> 1 ; Y --> 3 ; X --> 0 }. + (X !-> 2) =[ + pup_to_n + ]=> (X !-> 0 ; Y !-> 3 ; X !-> 1 ; Y !-> 2 ; Y !-> 0 ; X !-> 2). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -1189,8 +1329,8 @@ Proof. 实际上这不可能发生,因为 [ceval] _'确实'_是一个偏函数: *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. intros c st st1 st2 E1 E2. @@ -1232,8 +1372,8 @@ Proof. Theorem plus2_spec : forall st n st', st X = n -> - plus2 / st \\ st' -> - st' X = (n + 2). + st =[ plus2 ]=> st' -> + st' X = n + 2. Proof. intros st n st' HX Heval. @@ -1244,8 +1384,9 @@ Proof. inversion Heval. subst. clear Heval. simpl. apply t_update_eq. Qed. -(** **** 练习:3 星, recommended (XtimesYinZ_spec) *) -(** 叙述并证明 [XtimesYinZ] 的规范(Specification)。 *) +(** **** 练习:3 星, standard, recommended (XtimesYinZ_spec) + + 叙述并证明 [XtimesYinZ] 的规范(Specification)。 *) (* 请在此处解答 *) @@ -1253,12 +1394,12 @@ Proof. Definition manual_grade_for_XtimesYinZ_spec : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, recommended (loop_never_stops) *) +(** **** 练习:3 星, standard, recommended (loop_never_stops) *) Theorem loop_never_stops : forall st st', - ~(loop / st \\ st'). + ~(st =[ loop ]=> st'). Proof. intros st st' contra. unfold loop in contra. - remember (WHILE true DO SKIP END) as loopdef + remember (WHILE true DO SKIP END)%imp as loopdef eqn:Heqloopdef. (** 归纳讨论假设“[loopdef] 会终止”之构造,其中多数情形的矛盾显而易见, @@ -1267,9 +1408,11 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (no_whiles_eqv) *) -(** 考虑以下函数: *) +(** **** 练习:3 星, standard (no_whiles_eqv) + + 考虑以下函数: *) +Open Scope imp_scope. Fixpoint no_whiles (c : com) : bool := match c with | SKIP => @@ -1278,11 +1421,12 @@ Fixpoint no_whiles (c : com) : bool := true | c1 ;; c2 => andb (no_whiles c1) (no_whiles c2) - | IFB _ THEN ct ELSE cf FI => + | TEST _ THEN ct ELSE cf FI => andb (no_whiles ct) (no_whiles cf) | WHILE _ DO _ END => false end. +Close Scope imp_scope. (** 此断言只对没有 [WHILE] 循环的程序产生 [true]。请用 [Inductive] 写出一个性质 [no_whilesR] 使得 [no_whilesR c] 仅当 [c] 是个没有 @@ -1298,10 +1442,12 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (no_whiles_terminating) *) -(** 不涉及 [WHILE] 循环的 Imp 程序一定会终止。请陈述并证明定理 - [no_whiles_terminating] 来说明这一点。 *) -(** 按照你的偏好使用 [no_whiles] 或 [no_whilesR]。 *) +(** **** 练习:4 星, standard (no_whiles_terminating) + + 不涉及 [WHILE] 循环的 Imp 程序一定会终止。请陈述并证明定理 + [no_whiles_terminating] 来说明这一点。 + + 按照你的偏好使用 [no_whiles] 或 [no_whilesR]。 *) (* 请在此处解答 *) @@ -1312,8 +1458,9 @@ Definition manual_grade_for_no_whiles_terminating : option (nat*string) := None. (* ################################################################# *) (** * 附加练习 *) -(** **** 练习:3 星 (stack_compiler) *) -(** 旧式惠普计算器的编程语言类似于 Forth 和 Postscript,而其抽象机器类似于 +(** **** 练习:3 星, standard (stack_compiler) + + 旧式惠普计算器的编程语言类似于 Forth 和 Postscript,而其抽象机器类似于 Java 虚拟机,即所有对算术表达式的求值都使用_'栈'_来进行。例如,表达式 (2*3)+(3*(4-2)) @@ -1364,13 +1511,13 @@ Fixpoint s_execute (st : state) (stack : list nat) (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Example s_execute1 : - s_execute { --> 0 } [] + s_execute empty_st [] [SPush 5; SPush 3; SPush 1; SMinus] = [2; 5]. (* 请在此处解答 *) Admitted. Example s_execute2 : - s_execute { X --> 3 } [3;4] + s_execute (X !-> 3) [3;4] [SPush 4; SLoad X; SMult; SPlus] = [15; 4]. (* 请在此处解答 *) Admitted. @@ -1384,13 +1531,14 @@ Fixpoint s_compile (e : aexp) : list sinstr (** 在定义完 [s_compile] 之后,请证明以下示例来测试它是否起作用。 *) Example s_compile1 : - s_compile (X - (2 * Y)) + s_compile (X - (2 * Y))%imp = [SLoad X; SPush 2; SLoad Y; SMult; SMinus]. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced (stack_compiler_correct) *) -(** 现在我们将证明在之前练习中实现的编译器的正确性。记住当栈中的元素少于两个时, +(** **** 练习:4 星, advanced (stack_compiler_correct) + + 现在我们将证明在之前练习中实现的编译器的正确性。记住当栈中的元素少于两个时, 规范并未指定 [SPlus]、[SMinus] 或 [SMult] 指令的行为。 (为了让正确性证明更加容易,你可能需要返回去修改你的实现!) @@ -1403,8 +1551,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (short_circuit) *) -(** 大部分现代编程语言对布尔 [and] 运算提供了“短路求值”的方法:要对 +(** **** 练习:3 星, standard, optional (short_circuit) + + 大部分现代编程语言对布尔 [and] 运算提供了“短路求值”的方法:要对 [BAnd b1 b2] 进行求值,首先对 [b1] 求值。如果结果为 [false],那么整个 [BAnd] 表达式的求值就是 [false],而无需对 [b2] 求值。否则,[b2] 的求值结果就决定了 [BAnd] 表达式的值。 @@ -1414,17 +1563,19 @@ Proof. 在更大的语言中该表达式可能会发散,此时短路求值的 [BAnd] _'并不'_ 等价于原始版本,因为它能让更多程序终止。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) Module BreakImp. -(** **** 练习:4 星, advanced (break_imp) *) -(** 像 C 和 Java 这样的指令式语言通常会包含 [break] 或类似地语句来中断循环的执行。 +(** **** 练习:4 星, advanced (break_imp) + + 像 C 和 Java 这样的指令式语言通常会包含 [break] 或类似地语句来中断循环的执行。 在本练习中,我们考虑如何为 Imp 加上 [break]。首先,我们需要丰富语言的指令。 *) Inductive com : Type := | CSkip - | CBreak (* <-- 新增 *) + | CBreak (* <--- 新增 *) | CAss (x : string) (a : aexp) | CSeq (c1 c2 : com) | CIf (b : bexp) (c1 c2 : com) @@ -1440,7 +1591,7 @@ 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'" := +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" := (CIf c1 c2 c3) (at level 80, right associativity). (** 接着,我们需要定义 [BREAK] 的行为。非形式化地说,只要 [BREAK] @@ -1453,8 +1604,8 @@ Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := X ::= 0;; Y ::= 1;; - WHILE 0 <> Y DO - WHILE TRUE DO + WHILE ~(0 = Y) DO + WHILE true DO BREAK END;; X ::= 1;; @@ -1470,15 +1621,15 @@ Inductive result : Type := | SContinue | SBreak. -Reserved Notation "c1 '/' st '\\' s '/' st'" - (at level 40, st, s at level 39). +Reserved Notation "st '=[' c ']=>' st' '/' s" + (at level 40, st' at next level). -(** 直觉上说,[c / st \\ s / st'] 表示如果 [c] 在 [st] 状况下开始, +(** 直觉上说,[st =[ c ]=> st' / s] 表示如果 [c] 在 [st] 状况下开始, 它会在 [st'] 状态下终止,围绕它的最内层循环(或整个程序) 要么收到立即退出的信号([s = SBreak]),要么继续正常执行([s = SContinue])。 - “[c / st \\ s / st']”关系的定义非常类似于之前我们为一般求值关系 - ([c / st \\ st'])给出的定义 -- 我们只需要恰当地处理终止信号。 + “[st =[ c ]=> st' / s]”关系的定义非常类似于之前我们为一般求值关系 + ([st =[ c ]=> st'])给出的定义 -- 我们只需要恰当地处理终止信号。 - 若指令为 [SKIP],则状态不变,任何围绕它的循环继续正常执行。 @@ -1486,7 +1637,7 @@ Reserved Notation "c1 '/' st '\\' s '/' st'" - 若指令为赋值,则根据状态更新该变量绑定的值,并发出继续正常执行的信号。 - - 若指令为 [IFB b THEN c1 ELSE c2 FI] 的形式,则按照 Imp 的原始语义更新状态, + - 若指令为 [TEST b THEN c1 ELSE c2 FI] 的形式,则按照 Imp 的原始语义更新状态, 除此之外我们还要从被选择执行的分支中传播信号。 - 若指令为一系列 [c1 ;; c2],我们首先执行 [c1]。如果它产生了 @@ -1504,46 +1655,46 @@ Reserved Notation "c1 '/' st '\\' s '/' st'" Inductive ceval : com -> state -> result -> state -> Prop := | E_Skip : forall st, - CSkip / st \\ SContinue / st + st =[ CSkip ]=> st / SContinue (* 请在此处解答 *) - where "c1 '/' st '\\' s '/' st'" := (ceval c1 st s st'). + where "st '=[' c ']=>' st' '/' s" := (ceval c st s st'). (** 现在证明你定义的 [ceval] 的如下性质: *) Theorem break_ignore : forall c st st' s, - (BREAK;; c) / st \\ s / st' -> + st =[ BREAK;; c ]=> st' / s -> st = st'. Proof. (* 请在此处解答 *) Admitted. Theorem while_continue : forall b c st st' s, - (WHILE b DO c END) / st \\ s / st' -> + st =[ WHILE b DO c END ]=> st' / s -> s = SContinue. Proof. (* 请在此处解答 *) 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'. + st =[ c ]=> st' / SBreak -> + st =[ WHILE b DO c END ]=> st' / SContinue. Proof. (* 请在此处解答 *) Admitted. (** [] *) (** **** 练习:3 星, advanced, optional (while_break_true) *) Theorem while_break_true : forall b c st st', - (WHILE b DO c END) / st \\ SContinue / st' -> + st =[ WHILE b DO c END ]=> st' / SContinue -> beval st' b = true -> - exists st'', c / st'' \\ SBreak / st'. + exists st'', st'' =[ c ]=> st' / SBreak. Proof. (* 请在此处解答 *) Admitted. (** [] *) (** **** 练习:4 星, advanced, optional (ceval_deterministic) *) Theorem ceval_deterministic: forall (c:com) st st1 st2 s1 s2, - c / st \\ s1 / st1 -> - c / st \\ s2 / st2 -> + st =[ c ]=> st1 / s1 -> + st =[ c ]=> st2 / s2 -> st1 = st2 /\ s1 = s2. Proof. (* 请在此处解答 *) Admitted. @@ -1551,8 +1702,9 @@ Proof. (** [] *) End BreakImp. -(** **** 练习:4 星, optional (add_for_loop) *) -(** 为该语言添加 C 风格的 [for] 循环指令,更新 [ceval] 的定义来定义 +(** **** 练习:4 星, standard, optional (add_for_loop) + + 为该语言添加 C 风格的 [for] 循环指令,更新 [ceval] 的定义来定义 [for] 循环,按需添加 [for] 循环的情况使得本文件中的所有证明都被 Coq 所接受。 @@ -1561,7 +1713,9 @@ End BreakImp. (c) 一个在循环的每次迭代最后执行的语句,以及 (d) 一个创建循环体的语句 (你不必关心为 [for] 构造一个具体的记法,不过如果你喜欢,可以随意去做。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/ImpCEvalFun.html b/lf-current/ImpCEvalFun.html index 70cf52b8..13b13c6f 100644 --- a/lf-current/ImpCEvalFun.html +++ b/lf-current/ImpCEvalFun.html @@ -42,14 +42,14 @@

    ImpCEvalFunImp 的求值函数
    -

    一个无法完成的求值器

    +

    一个无法完成的求值器


    -Require Import Coq.omega.Omega.
    -Require Import Coq.Arith.Arith.
    +From Coq Require Import omega.Omega.
    +From Coq Require Import Arith.Arith.
    From LF Require Import Imp Maps.
    @@ -58,30 +58,34 @@

    ImpCEvalFunImp 的求值函数
    +Open Scope imp_scope.
    Fixpoint ceval_step1 (st : state) (c : com) : state :=
      match c with
        | SKIP
            st
        | l ::= a1
    -        st & { l --> (aeval st a1)}
    +        (l !-> aeval st a1 ; st)
        | c1 ;; c2
            let st' := ceval_step1 st c1 in
            ceval_step1 st' c2
    -    | IFB b THEN c1 ELSE c2 FI
    +    | TEST 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.
    +Close Scope imp_scope.
    Imp一章中所言,在 ML 或 Haskell 这类传统的函数式语言中, 我们可以这样处理 WHILE 指令:
    -    | WHILE b1 DO c1 END => if (beval st b1) then ceval_step1 st (c1;;
    -        WHILE b1 DO c1 END) else st
    +    | WHILE b1 DO c1 END =>
    +        if (beval st b1) then
    +          ceval_step1 st (c1;; WHILE b1 DO c1 END)
    +        else st
     
    Coq 不会接受此定义(它会提示出现错误 Error: Cannot guess decreasing argument of fix),因为我们想要定义的函数无需保证一定停机。 @@ -102,7 +106,7 @@

    ImpCEvalFunImp 的求值函数
    -

    一个计步的求值器

    +

    一个计步的求值器

    @@ -115,19 +119,20 @@

    ImpCEvalFunImp 的求值函数
    +Open Scope imp_scope.
    Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state :=
      match i with
    -  | O ⇒ { --> 0 }
    +  | Oempty_st
      | S i'
        match c with
          | SKIP
              st
          | l ::= a1
    -          st & { l --> (aeval st a1) }
    +          (l !-> aeval st a1 ; st)
          | c1 ;; c2
              let st' := ceval_step2 st c1 i' in
              ceval_step2 st' c2 i'
    -      | IFB b THEN c1 ELSE c2 FI
    +      | TEST b THEN c1 ELSE c2 FI
              if (beval st b)
                then ceval_step2 st c1 i'
                else ceval_step2 st c2 i'
    @@ -138,6 +143,7 @@

    ImpCEvalFunImp 的求值函数else st
        end
      end.
    +Close Scope imp_scope.

    @@ -154,6 +160,7 @@

    ImpCEvalFunImp 的求值函数
    +Open Scope imp_scope.
    Fixpoint ceval_step3 (st : state) (c : com) (i : nat)
                        : option state :=
      match i with
    @@ -163,13 +170,13 @@

    ImpCEvalFunImp 的求值函数SKIP ⇒
              Some st
          | l ::= a1
    -          Some (st & { l --> (aeval st a1) })
    +          Some (l !-> aeval st a1 ; st)
          | c1 ;; c2
              match (ceval_step3 st c1 i') with
              | Some st'ceval_step3 st' c2 i'
              | NoneNone
              end
    -      | IFB b THEN c1 ELSE c2 FI
    +      | TEST b THEN c1 ELSE c2 FI
              if (beval st b)
                then ceval_step3 st c1 i'
                else ceval_step3 st c2 i'
    @@ -182,6 +189,7 @@

    ImpCEvalFunImp 的求值函数else Some st
        end
      end.
    +Close Scope imp_scope.

    @@ -196,6 +204,7 @@

    ImpCEvalFunImp 的求值函数None ⇒ None
           end)
       (right associativity, at level 60).

    +Open Scope imp_scope.
    Fixpoint ceval_step (st : state) (c : com) (i : nat)
                        : option state :=
      match i with
    @@ -205,11 +214,11 @@

    ImpCEvalFunImp 的求值函数SKIP ⇒
              Some st
          | l ::= a1
    -          Some (st & { l --> (aeval st a1)})
    +          Some (l !-> aeval st a1 ; st)
          | c1 ;; c2
              LETOPT st' <== ceval_step st c1 i' IN
              ceval_step st' c2 i'
    -      | IFB b THEN c1 ELSE c2 FI
    +      | TEST b THEN c1 ELSE c2 FI
              if (beval st b)
                then ceval_step st c1 i'
                else ceval_step st c2 i'
    @@ -219,16 +228,17 @@

    ImpCEvalFunImp 的求值函数ceval_step st' c i'
              else Some st
        end
    -  end.

    +  end.
    +Close Scope imp_scope.

    Definition test_ceval (st:state) (c:com) :=
      match ceval_step st c 500 with
      | NoneNone
      | Some stSome (st X, st Y, st Z)
      end.

    (* Compute
    -     (test_ceval { --> 0 }
    +     (test_ceval empty_st
             (X ::= 2;;
    -          IFB (X <= 1)
    +          TEST (X <= 1)
                THEN Y ::= 3
                ELSE Z ::= 4
              FI)).
    @@ -237,7 +247,7 @@

    ImpCEvalFunImp 的求值函数
    -

    练习:2 星, recommended (pup_to_n)

    +

    练习:2 星, standard, recommended (pup_to_n)

    编写一个 Imp 程序对 1X 求和(即 1 + 2 + ... + X)并赋值给 Y。 确保你的解答能满足之后的测试。
    @@ -248,7 +258,7 @@

    ImpCEvalFunImp 的求值函数(* 

    Example pup_to_n_1 :
    -  test_ceval {X --> 5} pup_to_n
    +  test_ceval (X !-> 5) pup_to_n
      = Some (0, 15, 0).
    Proof. reflexivity. Qed.
    *)
    @@ -258,7 +268,7 @@

    ImpCEvalFunImp 的求值函数
    -

    练习:2 星, optional (peven)

    +

    练习:2 星, standard, optional (peven)

    编写一个 Imp 程序:该程序在 X 为偶数时将 Z 置为 0, 否则将 Z 置为 1。使用 test_ceval 测试你的程序。

    @@ -270,7 +280,7 @@

    ImpCEvalFunImp 的求值函数
    -

    关系求值 vs. 计步求值

    +

    关系求值 vs. 计步求值

    @@ -279,9 +289,9 @@

    ImpCEvalFunImp 的求值函数
    -Theorem ceval_step__ceval: c st st',
    -      ( i, ceval_step st c i = Some st') →
    -      c / st \\ st'.
    +Theorem ceval_step__ceval: c st st',
    +      (i, ceval_step st c i = Some st') →
    +      st =[ c ]⇒ st'.
    Proof.
    @@ -308,7 +318,7 @@

    ImpCEvalFunImp 的求值函数apply IHi'. simpl in H1. assumption.
            * (* Otherwise -- contradiction *)
              discriminate H1.

    -      + (* IFB *)
    +      + (* TEST *)
            destruct (beval st b) eqn:Heqr.
            * (* r = true *)
              apply E_IfTrue. rewrite Heqr. reflexivity.
    @@ -332,7 +342,7 @@

    ImpCEvalFunImp 的求值函数
    -

    练习:4 星 (ceval_step__ceval_inf)

    +

    练习:4 星, standard (ceval_step__ceval_inf)

    按照通常的模版写出 ceval_step__ceval 的非形式化证明, (对归纳定义的值进行分类讨论的模版,除了没有归纳假设外, 应当看起来与归纳证明相同。)不要简单地翻译形式化证明的步骤, @@ -348,7 +358,7 @@

    ImpCEvalFunImp 的求值函数
    -Theorem ceval_step_more: i1 i2 st st' c,
    +Theorem ceval_step_more: i1 i2 st st' c,
      i1i2
      ceval_step st c i1 = Some st'
      ceval_step st c i2 = Some st'.
    @@ -375,7 +385,7 @@

    ImpCEvalFunImp 的求值函数apply (IHi1' i2') in Hceval; try assumption.
          * (* st1'o = None *)
            discriminate Hceval.

    -    + (* IFB *)
    +    + (* TEST *)
          simpl in Hceval. simpl.
          destruct (beval st b); apply (IHi1' i2') in Hceval;
            assumption.

    @@ -392,15 +402,15 @@

    ImpCEvalFunImp 的求值函数
    -

    练习:3 星, recommended (ceval__ceval_step)

    +

    练习:3 星, standard, recommended (ceval__ceval_step)

    请完成以下证明。你会在某些地方用到 ceval_step_more 以及一些关于 plus 的基本事实。
    -Theorem ceval__ceval_step: c st st',
    -      c / st \\ st'
    -       i, ceval_step st c i = Some st'.
    +Theorem ceval__ceval_step: c st st',
    +      st =[ c ]⇒ st'
    +      i, ceval_step st c i = Some st'.
    Proof.
      intros c st st' Hce.
      induction Hce.
    @@ -410,9 +420,9 @@

    ImpCEvalFunImp 的求值函数
    -Theorem ceval_and_ceval_step_coincide: c st st',
    -      c / st \\ st'
    -  ↔ i, ceval_step st c i = Some st'.
    +Theorem ceval_and_ceval_step_coincide: c st st',
    +      st =[ c ]⇒ st'
    +  ↔ i, ceval_step st c i = Some st'.
    Proof.
      intros c st st'.
      split. apply ceval__ceval_step. apply ceval_step__ceval.
    @@ -420,7 +430,7 @@

    ImpCEvalFunImp 的求值函数
    -

    再论求值的确定性

    +

    再论求值的确定性

    @@ -429,9 +439,9 @@

    ImpCEvalFunImp 的求值函数
    -Theorem ceval_deterministic' : c st st1 st2,
    -     c / st \\ st1
    -     c / st \\ st2
    +Theorem ceval_deterministic' : c st st1 st2,
    +     st =[ c ]⇒ st1
    +     st =[ c ]⇒ st2
         st1 = st2.
    @@ -446,6 +456,9 @@

    ImpCEvalFunImp 的求值函数rewrite E1 in E2. inversion E2. reflexivity.
      omega. omega. Qed.

    + +
    +(* Sat Jan 26 15:14:46 UTC 2019 *)

    diff --git a/lf-current/ImpCEvalFun.v b/lf-current/ImpCEvalFun.v index 10e69417..424b0501 100644 --- a/lf-current/ImpCEvalFun.v +++ b/lf-current/ImpCEvalFun.v @@ -7,34 +7,38 @@ (* ################################################################# *) (** * 一个无法完成的求值器 *) -Require Import Coq.omega.Omega. -Require Import Coq.Arith.Arith. +From Coq Require Import omega.Omega. +From Coq Require Import Arith.Arith. From LF Require Import Imp Maps. (** 在初次为指令编写求值函数时,我们写出了如下忽略了 [WHILE] 的代码: *) +Open Scope imp_scope. Fixpoint ceval_step1 (st : state) (c : com) : state := match c with | SKIP => st | l ::= a1 => - st & { l --> (aeval st a1)} + (l !-> aeval st a1 ; st) | c1 ;; c2 => let st' := ceval_step1 st c1 in ceval_step1 st' c2 - | IFB b THEN c1 ELSE c2 FI => + | TEST 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. +Close Scope imp_scope. (** 如[Imp]一章中所言,在 ML 或 Haskell 这类传统的函数式语言中, 我们可以这样处理 [WHILE] 指令: - | WHILE b1 DO c1 END => if (beval st b1) then ceval_step1 st (c1;; - WHILE b1 DO c1 END) else st + | WHILE b1 DO c1 END => + if (beval st b1) then + ceval_step1 st (c1;; WHILE b1 DO c1 END) + else st Coq 不会接受此定义(它会提示出现错误 [Error: Cannot guess decreasing argument of fix]),因为我们想要定义的函数无需保证一定停机。 @@ -61,19 +65,20 @@ Fixpoint ceval_step1 (st : state) (c : com) : state := (我们也可以说当前的状态为求值器耗尽了汽油 -- 这无关紧要, 因为无论在哪种情况下结果都是错误的!) *) +Open Scope imp_scope. Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := match i with - | O => { --> 0 } + | O => empty_st | S i' => match c with | SKIP => st | l ::= a1 => - st & { l --> (aeval st a1) } + (l !-> aeval st a1 ; st) | c1 ;; c2 => let st' := ceval_step2 st c1 i' in ceval_step2 st' c2 i' - | IFB b THEN c1 ELSE c2 FI => + | TEST b THEN c1 ELSE c2 FI => if (beval st b) then ceval_step2 st c1 i' else ceval_step2 st c2 i' @@ -84,6 +89,7 @@ Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := else st end end. +Close Scope imp_scope. (** _'注意'_:很容易想到这里的索引 [i] 是用来计算“求值的步数”的。 然而我们仔细研究就会发现实际并非如此。例如,在串连的规则中,同一个 @@ -94,6 +100,7 @@ Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := 因为程序可能是正常停机,也可能是耗尽了汽油。我们的下下一个版本会返回一个 [option state] 而非只是一个 [state],这样我们就能区分正常和异常的停机了。 *) +Open Scope imp_scope. Fixpoint ceval_step3 (st : state) (c : com) (i : nat) : option state := match i with @@ -103,13 +110,13 @@ Fixpoint ceval_step3 (st : state) (c : com) (i : nat) | SKIP => Some st | l ::= a1 => - Some (st & { l --> (aeval st a1) }) + Some (l !-> aeval st a1 ; st) | 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 => + | TEST b THEN c1 ELSE c2 FI => if (beval st b) then ceval_step3 st c1 i' else ceval_step3 st c2 i' @@ -122,6 +129,7 @@ Fixpoint ceval_step3 (st : state) (c : com) (i : nat) else Some st end end. +Close Scope imp_scope. (** 我们可以引入一些辅助记法来隐藏对可选状态进行重复匹配的复杂工作, 从而提高此版本的可读性。 *) @@ -133,6 +141,7 @@ Notation "'LETOPT' x <== e1 'IN' e2" end) (right associativity, at level 60). +Open Scope imp_scope. Fixpoint ceval_step (st : state) (c : com) (i : nat) : option state := match i with @@ -142,11 +151,11 @@ Fixpoint ceval_step (st : state) (c : com) (i : nat) | SKIP => Some st | l ::= a1 => - Some (st & { l --> (aeval st a1)}) + Some (l !-> aeval st a1 ; st) | c1 ;; c2 => LETOPT st' <== ceval_step st c1 i' IN ceval_step st' c2 i' - | IFB b THEN c1 ELSE c2 FI => + | TEST b THEN c1 ELSE c2 FI => if (beval st b) then ceval_step st c1 i' else ceval_step st c2 i' @@ -157,6 +166,7 @@ Fixpoint ceval_step (st : state) (c : com) (i : nat) else Some st end end. +Close Scope imp_scope. Definition test_ceval (st:state) (c:com) := match ceval_step st c 500 with @@ -165,17 +175,18 @@ Definition test_ceval (st:state) (c:com) := end. (* Compute - (test_ceval { --> 0 } + (test_ceval empty_st (X ::= 2;; - IFB (X <= 1) + TEST (X <= 1) THEN Y ::= 3 ELSE Z ::= 4 FI)). ====> Some (2, 0, 4) *) -(** **** 练习:2 星, recommended (pup_to_n) *) -(** 编写一个 Imp 程序对 [1] 到 [X] 求和(即 [1 + 2 + ... + X])并赋值给 [Y]。 +(** **** 练习:2 星, standard, recommended (pup_to_n) + + 编写一个 Imp 程序对 [1] 到 [X] 求和(即 [1 + 2 + ... + X])并赋值给 [Y]。 确保你的解答能满足之后的测试。 *) Definition pup_to_n : com @@ -184,18 +195,20 @@ Definition pup_to_n : com (* Example pup_to_n_1 : - test_ceval {X --> 5} pup_to_n + test_ceval (X !-> 5) pup_to_n = Some (0, 15, 0). Proof. reflexivity. Qed. -*) -(** [] *) -(** **** 练习:2 星, optional (peven) *) -(** 编写一个 [Imp] 程序:该程序在 [X] 为偶数时将 [Z] 置为 [0], + [] *) + +(** **** 练习:2 星, standard, optional (peven) + + 编写一个 [Imp] 程序:该程序在 [X] 为偶数时将 [Z] 置为 [0], 否则将 [Z] 置为 [1]。使用 [test_ceval] 测试你的程序。 *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * 关系求值 vs. 计步求值 *) @@ -205,7 +218,7 @@ Proof. reflexivity. Qed. Theorem ceval_step__ceval: forall c st st', (exists i, ceval_step st c i = Some st') -> - c / st \\ st'. + st =[ c ]=> st'. Proof. intros c st st' H. inversion H as [i E]. @@ -234,7 +247,7 @@ Proof. * (* Otherwise -- contradiction *) discriminate H1. - + (* IFB *) + + (* TEST *) destruct (beval st b) eqn:Heqr. * (* r = true *) apply E_IfTrue. rewrite Heqr. reflexivity. @@ -256,9 +269,9 @@ Proof. injection H1. intros H2. rewrite <- H2. apply E_WhileFalse. apply Heqr. Qed. +(** **** 练习:4 星, standard (ceval_step__ceval_inf) -(** **** 练习:4 星 (ceval_step__ceval_inf) *) -(** 按照通常的模版写出 [ceval_step__ceval] 的非形式化证明, + 按照通常的模版写出 [ceval_step__ceval] 的非形式化证明, (对归纳定义的值进行分类讨论的模版,除了没有归纳假设外, 应当看起来与归纳证明相同。)不要简单地翻译形式化证明的步骤, 请让你的证明能够将主要想法传达给读者。 *) @@ -297,7 +310,7 @@ induction i1 as [|i1']; intros i2 st st' c Hle Hceval. * (* st1'o = None *) discriminate Hceval. - + (* IFB *) + + (* TEST *) simpl in Hceval. simpl. destruct (beval st b); apply (IHi1' i2') in Hceval; assumption. @@ -313,12 +326,13 @@ induction i1 as [|i1']; intros i2 st st' c Hle Hceval. * (* i1'o = None *) simpl in Hceval. discriminate Hceval. Qed. -(** **** 练习:3 星, recommended (ceval__ceval_step) *) -(** 请完成以下证明。你会在某些地方用到 [ceval_step_more] 以及一些关于 +(** **** 练习:3 星, standard, recommended (ceval__ceval_step) + + 请完成以下证明。你会在某些地方用到 [ceval_step_more] 以及一些关于 [<=] 和 [plus] 的基本事实。 *) Theorem ceval__ceval_step: forall c st st', - c / st \\ st' -> + st =[ c ]=> st' -> exists i, ceval_step st c i = Some st'. Proof. intros c st st' Hce. @@ -327,7 +341,7 @@ Proof. (** [] *) Theorem ceval_and_ceval_step_coincide: forall c st st', - c / st \\ st' + st =[ c ]=> st' <-> exists i, ceval_step st c i = Some st'. Proof. intros c st st'. @@ -341,8 +355,8 @@ Qed. 我们可以给出一种取巧的方式来证明求值_'关系'_是确定性的。 *) Theorem ceval_deterministic' : forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. intros c st st1 st2 He1 He2. @@ -355,3 +369,4 @@ Proof. rewrite E1 in E2. inversion E2. reflexivity. omega. omega. Qed. +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/ImpCEvalFunTest.v b/lf-current/ImpCEvalFunTest.v index a265f01c..449d22d5 100644 --- a/lf-current/ImpCEvalFunTest.v +++ b/lf-current/ImpCEvalFunTest.v @@ -84,3 +84,5 @@ Print Assumptions ceval__ceval_step. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:02 UTC 2019 *) diff --git a/lf-current/ImpParser.html b/lf-current/ImpParser.html index 147f08d4..beb55ef9 100644 --- a/lf-current/ImpParser.html +++ b/lf-current/ImpParser.html @@ -51,18 +51,18 @@

    ImpParser用 Coq 实现词法分析
    Set Warnings "-notation-overridden,-parsing".
    -Require Import Coq.Strings.String.
    -Require Import Coq.Strings.Ascii.
    -Require Import Coq.Arith.Arith.
    -Require Import Coq.Init.Nat.
    -Require Import Coq.Arith.EqNat.
    -Require Import Coq.Lists.List.
    +From Coq Require Import Strings.String.
    +From Coq Require Import Strings.Ascii.
    +From Coq Require Import Arith.Arith.
    +From Coq Require Import Init.Nat.
    +From Coq Require Import Arith.EqNat.
    +From Coq Require Import Lists.List.
    Import ListNotations.
    From LF Require Import Maps Imp.
    -

    内部结构

    +

    内部结构

    @@ -71,7 +71,7 @@

    ImpParser用 Coq 实现词法分析

    -

    词法分析

    +

    词法分析

    @@ -150,11 +150,11 @@

    ImpParser用 Coq 实现词法分析

    -

    语法分析

    +

    语法分析

    -

    带错误的可选值

    +

    带错误的可选值

    @@ -174,22 +174,23 @@

    ImpParser用 Coq 实现词法分析

    -Notation "'DO' ( x , y ) <== e1 ; e2"
    +Notation "' p <- e1 ;; e2"
       := (match e1 with
    -         | SomeE (x,y) ⇒ e2
    -         | NoneE errNoneE err
    +       | SomeE pe2
    +       | NoneE errNoneE err
           end)
    -   (right associativity, at level 60).

    -Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3"
    +   (right associativity, p pattern, at level 60, e1 at next level).

    +Notation "'TRY' ' p <- e1 ;; e2 'OR' e3"
       := (match e1 with
    -         | SomeE (x,y) ⇒ e2
    -         | NoneE erre3
    +       | SomeE pe2
    +       | NoneE _e3
           end)
    -   (right associativity, at level 60, e2 at next level).
    +   (right associativity, p pattern,
    +    at level 60, e1 at next level, e2 at next level).
    -

    用于构建语法分析器的通用组合子

    +

    用于构建语法分析器的通用组合子

    @@ -205,7 +206,7 @@

    ImpParser用 Coq 实现词法分析   | _, NoneE _
          SomeE ((rev acc), xs)
      | S steps', SomeE (t, xs') ⇒
    -      many_helper p (t::acc) steps' xs'
    +      many_helper p (t :: acc) steps' xs'
      end.

    @@ -241,11 +242,11 @@

    ImpParser用 Coq 实现词法分析
    Definition expect (t : token) : parser unit :=
    -  firstExpect t (fun xsSomeE(tt, xs)).
    +  firstExpect t (fun xsSomeE (tt, xs)).
    -

    一个 Imp 的递归下降语法分析器

    +

    一个 Imp 的递归下降语法分析器

    @@ -299,14 +300,15 @@

    ImpParser用 Coq 实现词法分析   match steps with
      | 0 ⇒ NoneE "Too many recursive calls"
      | S steps'
    -      DO (i, rest) <-- parseIdentifier xs ;
    +      TRY ' (i, rest) <- parseIdentifier xs ;;
              SomeE (AId i, rest)
    -      OR DO (n, rest) <-- parseNumber xs ;
    +      OR
    +      TRY ' (n, rest) <- parseNumber xs ;;
              SomeE (ANum n, rest)
    -                OR (DO (e, rest) <== firstExpect "("
    -                       (parseSumExp steps') xs;
    -          DO (u, rest') <== expect ")" rest ;
    -          SomeE(e,rest'))
    +      OR
    +      ' (e, rest) <- firstExpect "(" (parseSumExp steps') xs ;;
    +      ' (u, rest') <- expect ")" rest ;;
    +      SomeE (e,rest')
      end

    with parseProductExp (steps:nat)
    @@ -314,11 +316,9 @@

    ImpParser用 Coq 实现词法分析   match steps with
      | 0 ⇒ NoneE "Too many recursive calls"
      | S steps'
    -    DO (e, rest) <==
    -      parsePrimaryExp steps' xs ;
    -    DO (es, rest') <==
    -       many (firstExpect "*" (parsePrimaryExp steps'))
    -            steps' rest;
    +    ' (e, rest) <- parsePrimaryExp steps' xs ;;
    +    ' (es, rest') <- many (firstExpect "*" (parsePrimaryExp steps'))
    +                          steps' rest ;;
        SomeE (fold_left AMult es e, rest')
      end

    @@ -326,22 +326,22 @@

    ImpParser用 Coq 实现词法分析   match steps with
      | 0 ⇒ NoneE "Too many recursive calls"
      | S steps'
    -    DO (e, rest) <==
    -      parseProductExp steps' xs ;
    -    DO (es, rest') <==
    -      many (fun xs
    -        DO (e,rest') <--
    -           firstExpect "+"
    -             (parseProductExp steps') xs;
    -           SomeE ( (true, e), rest')
    -        OR DO (e,rest') <==
    -        firstExpect "-"
    -           (parseProductExp steps') xs;
    -            SomeE ( (false, e), rest'))
    -        steps' rest;
    +    ' (e, rest) <- parseProductExp steps' xs ;;
    +    ' (es, rest') <-
    +        many (fun xs
    +                TRY ' (e,rest') <-
    +                    firstExpect "+"
    +                                (parseProductExp steps') xs ;;
    +                    SomeE ( (true, e), rest')
    +                OR
    +                ' (e, rest') <-
    +                    firstExpect "-"
    +                                (parseProductExp steps') xs ;;
    +                SomeE ( (false, e), rest'))
    +        steps' rest ;;
          SomeE (fold_left (fun e0 term
                              match term with
    -                            (true, e) ⇒ APlus e0 e
    +                          | (true, e) ⇒ APlus e0 e
                              | (false, e) ⇒ AMinus e0 e
                              end)
                           es e,
    @@ -360,32 +360,33 @@

    ImpParser用 Coq 实现词法分析 match steps with
      | 0 ⇒ NoneE "Too many recursive calls"
      | S steps'
    -     DO (u,rest) <-- expect "true" xs;
    +     TRY ' (u,rest) <- expect "true" xs ;;
             SomeE (BTrue,rest)
    -     OR DO (u,rest) <-- expect "false" xs;
    +     OR
    +     TRY ' (u,rest) <- expect "false" xs ;;
             SomeE (BFalse,rest)
    -     OR DO (e,rest) <--
    -            firstExpect "!"
    -               (parseAtomicExp steps')
    -               xs;
    +     OR
    +     TRY ' (e,rest) <- firstExpect "¬"
    +                                   (parseAtomicExp steps')
    +                                   xs ;;
             SomeE (BNot e, rest)
    -     OR DO (e,rest) <--
    -              firstExpect "("
    -                (parseConjunctionExp steps') xs;
    -          (DO (u,rest') <== expect ")" rest;
    -              SomeE (e, rest'))
    -     OR DO (e, rest) <== parseProductExp steps' xs;
    -            (DO (e', rest') <--
    -              firstExpect "="
    -                (parseAExp steps') rest;
    -              SomeE (BEq e e', rest')
    -             OR DO (e', rest') <--
    -               firstExpect "≤"
    -                 (parseAExp steps') rest;
    -               SomeE (BLe e e', rest')
    -             OR
    -               NoneE
    -      "Expected '=' or '≤' after arithmetic expression")
    +     OR
    +     TRY ' (e,rest) <- firstExpect "("
    +                                   (parseConjunctionExp steps')
    +                                   xs ;;
    +         ' (u,rest') <- expect ")" rest ;;
    +         SomeE (e, rest')
    +     OR
    +     ' (e, rest) <- parseProductExp steps' xs ;;
    +     TRY ' (e', rest') <- firstExpect "="
    +                                  (parseAExp steps') rest ;;
    +         SomeE (BEq e e', rest')
    +     OR
    +     TRY ' (e', rest') <- firstExpect "≤"
    +                                      (parseAExp steps') rest ;;
    +         SomeE (BLe e e', rest')
    +     OR
    +     NoneE "Expected '=' or '≤' after arithmetic expression"
    end

    with parseConjunctionExp (steps:nat)
    @@ -393,12 +394,10 @@

    ImpParser用 Coq 实现词法分析   match steps with
      | 0 ⇒ NoneE "Too many recursive calls"
      | S steps'
    -    DO (e, rest) <==
    -      parseAtomicExp steps' xs ;
    -    DO (es, rest') <==
    -       many (firstExpect "&&"
    +    ' (e, rest) <- parseAtomicExp steps' xs ;;
    +    ' (es, rest') <- many (firstExpect "&&"
                   (parseAtomicExp steps'))
    -            steps' rest;
    +            steps' rest ;;
        SomeE (fold_left BAnd es e, rest')
      end.

    Definition parseBExp := parseConjunctionExp.

    @@ -412,10 +411,10 @@

    ImpParser用 Coq 实现词法分析   p 100 t.

    (*
    Eval compute in
    -  testParsing parseProductExp "x*y*(x*x)*x".
    +  testParsing parseProductExp "x.y.(x.x).x".

    Eval compute in
    -  testParsing parseConjunctionExp "not((x=x||x*x<=(x*x)*x)&&x=x".
    +  testParsing parseConjunctionExp "~(x=x&&x*x<=(x*x)*x)&&x=x".
    *)

    @@ -429,79 +428,114 @@

    ImpParser用 Coq 实现词法分析   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 "IFB" (parseBExp steps') xs;
    -       DO (c,rest') <==
    -         firstExpect "THEN"
    -           (parseSequencedCommand steps') rest;
    -       DO (c',rest'') <==
    -         firstExpect "ELSE"
    -           (parseSequencedCommand steps') rest';
    -       DO (u,rest''') <==
    -         expect "END" rest'';
    -       SomeE(IFB e THEN c ELSE c' FI, rest''')
    -    OR DO (e,rest) <--
    -         firstExpect "WHILE"
    -           (parseBExp steps') xs;
    -       DO (c,rest') <==
    -         firstExpect "DO"
    -           (parseSequencedCommand steps') rest;
    -       DO (u,rest'') <==
    -         expect "END" rest';
    -       SomeE(WHILE e DO c END, rest'')
    -    OR DO (i, rest) <==
    -         parseIdentifier xs;
    -       DO (e, rest') <==
    -         firstExpect ":=" (parseAExp steps') rest;
    -       SomeE(i ::= e, rest')
    -  end
    +    TRY ' (u, rest) <- expect "SKIP" xs ;;
    +        SomeE (SKIP%imp, rest)
    +    OR
    +    TRY ' (e,rest) <-
    +            firstExpect "TEST"
    +                        (parseBExp steps') xs ;;
    +        ' (c,rest') <-
    +            firstExpect "THEN"
    +                        (parseSequencedCommand steps') rest ;;
    +        ' (c',rest'') <-
    +            firstExpect "ELSE"
    +                        (parseSequencedCommand steps') rest' ;;
    +        ' (tt,rest''') <-
    +            expect "END" rest'' ;;
    +       SomeE(TEST e THEN c ELSE c' FI%imp, rest''')
    +    OR
    +    TRY ' (e,rest) <-
    +            firstExpect "WHILE"
    +                        (parseBExp steps') xs ;;
    +        ' (c,rest') <-
    +            firstExpect "DO"
    +                        (parseSequencedCommand steps') rest ;;
    +        ' (u,rest'') <-
    +            expect "END" rest' ;;
    +        SomeE(WHILE e DO c END%imp, rest'')
    +    OR
    +    TRY ' (i, rest) <- parseIdentifier xs ;;
    +        ' (e, rest') <- firstExpect "::=" (parseAExp steps') rest ;;
    +        SomeE ((i ::= e)%imp, rest')
    +    OR
    +        NoneE "Expecting a command"
    +end

    with parseSequencedCommand (steps:nat)
                               (xs : list token) :=
      match steps with
      | 0 ⇒ NoneE "Too many recursive calls"
      | S steps'
    -      DO (c, rest) <==
    -        parseSimpleCommand steps' xs;
    -      DO (c', rest') <--
    -        firstExpect ";;"
    -          (parseSequencedCommand steps') rest;
    -        SomeE(c ;; c', rest')
    -      OR
    -        SomeE(c, rest)
    +    ' (c, rest) <- parseSimpleCommand steps' xs ;;
    +    TRY ' (c', rest') <-
    +            firstExpect ";;"
    +                        (parseSequencedCommand steps') rest ;;
    +        SomeE ((c ;; c')%imp, rest')
    +    OR
    +    SomeE (c, rest)
      end.

    Definition bignumber := 1000.

    -Definition parse (str : string) : optionE (com * list token) :=
    +Definition parse (str : string) : optionE com :=
      let tokens := tokenize str in
    -  parseSequencedCommand bignumber tokens.
    +  match parseSequencedCommand bignumber tokens with
    +  | SomeE (c, []) ⇒ SomeE c
    +  | SomeE (_, t::_) ⇒ NoneE ("Trailing tokens remaining: " ++ t)
    +  | NoneE errNoneE err
    +  end.

    -

    示例

    +

    示例


    Example eg1 : parse "
    -  IFB x = y + 1 + 2 - y * 6 + 3 THEN
    -    x := x * 1;;
    -    y := 0
    +  TEST x = y + 1 + 2 - y * 6 + 3 THEN
    +    x ::= x * 1;;
    +    y ::= 0
      ELSE
        SKIP
      END "
    =
      SomeE (
    -     IFB "x" = "y" + 1 + 2 - "y" * 6 + 3 THEN
    -       "x" ::= "x" * 1;;
    -       "y" ::= 0
    -     ELSE
    -       SKIP
    -     FI,
    -     []).
    -Proof. reflexivity. Qed.
    +      TEST "x" = "y" + 1 + 2 - "y" * 6 + 3 THEN
    +        "x" ::= "x" * 1;;
    +        "y" ::= 0
    +      ELSE
    +        SKIP
    +      FI)%imp.
    +Proof. cbv. reflexivity. Qed.

    +Example eg2 : parse "
    +  SKIP;;
    +  z::=x*y*(x*x);;
    +  WHILE x=x DO
    +    TEST (z ≤ z*z) && ~(x = 2) THEN
    +      x ::= z;;
    +      y ::= z
    +    ELSE
    +      SKIP
    +    END;;
    +    SKIP
    +  END;;
    +  x::=z "
    +=
    +  SomeE (
    +      SKIP;;
    +      "z" ::= "x" * "y" * ("x" * "x");;
    +      WHILE "x" = "x" DO
    +        TEST ("z" ≤ "z" * "z") && ~("x" = 2) THEN
    +          "x" ::= "z";;
    +          "y" ::= "z"
    +        ELSE
    +          SKIP
    +        FI;;
    +        SKIP
    +      END;;
    +      "x" ::= "z")%imp.
    +Proof. cbv. reflexivity. Qed.

    +(* Sat Jan 26 15:14:46 UTC 2019 *)

    diff --git a/lf-current/ImpParser.v b/lf-current/ImpParser.v index a5e981c4..4d000d29 100644 --- a/lf-current/ImpParser.v +++ b/lf-current/ImpParser.v @@ -12,12 +12,12 @@ 但是大部分的读者大概只会粗略看一眼,然后跳到末尾的“例子”一节。 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Strings.String. -Require Import Coq.Strings.Ascii. -Require Import Coq.Arith.Arith. -Require Import Coq.Init.Nat. -Require Import Coq.Arith.EqNat. -Require Import Coq.Lists.List. +From Coq Require Import Strings.String. +From Coq Require Import Strings.Ascii. +From Coq Require Import Arith.Arith. +From Coq Require Import Init.Nat. +From Coq Require Import Arith.EqNat. +From Coq Require Import Lists.List. Import ListNotations. From LF Require Import Maps Imp. @@ -124,19 +124,20 @@ Arguments NoneE {X}. (** 加一些语法糖以便于编写嵌套的对 [optionE] 的匹配表达式。 *) -Notation "'DO' ( x , y ) <== e1 ; e2" +Notation "' p <- e1 ;; e2" := (match e1 with - | SomeE (x,y) => e2 - | NoneE err => NoneE err + | SomeE p => e2 + | NoneE err => NoneE err end) - (right associativity, at level 60). + (right associativity, p pattern, at level 60, e1 at next level). -Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3" +Notation "'TRY' ' p <- e1 ;; e2 'OR' e3" := (match e1 with - | SomeE (x,y) => e2 - | NoneE err => e3 + | SomeE p => e2 + | NoneE _ => e3 end) - (right associativity, at level 60, e2 at next level). + (right associativity, p pattern, + at level 60, e1 at next level, e2 at next level). (* ----------------------------------------------------------------- *) (** *** 用于构建语法分析器的通用组合子 *) @@ -153,7 +154,7 @@ Fixpoint many_helper {T} (p : parser T) acc steps xs := | _, NoneE _ => SomeE ((rev acc), xs) | S steps', SomeE (t, xs') => - many_helper p (t::acc) steps' xs' + many_helper p (t :: acc) steps' xs' end. (** 一个要求符合 [p] 零到多次的、指定步数的词法分析器: *) @@ -177,7 +178,7 @@ Definition firstExpect {T} (t : token) (p : parser T) (** 一个要求某个特定词法标记的语法分析器: *) Definition expect (t : token) : parser unit := - firstExpect t (fun xs => SomeE(tt, xs)). + firstExpect t (fun xs => SomeE (tt, xs)). (* ----------------------------------------------------------------- *) (** *** 一个 Imp 的递归下降语法分析器 *) @@ -222,14 +223,15 @@ Fixpoint parsePrimaryExp (steps:nat) match steps with | 0 => NoneE "Too many recursive calls" | S steps' => - DO (i, rest) <-- parseIdentifier xs ; + TRY ' (i, rest) <- parseIdentifier xs ;; SomeE (AId i, rest) - OR DO (n, rest) <-- parseNumber xs ; + OR + TRY ' (n, rest) <- parseNumber xs ;; SomeE (ANum n, rest) - OR (DO (e, rest) <== firstExpect "(" - (parseSumExp steps') xs; - DO (u, rest') <== expect ")" rest ; - SomeE(e,rest')) + OR + ' (e, rest) <- firstExpect "(" (parseSumExp steps') xs ;; + ' (u, rest') <- expect ")" rest ;; + SomeE (e,rest') end with parseProductExp (steps:nat) @@ -237,11 +239,9 @@ with parseProductExp (steps:nat) match steps with | 0 => NoneE "Too many recursive calls" | S steps' => - DO (e, rest) <== - parsePrimaryExp steps' xs ; - DO (es, rest') <== - many (firstExpect "*" (parsePrimaryExp steps')) - steps' rest; + ' (e, rest) <- parsePrimaryExp steps' xs ;; + ' (es, rest') <- many (firstExpect "*" (parsePrimaryExp steps')) + steps' rest ;; SomeE (fold_left AMult es e, rest') end @@ -249,22 +249,22 @@ with parseSumExp (steps:nat) (xs : list token) := match steps with | 0 => NoneE "Too many recursive calls" | S steps' => - DO (e, rest) <== - parseProductExp steps' xs ; - DO (es, rest') <== - many (fun xs => - DO (e,rest') <-- - firstExpect "+" - (parseProductExp steps') xs; - SomeE ( (true, e), rest') - OR DO (e,rest') <== - firstExpect "-" - (parseProductExp steps') xs; - SomeE ( (false, e), rest')) - steps' rest; + ' (e, rest) <- parseProductExp steps' xs ;; + ' (es, rest') <- + many (fun xs => + TRY ' (e,rest') <- + firstExpect "+" + (parseProductExp steps') xs ;; + SomeE ( (true, e), rest') + OR + ' (e, rest') <- + firstExpect "-" + (parseProductExp steps') xs ;; + SomeE ( (false, e), rest')) + steps' rest ;; SomeE (fold_left (fun e0 term => match term with - (true, e) => APlus e0 e + | (true, e) => APlus e0 e | (false, e) => AMinus e0 e end) es e, @@ -280,32 +280,33 @@ Fixpoint parseAtomicExp (steps:nat) match steps with | 0 => NoneE "Too many recursive calls" | S steps' => - DO (u,rest) <-- expect "true" xs; + TRY ' (u,rest) <- expect "true" xs ;; SomeE (BTrue,rest) - OR DO (u,rest) <-- expect "false" xs; + OR + TRY ' (u,rest) <- expect "false" xs ;; SomeE (BFalse,rest) - OR DO (e,rest) <-- - firstExpect "!" - (parseAtomicExp steps') - xs; + OR + TRY ' (e,rest) <- firstExpect "~" + (parseAtomicExp steps') + xs ;; SomeE (BNot e, rest) - OR DO (e,rest) <-- - firstExpect "(" - (parseConjunctionExp steps') xs; - (DO (u,rest') <== expect ")" rest; - SomeE (e, rest')) - OR DO (e, rest) <== parseProductExp steps' xs; - (DO (e', rest') <-- - firstExpect "=" - (parseAExp steps') rest; - SomeE (BEq e e', rest') - OR DO (e', rest') <-- - firstExpect "<=" - (parseAExp steps') rest; - SomeE (BLe e e', rest') - OR - NoneE - "Expected '=' or '<=' after arithmetic expression") + OR + TRY ' (e,rest) <- firstExpect "(" + (parseConjunctionExp steps') + xs ;; + ' (u,rest') <- expect ")" rest ;; + SomeE (e, rest') + OR + ' (e, rest) <- parseProductExp steps' xs ;; + TRY ' (e', rest') <- firstExpect "=" + (parseAExp steps') rest ;; + SomeE (BEq e e', rest') + OR + TRY ' (e', rest') <- firstExpect "<=" + (parseAExp steps') rest ;; + SomeE (BLe e e', rest') + OR + NoneE "Expected '=' or '<=' after arithmetic expression" end with parseConjunctionExp (steps:nat) @@ -313,12 +314,10 @@ with parseConjunctionExp (steps:nat) match steps with | 0 => NoneE "Too many recursive calls" | S steps' => - DO (e, rest) <== - parseAtomicExp steps' xs ; - DO (es, rest') <== - many (firstExpect "&&" + ' (e, rest) <- parseAtomicExp steps' xs ;; + ' (es, rest') <- many (firstExpect "&&" (parseAtomicExp steps')) - steps' rest; + steps' rest ;; SomeE (fold_left BAnd es e, rest') end. @@ -336,10 +335,10 @@ Definition testParsing {X : Type} (* Eval compute in - testParsing parseProductExp "x*y*(x*x)*x". + testParsing parseProductExp "x.y.(x.x).x". Eval compute in - testParsing parseConjunctionExp "not((x=x||x*x<=(x*x)*x)&&x=x". + testParsing parseConjunctionExp "~(x=x&&x*x<=(x*x)*x)&&x=x". *) (** 解析指令: *) @@ -349,74 +348,110 @@ Fixpoint parseSimpleCommand (steps:nat) 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 "IFB" (parseBExp steps') xs; - DO (c,rest') <== - firstExpect "THEN" - (parseSequencedCommand steps') rest; - DO (c',rest'') <== - firstExpect "ELSE" - (parseSequencedCommand steps') rest'; - DO (u,rest''') <== - expect "END" rest''; - SomeE(IFB e THEN c ELSE c' FI, rest''') - OR DO (e,rest) <-- - firstExpect "WHILE" - (parseBExp steps') xs; - DO (c,rest') <== - firstExpect "DO" - (parseSequencedCommand steps') rest; - DO (u,rest'') <== - expect "END" rest'; - SomeE(WHILE e DO c END, rest'') - OR DO (i, rest) <== - parseIdentifier xs; - DO (e, rest') <== - firstExpect ":=" (parseAExp steps') rest; - SomeE(i ::= e, rest') - end + TRY ' (u, rest) <- expect "SKIP" xs ;; + SomeE (SKIP%imp, rest) + OR + TRY ' (e,rest) <- + firstExpect "TEST" + (parseBExp steps') xs ;; + ' (c,rest') <- + firstExpect "THEN" + (parseSequencedCommand steps') rest ;; + ' (c',rest'') <- + firstExpect "ELSE" + (parseSequencedCommand steps') rest' ;; + ' (tt,rest''') <- + expect "END" rest'' ;; + SomeE(TEST e THEN c ELSE c' FI%imp, rest''') + OR + TRY ' (e,rest) <- + firstExpect "WHILE" + (parseBExp steps') xs ;; + ' (c,rest') <- + firstExpect "DO" + (parseSequencedCommand steps') rest ;; + ' (u,rest'') <- + expect "END" rest' ;; + SomeE(WHILE e DO c END%imp, rest'') + OR + TRY ' (i, rest) <- parseIdentifier xs ;; + ' (e, rest') <- firstExpect "::=" (parseAExp steps') rest ;; + SomeE ((i ::= e)%imp, rest') + OR + NoneE "Expecting a command" +end with parseSequencedCommand (steps:nat) (xs : list token) := match steps with | 0 => NoneE "Too many recursive calls" | S steps' => - DO (c, rest) <== - parseSimpleCommand steps' xs; - DO (c', rest') <-- - firstExpect ";;" - (parseSequencedCommand steps') rest; - SomeE(c ;; c', rest') - OR - SomeE(c, rest) + ' (c, rest) <- parseSimpleCommand steps' xs ;; + TRY ' (c', rest') <- + firstExpect ";;" + (parseSequencedCommand steps') rest ;; + SomeE ((c ;; c')%imp, rest') + OR + SomeE (c, rest) end. Definition bignumber := 1000. -Definition parse (str : string) : optionE (com * list token) := +Definition parse (str : string) : optionE com := let tokens := tokenize str in - parseSequencedCommand bignumber tokens. + match parseSequencedCommand bignumber tokens with + | SomeE (c, []) => SomeE c + | SomeE (_, t::_) => NoneE ("Trailing tokens remaining: " ++ t) + | NoneE err => NoneE err + end. (* ################################################################# *) (** * 示例 *) Example eg1 : parse " - IFB x = y + 1 + 2 - y * 6 + 3 THEN - x := x * 1;; - y := 0 + TEST x = y + 1 + 2 - y * 6 + 3 THEN + x ::= x * 1;; + y ::= 0 ELSE SKIP END " = SomeE ( - IFB "x" = "y" + 1 + 2 - "y" * 6 + 3 THEN - "x" ::= "x" * 1;; - "y" ::= 0 - ELSE - SKIP - FI, - []). -Proof. reflexivity. Qed. - + TEST "x" = "y" + 1 + 2 - "y" * 6 + 3 THEN + "x" ::= "x" * 1;; + "y" ::= 0 + ELSE + SKIP + FI)%imp. +Proof. cbv. reflexivity. Qed. + +Example eg2 : parse " + SKIP;; + z::=x*y*(x*x);; + WHILE x=x DO + TEST (z <= z*z) && ~(x = 2) THEN + x ::= z;; + y ::= z + ELSE + SKIP + END;; + SKIP + END;; + x::=z " += + SomeE ( + SKIP;; + "z" ::= "x" * "y" * ("x" * "x");; + WHILE "x" = "x" DO + TEST ("z" <= "z" * "z") && ~("x" = 2) THEN + "x" ::= "z";; + "y" ::= "z" + ELSE + SKIP + FI;; + SKIP + END;; + "x" ::= "z")%imp. +Proof. cbv. reflexivity. Qed. + +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/ImpParserTest.v b/lf-current/ImpParserTest.v index eed03e56..78c77b70 100644 --- a/lf-current/ImpParserTest.v +++ b/lf-current/ImpParserTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:01 UTC 2019 *) diff --git a/lf-current/ImpTest.v b/lf-current/ImpTest.v index 93a74520..29fd96b8 100644 --- a/lf-current/ImpTest.v +++ b/lf-current/ImpTest.v @@ -64,8 +64,8 @@ idtac " ". idtac "#> ceval_example2". idtac "Possible points: 2". check_type @ceval_example2 ( -((X ::= 0;; Y ::= 1;; Z ::= 2) / @Maps.t_empty nat 0 \\ - {X --> 0; Y --> 1; Z --> 2})). +(empty_st =[ X ::= 0;; Y ::= 1;; Z ::= 2 + ]=> @Maps.t_update nat (@Maps.t_update nat (X !-> 0) Y 1) Z 2)). idtac "Assumptions:". Abort. Print Assumptions ceval_example2. @@ -85,7 +85,7 @@ idtac " ". idtac "#> loop_never_stops". idtac "Possible points: 3". -check_type @loop_never_stops ((forall st st' : state, ~ loop / st \\ st')). +check_type @loop_never_stops ((forall st st' : state, ~ st =[ loop ]=> st')). idtac "Assumptions:". Abort. Print Assumptions loop_never_stops. @@ -118,7 +118,7 @@ idtac " ". idtac "#> s_execute1". idtac "Possible points: 0.5". check_type @s_execute1 ( -(s_execute (@Maps.t_empty nat 0) (@nil nat) +(s_execute empty_st (@nil nat) (SPush 5 :: (SPush 3 :: SPush 1 :: SMinus :: @nil sinstr)%list) = (2 :: 5 :: @nil nat)%list)). idtac "Assumptions:". @@ -130,7 +130,7 @@ idtac " ". idtac "#> s_execute2". idtac "Possible points: 0.5". check_type @s_execute2 ( -(s_execute {X --> 3} (3 :: (4 :: @nil nat)%list) +(s_execute (X !-> 3) (3 :: (4 :: @nil nat)%list) (SPush 4 :: (SLoad X :: SMult :: SPlus :: @nil sinstr)%list) = (15 :: 4 :: @nil nat)%list)). idtac "Assumptions:". @@ -245,3 +245,5 @@ Print Assumptions BreakImp.while_continue. idtac "---------- BreakImp.while_stops_on_break ---------". Print Assumptions BreakImp.while_stops_on_break. Abort. + +(* Sat Jan 26 15:15:00 UTC 2019 *) diff --git a/lf-current/IndPrinciples.html b/lf-current/IndPrinciples.html index 2c6aafa8..8af31c0d 100644 --- a/lf-current/IndPrinciples.html +++ b/lf-current/IndPrinciples.html @@ -45,7 +45,7 @@

    IndPrinciples归纳原理

    -

    基础

    +

    基础

    @@ -57,9 +57,9 @@

    IndPrinciples归纳原理

    Check nat_ind.
    (*  ===> nat_ind :
    -           forall P : nat -> Prop,
    -              P 0  ->
    -              (forall n : nat, P n -> P (S n))  ->
    +           forall P : nat -> Prop,
    +              P 0  ->
    +              (forall n : nat, P n -> P (S n))  ->
                  forall n : nat, P n  *)

    @@ -71,7 +71,7 @@

    IndPrinciples归纳原理

    -Theorem mult_0_r' : n:nat,
    +Theorem mult_0_r' : n:nat,
      n * 0 = 0.
    Proof.
      apply nat_ind.
    @@ -100,12 +100,12 @@

    IndPrinciples归纳原理

    nat_ind
    -

    练习:2 星, optional (plus_one_r')

    +

    练习:2 星, standard, optional (plus_one_r')

    请不使用 induction 策略来完成这个证明。
    -Theorem plus_one_r' : n:nat,
    +Theorem plus_one_r' : n:nat,
      n + 1 = S n.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -127,11 +127,11 @@

    IndPrinciples归纳原理

    -    t_ind :  P : t → Prop,
    +    t_ind : P : t → Prop,
                  ... case for c1 ... →
                  ... case for c2 ... → ...
                  ... case for cn ... →
    -               n : tP n +              n : tP n
    @@ -144,14 +144,14 @@

    IndPrinciples归纳原理

    yes
      | no.

    Check yesno_ind.
    -(* ===> yesno_ind : forall P : yesno -> Prop,
    -                      P yes  ->
    -                      P no  ->
    +(* ===> yesno_ind : forall P : yesno -> Prop,
    +                      P yes  ->
    +                      P no  ->
                          forall y : yesno, P y *)

    -

    练习:1 星, optional (rgb)

    +

    练习:1 星, standard, optional (rgb)

    请写出对这个数据类型 Coq 将会生成的归纳原理。在纸上或注释中写下你的答案, 然后同 Coq 打印的结果比较。
    @@ -178,15 +178,15 @@

    IndPrinciples归纳原理

    Check natlist_ind.
    (* ===> (除了一些变量被重命名了)
       natlist_ind :
    -      forall P : natlist -> Prop,
    -         P nnil  ->
    +      forall P : natlist -> Prop,
    +         P nnil  ->
             (forall (n : nat) (l : natlist),
    -            P l -> P (ncons n l)) ->
    +            P l -> P (ncons n l)) ->
             forall n : natlist, P n *)

    -

    练习:1 星, optional (natlist1)

    +

    练习:1 星, standard, optional (natlist1)

    假设我们写下的定义和上面的有一些区别:
    @@ -231,7 +231,7 @@

    IndPrinciples归纳原理

    -

    练习:1 星, optional (byntree_ind)

    +

    练习:1 星, standard, optional (byntree_ind)

    请写出对这个数据类型 Coq 将会生成的归纳原理。(与之前一样,在纸上或注释中写下你的答案, 然后同 Coq 打印的结果比较。)
    @@ -247,17 +247,17 @@

    IndPrinciples归纳原理

    -

    练习:1 星, optional (ex_set)

    +

    练习:1 星, standard, optional (ex_set)

    这是对一个归纳定义的集合的归纳原理。
          ExSet_ind :
    -          P : ExSet → Prop,
    -             ( b : boolP (con1 b)) →
    -             ( (n : nat) (e : ExSet), P e → P (con2 n e)) →
    -              e : ExSetP e +         P : ExSet → Prop,
    +             (b : boolP (con1 b)) →
    +             ((n : nat) (e : ExSet), P e → P (con2 n e)) →
    +             e : ExSetP e
    @@ -274,7 +274,7 @@

    IndPrinciples归纳原理

    -

    多态

    +

    多态

    @@ -302,10 +302,10 @@

    IndPrinciples归纳原理

          list_ind :
    -         (X : Type) (P : list X → Prop),
    +        (X : Type) (P : list X → Prop),
               P [] →
    -           ( (x : X) (l : list X), P l → P (x :: l)) →
    -            l : list XP l +           ((x : X) (l : list X), P l → P (x :: l)) →
    +           l : list XP l
    @@ -313,7 +313,7 @@

    IndPrinciples归纳原理

    X 时,返回特化在类型 list X 上的归纳原理。
    -

    练习:1 星, optional (tree)

    +

    练习:1 星, standard, optional (tree)

    请写出对这个数据类型 Coq 将会生成的归纳原理。同 Coq 打印的结果比较你的答案。
    @@ -328,45 +328,45 @@

    IndPrinciples归纳原理

    -

    练习:1 星, optional (mytype)

    +

    练习:1 星, standard, optional (mytype)

    请找到对应于以下归纳原理的归纳定义:
          mytype_ind :
    -         (X : Type) (P : mytype X → Prop),
    -            ( x : XP (constr1 X x)) →
    -            ( n : natP (constr2 X n)) →
    -            ( m : mytype XP m →
    -                n : natP (constr3 X m n)) →
    -             m : mytype XP m +        (X : Type) (P : mytype X → Prop),
    +            (x : XP (constr1 X x)) →
    +            (n : natP (constr2 X n)) →
    +            (m : mytype XP m →
    +               n : natP (constr3 X m n)) →
    +            m : mytype XP m
    -

    练习:1 星, optional (foo)

    +

    练习:1 星, standard, optional (foo)

    请找到对应于以下归纳原理的归纳定义:
          foo_ind :
    -         (X Y : Type) (P : foo X Y → Prop),
    -             ( x : XP (bar X Y x)) →
    -             ( y : YP (baz X Y y)) →
    -             ( f1 : nat → foo X Y,
    -               ( n : natP (f1 n)) → P (quux X Y f1)) →
    -              f2 : foo X YP f2 +        (X Y : Type) (P : foo X Y → Prop),
    +             (x : XP (bar X Y x)) →
    +             (y : YP (baz X Y y)) →
    +             (f1 : nat → foo X Y,
    +               (n : natP (f1 n)) → P (quux X Y f1)) →
    +             f2 : foo X YP f2
    -

    练习:1 星, optional (foo')

    +

    练习:1 星, standard, optional (foo')

    请考虑以下归纳定义:
    @@ -383,12 +383,12 @@

    IndPrinciples归纳原理

         foo'_ind :
    -         (X : Type) (P : foo' X → Prop),
    -              ( (l : list X) (f : foo' X),
    +        (X : Type) (P : foo' X → Prop),
    +              ((l : list X) (f : foo' X),
                        _______________________ →
                        _______________________   ) →
                 ___________________________________________ →
    -              f : foo' X________________________ +             f : foo' X________________________
    @@ -399,7 +399,7 @@

    IndPrinciples归纳原理

    -

    归纳假设

    +

    归纳假设

    @@ -412,10 +412,10 @@

    IndPrinciples归纳原理

    -        P : nat → Prop,
    +       P : nat → Prop,
                P 0  →
    -            ( n : natP n → P (S n))  →
    -             n : natP n +            (n : natP n → P (S n))  →
    +            n : natP n
    @@ -426,8 +426,8 @@

    IndPrinciples归纳原理

    通过命名这个表达式,我们可以让归纳证明更加明确。比如,除了陈述定理 - mult_0_r 为 “n, n * 0 = 0”,我们还可以写成 - “n, P_m0r n”,其中 O_m0r 定义为…… + mult_0_r 为 “ n, n * 0 = 0”,我们还可以写成 + “ n, P_m0r n”,其中 O_m0r 定义为……

    @@ -449,7 +449,7 @@

    IndPrinciples归纳原理

    -Theorem mult_0_r'' : n:nat,
    +Theorem mult_0_r'' : n:nat,
      P_m0r n.
    Proof.
      apply nat_ind.
    @@ -463,16 +463,16 @@

    IndPrinciples归纳原理

    这一步额外的命名步骤并不是我们在证明中通常会做的,但对一两个例子显式地 做这件事是由好处的,帮助我们清晰地看到哪个是归纳假设。 - 如果对 n 归纳来证明 n, P_m0r n(使用 induction + 如果对 n 归纳来证明 n, P_m0r n(使用 inductionapply nat_ind),可以看到第一个子目标要求我们证明 P_m0r 0 - (“P 对零成立”),而第二个子目标要求我们证明 n', P_m0r n' P_m0r (S n') + (“P 对零成立”),而第二个子目标要求我们证明 n', P_m0r n' P_m0r (S n') (也即,“PS n' 成立如果其对 n' 成立”,或者说,“PS 保持”)。 归纳假设是后一个蕴含式中的前提——假设 Pn' 成立,这是我们在证明 PS n' 的过程中允许使用的。
    -

    深入 induction 策略

    +

    深入 induction 策略

    @@ -512,7 +512,7 @@

    IndPrinciples归纳原理

    -Theorem plus_assoc' : n m p : nat,
    +Theorem plus_assoc' : n m p : nat,
      n + (m + p) = (n + m) + p.
    Proof.
      (* ……我们首先引入全部3个变量到上下文中,或者说是
    @@ -536,7 +536,7 @@

    IndPrinciples归纳原理

    -Theorem plus_comm' : n m : nat,
    +Theorem plus_comm' : n m : nat,
      n + m = m + n.
    Proof.
      induction n as [| n'].
    @@ -547,7 +547,7 @@

    IndPrinciples归纳原理

    请注意 induction 留下 m 仍然绑定在目标中——也即,我们在归纳证明的陈述 - 仍然是以 m 开始的。 + 仍然是以 m 开始的。
    @@ -556,7 +556,7 @@

    IndPrinciples归纳原理

    -Theorem plus_comm'' : n m : nat,
    +Theorem plus_comm'' : n m : nat,
      n + m = m + n.
    Proof.
      (* 这次让我们对 m 而非 n 进行归纳…… *)
    @@ -567,7 +567,7 @@

    IndPrinciples归纳原理

    -

    练习:1 星, optional (plus_explicit_prop)

    +

    练习:1 星, standard, optional (plus_explicit_prop)

    以上面 mult_0_r'' 的方式来重写 plus_assoc'plus_comm' 和它们的证明—— 也即,对于每个定理,给出一个明确的命题的 Definition,陈述定理并用归纳法证明这个 定义的命题。 @@ -580,27 +580,27 @@

    IndPrinciples归纳原理

    -

    Prop 中的归纳原理

    +

    Prop 中的归纳原理

    - 之前,我们仔细学习了 Coq 为归纳定义的集合生成的归纳原理。 像 ev + 之前,我们仔细学习了 Coq 为归纳定义的集合生成的归纳原理。 像 even 这样的归纳定义命题的归纳原理会复杂一点点。就全部归纳原理来说,我们想要 - 通过使用 ev 的归纳原理并归纳地考虑 ev 中所有可能的形式来证明一些东西。 + 通过使用 even 的归纳原理并归纳地考虑 even 中所有可能的形式来证明一些东西。 然而,直观地讲,我们想要证明的东西并不是关于证据的陈述,而是关于 数字的陈述:因此,我们想要让归纳原理允许通过对证据进行归纳来 证明关于数字的性质。
    - 比如,根据我们前面所讲,你可能会期待这样归纳定义的 ev…… + 比如,根据我们前面所讲,你可能会期待这样归纳定义的 even……
    -      Inductive ev : nat → Prop :=
    -      | ev_0 : ev 0
    -      | ev_SS :  n : natev n → ev (S (S n)). +      Inductive even : nat → Prop :=
    +      | ev_0 : even 0
    +      | ev_SS : n : nateven n → even (S (S n)).
    @@ -609,12 +609,12 @@

    IndPrinciples归纳原理

    -    ev_ind_max :  P : ( n : natev n → Prop),
    +    ev_ind_max : P : (n : nateven n → Prop),
             P O ev_0 →
    -         ( (m : nat) (E : ev m),
    +         ((m : nat) (E : even m),
                P m E →
                P (S (S m)) (ev_SS m E)) →
    -          (n : nat) (E : ev n),
    +         (n : nat) (E : even n),
             P n E
    @@ -624,7 +624,7 @@

    IndPrinciples归纳原理

      -
    • 因为 ev 被数字 n 所索引(任何 ev 的对象 E 都是某个数字 n +
    • 因为 even 被数字 n 所索引(任何 even 的对象 E 都是某个数字 n 是偶数的证据),命题 P 同时被 nE 所参数化——也即,被用于证明断言的 归纳原理涉同时及到数字和这个数字是偶数的证据。 @@ -632,7 +632,7 @@

      IndPrinciples归纳原理

      -
    • 由于有两种方法来给出偶数性质的证据(因为 ev 有两个构造子),应用归纳原理生成 +
    • 由于有两种方法来给出偶数性质的证据(因为 even 有两个构造子),应用归纳原理生成 了两个子目标:
      @@ -670,24 +670,24 @@

      IndPrinciples归纳原理

    -        P : nat → Prop,
    +       P : nat → Prop,
           ... →
    -        n : nat,
    +       n : nat,
           even n → P n
    - 出于这样的原因,Coq 实际上为 ev 生成了简化过的归纳原理: + 出于这样的原因,Coq 实际上为 even 生成了简化过的归纳原理:
    -Check ev_ind.
    +Check even_ind.
    (* ===> ev_ind
    -        : forall P : nat -> Prop,
    -          P 0 ->
    -          (forall n : nat, ev n -> P n -> P (S (S n))) ->
    +        : forall P : nat -> Prop,
    +          P 0 ->
    +          (forall n : nat, even n -> P n -> P (S (S n))) ->
              forall n : nat,
    -          ev n -> P n *)

    +          even n -> P n *)
    @@ -721,19 +721,19 @@

    IndPrinciples归纳原理

    正如期待的那样,我们可以不使用 induction 而直接应用 ev_ind。 - 比如,我们可以使用它来证明 ev'(那个在 IndProp 一章的练习中有点笨拙的偶数性质的定义) - 等价于更简洁的归纳定义 ev: + 比如,我们可以使用它来证明 even'(那个在 IndProp 一章的练习中有点笨拙的偶数性质的定义) + 等价于更简洁的归纳定义 even
    -Theorem ev_ev' : n, ev nev' n.
    +Theorem ev_ev' : n, even neven' n.
    Proof.
    -  apply ev_ind.
    +  apply even_ind.
      - (* ev_0 *)
    -    apply ev'_0.
    +    apply even'_0.
      - (* ev_SS *)
        intros m Hm IH.
    -    apply (ev'_sum 2 m).
    -    + apply ev'_2.
    +    apply (even'_sum 2 m).
    +    + apply even'_2.
        + apply IH.
    Qed.
    @@ -747,9 +747,9 @@

    IndPrinciples归纳原理

    -(* Inductive le : nat -> nat -> Prop :=
    +(* Inductive le : nat -> nat -> Prop :=
         | le_n : forall n, le n n
    -     | le_S : forall n m, (le n m) -> (le n (S m)). *)

    +     | le_S : forall n m, (le n m) -> (le n (S m)). *)

    @@ -770,14 +770,14 @@

    IndPrinciples归纳原理

    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 *)

    +(* ===>  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 *)

    -

    形式化 vs. 非形式化的归纳证明

    +

    形式化 vs. 非形式化的归纳证明

    @@ -826,7 +826,7 @@

    IndPrinciples归纳原理

    证据(也即,Prop 中归纳定义的东西)。
    -

    对归纳定义的集合进行归纳

    +

    对归纳定义的集合进行归纳

    @@ -929,7 +929,7 @@

    IndPrinciples归纳原理

    -

    对归纳定义的命题进行归纳

    +

    对归纳定义的命题进行归纳

    @@ -1012,6 +1012,10 @@

    IndPrinciples归纳原理

    +
    +
    + +(* Sat Jan 26 15:14:46 UTC 2019 *)
    diff --git a/lf-current/IndPrinciples.v b/lf-current/IndPrinciples.v index de0c5fed..df6f49b5 100644 --- a/lf-current/IndPrinciples.v +++ b/lf-current/IndPrinciples.v @@ -44,8 +44,9 @@ Proof. 相比于直接使用 [nat_ind] 这样的归纳原理,在实践中使用 [induction] 更加方便。 但重要的是认识到除了这一点变量名的管理工作,我们在做的其实就是应用 [nat_ind]。 *) -(** **** 练习:2 星, optional (plus_one_r') *) -(** 请不使用 [induction] 策略来完成这个证明。 *) +(** **** 练习:2 星, standard, optional (plus_one_r') + + 请不使用 [induction] 策略来完成这个证明。 *) Theorem plus_one_r' : forall n:nat, n + 1 = S n. @@ -79,8 +80,9 @@ Check yesno_ind. P no -> forall y : yesno, P y *) -(** **** 练习:1 星, optional (rgb) *) -(** 请写出对这个数据类型 Coq 将会生成的归纳原理。在纸上或注释中写下你的答案, +(** **** 练习:1 星, standard, optional (rgb) + + 请写出对这个数据类型 Coq 将会生成的归纳原理。在纸上或注释中写下你的答案, 然后同 Coq 打印的结果比较。 *) Inductive rgb : Type := @@ -105,15 +107,17 @@ Check natlist_ind. P l -> P (ncons n l)) -> forall n : natlist, P n *) -(** **** 练习:1 星, optional (natlist1) *) -(** 假设我们写下的定义和上面的有一些区别: *) +(** **** 练习:1 星, standard, optional (natlist1) + + 假设我们写下的定义和上面的有一些区别: *) Inductive natlist1 : Type := | nnil1 | nsnoc1 (l : natlist1) (n : nat). -(** 现在归纳原理会是什么呢? *) -(** [] *) +(** 现在归纳原理会是什么呢? + + [] *) (** 对于这些例子,我们可以总结出一般的规则: @@ -127,8 +131,9 @@ Inductive natlist1 : Type := 成立”。 *) -(** **** 练习:1 星, optional (byntree_ind) *) -(** 请写出对这个数据类型 Coq 将会生成的归纳原理。(与之前一样,在纸上或注释中写下你的答案, +(** **** 练习:1 星, standard, optional (byntree_ind) + + 请写出对这个数据类型 Coq 将会生成的归纳原理。(与之前一样,在纸上或注释中写下你的答案, 然后同 Coq 打印的结果比较。) *) Inductive byntree : Type := @@ -137,8 +142,9 @@ Inductive byntree : Type := | nbranch (yn : yesno) (t1 t2 : byntree). (** [] *) -(** **** 练习:1 星, optional (ex_set) *) -(** 这是对一个归纳定义的集合的归纳原理。 +(** **** 练习:1 星, standard, optional (ex_set) + + 这是对一个归纳定义的集合的归纳原理。 ExSet_ind : forall P : ExSet -> Prop, @@ -178,8 +184,9 @@ Inductive ExSet : Type := 请注意_'全部的'_归纳原理都被 [X] 所参数化。也即,[list_ind] 可认为是一个 多态函数,当被应用类型 [X] 时,返回特化在类型 [list X] 上的归纳原理。 *) -(** **** 练习:1 星, optional (tree) *) -(** 请写出对这个数据类型 Coq 将会生成的归纳原理。同 Coq 打印的结果比较你的答案。*) +(** **** 练习:1 星, standard, optional (tree) + + 请写出对这个数据类型 Coq 将会生成的归纳原理。同 Coq 打印的结果比较你的答案。*) Inductive tree (X:Type) : Type := | leaf (x : X) @@ -187,8 +194,9 @@ Inductive tree (X:Type) : Type := Check tree_ind. (** [] *) -(** **** 练习:1 星, optional (mytype) *) -(** 请找到对应于以下归纳原理的归纳定义: +(** **** 练习:1 星, standard, optional (mytype) + + 请找到对应于以下归纳原理的归纳定义: mytype_ind : forall (X : Type) (P : mytype X -> Prop), @@ -200,8 +208,9 @@ Check tree_ind. *) (** [] *) -(** **** 练习:1 星, optional (foo) *) -(** 请找到对应于以下归纳原理的归纳定义: +(** **** 练习:1 星, standard, optional (foo) + + 请找到对应于以下归纳原理的归纳定义: foo_ind : forall (X Y : Type) (P : foo X Y -> Prop), @@ -213,8 +222,9 @@ Check tree_ind. *) (** [] *) -(** **** 练习:1 星, optional (foo') *) -(** 请考虑以下归纳定义: *) +(** **** 练习:1 星, standard, optional (foo') + + 请考虑以下归纳定义: *) Inductive foo' (X:Type) : Type := | C1 (l : list X) (f : foo' X) @@ -343,47 +353,49 @@ Proof. - (* m = S m' *) simpl. rewrite <- IHm'. rewrite <- plus_n_Sm. reflexivity. Qed. -(** **** 练习:1 星, optional (plus_explicit_prop) *) -(** 以上面 [mult_0_r''] 的方式来重写 [plus_assoc'],[plus_comm'] 和它们的证明—— +(** **** 练习:1 星, standard, optional (plus_explicit_prop) + + 以上面 [mult_0_r''] 的方式来重写 [plus_assoc'],[plus_comm'] 和它们的证明—— 也即,对于每个定理,给出一个明确的命题的 [Definition],陈述定理并用归纳法证明这个 定义的命题。 *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * [Prop] 中的归纳原理 *) -(** 之前,我们仔细学习了 Coq 为归纳定义的_'集合'_生成的归纳原理。 像 [ev] +(** 之前,我们仔细学习了 Coq 为归纳定义的_'集合'_生成的归纳原理。 像 [even] 这样的归纳定义_'命题'_的归纳原理会复杂一点点。就全部归纳原理来说,我们想要 - 通过使用 [ev] 的归纳原理并归纳地考虑 [ev] 中所有可能的形式来证明一些东西。 + 通过使用 [even] 的归纳原理并归纳地考虑 [even] 中所有可能的形式来证明一些东西。 然而,直观地讲,我们想要证明的东西并不是关于_'证据'_的陈述,而是关于 _'数字'_的陈述:因此,我们想要让归纳原理允许通过对证据进行归纳来 证明关于数字的性质。 - 比如,根据我们前面所讲,你可能会期待这样归纳定义的 [ev]…… + 比如,根据我们前面所讲,你可能会期待这样归纳定义的 [even]…… - Inductive ev : nat -> Prop := - | ev_0 : ev 0 - | ev_SS : forall n : nat, ev n -> ev (S (S n)). + Inductive even : nat -> Prop := + | ev_0 : even 0 + | ev_SS : forall n : nat, even n -> even (S (S n)). ……并给我们下面这样的归纳原理…… - ev_ind_max : forall P : (forall n : nat, ev n -> Prop), + ev_ind_max : forall P : (forall n : nat, even n -> Prop), P O ev_0 -> - (forall (m : nat) (E : ev m), + (forall (m : nat) (E : even m), P m E -> P (S (S m)) (ev_SS m E)) -> - forall (n : nat) (E : ev n), + forall (n : nat) (E : even n), P n E ……因为: - - 因为 [ev] 被数字 [n] 所索引(任何 [ev] 的对象 [E] 都是某个数字 [n] + - 因为 [even] 被数字 [n] 所索引(任何 [even] 的对象 [E] 都是某个数字 [n] 是偶数的证据),命题 [P] 同时被 [n] 和 [E] 所参数化——也即,被用于证明断言的 归纳原理涉同时及到数字和这个数字是偶数的证据。 - - 由于有两种方法来给出偶数性质的证据(因为 [ev] 有两个构造子),应用归纳原理生成 + - 由于有两种方法来给出偶数性质的证据(因为 [even] 有两个构造子),应用归纳原理生成 了两个子目标: - 我们必须证明 [P] 对 [0] 和 [ev_0] 成立。 @@ -404,15 +416,15 @@ Proof. forall n : nat, even n -> P n - 出于这样的原因,Coq 实际上为 [ev] 生成了简化过的归纳原理: *) + 出于这样的原因,Coq 实际上为 [even] 生成了简化过的归纳原理: *) -Check ev_ind. +Check even_ind. (* ===> ev_ind : forall P : nat -> Prop, P 0 -> - (forall n : nat, ev n -> P n -> P (S (S n))) -> + (forall n : nat, even n -> P n -> P (S (S n))) -> forall n : nat, - ev n -> P n *) + even n -> P n *) (** 请特别注意,Coq 丢弃了命题 [P] 参数中的证据项 [E]。 *) @@ -426,17 +438,17 @@ Check ev_ind. - 对任意 [n],如果 [n] 是偶数且 [P] 对 [n] 成立,那么 [P] 对 [S (S n)] 成立。 *) (** 正如期待的那样,我们可以不使用 [induction] 而直接应用 [ev_ind]。 - 比如,我们可以使用它来证明 [ev'](那个在 [IndProp] 一章的练习中有点笨拙的偶数性质的定义) - 等价于更简洁的归纳定义 [ev]: *) -Theorem ev_ev' : forall n, ev n -> ev' n. + 比如,我们可以使用它来证明 [even'](那个在 [IndProp] 一章的练习中有点笨拙的偶数性质的定义) + 等价于更简洁的归纳定义 [even]: *) +Theorem ev_ev' : forall n, even n -> even' n. Proof. - apply ev_ind. + apply even_ind. - (* ev_0 *) - apply ev'_0. + apply even'_0. - (* ev_SS *) intros m Hm IH. - apply (ev'_sum 2 m). - + apply ev'_2. + apply (even'_sum 2 m). + + apply even'_2. + apply IH. Qed. @@ -580,3 +592,4 @@ Check le_ind. 因此,根据 [le_S],[n <= S o']。 [] *) +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/IndPrinciplesTest.v b/lf-current/IndPrinciplesTest.v index 7cb19cb2..ac8abd2d 100644 --- a/lf-current/IndPrinciplesTest.v +++ b/lf-current/IndPrinciplesTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:14:57 UTC 2019 *) diff --git a/lf-current/IndProp.html b/lf-current/IndProp.html index 6fc20778..40bf6110 100644 --- a/lf-current/IndProp.html +++ b/lf-current/IndProp.html @@ -40,17 +40,27 @@

    IndProp归纳定义的命题<

    -

    归纳定义的命题

    +

    归纳定义的命题

    - 在 Logic 一章中,我们学习了多种方式来书写命题,包括合取、析取和量词。 - 在本章中,我们引入新的方式:归纳定义的命题(Inductive Definitions)。 + 在 Logic 一章中,我们学习了多种方式来书写命题,包括合取、析取和存在量词。 + 在本章中,我们引入另一种新的方式:归纳定义(Inductive Definitions)
    - 请回想一下我们已经学过的两种方法来表达 n 是偶数: - (1) evenb n = true,以及 (2) k, n = double k 。 - 然而另一种可能是通过如下规则来建立 n 的偶数性质: + 在前面的章节中,我们已经见过两种表述 n 为偶数的方式了: + +
    + + (1) evenb n = true,以及 + +
    + + (2) k, n = double k。 + +
    + + 然而还有一种方式是通过如下规则来建立 n 的偶数性质:
    @@ -58,20 +68,20 @@

    IndProp归纳定义的命题<
  • 规则 ev_0: 0 是偶数。
  • -
  • 规则 ev_SS: 如果 n 是偶数, 那么 S (S n) 是偶数。 +
  • 规则 ev_SS: 如果 n 是偶数, 那么 S (S n) 也是偶数。
  • - 为了理解这样的偶数性质定义如何工作,我们可想象如何证明 4 是偶数。 + 为了理解这个新的偶数性质定义如何工作,我们可想象如何证明 4 是偶数。 根据规则 ev_SS,需要证明 2 是偶数。这时,只要证明 0 是偶数, 我们可继续通过规则 ev_SS 确保它成立。而使用规则 ev_0 可直接证明 0 是偶数。
    接下来的课程中,我们会看到很多类似方式定义的命题。 在非形式化的讨论中,使用轻量化的记法有助于阅读和书写。 -'推断规则(Inference Rules)是其中的一种: + 推断规则(Inference Rules)是其中的一种:
    @@ -84,12 +94,12 @@

    IndProp归纳定义的命题<

    - +

    ev 0even 0
    - + @@ -97,7 +107,7 @@

    IndProp归纳定义的命题<

    - +
    ev neven n (ev_SS)  

    ev (S (S n))even (S (S n))
    @@ -108,7 +118,7 @@

    IndProp归纳定义的命题< 若将前文所述的规则重新排版成推断规则,我们可以这样阅读它,如果线上方的 前提(premises)成立,那么线下方的结论(conclusion)成立。 - 比如,规则 ev_SS 读做如果 n 满足 ev,那么 S (S n) 也满足。 + 比如,规则 ev_SS 读做如果 n 满足 even,那么 S (S n) 也满足。 如果一条规则在线上方没有前提,则结论直接成立。
    @@ -120,12 +130,12 @@

    IndProp归纳定义的命题<
    -                             ------  (ev_0)
    -                              ev 0
    -                             ------ (ev_SS)
    -                              ev 2
    -                             ------ (ev_SS)
    -                              ev 4 +                             --------  (ev_0)
    +                              even 0
    +                             -------- (ev_SS)
    +                              even 2
    +                             -------- (ev_SS)
    +                              even 4
    @@ -135,25 +145,26 @@

    IndProp归纳定义的命题<
    - 为什么我们把这样的证明称之为“树”(而非其他,比如“栈”)? - 因为一般来说推断规则可以有多个前提。我们会在后面看到一些例子。 + (为什么我们把这样的证明称之为“树”(而非其他,比如“栈”)? + 因为一般来说推断规则可以有多个前提。我们很快就会看到一些例子。
    +

    偶数性的归纳定义

    基于上述,可将偶数性质的定义翻译为在 Coq 中使用 Inductive 声明的定义, 声明中每一个构造子对应一个推断规则:
    -Inductive ev : natProp :=
    -| ev_0 : ev 0
    -| ev_SS (n : nat) (H : ev n) : ev (S (S n)).
    +Inductive even : natProp :=
    +| ev_0 : even 0
    +| ev_SS (n : nat) (H : even n) : even (S (S n)).
    这个定义同之前其他 Inductive 的使用有一个重要的区别: - 它的结果并不是一个 Type ,而是一个将 nat 映射到 Prop 的函数——即关于数的性质。 - 注意我们曾见过结果也为函数的归纳定义,比如 list,其类型是 Type Type 。 - 值得注意的是,由于 ev 中出现在冒号右侧nat 参数是 未命名 的, + 我们所定义的并不是一个 Type,而是一个将 nat 映射到 Prop 的函数——即关于数的性质。 + 我们曾见过结果也是函数的归纳定义,比如 list,其类型是 Type Type 。 + 真正要关注的是,由于 even 中出现在冒号右侧nat 参数是 未命名 的, 这允许在不同的构造子类型中使用不同的值:例如 ev_0 类型中的 0 以及 ev_SS 类型中的 S (S n)。 @@ -161,33 +172,54 @@

    IndProp归纳定义的命题< 相反,list 的定义以全局方式命名了冒号左侧的参数 X, 强迫 nilcons 的结果为同一个类型(list X)。 - 如果在定义 ev 时我们将 nat 置于冒号左侧,会得到如下错误: + 如果在定义 even 时我们将 nat 置于冒号左侧,会得到如下错误:

    Fail Inductive wrong_ev (n : nat) : Prop :=
    | wrong_ev_0 : wrong_ev 0
    -| wrong_ev_SS : n, wrong_ev nwrong_ev (S (S n)).
    -(* ===> Error: A parameter of an inductive type n is not
    -        allowed to be used as a bound variable in the type
    -        of its constructor. *)

    +| wrong_ev_SS : wrong_ev nwrong_ev (S (S n)).
    +(* ===> Error: Last occurrence of "wrong_ev" must have "n"
    +        as 1st argument in "wrong_ev 0". *)

    -(“parameter” 是 Coq 中的一个术语来表示 Inductive 定义中冒号左侧的参数; - “index” 则指冒号右侧的参数。) +在 Inductive 定义中,类型构造子的冒号左侧的参数叫做形参(Parameter), + 而右侧的叫做索引(Index)。 + +
    + + 例如,在 Inductive list (X : Type) := ... 中,X 是一个形参;而在 + Inductive even : nat Prop := ... 中,未命名的 nat 参数是一个索引。 +
    + + 在 Coq 中,我们可以认为 even 定义了一个性质 ev : nat Prop,其包括原语定理 + ev_0 : even 0ev_SS : n, even n even (S (S n))。 +
    + + 该定义也可写作如下形式... + +
    + +
    +  Inductive even : nat → Prop :=
    +  | ev_0 : even 0
    +  | ev_SS : neven n → even (S (S n)). +
    + +
    +
    - 在 Coq 中,我们可以认为 ev 定义了一个性质 ev : nat Prop,其包括公理(primitive theorems) - ev_0 : ev 0ev_SS : n, ev n ev (S (S n))。 + ... 以便让 ev_SS 的类型更加直白。
    这些 “定理构造子” 等同于已经证明过的定理。 - 具体来说,我们可以使用 Coq 中的 apply 策略和规则名称来证明某个数的 ev 性质…… + 具体来说,我们可以使用 Coq 中的 apply 策略和规则名称来证明某个数的 even 性质……
    -Theorem ev_4 : ev 4.
    +Theorem ev_4 : even 4.
    Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed.
    @@ -196,16 +228,16 @@

    IndProp归纳定义的命题<

    -Theorem ev_4' : ev 4.
    +Theorem ev_4' : even 4.
    Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed.
    -我们同样可以对前提中使用到 ev 的定理进行证明。 +我们同样可以对前提中使用到 even 的定理进行证明。
    -Theorem ev_plus4 : n, ev nev (4 + n).
    +Theorem ev_plus4 : n, even neven (4 + n).
    Proof.
      intros n. simpl. intros Hn.
      apply ev_SS. apply ev_SS. apply Hn.
    @@ -216,12 +248,12 @@

    IndProp归纳定义的命题< 更一般地,我们可以证明以任意数乘 2 是偶数:
    -

    练习:1 星 (ev_double)

    +

    练习:1 星, standard (ev_double)

    -Theorem ev_double : n,
    -  ev (double n).
    +Theorem ev_double : n,
    +  even (double n).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -229,7 +261,7 @@

    IndProp归纳定义的命题<
    -

    在证明中使用证据

    +

    在证明中使用证据

    @@ -237,12 +269,12 @@

    IndProp归纳定义的命题<
    - 对 ev 而言,使用 Inductive 声明来引入 ev 不仅仅表示在 Coq + 对 even 而言,使用 Inductive 声明来引入 even 不仅仅表示在 Coq 中 ev_0ev_SS 这样的构造子是合法的方式来构造偶数证明的证据, 他们也是仅有的方式。
    - 换句话说,如果某人展示了对于 ev n 的证据 E,那么我们知道 E + 换句话说,如果某人展示了对于 even n 的证据 E,那么我们知道 E 必是二者其一:
    @@ -252,39 +284,42 @@

    IndProp归纳定义的命题<

  • Eev_SS n' E'(且 nS (S n'), E' 为 - ev n' 的证据). + even n' 的证据).
  • - 这样的形式暗示着,我们可以像分析归纳定义的数据结构一样分析形如 ev n + 这样的形式暗示着,我们可以像分析归纳定义的数据结构一样分析形如 even n 的假设;特别地,对于这类证据使用归纳(induction)分类讨论(case analysis)来进行论证也是可行的。让我们通过一些例子来学习实践中如何使用他们。
    -

    对证据进行反演

    +

    对证据进行反演

    - Suppose we are proving some fact involving a number n, and we - are given ev n as a hypothesis. We already know how to perform - case analysis on n using destruct or induction, generating - separate subgoals for the case where n = O and the case where n - = S n' for some n'. But for some proofs we may instead want to - analyze the evidence that ev n _directly_. As a tool, we can - prove our characterization of evidence for ev n, using destruct. + Suppose we are proving some fact involving a number n, and + we are given even n as a hypothesis. We already know how to + perform case analysis on n using destruct or induction, + generating separate subgoals for the case where n = O and the + case where n = S n' for some n'. But for some proofs we may + instead want to analyze the evidence that even n _directly_. As + a tool, we can prove our characterization of evidence for + even n, using destruct.
    Theorem ev_inversion :
    -   (n : nat), ev n
    -    (n = 0) ∨ ( m, n = S (S m) ∧ ev m).
    +  (n : nat), even n
    +    (n = 0) ∨ (n', n = S (S n') ∧ even n').
    Proof.
    -  intros n Hev.
    -  destruct Hev as [ | m Hm].
    -  - left. reflexivity.
    -  - right. m. split. reflexivity. apply Hm.
    +  intros n E.
    +  destruct E as [ | n' E'].
    +  - (* E = ev_0 : even 0 *)
    +    left. reflexivity.
    +  - (* E = ev_SS n' E' : even (S (S n')) *)
    +    right. n'. split. reflexivity. apply E'.
    Qed.
    @@ -293,13 +328,14 @@

    IndProp归纳定义的命题<

    -Theorem ev_minus2 : n,
    -  ev nev (pred (pred n)).
    +Theorem ev_minus2 : n,
    +  even neven (pred (pred n)).
    Proof.
      intros n E.
      destruct E as [| n' E'].
      - (* E = ev_0 *) simpl. apply ev_0.
    -  - (* E = ev_SS n' E' *) simpl. apply E'. Qed.
    +  - (* E = ev_SS n' E' *) simpl. apply E'.
    +Qed.
    @@ -307,8 +343,8 @@

    IndProp归纳定义的命题<

    -Theorem evSS_ev : n,
    -  ev (S (S n)) → ev n.
    +Theorem evSS_ev : n,
    +  even (S (S n)) → even n.
    @@ -333,15 +369,15 @@

    IndProp归纳定义的命题< 然而,这对于 evSS_ev 并没有帮助,因为被替换掉的 S (S n) 并没有在其他地方被使用。
    - We can patch this proof by replacing the goal ev n, which - does not mention the replaced term S (S n), by the equivalent - goal ev (pred (pred (S (S n)))), which does mention this - term, after which destruct can make progress. But it is + We could patch this proof by replacing the goal even n, + which does not mention the replaced term S (S n), by the + equivalent goal even (pred (pred (S (S n)))), which does mention + this term, after which destruct can make progress. But it is more straightforward to use our inversion lemma.

    -Theorem evSS_ev : n, ev (S (S n)) → ev n.
    +Theorem evSS_ev : n, even (S (S n)) → even n.
    Proof. intros n H. apply ev_inversion in H. destruct H.
     - discriminate H.
     - destruct H as [n' [Hnm Hev]]. injection Hnm.
    @@ -350,20 +386,20 @@

    IndProp归纳定义的命题<

    -Coq provides the inversion tactic, which does the work - of our inversion lemma and more besides. +Coq provides a tactic called inversion, which does the work of + our inversion lemma and more besides.
    The inversion tactic can detect (1) that the first case (n = 0) does not apply and (2) that the n' that appears in the - ev_SS case must be the same as n. It has an "as" - variant similar to destruct, allowing us to assign names - rather than have Coq choose them. + ev_SS case must be the same as n. It has an "as" variant + similar to destruct, allowing us to assign names rather than + have Coq choose them.
    -Theorem evSS_ev' : n,
    -  ev (S (S n)) → ev n.
    +Theorem evSS_ev' : n,
    +  even (S (S n)) → even n.
    Proof.
      intros n E.
      inversion E as [| n' E'].
    @@ -379,25 +415,25 @@

    IndProp归纳定义的命题< inversion lemma. For example:

    -Theorem one_not_even : ¬ ev 1.
    +Theorem one_not_even : ¬even 1.
    Proof.
      intros H. apply ev_inversion in H.
      destruct H as [ | [m [Hm _]]].
      - discriminate H.
      - discriminate Hm.
    Qed.

    -Theorem one_not_even' : ¬ ev 1.
    +Theorem one_not_even' : ¬even 1.
      intros H. inversion H. Qed.
    -

    练习:1 星 (inversion_practice)

    +

    练习:1 星, standard (inversion_practice)

    利用 inversion 策略证明以下结论。如想进一步练习,请使用反演定理证明之。
    -Theorem SSSSev__even : n,
    -  ev (S (S (S (S n)))) → ev n.
    +Theorem SSSSev__even : n,
    +  even (S (S (S (S n)))) → even n.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -406,13 +442,13 @@

    IndProp归纳定义的命题<
    -

    练习:1 星 (even5_nonsense)

    +

    练习:1 星, standard (even5_nonsense)

    请使用 inversion 策略证明以下结果。
    Theorem even5_nonsense :
    -  ev 5 → 2 + 2 = 9.
    +  even 5 → 2 + 2 = 9.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -421,22 +457,22 @@

    IndProp归纳定义的命题<
    - The inversion tactic is complex. When applied to equalities, as a - special case, it does the work of both discriminate and - injection. In addition, it carries out the intros and - rewrites that are typically necessary in the case of - injection. It can also be applied, more generally, - to analyzing evidence for inductively defined propositions. - As examples, we'll use it to reprove some theorems from Tactics.v. + The inversion tactic does quite a bit of work. When + applied to equalities, as a special case, it does the work of both + discriminate and injection. In addition, it carries out the + intros and rewrites that are typically necessary in the case + of injection. It can also be applied, more generally, to analyze + evidence for inductively defined propositions. As examples, we'll + use it to reprove some theorems from Tactics.v.
    -Theorem inversion_ex1 : (n m o : nat),
    +Theorem inversion_ex1 : (n m o : nat),
      [n; m] = [o; o] →
      [n] = [m].
    Proof.
      intros n m o H. inversion H. reflexivity. Qed.

    -Theorem inversion_ex2 : (n : nat),
    +Theorem inversion_ex2 : (n : nat),
      S n = O
      2 + 2 = 5.
    Proof.
    @@ -444,10 +480,10 @@

    IndProp归纳定义的命题<

    -inversion 的工作原理大致如下:假设 I 指代上下文中的假设 P, - 且 PInductive 归纳定义,则对于 P 每一种可能的构造,inversion I +inversion 的工作原理大致如下:假设 H 指代上下文中的假设 P, + 且 PInductive 归纳定义,则对于 P 每一种可能的构造,inversion H 各为其生成子目标。子目标中自相矛盾者被忽略,证明其余子命题即可得证原命题。 - 在证明子目标时,上下文中的 I 会替换为 P 的构造条件, + 在证明子目标时,上下文中的 H 会替换为 P 的构造条件, 即其构造子所需参数以及必要的等式关系。例如:倘若 ev nevSS 构造, 上下文中会引入参数 n'ev n',以及等式 S (S n') = n
    @@ -459,36 +495,36 @@

    IndProp归纳定义的命题<

    -Lemma ev_even_firsttry : n,
    -  ev n k, n = double k.
    +Lemma ev_even_firsttry : n,
    +  even nk, n = double k.
    Proof.
    (* 课上已完成 *)
    我们可以尝试使用分类讨论或对 n 进行归纳。 - 但由于 ev 在前提中出现,如同之前章节的一些例子,这种策略或许无法行得通。 - 如此我们似乎可以首先尝试对 ev 的证据进行反演。 + 但由于 even 在前提中出现,如同之前章节的一些例子,这种策略或许无法行得通。 + 如此我们似乎可以首先尝试对 even 的证据进行反演。 确实,第一个分类可以被平凡地证明。
      intros n E. inversion E as [| n' E'].
      - (* E = ev_0 *)
    -     0. reflexivity.
    +    0. reflexivity.
      - (* E = ev_SS n' E' *) simpl.
    -不幸地是,第二个分类要困难一些。我们需要证明 k, S (S n') = double k, - 但唯一可用的假设是 E',也即 ev n' 成立。但这对证明并没有帮助, +不幸地是,第二个分类要困难一些。我们需要证明 k, S (S n') = double k, + 但唯一可用的假设是 E',也即 even n' 成立。但这对证明并没有帮助, 我们似乎被卡住了,而对 E 进行分类讨论是徒劳的。
    如果仔细观察第二个(子)目标,我们可以发现一些有意思的事情: 对 E 进行分类讨论,我们可以把要证明的原始目标归约到另一个上, - 其涉及到另一个 ev 的证据: E'。 + 其涉及到另一个 even 的证据: E'。 形式化地说,我们可以通过展示如下证据来完成证明:
    @@ -497,7 +533,7 @@

    IndProp归纳定义的命题<
    -         k'n' = double k', +        k'n' = double k',
    @@ -509,15 +545,15 @@

    IndProp归纳定义的命题<

    -    assert (I : ( k', n' = double k') →
    -                ( k, S (S n') = double k)).
    -    { intros [k' Hk']. rewrite Hk'. (S k'). reflexivity. }
    +    assert (I : (k', n' = double k') →
    +                (k, S (S n') = double k)).
    +    { intros [k' Hk']. rewrite Hk'. (S k'). reflexivity. }
        apply I. (* 将原始目标归约到新目标上 *)

    Abort.
    -

    对证据进行归纳

    +

    对证据进行归纳

    @@ -531,38 +567,38 @@

    IndProp归纳定义的命题<
    - To prove a property of n holds for all number for which ev n - holds, we can use induction on ev n. This requires us to prove - two things, corresponding to the two cases of how ev n could - have been constructed. If it was constructed by ev_0, then n=0, - and the property must hold of 0. If it was constructed by ev_SS, - then the evidence of ev n is of the form ev_SS n' E', where - n = S (S n') and E' is evidence for ev n'. In this case, - the inductive hypothesis says that the property we are trying to prove - holds for n'. + To prove a property of n holds for all numbers for which even + n holds, we can use induction on even n. This requires us to + prove two things, corresponding to the two ways in which even n + could have been constructed. If it was constructed by ev_0, then + n=0, and the property must hold of 0. If it was constructed by + ev_SS, then the evidence of even n is of the form ev_SS n' + E', where n = S (S n') and E' is evidence for even n'. In + this case, the inductive hypothesis says that the property we are + trying to prove holds for n'.
    让我们再次尝试证明这个引理:

    -Lemma ev_even : n,
    -  ev n k, n = double k.
    +Lemma ev_even : n,
    +  even nk, n = double k.
    Proof.
      intros n E.
      induction E as [|n' E' IH].
      - (* E = ev_0 *)
    -     0. reflexivity.
    +    0. reflexivity.
      - (* E = ev_SS n' E'
           同时 IH : exists k', n' = double k' *)

        destruct IH as [k' Hk'].
    -    rewrite Hk'. (S k'). reflexivity.
    +    rewrite Hk'. (S k'). reflexivity.
    Qed.
    这里我们看到 Coq 对 E' 产生了 IH,而 E' 是唯一递归出现的 - ev 命题。 由于 E' 中涉及到 n',这个归纳假设是关于 n' 的, + even 命题。 由于 E' 中涉及到 n',这个归纳假设是关于 n' 的, 而非关于 n 或其他数字的。
    @@ -570,11 +606,11 @@

    IndProp归纳定义的命题<

    -Theorem ev_even_iff : n,
    -  ev n k, n = double k.
    +Theorem ev_even_iff : n,
    +  even nk, n = double k.
    Proof.
      intros n. split.
    -  - (* -> *) apply ev_even.
    +  - (* -> *) apply ev_even.
      - (* <- *) intros [k Hk]. rewrite Hk. apply ev_double.
    Qed.
    @@ -587,11 +623,11 @@

    IndProp归纳定义的命题< 下面的练习提供了一些简单的例子,来帮助你熟悉这项技术。
    -

    练习:2 星 (ev_sum)

    +

    练习:2 星, standard (ev_sum)

    -Theorem ev_sum : n m, ev nev mev (n + m).
    +Theorem ev_sum : n m, even neven meven (n + m).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -600,15 +636,16 @@

    IndProp归纳定义的命题<
    -

    练习:4 星, advanced, optional (evev)

    - 一般来说,有很多种方式来归纳地定义一个性质。比如说,下面是关于 ev 的另一种(蹩脚的)定义: +

    练习:4 星, advanced, optional (evenev)

    + 一般来说,有很多种方式来归纳地定义一个性质。比如说,下面是关于 + even 的另一种(蹩脚的)定义:
    -Inductive ev' : natProp :=
    -| ev'_0 : ev' 0
    -| ev'_2 : ev' 2
    -| ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m).
    +Inductive even' : natProp :=
    +| even'_0 : even' 0
    +| even'_2 : even' 2
    +| even'_sum n m (Hn : even' n) (Hm : even' m) : even' (n + m).
    @@ -616,7 +653,7 @@

    IndProp归纳定义的命题<

    -Theorem ev'_ev : n, ev' nev n.
    +Theorem even'_ev : n, even' neven n.
    Proof.
     (* 请在此处解答 *) Admitted.
    @@ -625,13 +662,13 @@

    IndProp归纳定义的命题<
    -

    练习:3 星, advanced, recommended (ev_ev__ev)

    +

    练习:3 星, advanced, recommended (ev_ev__ev)

    在本题中找到适合进行归纳的项需要一点技巧:
    -Theorem ev_ev__ev : n m,
    -  ev (n+m) → ev nev m.
    +Theorem ev_ev__ev : n m,
    +  even (n+m) → even neven m.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -640,13 +677,13 @@

    IndProp归纳定义的命题<
    -

    练习:3 星, optional (ev_plus_plus)

    +

    练习:3 星, standard, optional (ev_plus_plus)

    这个练习仅仅需要使用前述引理,而不需要使用归纳或分类讨论,尽管一些重写可能会比较乏味。
    -Theorem ev_plus_plus : n m p,
    -  ev (n+m) → ev (n+p) → ev (m+p).
    +Theorem ev_plus_plus : n m p,
    +  even (n+m) → even (n+p) → even (m+p).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -654,11 +691,11 @@

    IndProp归纳定义的命题<
    -

    归纳关系

    +

    归纳关系

    - 我们可以认为被一个数所参数化的命题(比如 ev)是一个性质,也即, + 我们可以认为被一个数所参数化的命题(比如 even)是一个性质,也即, 它定义了 nat 的一个子集,其中的数可以被证明满足此命题。 以同样的方式,我们可认为有两个参数的命题是一个关系,也即,它定义了一个 可满足此命题的序对集合。 @@ -684,7 +721,7 @@

    IndProp归纳定义的命题<

    -类似于证明 ev 这样的性质,使用 le_nle_S 构造子来证明关于 +类似于证明 even 这样的性质,使用 le_nle_S 构造子来证明关于 的事实遵循了同样的模式。我们可以对构造子使用 apply 策略来证明 目标 (比如证明 3≤33≤6),也可以使用 inversion 策略来从上下文中 的假设里抽取信息(比如证明 (2≤1) 2+2=5)。 @@ -733,12 +770,12 @@

    IndProp归纳定义的命题< Inductive next_nat : natnatProp :=
      | nn n : next_nat n (S n).

    Inductive next_even : natnatProp :=
    -  | ne_1 n : ev (S n) → next_even n (S n)
    -  | ne_2 n (H : ev (S (S n))) : next_even n (S (S n)).
    +  | ne_1 n : even (S n) → next_even n (S n)
    +  | ne_2 n (H : even (S (S n))) : next_even n (S (S n)).

    -

    练习:2 星, optional (total_relation)

    +

    练习:2 星, standard, optional (total_relation)

    请定一个二元归纳关系 total_relation 对每一个自然数的序对成立。
    @@ -750,7 +787,7 @@

    IndProp归纳定义的命题<
    -

    练习:2 星, optional (empty_relation)

    +

    练习:2 星, standard, optional (empty_relation)

    请定一个二元归纳关系 empty_relation 对自然数永远为假。
    @@ -770,48 +807,48 @@

    IndProp归纳定义的命题< In the second case, e2 = S n' for some n' for which le e1 n' holds, and it will replace instances of e2 with S n'. Doing inversion H will remove impossible cases and add generated - equalities to the context for further use. Doing induction H will, - in the second case, add the inductive hypothesis that the goal holds - when e2 is replaced with n'. + equalities to the context for further use. Doing induction H + will, in the second case, add the induction hypothesis that the + goal holds when e2 is replaced with n'.
    -

    练习:3 星, optional (le_exercises)

    +

    练习:3 星, standard, optional (le_exercises)

    这里展示一些 < 关系的事实,我们在接下来的课程中将会用到他们。 证明他们将会是非常有益的练习。
    -Lemma le_trans : m n o, mnnomo.
    +Lemma le_trans : m n o, mnnomo.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem O_le_n : n,
    +Theorem O_le_n : n,
      0 ≤ n.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem n_le_m__Sn_le_Sm : n m,
    +Theorem n_le_m__Sn_le_Sm : n m,
      nmS nS m.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem Sn_le_Sm__n_le_m : n m,
    +Theorem Sn_le_Sm__n_le_m : n m,
      S nS mnm.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem le_plus_l : a b,
    +Theorem le_plus_l : a b,
      aa + b.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem plus_lt : n1 n2 m,
    +Theorem plus_lt : n1 n2 m,
      n1 + n2 < m
      n1 < mn2 < m.
    Proof.
     unfold lt.
     (* 请在此处解答 *) Admitted.

    -Theorem lt_S : n m,
    +Theorem lt_S : n m,
      n < m
      n < S m.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem leb_complete : n m,
    +Theorem leb_complete : n m,
      n <=? m = truenm.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -822,7 +859,7 @@

    IndProp归纳定义的命题<

    -Theorem leb_correct : n m,
    +Theorem leb_correct : n m,
      nm
      n <=? m = true.
    Proof.
    @@ -834,7 +871,7 @@

    IndProp归纳定义的命题<

    -Theorem leb_true_trans : n m o,
    +Theorem leb_true_trans : n m o,
      n <=? m = truem <=? o = truen <=? o = true.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -844,11 +881,11 @@

    IndProp归纳定义的命题<
    -

    练习:2 星, optional (leb_iff)

    +

    练习:2 星, standard, optional (leb_iff)

    -Theorem leb_iff : n m,
    +Theorem leb_iff : n m,
      n <=? m = truenm.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -861,7 +898,7 @@

    IndProp归纳定义的命题<

    -

    练习:3 星, recommended (R_provability)

    +

    练习:3 星, standard, recommended (R_provability)

    通过同样的方式,我们可以定义三元关系、四元关系等。例如,考虑以下定义在自然数上的三元关系:
    @@ -924,14 +961,14 @@

    IndProp归纳定义的命题<
    -

    练习:3 星, optional (R_fact)

    +

    练习:3 星, standard, optional (R_fact)

    关系 R 其实编码了一个熟悉的函数。请找出这个函数,定义它并在 Coq 中证明他们等价。
    Definition fR : natnatnat
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    -Theorem R_equiv_fR : m n o, R m n ofR m n = o.
    +Theorem R_equiv_fR : m n o, R m n ofR m n = o.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -943,7 +980,7 @@

    IndProp归纳定义的命题<

    -

    练习:4 星, advanced (subsequence)

    +

    练习:2 星, advanced (subsequence)

    如果一个列表的所有元素以相同的顺序出现在另一个列表之中(但允许其中出现其他额外的元素), 我们把第一个列表称作第二个列表的子序列。 例如: @@ -1010,16 +1047,30 @@

    IndProp归纳定义的命题<

    -(* 请在此处解答 *)

    -(* 请勿修改下面这一行: *)
    -Definition manual_grade_for_subsequence : option (nat*string) := None.
    +Inductive subseq : list natlist natProp :=
    +(* 请在此处解答 *)
    +.

    +Theorem subseq_refl : (l : list nat), subseq l l.
    +Proof.
    +  (* 请在此处解答 *) Admitted.

    +Theorem subseq_app : (l1 l2 l3 : list nat),
    +  subseq l1 l2
    +  subseq l1 (l2 ++ l3).
    +Proof.
    +  (* 请在此处解答 *) Admitted.

    +Theorem subseq_trans : (l1 l2 l3 : list nat),
    +  subseq l1 l2
    +  subseq l2 l3
    +  subseq l1 l3.
    +Proof.
    +  (* 请在此处解答 *) Admitted.
    -

    练习:2 星, optional (R_provability2)

    +

    练习:2 星, standard, optional (R_provability2)

    假设我们在 Coq 中有如下定义:
    @@ -1027,8 +1078,8 @@

    IndProp归纳定义的命题<
        Inductive R : nat → list nat → Prop :=
          | c1 : R 0 []
    -      | c2 :  n lR n l → R (S n) (n :: l)
    -      | c3 :  n lR (S nl → R n l. +      | c2 : n lR n l → R (S n) (n :: l)
    +      | c3 : n lR (S nl → R n l.
    @@ -1056,17 +1107,17 @@

    IndProp归纳定义的命题<
    -

    案例学习:正则表达式

    +

    案例学习:正则表达式

    - 性质 ev 提供了一个简单的例子来展示归纳定义和其基础的推理技巧, - 但这还不是什么激动人心的东西——毕竟,ev 等价于我们之前见过的两个非归纳的定义, + 性质 even 提供了一个简单的例子来展示归纳定义和其基础的推理技巧, + 但这还不是什么激动人心的东西——毕竟,even 等价于我们之前见过的两个非归纳的定义, 而看起来归纳定义并没有提供什么好处。为了更好地展示归纳定义的表达能力, 我们继续使用它来建模计算机科学中的一个经典概念——正则表达式。
    - 正则表达式是用来描述字符串的一种简单语言,定义如下: + 正则表达式是用来描述字符串集合的一种简单语言,定义如下:
    @@ -1314,7 +1365,7 @@

    IndProp归纳定义的命题<

    -Example reg_exp_ex3 : ¬ ([1; 2] =~ Char 1).
    +Example reg_exp_ex3 : ¬([1; 2] =~ Char 1).
    Proof.
    @@ -1356,7 +1407,7 @@

    IndProp归纳定义的命题<
    Lemma MStar1 :
    -   T s (re : @reg_exp T) ,
    +  T s (re : @reg_exp T) ,
        s =~ re
        s =~ Star re.
    @@ -1375,16 +1426,16 @@

    IndProp归纳定义的命题< (请注意对 app_nil_r 的使用改变了目标,以此可匹配 MStarApp 所需要的形式。)
    -

    练习:3 星 (exp_match_ex1)

    +

    练习:3 星, standard (exp_match_ex1)

    下面的引理显示从形式化的归纳定义中可以得到本章开始的非形式化匹配规则。
    -Lemma empty_is_empty : T (s : list T),
    -  ¬ (s =~ EmptySet).
    +Lemma empty_is_empty : T (s : list T),
    +  ¬(s =~ EmptySet).
    Proof.
      (* 请在此处解答 *) Admitted.

    -Lemma MUnion' : T (s : list T) (re1 re2 : @reg_exp T),
    +Lemma MUnion' : T (s : list T) (re1 re2 : @reg_exp T),
      s =~ re1s =~ re2
      s =~ Union re1 re2.
    Proof.
    @@ -1398,8 +1449,8 @@

    IndProp归纳定义的命题<

    -Lemma MStar' : T (ss : list (list T)) (re : reg_exp),
    -  ( s, In s sss =~ re) →
    +Lemma MStar' : T (ss : list (list T)) (re : reg_exp),
    +  (s, In s sss =~ re) →
      fold app ss [] =~ Star re.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1409,12 +1460,12 @@

    IndProp归纳定义的命题<
    -

    练习:4 星, optional (reg_exp_of_list_spec)

    +

    练习:4 星, standard, optional (reg_exp_of_list_spec)

    请证明 reg_exp_of_list 满足以下规范:
    -Lemma reg_exp_of_list_spec : T (s1 s2 : list T),
    +Lemma reg_exp_of_list_spec : T (s1 s2 : list T),
      s1 =~ reg_exp_of_list s2s1 = s2.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1446,7 +1497,8 @@

    IndProp归纳定义的命题<   | App re1 re2re_chars re1 ++ re_chars re2
      | Union re1 re2re_chars re1 ++ re_chars re2
      | Star rere_chars re
    -  end.
    +  end.

    +(* /HIDEFROMHTML *)

    @@ -1454,7 +1506,7 @@

    IndProp归纳定义的命题<

    -Theorem in_re_match : T (s : list T) (re : reg_exp) (x : T),
    +Theorem in_re_match : T (s : list T) (re : reg_exp) (x : T),
      s =~ re
      In x s
      In x (re_chars re).
    @@ -1507,7 +1559,7 @@

    IndProp归纳定义的命题<

    -

    练习:4 星 (re_not_empty)

    +

    练习:4 星, standard (re_not_empty)

    请编写一个递归函数 re_not_empty 用来测试某个正则表达式是否会匹配一些字符串。 并证明你的函数是正确的。
    @@ -1515,8 +1567,8 @@

    IndProp归纳定义的命题< Fixpoint re_not_empty {T : Type} (re : @reg_exp T) : bool
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    -Lemma re_not_empty_correct : T (re : @reg_exp T),
    -  ( s, s =~ re) ↔ re_not_empty re = true.
    +Lemma re_not_empty_correct : T (re : @reg_exp T),
    +  (s, s =~ re) ↔ re_not_empty re = true.
    Proof.
      (* 请在此处解答 *) Admitted.

    @@ -1525,17 +1577,17 @@

    IndProp归纳定义的命题<
    -

    remember 策略

    +

    remember 策略

    - induction 策略让人困惑的一个特点是它会欣然接受任意一个项并尝试归纳, - 即使这个项不够一般(general)。其副作用是会丢失掉一些信息(类似 destruct), - 并且使你无法完成证明。比如: + induction 策略让人困惑的一个特点是它会接受任意一个项并尝试归纳, + 即使这个项不够一般(general)。其副作用是会丢失掉一些信息(类似没有 eqn: + 从句的 destruct),并且使你无法完成证明。比如:
    -Lemma star_app: T (s1 s2 : list T) (re : @reg_exp T),
    +Lemma star_app: T (s1 s2 : list T) (re : @reg_exp T),
      s1 =~ Star re
      s2 =~ Star re
      s1 ++ s2 =~ Star re.
    @@ -1592,15 +1644,17 @@

    IndProp归纳定义的命题<
    - (由此,对证据使用 induction 的行为更像是 destruct 而非 inversion。) + (由此,对证据使用 induction 的行为更像是没有 eqn:destruct + 而非 inversion。)
    - 通过显式地添加一个等式来一般化这个有问题的表达式,我们便可以解决这个问题: + 解决此问题的一种直接的方式是“手动推广”这个有问题的表达式, + 即为此引理添加一个显式的等式:

    -Lemma star_app: T (s1 s2 : list T) (re re' : reg_exp),
    +Lemma star_app: T (s1 s2 : list T) (re re' : reg_exp),
      re' = Star re
      s1 =~ re'
      s2 =~ Star re
    @@ -1622,13 +1676,13 @@

    IndProp归纳定义的命题<

    -在 Coq 中使用 remember e as x 策略会(1)替换所有表达式 e 为变量 x, +在 Coq 中调用 remember e as x 策略会(1)替换所有表达式 e 为变量 x, (2)在当前上下文中添加一个等式 x = e。我们可以这样使用 remember 来证明上面的结果:
    -Lemma star_app: T (s1 s2 : list T) (re : reg_exp),
    +Lemma star_app: T (s1 s2 : list T) (re : reg_exp),
      s1 =~ Star re
      s2 =~ Star re
      s1 ++ s2 =~ Star re.
    @@ -1682,20 +1736,20 @@

    IndProp归纳定义的命题<

    -

    练习:4 星, optional (exp_match_ex2)

    +

    练习:4 星, standard, optional (exp_match_ex2)

    - 下面的引理 MStar''(以及它的逆,之前的练习题中的 MStar')显示 + 下面的引理 MStar''(以及它的逆,之前的练习题中的 MStar')显示 exp_matchStar 的定义等价于前面给出的非形式化定义。
    -Lemma MStar'' : T (s : list T) (re : reg_exp),
    +Lemma MStar'' : T (s : list T) (re : reg_exp),
      s =~ Star re
    -   ss : list (list T),
    +  ss : list (list T),
        s = fold app ss []
    -    ∧ s', In s' sss' =~ re.
    +    ∧ s', In s' sss' =~ re.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1704,7 +1758,7 @@

    IndProp归纳定义的命题<
    -

    练习:5 星, advanced (pumping)

    +

    练习:5 星, advanced (pumping)

    正则表达式中一个非常有趣的定理叫做泵引理(Pumping Lemma), 非形式化地来讲,它陈述了任意某个足够长的字符串 s 若匹配一个正则表达式 re, 则可以被抽取(pumped)——将 s 的某个中间部分重复任意次产生的新字符串 @@ -1741,7 +1795,7 @@

    IndProp归纳定义的命题<   | 0 ⇒ []
      | S n'l ++ napp n' l
      end.

    -Lemma napp_plus: T (n m : nat) (l : list T),
    +Lemma napp_plus: T (n m : nat) (l : list T),
      napp (n + m) l = napp n l ++ napp m l.
    Proof.
      intros T n m l.
    @@ -1759,13 +1813,13 @@

    IndProp归纳定义的命题<

    -Lemma pumping : T (re : @reg_exp T) s,
    +Lemma pumping : T (re : @reg_exp T) s,
      s =~ re
      pumping_constant relength s
    -   s1 s2 s3,
    +  s1 s2 s3,
        s = s1 ++ s2 ++ s3
        s2 ≠ [] ∧
    -     m, s1 ++ napp m s2 ++ s3 =~ re.
    +    m, s1 ++ napp m s2 ++ s3 =~ re.
    @@ -1792,7 +1846,7 @@

    IndProp归纳定义的命题<
    -

    案例学习:改进互映

    +

    案例学习:改进互映

    @@ -1801,7 +1855,7 @@

    IndProp归纳定义的命题<

    -Theorem filter_not_empty_In : n l,
    +Theorem filter_not_empty_In : n l,
      filter (fun xn =? x) l ≠ [] →
      In n l.
    Proof.
    @@ -1827,32 +1881,33 @@

    IndProp归纳定义的命题< 为了简化这样的证明,我们可定义一个归纳命题,用于对 n =? m 产生更好的分类讨论原理。 - 它不会生成类似 n =? m = true 这样的等式,因为一般来说对证明并不直接有用, + 它不会生成类似 (n =? m) = true这样的等式,因为一般来说对证明并不直接有用, 其生成的分类讨论原理正是我们所需要的假设: n = m

    Inductive reflect (P : Prop) : boolProp :=
    | ReflectT (H : P) : reflect P true
    -| ReflectF (H : ¬ P) : reflect P false.
    +| ReflectF (H : ¬P) : reflect P false.
    性质 reflect 接受两个参数:一个命题 P 和一个布尔值 b。 直观地讲,它陈述了性质 P 在布尔值 b 中所映现(也即,等价): 换句话说,P 成立当且仅当 b = true。为了理解这一点,请注意定义, - 我们能够产生 reflect P true 的证据的唯一方式是证明 P 为真且使用 + 我们能够产生 reflect P true 的证据的唯一方式是证明 P 为真并使用 ReflectT 构造子。如果我们反转这个陈述,意味着从 reflect P true - 的证明中抽取出 P 的证据也是可能的。相反地,展示 reflect P false + 的证明中抽取出 P 的证据也是可能的。与此类似,证明 reflect P false 的唯一方式是合并 ¬ P 的证据和 ReflectF 构造子。
    - 形式化这种直觉并证明两个表述确实等价是十分容易的: + 形式化这种直觉并证明 P b = truereflect P b + 这两个表述确实等价是十分容易的。首先是从左到右的蕴含:
    -Theorem iff_reflect : P b, (Pb = true) → reflect P b.
    +Theorem iff_reflect : P b, (Pb = true) → reflect P b.
    Proof.
      (* 课上已完成 *)
      intros P b H. destruct b.
    @@ -1862,11 +1917,14 @@

    IndProp归纳定义的命题<

    -

    练习:2 星, recommended (reflect_iff)

    +Now you prove the right-to-left implication: +
    + +

    练习:2 星, standard, recommended (reflect_iff)

    -Theorem reflect_iff : P b, reflect P b → (Pb = true).
    +Theorem reflect_iff : P b, reflect P b → (Pb = true).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1882,14 +1940,14 @@

    IndProp归纳定义的命题<

    -Lemma eqbP : n m, reflect (n = m) (n =? m).
    +Lemma eqbP : n m, reflect (n = m) (n =? m).
    Proof.
      intros n m. apply iff_reflect. rewrite eqb_eq. reflexivity.
    Qed.
    -filter_not_empty_In 的新证明如下所示。请注意对 destructapply +filter_not_empty_In 的一种更流畅证明如下所示。请注意对 destructapply 的使用是如何合并成一个 destruct 的使用。
    @@ -1898,7 +1956,7 @@

    IndProp归纳定义的命题<

    -Theorem filter_not_empty_In' : n l,
    +Theorem filter_not_empty_In' : n l,
      filter (fun xn =? x) l ≠ [] →
      In n l.
    Proof.
    @@ -1915,7 +1973,7 @@

    IndProp归纳定义的命题<

    -

    练习:3 星, recommended (eqbP_practice)

    +

    练习:3 星, standard, recommended (eqbP_practice)

    使用上面的 eqbP 证明以下定理:
    @@ -1925,7 +1983,7 @@

    IndProp归纳定义的命题<   | [] ⇒ 0
      | m :: l' ⇒ (if n =? m then 1 else 0) + count n l'
      end.

    -Theorem eqbP_practice : n l,
    +Theorem eqbP_practice : n l,
      count n l = 0 → ~(In n l).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1935,24 +1993,24 @@

    IndProp归纳定义的命题<
    - 在这个小例子中,这种技术仅仅在证明时提升了一点方便;然而,当证明变得庞大时, + 这个小例子展示了互映证明可以怎样为我们提供一些便利。在大型的开发中, 使用 reflect 往往更容易写出清晰和简短的证明脚本。我们将会在后面的章节 和编程语言基础一卷中看到更多的例子。
    - 对 reflect 性质的使用是随着 SSReflect 而流行开来的,这是一个 + 对 reflect 性质的使用已被 SSReflect 推广开来,这是一个 Coq 程序库,用于形式化一些数学上的重要结果,包括四色定理和法伊特-汤普森定理。 SSReflect 的名字代表着 small-scale reflection,也即,普遍性地使用 互映来简化与布尔值计算有关的证明。
    -

    额外练习

    +

    额外练习

    -

    练习:3 星, recommended (nostutter_defn)

    +

    练习:3 星, standard, recommended (nostutter_defn)

    写出性质的归纳定义是本课程中你需要的重要技能。请尝试去独立解决以下的练习。
    @@ -2000,7 +2058,7 @@

    IndProp归纳定义的命题< (* 
      Proof. intro.
      repeat match goal with
    -    h: nostutter _ |- _ => inversion h; clear h; subst
    +    h: nostutter _ ⊢ _ => inversion h; clear h; subst
      end.
      contradiction Hneq0; auto. Qed.
    *)


    @@ -2012,7 +2070,7 @@

    IndProp归纳定义的命题<
    -

    练习:4 星, advanced (filter_challenge)

    +

    练习:4 星, advanced (filter_challenge)

    让我们证明在 Poly 一章中 filter 的定义匹配某个抽象的规范。 可以这样非形式化地描述这个规范: @@ -2070,7 +2128,7 @@

    IndProp归纳定义的命题<
    -

    练习:5 星, advanced, optional (filter_challenge_2)

    +

    练习:5 星, advanced, optional (filter_challenge_2)

    另一种刻画 filter 行为的方式是:在 l 的所有其元素满足 test 的子序列中, filter test l 是最长的那个。请形式化这个命题并证明它。
    @@ -2083,7 +2141,7 @@

    IndProp归纳定义的命题<
    -

    练习:4 星, optional (palindromes)

    +

    练习:4 星, standard, optional (palindromes)

    回文是倒序排列与正序排列相同的序列。
    @@ -2095,7 +2153,7 @@

    IndProp归纳定义的命题<
    -  c :  ll = rev l → pal l +  c : ll = rev l → pal l
    @@ -2110,7 +2168,7 @@

    IndProp归纳定义的命题<
     lpal (l ++ rev l). + lpal (l ++ rev l).
    @@ -2121,7 +2179,7 @@

    IndProp归纳定义的命题<
     lpal l → l = rev l. + lpal l → l = rev l.
    @@ -2141,13 +2199,13 @@

    IndProp归纳定义的命题<
    -

    练习:5 星, optional (palindrome_converse)

    +

    练习:5 星, standard, optional (palindrome_converse)

    由于缺乏证据,反方向的证明要困难许多。使用之前练习中定义的 pal 来证明
    -      ll = rev l → pal l. +     ll = rev l → pal l.
    @@ -2162,7 +2220,7 @@

    IndProp归纳定义的命题<
    -

    练习:4 星, advanced, optional (NoDup)

    +

    练习:4 星, advanced, optional (NoDup)

    请回忆一下 Logic 章节中性质 In 的定义,其断言值 x 在列表 l 中至少出现一次:
    @@ -2208,7 +2266,7 @@

    IndProp归纳定义的命题<
    -

    练习:4 星, advanced, optional (pigeonhole_principle)

    +

    练习:4 星, advanced, optional (pigeonhole_principle)

    _鸽笼原理(Pigeonhole Principle)是一个关于计数的基本事实: 将超过 n 个物体放进 n 个鸽笼,则必有鸽笼包含至少两个物体。 与此前诸多情形相似,这一数学事实看似乏味,但其证明手段并不平凡, @@ -2219,9 +2277,9 @@

    IndProp归纳定义的命题<

    -Lemma in_split : (X:Type) (x:X) (l:list X),
    +Lemma in_split : (X:Type) (x:X) (l:list X),
      In x l
    -   l1 l2, l = l1 ++ x :: l2.
    +  l1 l2, l = l1 ++ x :: l2.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -2245,15 +2303,15 @@

    IndProp归纳定义的命题<
    如果使用 excluded_middule 假设并展示 In 是可判定的(decidable), - 即 x l, (In x l) ¬ (In x l),那么这个证明会容易很多。 + 即 x l, (In x l) ¬ (In x l),那么这个证明会容易很多。 然而,若假设 In 的可判定性也同样可以证明它;在这样的情况下便不必使用 excluded_middle 假设。

    -Theorem pigeonhole_principle: (X:Type) (l1 l2:list X),
    +Theorem pigeonhole_principle: (X:Type) (l1 l2:list X),
       excluded_middle
    -   ( x, In x l1In x l2) →
    +   (x, In x l1In x l2) →
       length l2 < length l1
       repeats l1.
    Proof.
    @@ -2267,7 +2325,7 @@

    IndProp归纳定义的命题<
    -

    扩展练习:验证正则表达式匹配器

    +

    扩展练习:经验证的正则表达式匹配器

    @@ -2316,7 +2374,7 @@

    IndProp归纳定义的命题< 每个可被证明的 Prop 等价于 True

    -Lemma provable_equiv_true : (P : Prop), P → (PTrue).
    +Lemma provable_equiv_true : (P : Prop), P → (PTrue).
    Proof.
      intros.
      split.
    @@ -2329,7 +2387,7 @@

    IndProp归纳定义的命题< 其逆可被证明的 Prop 等价于 False

    -Lemma not_equiv_false : (P : Prop), ¬P → (PFalse).
    +Lemma not_equiv_false : (P : Prop), ¬P → (PFalse).
    Proof.
      intros.
      split.
    @@ -2342,7 +2400,7 @@

    IndProp归纳定义的命题< EmptySet 不匹配字符串。

    -Lemma null_matches_none : (s : string), (s =~ EmptySet) ↔ False.
    +Lemma null_matches_none : (s : string), (s =~ EmptySet) ↔ False.
    Proof.
      intros.
      apply not_equiv_false.
    @@ -2354,7 +2412,7 @@

    IndProp归纳定义的命题< EmptyStr 仅匹配空字符串。

    -Lemma empty_matches_eps : (s : string), s =~ EmptyStrs = [ ].
    +Lemma empty_matches_eps : (s : string), s =~ EmptyStrs = [ ].
    Proof.
      split.
      - intros. inversion H. reflexivity.
    @@ -2366,7 +2424,7 @@

    IndProp归纳定义的命题< EmptyStr 不匹配非空字符串。

    -Lemma empty_nomatch_ne : (a : ascii) s, (a :: s =~ EmptyStr) ↔ False.
    +Lemma empty_nomatch_ne : (a : ascii) s, (a :: s =~ EmptyStr) ↔ False.
    Proof.
      intros.
      apply not_equiv_false.
    @@ -2379,7 +2437,7 @@

    IndProp归纳定义的命题<

    Lemma char_nomatch_char :
    -   (a b : ascii) s, ba → (b :: s =~ Char aFalse).
    +  (a b : ascii) s, ba → (b :: s =~ Char aFalse).
    Proof.
      intros.
      apply not_equiv_false.
    @@ -2395,7 +2453,7 @@

    IndProp归纳定义的命题< 如果 Char a 匹配一个非空字符串,那么这个字符串的尾(tail)为空。

    -Lemma char_eps_suffix : (a : ascii) s, a :: s =~ Char as = [ ].
    +Lemma char_eps_suffix : (a : ascii) s, a :: s =~ Char as = [ ].
    Proof.
      split.
      - intros. inversion H. reflexivity.
    @@ -2408,13 +2466,13 @@

    IndProp归纳定义的命题< 匹配 re0s1 匹配 re1

    -Lemma app_exists : (s : string) re0 re1,
    +Lemma app_exists : (s : string) re0 re1,
        s =~ App re0 re1
    -     s0 s1, s = s0 ++ s1s0 =~ re0s1 =~ re1.
    +    s0 s1, s = s0 ++ s1s0 =~ re0s1 =~ re1.
    Proof.
      intros.
      split.
    -  - intros. inversion H. s1, s2. split.
    +  - intros. inversion H. s1, s2. split.
        * reflexivity.
        * split. apply H3. apply H4.
      - intros [ s0 [ s1 [ Happ [ Hmat0 Hmat1 ] ] ] ].
    @@ -2423,7 +2481,7 @@

    IndProp归纳定义的命题<

    -

    练习:3 星, optional (app_ne)

    +

    练习:3 星, standard, optional (app_ne)

    App re0 re1 匹配 a::s 当且仅当 re0 匹配空字符串 且 a::s 匹配 re1s=s0++s1,其中 a::s0 匹配 re0s1 匹配 re1。 @@ -2434,10 +2492,10 @@

    IndProp归纳定义的命题< 因此(1)花一些时间理解它,(2)证明它,并且(3)留心后面你会如何使用它。

    -Lemma app_ne : (a : ascii) s re0 re1,
    +Lemma app_ne : (a : ascii) s re0 re1,
        a :: s =~ (App re0 re1) ↔
        ([ ] =~ re0a :: s =~ re1) ∨
    -     s0 s1, s = s0 ++ s1a :: s0 =~ re0s1 =~ re1.
    +    s0 s1, s = s0 ++ s1a :: s0 =~ re0s1 =~ re1.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -2449,7 +2507,7 @@

    IndProp归纳定义的命题< s 匹配 Union re0 re1 当且仅当 s 匹配 re0s 匹配 re1.

    -Lemma union_disj : (s : string) re0 re1,
    +Lemma union_disj : (s : string) re0 re1,
        s =~ Union re0 re1s =~ re0s =~ re1.
    Proof.
      intros. split.
    @@ -2463,7 +2521,7 @@

    IndProp归纳定义的命题<

    -

    练习:3 星, optional (star_ne)

    +

    练习:3 星, standard, optional (star_ne)

    a::s 匹配 Star re 当且仅当 s = s0 ++ s1,其中 a::s0 匹配 res1 匹配 Star re。 同 app_ne一样,这个观察很重要, 因此理解,证明并留意它。 @@ -2481,9 +2539,9 @@

    IndProp归纳定义的命题<

    -Lemma star_ne : (a : ascii) s re,
    +Lemma star_ne : (a : ascii) s re,
        a :: s =~ Star re
    -     s0 s1, s = s0 ++ s1a :: s0 =~ res1 =~ Star re.
    +    s0 s1, s = s0 ++ s1a :: s0 =~ res1 =~ Star re.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -2497,11 +2555,11 @@

    IndProp归纳定义的命题<

    Definition refl_matches_eps m :=
    -   re : @reg_exp ascii, reflect ([ ] =~ re) (m re).
    +  re : @reg_exp ascii, reflect ([ ] =~ re) (m re).
    -

    练习:2 星, optional (match_eps)

    +

    练习:2 星, standard, optional (match_eps)

    完成 match_eps 的定义,其测试给定的正则表达式是否匹配空字符串:
    @@ -2513,7 +2571,7 @@

    IndProp归纳定义的命题<
    -

    练习:3 星, optional (match_eps_refl)

    +

    练习:3 星, standard, optional (match_eps_refl)

    现在,请证明 match_eps 确实测试了给定的正则表达式是否匹配空字符串。 (提示:你会使用到互映引理 ReflectTReflectF。)
    @@ -2540,7 +2598,7 @@

    IndProp归纳定义的命题<
    Definition is_der re (a : ascii) re' :=
    -   s, a :: s =~ res =~ re'.
    +  s, a :: s =~ res =~ re'.
    @@ -2548,11 +2606,11 @@

    IndProp归纳定义的命题< 它求值为 rea 上的生成式。也即,d 满足以下关系:

    -Definition derives d := a re, is_der re a (d a re).
    +Definition derives d := a re, is_der re a (d a re).
    -

    练习:3 星, optional (derive)

    +

    练习:3 星, standard, optional (derive)

    请定义 derive 使其生成字符串。一个自然的实现是在某些分类使用 match_eps 来判断正则表达式是否匹配空字符串。
    @@ -2649,7 +2707,7 @@

    IndProp归纳定义的命题<

    -

    练习:4 星, optional (derive_corr)

    +

    练习:4 星, standard, optional (derive_corr)

    请证明 derive 确实总是会生成字符串。
    @@ -2691,11 +2749,11 @@

    IndProp归纳定义的命题<

    Definition matches_regex m : Prop :=
    -   (s : string) re, reflect (s =~ re) (m s re).
    +  (s : string) re, reflect (s =~ re) (m s re).
    -

    练习:2 星, optional (regex_match)

    +

    练习:2 星, standard, optional (regex_match)

    完成 regex_match 的定义,使其可以匹配正则表达式。
    @@ -2707,7 +2765,7 @@

    IndProp归纳定义的命题<
    -

    练习:3 星, optional (regex_refl)

    +

    练习:3 星, standard, optional (regex_refl)

    最后,证明 regex_match 确实可以匹配正则表达式。
    @@ -2729,6 +2787,10 @@

    IndProp归纳定义的命题<

    +
    + +(* Sat Jan 26 15:14:46 UTC 2019 *)
    +

    diff --git a/lf-current/IndProp.v b/lf-current/IndProp.v index 4375cdc5..c27ad891 100644 --- a/lf-current/IndProp.v +++ b/lf-current/IndProp.v @@ -7,99 +7,115 @@ Require Coq.omega.Omega. (* ################################################################# *) (** * 归纳定义的命题 *) -(** 在 [Logic] 一章中,我们学习了多种方式来书写命题,包括合取、析取和量词。 - 在本章中,我们引入新的方式:_'归纳定义的命题(Inductive Definitions)'_。 *) +(** 在 [Logic] 一章中,我们学习了多种方式来书写命题,包括合取、析取和存在量词。 + 在本章中,我们引入另一种新的方式:_'归纳定义(Inductive Definitions)'_。 *) -(** 请回想一下我们已经学过的两种方法来表达 [n] 是偶数: - (1) [evenb n = true],以及 (2) [exists k, n = double k] 。 - 然而另一种可能是通过如下规则来建立 [n] 的偶数性质: +(** 在前面的章节中,我们已经见过两种表述 [n] 为偶数的方式了: + + (1) [evenb n = true],以及 + + (2) [exists k, n = double k]。 + + 然而还有一种方式是通过如下规则来建立 [n] 的偶数性质: - 规则 [ev_0]: [0] 是偶数。 - - 规则 [ev_SS]: 如果 [n] 是偶数, 那么 [S (S n)] 是偶数。 *) + - 规则 [ev_SS]: 如果 [n] 是偶数, 那么 [S (S n)] 也是偶数。 *) -(** 为了理解这样的偶数性质定义如何工作,我们可想象如何证明 [4] 是偶数。 +(** 为了理解这个新的偶数性质定义如何工作,我们可想象如何证明 [4] 是偶数。 根据规则 [ev_SS],需要证明 [2] 是偶数。这时,只要证明 [0] 是偶数, 我们可继续通过规则 [ev_SS] 确保它成立。而使用规则 [ev_0] 可直接证明 [0] 是偶数。*) (** 接下来的课程中,我们会看到很多类似方式定义的命题。 在非形式化的讨论中,使用轻量化的记法有助于阅读和书写。 -_'推断规则(Inference Rules)'_是其中的一种: *) -(** + _'推断规则(Inference Rules)'_是其中的一种: - ------------ (ev_0) - ev 0 + ------------ (ev_0) + even 0 - ev n - -------------- (ev_SS) - ev (S (S n)) + even n + ---------------- (ev_SS) + even (S (S n)) *) (** 若将前文所述的规则重新排版成推断规则,我们可以这样阅读它,如果线上方的 _'前提(premises)'_成立,那么线下方的_'结论(conclusion)'_成立。 - 比如,规则 [ev_SS] 读做如果 [n] 满足 [ev],那么 [S (S n)] 也满足。 + 比如,规则 [ev_SS] 读做如果 [n] 满足 [even],那么 [S (S n)] 也满足。 如果一条规则在线上方没有前提,则结论直接成立。 - 我们可以通过组合推断规则来展示证明。下面展示如何转译 [4] 是偶数的证明: *) -(** + 我们可以通过组合推断规则来展示证明。下面展示如何转译 [4] 是偶数的证明: - ------ (ev_0) - ev 0 - ------ (ev_SS) - ev 2 - ------ (ev_SS) - ev 4 + -------- (ev_0) + even 0 + -------- (ev_SS) + even 2 + -------- (ev_SS) + even 4 *) (** - 为什么我们把这样的证明称之为“树”(而非其他,比如“栈”)? - 因为一般来说推断规则可以有多个前提。我们会在后面看到一些例子。 *) + (为什么我们把这样的证明称之为“树”(而非其他,比如“栈”)? + 因为一般来说推断规则可以有多个前提。我们很快就会看到一些例子。 *) -(** 基于上述,可将偶数性质的定义翻译为在 Coq 中使用 [Inductive] 声明的定义, +(* ================================================================= *) +(** ** 偶数性的归纳定义 + + 基于上述,可将偶数性质的定义翻译为在 Coq 中使用 [Inductive] 声明的定义, 声明中每一个构造子对应一个推断规则: *) -Inductive ev : nat -> Prop := -| ev_0 : ev 0 -| ev_SS (n : nat) (H : ev n) : ev (S (S n)). +Inductive even : nat -> Prop := +| ev_0 : even 0 +| ev_SS (n : nat) (H : even n) : even (S (S n)). (** 这个定义同之前其他 [Inductive] 的使用有一个重要的区别: - 它的结果并不是一个 [Type] ,而是一个将 [nat] 映射到 [Prop] 的函数——即关于数的性质。 - 注意我们曾见过结果也为函数的归纳定义,比如 [list],其类型是 [Type -> Type] 。 - 值得注意的是,由于 [ev] 中出现在冒号_'右侧'_的 [nat] 参数是 _'未命名'_ 的, + 我们所定义的并不是一个 [Type],而是一个将 [nat] 映射到 [Prop] 的函数——即关于数的性质。 + 我们曾见过结果也是函数的归纳定义,比如 [list],其类型是 [Type -> Type] 。 + 真正要关注的是,由于 [even] 中出现在冒号_'右侧'_的 [nat] 参数是 _'未命名'_ 的, 这允许在不同的构造子类型中使用不同的值:例如 [ev_0] 类型中的 [0] 以及 [ev_SS] 类型中的 [S (S n)]。 相反,[list] 的定义以_'全局方式'_命名了冒号_'左侧'_的参数 [X], 强迫 [nil] 和 [cons] 的结果为同一个类型([list X])。 - 如果在定义 [ev] 时我们将 [nat] 置于冒号左侧,会得到如下错误: *) + 如果在定义 [even] 时我们将 [nat] 置于冒号左侧,会得到如下错误: *) Fail Inductive wrong_ev (n : nat) : Prop := | wrong_ev_0 : wrong_ev 0 -| wrong_ev_SS : forall n, wrong_ev n -> wrong_ev (S (S n)). -(* ===> Error: A parameter of an inductive type n is not - allowed to be used as a bound variable in the type - of its constructor. *) +| wrong_ev_SS : wrong_ev n -> wrong_ev (S (S n)). +(* ===> Error: Last occurrence of "[wrong_ev]" must have "[n]" + as 1st argument in "[wrong_ev 0]". *) + +(** 在 [Inductive] 定义中,类型构造子的冒号左侧的参数叫做形参(Parameter), + 而右侧的叫做索引(Index)。 + + 例如,在 [Inductive list (X : Type) := ...] 中,[X] 是一个形参;而在 + [Inductive even : nat -> Prop := ...] 中,未命名的 [nat] 参数是一个索引。 *) -(** (“parameter” 是 Coq 中的一个术语来表示 [Inductive] 定义中冒号左侧的参数; - “index” 则指冒号右侧的参数。) *) +(** 在 Coq 中,我们可以认为 [even] 定义了一个性质 [ev : nat -> Prop],其包括原语定理 + [ev_0 : even 0] 和 [ev_SS : forall n, even n -> even (S (S n))]。 *) -(** 在 Coq 中,我们可以认为 [ev] 定义了一个性质 [ev : nat -> Prop],其包括公理(primitive theorems) - [ev_0 : ev 0] 和 [ev_SS : forall n, ev n -> ev (S (S n))]。*) +(** 该定义也可写作如下形式... + + Inductive even : nat -> Prop := + | ev_0 : even 0 + | ev_SS : forall n, even n -> even (S (S n)). +*) + +(** ... 以便让 [ev_SS] 的类型更加直白。 *) (** 这些 “定理构造子” 等同于已经证明过的定理。 - 具体来说,我们可以使用 Coq 中的 [apply] 策略和规则名称来证明某个数的 [ev] 性质…… *) + 具体来说,我们可以使用 Coq 中的 [apply] 策略和规则名称来证明某个数的 [even] 性质…… *) -Theorem ev_4 : ev 4. +Theorem ev_4 : even 4. Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed. (** ……或使用函数应用的语法: *) -Theorem ev_4' : ev 4. +Theorem ev_4' : even 4. Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed. -(** 我们同样可以对前提中使用到 [ev] 的定理进行证明。 *) +(** 我们同样可以对前提中使用到 [even] 的定理进行证明。 *) -Theorem ev_plus4 : forall n, ev n -> ev (4 + n). +Theorem ev_plus4 : forall n, even n -> even (4 + n). Proof. intros n. simpl. intros Hn. apply ev_SS. apply ev_SS. apply Hn. @@ -107,9 +123,9 @@ Qed. (** 更一般地,我们可以证明以任意数乘 2 是偶数: *) -(** **** 练习:1 星 (ev_double) *) +(** **** 练习:1 星, standard (ev_double) *) Theorem ev_double : forall n, - ev (double n). + even (double n). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -119,57 +135,60 @@ Proof. (** 除了_'构造'_证据(evidence)来表示某个数是偶数,我们还可以对这些证据进行_'推理'_。 - 对 [ev] 而言,使用 [Inductive] 声明来引入 [ev] 不仅仅表示在 Coq + 对 [even] 而言,使用 [Inductive] 声明来引入 [even] 不仅仅表示在 Coq 中 [ev_0] 和 [ev_SS] 这样的构造子是合法的方式来构造偶数证明的证据, 他们也是_'仅有的'_方式。 *) -(** 换句话说,如果某人展示了对于 [ev n] 的证据 [E],那么我们知道 [E] +(** 换句话说,如果某人展示了对于 [even n] 的证据 [E],那么我们知道 [E] 必是二者其一: - [E] 是 [ev_0](且 [n] 为 [O]), 或 - [E] 是 [ev_SS n' E'](且 [n] 为 [S (S n')], [E'] 为 - [ev n'] 的证据). *) + [even n'] 的证据). *) -(** 这样的形式暗示着,我们可以像分析归纳定义的数据结构一样分析形如 [ev n] +(** 这样的形式暗示着,我们可以像分析归纳定义的数据结构一样分析形如 [even n] 的假设;特别地,对于这类证据使用_'归纳(induction)'_和_'分类讨论(case analysis)'_来进行论证也是可行的。让我们通过一些例子来学习实践中如何使用他们。 *) (* ================================================================= *) (** ** 对证据进行反演 *) -(** Suppose we are proving some fact involving a number [n], and we - are given [ev n] as a hypothesis. We already know how to perform - case analysis on [n] using [destruct] or [induction], generating - separate subgoals for the case where [n = O] and the case where [n - = S n'] for some [n']. But for some proofs we may instead want to - analyze the evidence that [ev n] _directly_. As a tool, we can - prove our characterization of evidence for [ev n], using [destruct]. *) +(** Suppose we are proving some fact involving a number [n], and + we are given [even n] as a hypothesis. We already know how to + perform case analysis on [n] using [destruct] or [induction], + generating separate subgoals for the case where [n = O] and the + case where [n = S n'] for some [n']. But for some proofs we may + instead want to analyze the evidence that [even n] _directly_. As + a tool, we can prove our characterization of evidence for + [even n], using [destruct]. *) Theorem ev_inversion : - forall (n : nat), ev n -> - (n = 0) \/ (exists m, n = S (S m) /\ ev m). + forall (n : nat), even n -> + (n = 0) \/ (exists n', n = S (S n') /\ even n'). Proof. - intros n Hev. - destruct Hev as [ | m Hm]. - - left. reflexivity. - - right. exists m. split. reflexivity. apply Hm. + intros n E. + destruct E as [ | n' E']. + - (* E = ev_0 : even 0 *) + left. reflexivity. + - (* E = ev_SS n' E' : even (S (S n')) *) + right. exists n'. split. reflexivity. apply E'. Qed. (** 用 [destruct] 解构证据即可证明下述定理: *) Theorem ev_minus2 : forall n, - ev n -> ev (pred (pred n)). + even n -> even (pred (pred n)). Proof. intros n E. destruct E as [| n' E']. - (* E = ev_0 *) simpl. apply ev_0. - - (* E = ev_SS n' E' *) simpl. apply E'. Qed. + - (* E = ev_SS n' E' *) simpl. apply E'. +Qed. (** However, this variation cannot easily be handled with [destruct]. *) Theorem evSS_ev : forall n, - ev (S (S n)) -> ev n. - + even (S (S n)) -> even n. (** 直观来说,我们知道支撑前提的证据不会由 [ev_0] 组成,因为 [0] 和 [S] 是 [nat] 类型不同的构造子;由此 [ev_SS] 是唯一需要应对的情况(译注:[ev_0] 无条件成立)。 不幸的是,[destruct] 并没有如此智能,它仍然为我们生成两个子目标。 @@ -186,31 +205,30 @@ Abort. 这对于证明 [ev_minus2'] 是有帮助的,因为在最终目标中直接使用到了参数 [n]。 然而,这对于 [evSS_ev] 并没有帮助,因为被替换掉的 [S (S n)] 并没有在其他地方被使用。*) -(** We can patch this proof by replacing the goal [ev n], which - does not mention the replaced term [S (S n)], by the equivalent - goal [ev (pred (pred (S (S n))))], which does mention this - term, after which [destruct] can make progress. But it is +(** We could patch this proof by replacing the goal [even n], + which does not mention the replaced term [S (S n)], by the + equivalent goal [even (pred (pred (S (S n))))], which does mention + this term, after which [destruct] can make progress. But it is more straightforward to use our inversion lemma. *) - -Theorem evSS_ev : forall n, ev (S (S n)) -> ev n. +Theorem evSS_ev : forall n, even (S (S n)) -> even n. Proof. intros n H. apply ev_inversion in H. destruct H. - discriminate H. - destruct H as [n' [Hnm Hev]]. injection Hnm. intro Heq. rewrite Heq. apply Hev. Qed. -(** Coq provides the [inversion] tactic, which does the work - of our inversion lemma and more besides. *) +(** Coq provides a tactic called [inversion], which does the work of + our inversion lemma and more besides. *) (** The [inversion] tactic can detect (1) that the first case ([n = 0]) does not apply and (2) that the [n'] that appears in the - [ev_SS] case must be the same as [n]. It has an "as" - variant similar to [destruct], allowing us to assign names - rather than have Coq choose them. *) + [ev_SS] case must be the same as [n]. It has an "[as]" variant + similar to [destruct], allowing us to assign names rather than + have Coq choose them. *) Theorem evSS_ev' : forall n, - ev (S (S n)) -> ev n. + even (S (S n)) -> even n. Proof. intros n E. inversion E as [| n' E']. @@ -222,7 +240,7 @@ Qed. "obviously contradictory" hypotheses involving inductive properties, something that takes a bit more work using our inversion lemma. For example: *) -Theorem one_not_even : ~ ev 1. +Theorem one_not_even : ~ even 1. Proof. intros H. apply ev_inversion in H. destruct H as [ | [m [Hm _]]]. @@ -230,38 +248,36 @@ Proof. - discriminate Hm. Qed. -Theorem one_not_even' : ~ ev 1. +Theorem one_not_even' : ~ even 1. intros H. inversion H. Qed. +(** **** 练习:1 星, standard (inversion_practice) -(** **** 练习:1 星 (inversion_practice) *) -(** 利用 [inversion] 策略证明以下结论。如想进一步练习,请使用反演定理证明之。 *) + 利用 [inversion] 策略证明以下结论。如想进一步练习,请使用反演定理证明之。 *) Theorem SSSSev__even : forall n, - ev (S (S (S (S n)))) -> ev n. + even (S (S (S (S n)))) -> even n. Proof. (* 请在此处解答 *) Admitted. - (** [] *) -(** **** 练习:1 星 (even5_nonsense) *) -(** 请使用 [inversion] 策略证明以下结果。 *) +(** **** 练习:1 星, standard (even5_nonsense) + + 请使用 [inversion] 策略证明以下结果。 *) Theorem even5_nonsense : - ev 5 -> 2 + 2 = 9. + even 5 -> 2 + 2 = 9. Proof. (* 请在此处解答 *) Admitted. (** [] *) - -(** The [inversion] tactic is complex. When applied to equalities, as a - special case, it does the work of both [discriminate] and - [injection]. In addition, it carries out the [intros] and - [rewrite]s that are typically necessary in the case of - [injection]. It can also be applied, more generally, - to analyzing evidence for inductively defined propositions. - As examples, we'll use it to reprove some theorems from [Tactics.v]. *) - +(** The [inversion] tactic does quite a bit of work. When + applied to equalities, as a special case, it does the work of both + [discriminate] and [injection]. In addition, it carries out the + [intros] and [rewrite]s that are typically necessary in the case + of [injection]. It can also be applied, more generally, to analyze + evidence for inductively defined propositions. As examples, we'll + use it to reprove some theorems from [Tactics.v]. *) Theorem inversion_ex1 : forall (n m o : nat), [n; m] = [o; o] -> @@ -275,11 +291,10 @@ Theorem inversion_ex2 : forall (n : nat), Proof. intros n contra. inversion contra. Qed. - -(** [inversion] 的工作原理大致如下:假设 [I] 指代上下文中的假设 [P], - 且 [P] 由 [Inductive] 归纳定义,则对于 [P] 每一种可能的构造,[inversion I] +(** [inversion] 的工作原理大致如下:假设 [H] 指代上下文中的假设 [P], + 且 [P] 由 [Inductive] 归纳定义,则对于 [P] 每一种可能的构造,[inversion H] 各为其生成子目标。子目标中自相矛盾者被忽略,证明其余子命题即可得证原命题。 - 在证明子目标时,上下文中的 [I] 会替换为 [P] 的构造条件, + 在证明子目标时,上下文中的 [H] 会替换为 [P] 的构造条件, 即其构造子所需参数以及必要的等式关系。例如:倘若 [ev n] 由 [evSS] 构造, 上下文中会引入参数 [n']、[ev n'],以及等式 [S (S n') = n]。 *) @@ -289,13 +304,13 @@ Proof. 为了展示这三种方式的一致性,我们需要下面的引理: *) Lemma ev_even_firsttry : forall n, - ev n -> exists k, n = double k. + even n -> exists k, n = double k. Proof. (* 课上已完成 *) (** 我们可以尝试使用分类讨论或对 [n] 进行归纳。 - 但由于 [ev] 在前提中出现,如同之前章节的一些例子,这种策略或许无法行得通。 - 如此我们似乎可以首先尝试对 [ev] 的证据进行反演。 + 但由于 [even] 在前提中出现,如同之前章节的一些例子,这种策略或许无法行得通。 + 如此我们似乎可以首先尝试对 [even] 的证据进行反演。 确实,第一个分类可以被平凡地证明。 *) intros n E. inversion E as [| n' E']. @@ -304,18 +319,16 @@ Proof. - (* E = ev_SS n' E' *) simpl. (** 不幸地是,第二个分类要困难一些。我们需要证明 [exists k, S (S n') = double k], - 但唯一可用的假设是 [E'],也即 [ev n'] 成立。但这对证明并没有帮助, + 但唯一可用的假设是 [E'],也即 [even n'] 成立。但这对证明并没有帮助, 我们似乎被卡住了,而对 [E] 进行分类讨论是徒劳的。 如果仔细观察第二个(子)目标,我们可以发现一些有意思的事情: 对 [E] 进行分类讨论,我们可以把要证明的原始目标归约到另一个上, - 其涉及到另一个 [ev] 的证据: [E']。 + 其涉及到另一个 [even] 的证据: [E']。 形式化地说,我们可以通过展示如下证据来完成证明: - exists k', n' = double k', - 这同原始的命题是等价的,只是 [n'] 被替换为 n。确实,通过这个中间结果完成证明 并不困难。 *) @@ -335,20 +348,20 @@ Abort. 对证据和对数据使用 [induction] 具有同样的行为:它导致 Coq 对每个可用于构造证据的 构造子生成一个子目标,同时对递归出现的问题性质提供了归纳假设。 - To prove a property of [n] holds for all number for which [ev n] - holds, we can use induction on [ev n]. This requires us to prove - two things, corresponding to the two cases of how [ev n] could - have been constructed. If it was constructed by [ev_0], then [n=0], - and the property must hold of [0]. If it was constructed by [ev_SS], - then the evidence of [ev n] is of the form [ev_SS n' E'], where - [n = S (S n')] and [E'] is evidence for [ev n']. In this case, - the inductive hypothesis says that the property we are trying to prove - holds for [n']. *) + To prove a property of [n] holds for all numbers for which [even + n] holds, we can use induction on [even n]. This requires us to + prove two things, corresponding to the two ways in which [even n] + could have been constructed. If it was constructed by [ev_0], then + [n=0], and the property must hold of [0]. If it was constructed by + [ev_SS], then the evidence of [even n] is of the form [ev_SS n' + E'], where [n = S (S n')] and [E'] is evidence for [even n']. In + this case, the inductive hypothesis says that the property we are + trying to prove holds for [n']. *) (** 让我们再次尝试证明这个引理: *) Lemma ev_even : forall n, - ev n -> exists k, n = double k. + even n -> exists k, n = double k. Proof. intros n E. induction E as [|n' E' IH]. @@ -361,13 +374,13 @@ Proof. Qed. (** 这里我们看到 Coq 对 [E'] 产生了 [IH],而 [E'] 是唯一递归出现的 - [ev] 命题。 由于 [E'] 中涉及到 [n'],这个归纳假设是关于 [n'] 的, + [even] 命题。 由于 [E'] 中涉及到 [n'],这个归纳假设是关于 [n'] 的, 而非关于 [n] 或其他数字的。 *) (** 关于偶数性质的第二个和第三个定义的等价关系如下: *) Theorem ev_even_iff : forall n, - ev n <-> exists k, n = double k. + even n <-> exists k, n = double k. Proof. intros n. split. - (* -> *) apply ev_even. @@ -379,41 +392,45 @@ Qed. (** 下面的练习提供了一些简单的例子,来帮助你熟悉这项技术。 *) -(** **** 练习:2 星 (ev_sum) *) -Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m). +(** **** 练习:2 星, standard (ev_sum) *) +Theorem ev_sum : forall n m, even n -> even m -> even (n + m). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced, optional (ev'_ev) *) -(** 一般来说,有很多种方式来归纳地定义一个性质。比如说,下面是关于 [ev] 的另一种(蹩脚的)定义:*) +(** **** 练习:4 星, advanced, optional (even'_ev) + + 一般来说,有很多种方式来归纳地定义一个性质。比如说,下面是关于 + [even] 的另一种(蹩脚的)定义:*) -Inductive ev' : nat -> Prop := -| ev'_0 : ev' 0 -| ev'_2 : ev' 2 -| ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m). +Inductive even' : nat -> Prop := +| even'_0 : even' 0 +| even'_2 : even' 2 +| even'_sum n m (Hn : even' n) (Hm : even' m) : even' (n + m). (** 请证明这个定义在逻辑上等同于前述定义。(当进入到归纳步骤时,你可能会想参考一下上一个定理。)*) -Theorem ev'_ev : forall n, ev' n <-> ev n. +Theorem even'_ev : forall n, even' n <-> even n. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced, recommended (ev_ev__ev) *) -(** 在本题中找到适合进行归纳的项需要一点技巧: *) +(** **** 练习:3 星, advanced, recommended (ev_ev__ev) + + 在本题中找到适合进行归纳的项需要一点技巧: *) Theorem ev_ev__ev : forall n m, - ev (n+m) -> ev n -> ev m. + even (n+m) -> even n -> even m. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (ev_plus_plus) *) -(** 这个练习仅仅需要使用前述引理,而不需要使用归纳或分类讨论,尽管一些重写可能会比较乏味。 *) +(** **** 练习:3 星, standard, optional (ev_plus_plus) + + 这个练习仅仅需要使用前述引理,而不需要使用归纳或分类讨论,尽管一些重写可能会比较乏味。 *) Theorem ev_plus_plus : forall n m p, - ev (n+m) -> ev (n+p) -> ev (m+p). + even (n+m) -> even (n+p) -> even (m+p). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -421,7 +438,7 @@ Proof. (* ################################################################# *) (** * 归纳关系 *) -(** 我们可以认为被一个数所参数化的命题(比如 [ev])是一个_'性质'_,也即, +(** 我们可以认为被一个数所参数化的命题(比如 [even])是一个_'性质'_,也即, 它定义了 [nat] 的一个子集,其中的数可以被证明满足此命题。 以同样的方式,我们可认为有两个参数的命题是一个_'关系'_,也即,它定义了一个 可满足此命题的序对集合。*) @@ -439,7 +456,7 @@ Inductive le : nat -> nat -> Prop := Notation "m <= n" := (le m n). -(** 类似于证明 [ev] 这样的性质,使用 [le_n] 和 [le_S] 构造子来证明关于 [<=] +(** 类似于证明 [even] 这样的性质,使用 [le_n] 和 [le_S] 构造子来证明关于 [<=] 的事实遵循了同样的模式。我们可以对构造子使用 [apply] 策略来证明 [<=] 目标 (比如证明 [3<=3] 或 [3<=6]),也可以使用 [inversion] 策略来从上下文中 [<=] 的假设里抽取信息(比如证明 [(2<=1) -> 2+2=5])。 *) @@ -483,20 +500,24 @@ Inductive next_nat : nat -> nat -> Prop := | nn n : next_nat n (S n). Inductive next_even : nat -> nat -> Prop := - | ne_1 n : ev (S n) -> next_even n (S n) - | ne_2 n (H : ev (S (S n))) : next_even n (S (S n)). + | ne_1 n : even (S n) -> next_even n (S n) + | ne_2 n (H : even (S (S n))) : next_even n (S (S n)). -(** **** 练习:2 星, optional (total_relation) *) -(** 请定一个二元归纳关系 [total_relation] 对每一个自然数的序对成立。 *) +(** **** 练习:2 星, standard, optional (total_relation) -(* 请在此处解答 *) -(** [] *) + 请定一个二元归纳关系 [total_relation] 对每一个自然数的序对成立。 *) -(** **** 练习:2 星, optional (empty_relation) *) -(** 请定一个二元归纳关系 [empty_relation] 对自然数永远为假。 *) +(* 请在此处解答 -(* 请在此处解答 *) -(** [] *) + [] *) + +(** **** 练习:2 星, standard, optional (empty_relation) + + 请定一个二元归纳关系 [empty_relation] 对自然数永远为假。 *) + +(* 请在此处解答 + + [] *) (** From the definition of [le], we can sketch the behaviors of [destruct], [inversion], and [induction] on a hypothesis [H] @@ -506,12 +527,13 @@ Inductive next_even : nat -> nat -> Prop := In the second case, [e2 = S n'] for some [n'] for which [le e1 n'] holds, and it will replace instances of [e2] with [S n']. Doing [inversion H] will remove impossible cases and add generated - equalities to the context for further use. Doing [induction H] will, - in the second case, add the inductive hypothesis that the goal holds - when [e2] is replaced with [n'].*) + equalities to the context for further use. Doing [induction H] + will, in the second case, add the induction hypothesis that the + goal holds when [e2] is replaced with [n']. *) + +(** **** 练习:3 星, standard, optional (le_exercises) -(** **** 练习:3 星, optional (le_exercises) *) -(** 这里展示一些 [<=] 和 [<] 关系的事实,我们在接下来的课程中将会用到他们。 + 这里展示一些 [<=] 和 [<] 关系的事实,我们在接下来的课程中将会用到他们。 证明他们将会是非常有益的练习。 *) Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o. @@ -572,7 +594,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (leb_iff) *) +(** **** 练习:2 星, standard, optional (leb_iff) *) Theorem leb_iff : forall n m, n <=? m = true <-> n <= m. Proof. @@ -581,8 +603,9 @@ Proof. Module R. -(** **** 练习:3 星, recommended (R_provability) *) -(** 通过同样的方式,我们可以定义三元关系、四元关系等。例如,考虑以下定义在自然数上的三元关系: *) +(** **** 练习:3 星, standard, recommended (R_provability) + + 通过同样的方式,我们可以定义三元关系、四元关系等。例如,考虑以下定义在自然数上的三元关系: *) Inductive R : nat -> nat -> nat -> Prop := | c1 : R 0 0 0 @@ -608,8 +631,9 @@ Inductive R : nat -> nat -> nat -> Prop := Definition manual_grade_for_R_provability : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, optional (R_fact) *) -(** 关系 [R] 其实编码了一个熟悉的函数。请找出这个函数,定义它并在 Coq 中证明他们等价。*) +(** **** 练习:3 星, standard, optional (R_fact) + + 关系 [R] 其实编码了一个熟悉的函数。请找出这个函数,定义它并在 Coq 中证明他们等价。*) Definition fR : nat -> nat -> nat (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -621,8 +645,9 @@ Proof. End R. -(** **** 练习:4 星, advanced (subsequence) *) -(** 如果一个列表的所有元素以相同的顺序出现在另一个列表之中(但允许其中出现其他额外的元素), +(** **** 练习:2 星, advanced (subsequence) + + 如果一个列表的所有元素以相同的顺序出现在另一个列表之中(但允许其中出现其他额外的元素), 我们把第一个列表称作第二个列表的_'子序列'_。 例如: [1;2;3] @@ -652,14 +677,31 @@ End R. 的子序列,且 [l2] 是 [l3] 的子序列,那么 [l1] 是 [l3] 的子序列。 (提示:仔细选择进行归纳的项!) *) +Inductive subseq : list nat -> list nat -> Prop := (* 请在此处解答 *) +. -(* 请勿修改下面这一行: *) -Definition manual_grade_for_subsequence : option (nat*string) := None. +Theorem subseq_refl : forall (l : list nat), subseq l l. +Proof. + (* 请在此处解答 *) Admitted. + +Theorem subseq_app : forall (l1 l2 l3 : list nat), + subseq l1 l2 -> + subseq l1 (l2 ++ l3). +Proof. + (* 请在此处解答 *) Admitted. + +Theorem subseq_trans : forall (l1 l2 l3 : list nat), + subseq l1 l2 -> + subseq l2 l3 -> + subseq l1 l3. +Proof. + (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (R_provability2) *) -(** 假设我们在 Coq 中有如下定义: +(** **** 练习:2 星, standard, optional (R_provability2) + + 假设我们在 Coq 中有如下定义: Inductive R : nat -> list nat -> Prop := | c1 : R 0 [] @@ -672,19 +714,19 @@ Definition manual_grade_for_subsequence : option (nat*string) := None. - [R 1 [1;2;1;0]] - [R 6 [3;2;1;0]] *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + [] *) (* ################################################################# *) (** * 案例学习:正则表达式 *) -(** 性质 [ev] 提供了一个简单的例子来展示归纳定义和其基础的推理技巧, - 但这还不是什么激动人心的东西——毕竟,[ev] 等价于我们之前见过的两个非归纳的定义, +(** 性质 [even] 提供了一个简单的例子来展示归纳定义和其基础的推理技巧, + 但这还不是什么激动人心的东西——毕竟,[even] 等价于我们之前见过的两个非归纳的定义, 而看起来归纳定义并没有提供什么好处。为了更好地展示归纳定义的表达能力, 我们继续使用它来建模计算机科学中的一个经典概念——正则表达式。 *) -(** 正则表达式是用来描述字符串的一种简单语言,定义如下: *) +(** 正则表达式是用来描述字符串集合的一种简单语言,定义如下: *) Inductive reg_exp {T : Type} : Type := | EmptySet @@ -845,8 +887,9 @@ Qed. (** (请注意对 [app_nil_r] 的使用改变了目标,以此可匹配 [MStarApp] 所需要的形式。)*) -(** **** 练习:3 星 (exp_match_ex1) *) -(** 下面的引理显示从形式化的归纳定义中可以得到本章开始的非形式化匹配规则。 *) +(** **** 练习:3 星, standard (exp_match_ex1) + + 下面的引理显示从形式化的归纳定义中可以得到本章开始的非形式化匹配规则。 *) Lemma empty_is_empty : forall T (s : list T), ~ (s =~ EmptySet). @@ -870,9 +913,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, optional (reg_exp_of_list_spec) *) -(** 请证明 [reg_exp_of_list] 满足以下规范: *) +(** **** 练习:4 星, standard, optional (reg_exp_of_list_spec) + 请证明 [reg_exp_of_list] 满足以下规范: *) Lemma reg_exp_of_list_spec : forall T (s1 s2 : list T), s1 =~ reg_exp_of_list s2 <-> s1 = s2. @@ -883,7 +926,6 @@ Proof. (** 由于 [exp_match] 以递归方式定义,我们可能会发现 关于正则表达式的证明常常需要对证据进行归纳。*) - (** 比如,假设我们想要证明以下显然的结果:如果正则表达式 [re] 匹配某个字符串 [s], 那么 [s] 中的所有元素必在 [re] 中某处以字符字面量的形式出现。 @@ -949,8 +991,9 @@ Proof. apply (IH2 Hin). Qed. -(** **** 练习:4 星 (re_not_empty) *) -(** 请编写一个递归函数 [re_not_empty] 用来测试某个正则表达式是否会匹配一些字符串。 +(** **** 练习:4 星, standard (re_not_empty) + + 请编写一个递归函数 [re_not_empty] 用来测试某个正则表达式是否会匹配一些字符串。 并证明你的函数是正确的。*) Fixpoint re_not_empty {T : Type} (re : @reg_exp T) : bool @@ -965,9 +1008,9 @@ Proof. (* ================================================================= *) (** ** [remember] 策略 *) -(** [induction] 策略让人困惑的一个特点是它会欣然接受任意一个项并尝试归纳, - 即使这个项不够一般(general)。其副作用是会丢失掉一些信息(类似 [destruct]), - 并且使你无法完成证明。比如: *) +(** [induction] 策略让人困惑的一个特点是它会接受任意一个项并尝试归纳, + 即使这个项不够一般(general)。其副作用是会丢失掉一些信息(类似没有 [eqn:] + 从句的 [destruct]),并且使你无法完成证明。比如: *) Lemma star_app: forall T (s1 s2 : list T) (re : @reg_exp T), s1 =~ Star re -> @@ -1005,9 +1048,11 @@ Abort. (** 问题是,只有当 [Prop] 的假设是完全一般的时候,对其使用 [induction] 的才会起作用, 也即,我们需要其所有的参数都是变量,而非更复杂的表达式,比如 [Star re]。 - (由此,对证据使用 [induction] 的行为更像是 [destruct] 而非 [inversion]。) + (由此,对证据使用 [induction] 的行为更像是没有 [eqn:] 的 [destruct] + 而非 [inversion]。) - 通过显式地添加一个等式来一般化这个有问题的表达式,我们便可以解决这个问题: *) + 解决此问题的一种直接的方式是“手动推广”这个有问题的表达式, + 即为此引理添加一个显式的等式: *) Lemma star_app: forall T (s1 s2 : list T) (re re' : reg_exp), re' = Star re -> @@ -1023,7 +1068,7 @@ Lemma star_app: forall T (s1 s2 : list T) (re re' : reg_exp), Abort. -(** 在 Coq 中使用 [remember e as x] 策略会(1)替换所有表达式 [e] 为变量 [x], +(** 在 Coq 中调用 [remember e as x] 策略会(1)替换所有表达式 [e] 为变量 [x], (2)在当前上下文中添加一个等式 [x = e]。我们可以这样使用 [remember] 来证明上面的结果: *) @@ -1068,9 +1113,9 @@ Proof. * apply H1. Qed. -(** **** 练习:4 星, optional (exp_match_ex2) *) +(** **** 练习:4 星, standard, optional (exp_match_ex2) *) -(** 下面的引理 [MStar''](以及它的逆,之前的练习题中的 [MStar'])显示 +(** 下面的引理 [MStar''](以及它的逆,之前的练习题中的 [MStar'])显示 [exp_match] 中 [Star] 的定义等价于前面给出的非形式化定义。*) Lemma MStar'' : forall T (s : list T) (re : reg_exp), @@ -1082,8 +1127,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, advanced (pumping) *) -(** 正则表达式中一个非常有趣的定理叫做_'泵引理(Pumping Lemma)'_, +(** **** 练习:5 星, advanced (pumping) + + 正则表达式中一个非常有趣的定理叫做_'泵引理(Pumping Lemma)'_, 非形式化地来讲,它陈述了任意某个足够长的字符串 [s] 若匹配一个正则表达式 [re], 则可以被抽取(pumped)——将 [s] 的某个中间部分重复任意次产生的新字符串 仍然匹配 [re]。 @@ -1184,7 +1230,7 @@ Qed. (** 为了简化这样的证明,我们可定义一个归纳命题,用于对 [n =? m] 产生更好的分类讨论原理。 - 它不会生成类似 [n =? m = true] 这样的等式,因为一般来说对证明并不直接有用, + 它不会生成类似 [(n =? m) = true]这样的等式,因为一般来说对证明并不直接有用, 其生成的分类讨论原理正是我们所需要的假设: [n = m]。*) Inductive reflect (P : Prop) : bool -> Prop := @@ -1194,12 +1240,13 @@ Inductive reflect (P : Prop) : bool -> Prop := (** 性质 [reflect] 接受两个参数:一个命题 [P] 和一个布尔值 [b]。 直观地讲,它陈述了性质 [P] 在布尔值 [b] 中所_'映现'_(也即,等价): 换句话说,[P] 成立当且仅当 [b = true]。为了理解这一点,请注意定义, - 我们能够产生 [reflect P true] 的证据的唯一方式是证明 [P] 为真且使用 + 我们能够产生 [reflect P true] 的证据的唯一方式是证明 [P] 为真并使用 [ReflectT] 构造子。如果我们反转这个陈述,意味着从 [reflect P true] - 的证明中抽取出 [P] 的证据也是可能的。相反地,展示 [reflect P false] + 的证明中抽取出 [P] 的证据也是可能的。与此类似,证明 [reflect P false] 的唯一方式是合并 [~ P] 的证据和 [ReflectF] 构造子。 - 形式化这种直觉并证明两个表述确实等价是十分容易的:*) + 形式化这种直觉并证明 [P <-> b = true] 和 [reflect P b] + 这两个表述确实等价是十分容易的。首先是从左到右的蕴含:*) Theorem iff_reflect : forall P b, (P <-> b = true) -> reflect P b. Proof. @@ -1209,7 +1256,9 @@ Proof. - apply ReflectF. rewrite H. intros H'. discriminate. Qed. -(** **** 练习:2 星, recommended (reflect_iff) *) +(** Now you prove the right-to-left implication: *) + +(** **** 练习:2 星, standard, recommended (reflect_iff) *) Theorem reflect_iff : forall P b, reflect P b -> (P <-> b = true). Proof. (* 请在此处解答 *) Admitted. @@ -1220,13 +1269,12 @@ Proof. 进行分类讨论,同时为两个分支(第一个子目标中的 [P] 和第二个中的 [~ P])生成适当的假设。 *) - Lemma eqbP : forall n m, reflect (n = m) (n =? m). Proof. intros n m. apply iff_reflect. rewrite eqb_eq. reflexivity. Qed. -(** [filter_not_empty_In] 的新证明如下所示。请注意对 [destruct] 和 [apply] +(** [filter_not_empty_In] 的一种更流畅证明如下所示。请注意对 [destruct] 和 [apply] 的使用是如何合并成一个 [destruct] 的使用。 *) (** (为了更清晰地看到这点,使用 Coq 查看 [filter_not_empty_In] @@ -1247,8 +1295,9 @@ Proof. intros H'. right. apply IHl'. apply H'. Qed. -(** **** 练习:3 星, recommended (eqbP_practice) *) -(** 使用上面的 [eqbP] 证明以下定理:*) +(** **** 练习:3 星, standard, recommended (eqbP_practice) + + 使用上面的 [eqbP] 证明以下定理:*) Fixpoint count n l := match l with @@ -1262,11 +1311,11 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 在这个小例子中,这种技术仅仅在证明时提升了一点方便;然而,当证明变得庞大时, +(** 这个小例子展示了互映证明可以怎样为我们提供一些便利。在大型的开发中, 使用 [reflect] 往往更容易写出清晰和简短的证明脚本。我们将会在后面的章节 和_'编程语言基础'_一卷中看到更多的例子。 - 对 [reflect] 性质的使用是随着 _'SSReflect'_ 而流行开来的,这是一个 + 对 [reflect] 性质的使用已被 _'SSReflect'_ 推广开来,这是一个 Coq 程序库,用于形式化一些数学上的重要结果,包括四色定理和法伊特-汤普森定理。 SSReflect 的名字代表着 _'small-scale reflection'_,也即,普遍性地使用 互映来简化与布尔值计算有关的证明。*) @@ -1274,8 +1323,9 @@ Proof. (* ################################################################# *) (** * 额外练习 *) -(** **** 练习:3 星, recommended (nostutter_defn) *) -(** 写出性质的归纳定义是本课程中你需要的重要技能。请尝试去独立解决以下的练习。 +(** **** 练习:3 星, standard, recommended (nostutter_defn) + + 写出性质的归纳定义是本课程中你需要的重要技能。请尝试去独立解决以下的练习。 列表连续地重复某元素称为 "百叶窗式" (stutter)。 (此概念不同于不包含重复元素:[1;4;1] 虽然包含重复元素 [1], @@ -1325,8 +1375,9 @@ Example test_nostutter_4: not (nostutter [3;1;1;4]). Definition manual_grade_for_nostutter : option (nat*string) := None. (** [] *) -(** **** 练习:4 星, advanced (filter_challenge) *) -(** 让我们证明在 [Poly] 一章中 [filter] 的定义匹配某个抽象的规范。 +(** **** 练习:4 星, advanced (filter_challenge) + + 让我们证明在 [Poly] 一章中 [filter] 的定义匹配某个抽象的规范。 可以这样非形式化地描述这个规范: 列表 [l] 是一个 [l1] 和 [l2] 的“顺序合并”(in-order merge),如果它以 @@ -1357,15 +1408,18 @@ Definition manual_grade_for_nostutter : option (nat*string) := None. Definition manual_grade_for_filter_challenge : option (nat*string) := None. (** [] *) -(** **** 练习:5 星, advanced, optional (filter_challenge_2) *) -(** 另一种刻画 [filter] 行为的方式是:在 [l] 的所有其元素满足 [test] 的子序列中, +(** **** 练习:5 星, advanced, optional (filter_challenge_2) + + 另一种刻画 [filter] 行为的方式是:在 [l] 的所有其元素满足 [test] 的子序列中, [filter test l] 是最长的那个。请形式化这个命题并证明它。*) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 -(** **** 练习:4 星, optional (palindromes) *) -(** 回文是倒序排列与正序排列相同的序列。 + [] *) + +(** **** 练习:4 星, standard, optional (palindromes) + + 回文是倒序排列与正序排列相同的序列。 - 在 [listX] 上定义一个归纳命题 [pal] 来表达回文的含义。 (提示:你需要三个分类。定义应当基于列表的结构;仅仅使用一个构造子,例如 @@ -1389,17 +1443,20 @@ Definition manual_grade_for_filter_challenge : option (nat*string) := None. Definition manual_grade_for_pal_pal_app_rev_pal_rev : option (nat*string) := None. (** [] *) -(** **** 练习:5 星, optional (palindrome_converse) *) -(** 由于缺乏证据,反方向的证明要困难许多。使用之前练习中定义的 [pal] 来证明 +(** **** 练习:5 星, standard, optional (palindrome_converse) + + 由于缺乏证据,反方向的证明要困难许多。使用之前练习中定义的 [pal] 来证明 forall l, l = rev l -> pal l. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) -(** **** 练习:4 星, advanced, optional (NoDup) *) -(** 请回忆一下 [Logic] 章节中性质 [In] 的定义,其断言值 [x] 在列表 [l] 中至少出现一次:*) +(** **** 练习:4 星, advanced, optional (NoDup) + + 请回忆一下 [Logic] 章节中性质 [In] 的定义,其断言值 [x] 在列表 [l] 中至少出现一次:*) (* Fixpoint In (A : Type) (x : A) (l : list A) : Prop := match l with @@ -1427,8 +1484,9 @@ Definition manual_grade_for_pal_pal_app_rev_pal_rev : option (nat*string) := Non Definition manual_grade_for_NoDup_disjoint_etc : option (nat*string) := None. (** [] *) -(** **** 练习:4 星, advanced, optional (pigeonhole_principle) *) -(** _鸽笼原理(Pigeonhole Principle)'_是一个关于计数的基本事实: +(** **** 练习:4 星, advanced, optional (pigeonhole_principle) + + _鸽笼原理(Pigeonhole Principle)'_是一个关于计数的基本事实: 将超过 [n] 个物体放进 [n] 个鸽笼,则必有鸽笼包含至少两个物体。 与此前诸多情形相似,这一数学事实看似乏味,但其证明手段并不平凡, 如下所述: *) @@ -1470,9 +1528,8 @@ Proof. Definition manual_grade_for_check_repeats : option (nat*string) := None. (** [] *) - (* ================================================================= *) -(** ** 扩展练习:验证正则表达式匹配器 *) +(** ** 扩展练习:经验证的正则表达式匹配器 *) (** 我们现在已经定义了正则表达式的匹配关系和多态列表。我们可以使用这些定义来手动地证明 给定的正则表达式是否匹配某个字符串,但这并不是一个可以自动地判断是否匹配的程序。 @@ -1503,7 +1560,6 @@ Definition string := list ascii. [match] 关系并不依赖匹配函数。我们将会首先证明后一类性质。他们中的多数 将会是很直接的证明,已经被直接给出;少部分关键的引理会留给你来证明。 *) - (** 每个可被证明的 [Prop] 等价于 [True]。 *) Lemma provable_equiv_true : forall (P : Prop), P -> (P <-> True). Proof. @@ -1582,8 +1638,9 @@ Proof. rewrite Happ. apply (MApp s0 _ s1 _ Hmat0 Hmat1). Qed. -(** **** 练习:3 星, optional (app_ne) *) -(** [App re0 re1] 匹配 [a::s] 当且仅当 [re0] 匹配空字符串 +(** **** 练习:3 星, standard, optional (app_ne) + + [App re0 re1] 匹配 [a::s] 当且仅当 [re0] 匹配空字符串 且 [a::s] 匹配 [re1] 或 [s=s0++s1],其中 [a::s0] 匹配 [re0] 且 [s1] 匹配 [re1]。 @@ -1610,8 +1667,9 @@ Proof. + apply MUnionR. apply H. Qed. -(** **** 练习:3 星, optional (star_ne) *) -(** [a::s] 匹配 [Star re] 当且仅当 [s = s0 ++ s1],其中 [a::s0] 匹配 +(** **** 练习:3 星, standard, optional (star_ne) + + [a::s] 匹配 [Star re] 当且仅当 [s = s0 ++ s1],其中 [a::s0] 匹配 [re] 且 [s1] 匹配 [Star re]。 同 [app_ne]一样,这个观察很重要, 因此理解,证明并留意它。 @@ -1634,14 +1692,16 @@ Proof. Definition refl_matches_eps m := forall re : @reg_exp ascii, reflect ([ ] =~ re) (m re). -(** **** 练习:2 星, optional (match_eps) *) -(** 完成 [match_eps] 的定义,其测试给定的正则表达式是否匹配空字符串: *) +(** **** 练习:2 星, standard, optional (match_eps) + + 完成 [match_eps] 的定义,其测试给定的正则表达式是否匹配空字符串: *) Fixpoint match_eps (re: @reg_exp ascii) : bool (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. (** [] *) -(** **** 练习:3 星, optional (match_eps_refl) *) -(** 现在,请证明 [match_eps] 确实测试了给定的正则表达式是否匹配空字符串。 +(** **** 练习:3 星, standard, optional (match_eps_refl) + + 现在,请证明 [match_eps] 确实测试了给定的正则表达式是否匹配空字符串。 (提示:你会使用到互映引理 [ReflectT] 和 [ReflectF]。) *) Lemma match_eps_refl : refl_matches_eps match_eps. Proof. @@ -1651,7 +1711,6 @@ Proof. (** 我们将会定义其他函数也使用到 [match_eps]。然而,这些函数的证明中你唯一会用到的 [match_eps] 的性质是 [match_eps_refl]。*) - (** 我们匹配器所进行的关键操作是迭代地构造一个正则表达式生成式的序列。 对于字符 [a] 和正则表达式 [re],[re] 在 [a] 上的生成式是一个正则表达式, 其匹配所有匹配 [re] 且以 [a] 开始的字符串的后缀。也即,[re'] @@ -1664,8 +1723,9 @@ Definition is_der re (a : ascii) re' := 它求值为 [re] 在 [a] 上的生成式。也即,[d] 满足以下关系: *) Definition derives d := forall a re, is_der re a (d a re). -(** **** 练习:3 星, optional (derive) *) -(** 请定义 [derive] 使其生成字符串。一个自然的实现是在某些分类使用 +(** **** 练习:3 星, standard, optional (derive) + + 请定义 [derive] 使其生成字符串。一个自然的实现是在某些分类使用 [match_eps] 来判断正则表达式是否匹配空字符串。 *) Fixpoint derive (a : ascii) (re : @reg_exp ascii) : @reg_exp ascii (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -1719,8 +1779,9 @@ Example test_der7 : Proof. (* 请在此处解答 *) Admitted. -(** **** 练习:4 星, optional (derive_corr) *) -(** 请证明 [derive] 确实总是会生成字符串。 +(** **** 练习:4 星, standard, optional (derive_corr) + + 请证明 [derive] 确实总是会生成字符串。 提示:一种证明方法是对 [re] 归纳,尽管你需要通过归纳和一般化合适的项来 仔细选择要证明的性质。 @@ -1742,20 +1803,21 @@ Proof. (** 我们将会使用 [derive] 来定义正则表达式匹配器。然而,在匹配器的性质的证明中你唯一会用到 的 [derive] 的性质是 [derive_corr]。 *) - (** 函数 [m] 匹配正则表达式如果对给定的字符串 [s] 和正则表达式 [re], 它求值的结果映射了 [s] 是否被 [re] 匹配。也即,[m] 满足以下性质:*) Definition matches_regex m : Prop := forall (s : string) re, reflect (s =~ re) (m s re). -(** **** 练习:2 星, optional (regex_match) *) -(** 完成 [regex_match] 的定义,使其可以匹配正则表达式。*) +(** **** 练习:2 星, standard, optional (regex_match) + + 完成 [regex_match] 的定义,使其可以匹配正则表达式。*) Fixpoint regex_match (s : string) (re : @reg_exp ascii) : bool (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. (** [] *) -(** **** 练习:3 星, optional (regex_refl) *) -(** 最后,证明 [regex_match] 确实可以匹配正则表达式。 +(** **** 练习:3 星, standard, optional (regex_refl) + + 最后,证明 [regex_match] 确实可以匹配正则表达式。 提示:如果你定义的 [regex_match] 对正则表达式 [re] 使用了 [match_eps], 那么可对 [re] 应用 [match_eps_refl],接着对结果解构并生成 @@ -1769,4 +1831,4 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) - +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/IndPropTest.v b/lf-current/IndPropTest.v index b071118c..ccc9cae1 100644 --- a/lf-current/IndPropTest.v +++ b/lf-current/IndPropTest.v @@ -37,7 +37,7 @@ idtac " ". idtac "#> ev_double". idtac "Possible points: 1". -check_type @ev_double ((forall n : nat, ev (double n))). +check_type @ev_double ((forall n : nat, even (double n))). idtac "Assumptions:". Abort. Print Assumptions ev_double. @@ -49,7 +49,7 @@ idtac " ". idtac "#> SSSSev__even". idtac "Possible points: 1". -check_type @SSSSev__even ((forall n : nat, ev (S (S (S (S n)))) -> ev n)). +check_type @SSSSev__even ((forall n : nat, even (S (S (S (S n)))) -> even n)). idtac "Assumptions:". Abort. Print Assumptions SSSSev__even. @@ -61,7 +61,7 @@ idtac " ". idtac "#> even5_nonsense". idtac "Possible points: 1". -check_type @even5_nonsense ((ev 5 -> 2 + 2 = 9)). +check_type @even5_nonsense ((even 5 -> 2 + 2 = 9)). idtac "Assumptions:". Abort. Print Assumptions even5_nonsense. @@ -73,7 +73,7 @@ idtac " ". idtac "#> ev_sum". idtac "Possible points: 2". -check_type @ev_sum ((forall n m : nat, ev n -> ev m -> ev (n + m))). +check_type @ev_sum ((forall n m : nat, even n -> even m -> even (n + m))). idtac "Assumptions:". Abort. Print Assumptions ev_sum. @@ -86,7 +86,7 @@ idtac " ". idtac "#> ev_ev__ev". idtac "Advanced". idtac "Possible points: 3". -check_type @ev_ev__ev ((forall n m : nat, ev (n + m) -> ev n -> ev m)). +check_type @ev_ev__ev ((forall n m : nat, even (n + m) -> even n -> even m)). idtac "Assumptions:". Abort. Print Assumptions ev_ev__ev. @@ -104,10 +104,25 @@ idtac " ". idtac "------------------- subsequence --------------------". idtac " ". -idtac "#> Manually graded: subsequence". +idtac "#> subseq_refl". idtac "Advanced". -idtac "Possible points: 4". -print_manual_grade manual_grade_for_subsequence. +idtac "Possible points: 1". +check_type @subseq_refl ((forall l : list nat, subseq l l)). +idtac "Assumptions:". +Abort. +Print Assumptions subseq_refl. +Goal True. +idtac " ". + +idtac "#> subseq_app". +idtac "Advanced". +idtac "Possible points: 1". +check_type @subseq_app ( +(forall l1 l2 l3 : list nat, subseq l1 l2 -> subseq l1 (l2 ++ l3))). +idtac "Assumptions:". +Abort. +Print Assumptions subseq_app. +Goal True. idtac " ". idtac "------------------- exp_match_ex1 --------------------". @@ -232,7 +247,7 @@ idtac " ". idtac " ". idtac "Max points - standard: 23". -idtac "Max points - advanced: 39". +idtac "Max points - advanced: 37". idtac "". idtac "********** Summary **********". idtac "". @@ -267,10 +282,14 @@ idtac "". idtac "********** Advanced **********". idtac "---------- ev_ev__ev ---------". Print Assumptions ev_ev__ev. -idtac "---------- subsequence ---------". -idtac "MANUAL". +idtac "---------- subseq_refl ---------". +Print Assumptions subseq_refl. +idtac "---------- subseq_app ---------". +Print Assumptions subseq_app. idtac "---------- Pumping.pumping ---------". Print Assumptions Pumping.pumping. idtac "---------- filter_challenge ---------". idtac "MANUAL". Abort. + +(* Sat Jan 26 15:14:54 UTC 2019 *) diff --git a/lf-current/Induction.html b/lf-current/Induction.html index 5dfbfa49..7ebea673 100644 --- a/lf-current/Induction.html +++ b/lf-current/Induction.html @@ -179,7 +179,7 @@

    Induction归纳证明

    -

    归纳法证明

    +

    归纳法证明

    @@ -188,7 +188,7 @@

    Induction归纳证明

    -Theorem plus_n_O_firsttry : n:nat,
    +Theorem plus_n_O_firsttry : n:nat,
      n = n + 0.
    @@ -210,7 +210,7 @@

    Induction归纳证明

    -Theorem plus_n_O_secondtry : n:nat,
    +Theorem plus_n_O_secondtry : n:nat,
      n = n + 0.
    Proof.
      intros n. destruct n as [| n'] eqn:E.
    @@ -257,7 +257,7 @@

    Induction归纳证明

    -Theorem plus_n_O : n:nat, n = n + 0.
    +Theorem plus_n_O : n:nat, n = n + 0.
    Proof.
      intros n. induction n as [| n' IHn'].
      - (* n = 0 *) reflexivity.
    @@ -285,7 +285,7 @@

    Induction归纳证明

    -Theorem minus_diag : n,
    +Theorem minus_diag : n,
      minus n n = 0.
    Proof.
      (* 课上已完成 *)
    @@ -301,24 +301,24 @@

    Induction归纳证明

    策略被应用到包含量化变量的目标中时,它会自动将需要的变量移到上下文中。)
    -

    练习:2 星, recommended (basic_induction)

    +

    练习:2 星, standard, recommended (basic_induction)

    用归纳法证明以下命题。你可能需要之前的证明结果。
    -Theorem mult_0_r : n:nat,
    +Theorem mult_0_r : n:nat,
      n * 0 = 0.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem plus_n_Sm : n m : nat,
    +Theorem plus_n_Sm : n m : nat,
      S (n + m) = n + (S m).
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem plus_comm : n m : nat,
    +Theorem plus_comm : n m : nat,
      n + m = m + n.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem plus_assoc : n m p : nat,
    +Theorem plus_assoc : n m p : nat,
      n + (m + p) = (n + m) + p.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -328,7 +328,7 @@

    Induction归纳证明

    -

    练习:2 星 (double_plus)

    +

    练习:2 星, standard (double_plus)

    考虑以下函数,它将其参数乘以二:
    @@ -345,7 +345,7 @@

    Induction归纳证明

    -Lemma double_plus : n, double n = n + n .
    +Lemma double_plus : n, double n = n + n .
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -354,14 +354,14 @@

    Induction归纳证明

    -

    练习:2 星, optional (evenb_S)

    +

    练习:2 星, standard, optional (evenb_S)

    我们的 evenb n 定义对 n - 2 的递归调用不大方便。这让证明 evenb n 时更难对 n 进行归纳,因此我们需要一个关于 n - 2 的归纳假设。 以下引理赋予了 evenb (S n) 另一个特征,使其在归纳时能够更好地工作:
    -Theorem evenb_S : n : nat,
    +Theorem evenb_S : n : nat,
      evenb (S n) = negb (evenb n).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -371,7 +371,7 @@

    Induction归纳证明

    -

    练习:1 星 (destruct_induction)

    +

    练习:1 星, standard (destruct_induction)

    请简要说明一下 destruct 策略和 induction 策略之间的区别。
    @@ -388,7 +388,7 @@

    Induction归纳证明

    -

    证明里的证明

    +

    证明里的证明

    @@ -402,7 +402,7 @@

    Induction归纳证明

    -Theorem mult_0_plus' : n m : nat,
    +Theorem mult_0_plus' : n m : nat,
      (0 + n) * m = n * m.
    Proof.
      intros n m.
    @@ -433,7 +433,7 @@

    Induction归纳证明

    -Theorem plus_rearrange_firsttry : n m p q : nat,
    +Theorem plus_rearrange_firsttry : n m p q : nat,
      (n + m) + (p + q) = (m + n) + (p + q).
    Proof.
      intros n m p q.
    @@ -450,7 +450,7 @@

    Induction归纳证明

    -Theorem plus_rearrange : n m p q : nat,
    +Theorem plus_rearrange : n m p q : nat,
      (n + m) + (p + q) = (m + n) + (p + q).
    Proof.
      intros n m p q.
    @@ -460,7 +460,7 @@

    Induction归纳证明

    -

    形式化证明 vs. 非形式化证明

    +

    形式化证明 vs. 非形式化证明

    @@ -508,7 +508,7 @@

    Induction归纳证明

    -Theorem plus_assoc' : n m p : nat,
    +Theorem plus_assoc' : n m p : nat,
      n + (m + p) = (n + m) + p.
    Proof. intros n m p. induction n as [| n' IHn']. reflexivity.
      simpl. rewriteIHn'. reflexivity. Qed.
    @@ -520,7 +520,7 @@

    Induction归纳证明

    -Theorem plus_assoc'' : n m p : nat,
    +Theorem plus_assoc'' : n m p : nat,
      n + (m + p) = (n + m) + p.
    Proof.
      intros n m p. induction n as [| n' IHn'].
    @@ -615,7 +615,7 @@

    Induction归纳证明

    隐含的,而非形式化证明则经常反复告诉读者目前证明进行的状态)。
    -

    练习:2 星, advanced, recommended (plus_comm_informal)

    +

    练习:2 星, advanced, recommended (plus_comm_informal)

    将你对 plus_comm 的解答翻译成非形式化证明:
    @@ -637,7 +637,7 @@

    Induction归纳证明

    -

    练习:2 星, optional (eqb_refl_informal)

    +

    练习:2 星, standard, optional (eqb_refl_informal)

    plus_assoc 的非形式化证明为范本,写出以下定理的非形式化证明。 不要只是用中文来解释 Coq 策略! @@ -654,10 +654,7 @@

    Induction归纳证明


    -(* NEW NAME *)
    -Notation zero_neqb_S := zero_nbeq_S (only parsing).
    -Notation S_neqb_0 := S_nbeq_0 (only parsing).
    -Notation plus_leb_compat_l := plus_ble_compat_l (only parsing).
    +(* Sat Jan 26 15:14:45 UTC 2019 *)
    diff --git a/lf-current/Induction.v b/lf-current/Induction.v index 49500e7e..350a2c8a 100644 --- a/lf-current/Induction.v +++ b/lf-current/Induction.v @@ -151,7 +151,6 @@ Proof. [(S n') + 0 = S n'];它可被化简为 [S (n' + 0) = S n'],而此结论可通过 [IHn'] 得出。 *) - Theorem minus_diag : forall n, minus n n = 0. Proof. @@ -165,8 +164,9 @@ Proof. (** (其实在这些证明中我们并不需要 [intros]:当 [induction] 策略被应用到包含量化变量的目标中时,它会自动将需要的变量移到上下文中。) *) -(** **** 练习:2 星, recommended (basic_induction) *) -(** 用归纳法证明以下命题。你可能需要之前的证明结果。 *) +(** **** 练习:2 星, standard, recommended (basic_induction) + + 用归纳法证明以下命题。你可能需要之前的证明结果。 *) Theorem mult_0_r : forall n:nat, n * 0 = 0. @@ -189,8 +189,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (double_plus) *) -(** 考虑以下函数,它将其参数乘以二: *) +(** **** 练习:2 星, standard (double_plus) + + 考虑以下函数,它将其参数乘以二: *) Fixpoint double (n:nat) := match n with @@ -205,8 +206,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (evenb_S) *) -(** 我们的 [evenb n] 定义对 [n - 2] 的递归调用不大方便。这让证明 [evenb n] +(** **** 练习:2 星, standard, optional (evenb_S) + + 我们的 [evenb n] 定义对 [n - 2] 的递归调用不大方便。这让证明 [evenb n] 时更难对 [n] 进行归纳,因此我们需要一个关于 [n - 2] 的归纳假设。 以下引理赋予了 [evenb (S n)] 另一个特征,使其在归纳时能够更好地工作: *) @@ -216,8 +218,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (destruct_induction) *) -(** 请简要说明一下 [destruct] 策略和 [induction] 策略之间的区别。 +(** **** 练习:1 星, standard (destruct_induction) + + 请简要说明一下 [destruct] 策略和 [induction] 策略之间的区别。 (* 请在此处解答 *) *) @@ -372,8 +375,9 @@ Proof. 但在其它方面则不够明确(特别是 Coq 证明中任何一处的“证明状态”都是完全 隐含的,而非形式化证明则经常反复告诉读者目前证明进行的状态)。 *) -(** **** 练习:2 星, advanced, recommended (plus_comm_informal) *) -(** 将你对 [plus_comm] 的解答翻译成非形式化证明: +(** **** 练习:2 星, advanced, recommended (plus_comm_informal) + + 将你对 [plus_comm] 的解答翻译成非形式化证明: 定理:加法满足交换律。 @@ -384,21 +388,23 @@ Proof. Definition manual_grade_for_plus_comm_informal : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, optional (eqb_refl_informal) *) -(** 以 [plus_assoc] 的非形式化证明为范本,写出以下定理的非形式化证明。 +(** **** 练习:2 星, standard, optional (eqb_refl_informal) + + 以 [plus_assoc] 的非形式化证明为范本,写出以下定理的非形式化证明。 不要只是用中文来解释 Coq 策略! 定理:对于任何 [n],均有 [true = n =? n]。 证明: (* 请在此处解答 *) -*) -(** [] *) + + [] *) (* ################################################################# *) (** * 更多练习 *) -(** **** 练习:3 星, recommended (mult_comm) *) -(** 用 [assert] 来帮助证明此定理。你应该不需要对 [plus_swap] 进行归纳。 *) +(** **** 练习:3 星, standard, recommended (mult_comm) + + 用 [assert] 来帮助证明此定理。你应该不需要对 [plus_swap] 进行归纳。 *) Theorem plus_swap : forall n m p : nat, n + (m + p) = m + (n + p). @@ -414,8 +420,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (more_exercises) *) -(** 找一张纸。对于以下定理,首先请 _'思考'_ (a) 它能否能只用化简和改写来证明, +(** **** 练习:3 星, standard, optional (more_exercises) + + 找一张纸。对于以下定理,首先请 _'思考'_ (a) 它能否能只用化简和改写来证明, (b) 它还需要分类讨论([destruct]),以及 (c) 它还需要归纳证明。先写下你的 预判,然后填写下面的证明(你的纸不用交上来,这只是鼓励你先思考再行动!) *) @@ -470,8 +477,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (eqb_refl) *) -(** 证明以下定理。(把 [true] 放在等式左边可能看起来有点奇怪,不过 Coq 标准库中 +(** **** 练习:2 星, standard, optional (eqb_refl) + + 证明以下定理。(把 [true] 放在等式左边可能看起来有点奇怪,不过 Coq 标准库中 就是这样表示的,我们照做就是。无论按哪个方向改写都一样好用,所以无论我们如何 表示定理,用起来都没问题。) *) @@ -481,8 +489,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (plus_swap') *) -(** [replace] 策略允许你指定一个具体的要改写的子项和你想要将它改写成的项: +(** **** 练习:2 星, standard, optional (plus_swap') + + [replace] 策略允许你指定一个具体的要改写的子项和你想要将它改写成的项: [replace (t) with (u)] 会将目标中表达式 [t](的所有副本)替换为表达式 [u], 并生成 [t = u] 作为附加的子目标。在简单的 [rewrite] 作用在目标错误的部分上时 这种做法通常很有用。 @@ -496,8 +505,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, recommended (binary_commute) *) -(** 回忆一下你在 [Basics] 中为练习 [binary] 编写的 [incr] 和 [bin_to_nat] +(** **** 练习:3 星, standard, recommended (binary_commute) + + 回忆一下你在 [Basics] 中为练习 [binary] 编写的 [incr] 和 [bin_to_nat] 函数。证明下图可交换。 incr @@ -523,8 +533,9 @@ Proof. Definition manual_grade_for_binary_commute : option (nat*string) := None. (** [] *) -(** **** 练习:5 星, advanced (binary_inverse) *) -(** This is a further continuation of the previous exercises about +(** **** 练习:5 星, advanced (binary_inverse) + + This is a further continuation of the previous exercises about binary numbers. You may find you need to go back and change your earlier definitions to get things to work here. @@ -577,7 +588,4 @@ Definition manual_grade_for_binary_inverse_c : option (nat*string) := None. (** [] *) -(* NEW NAME *) -Notation zero_neqb_S := zero_nbeq_S (only parsing). -Notation S_neqb_0 := S_nbeq_0 (only parsing). -Notation plus_leb_compat_l := plus_ble_compat_l (only parsing). +(* Sat Jan 26 15:14:45 UTC 2019 *) diff --git a/lf-current/InductionTest.v b/lf-current/InductionTest.v index 9ccd1d4f..649553c2 100644 --- a/lf-current/InductionTest.v +++ b/lf-current/InductionTest.v @@ -176,3 +176,5 @@ idtac "MANUAL". idtac "---------- binary_inverse_c ---------". idtac "MANUAL". Abort. + +(* Sat Jan 26 15:14:48 UTC 2019 *) diff --git a/lf-current/LICENSE b/lf-current/LICENSE index 15ebac8e..568f5c1d 100644 --- a/lf-current/LICENSE +++ b/lf-current/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2018 +Copyright (c) 2019 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/lf-current/Lists.html b/lf-current/Lists.html index 58501a5f..abb65d23 100644 --- a/lf-current/Lists.html +++ b/lf-current/Lists.html @@ -39,7 +39,7 @@

    Lists使用结构化的数据

    -

    数值序对

    +

    数值序对

    @@ -168,7 +168,7 @@

    Lists使用结构化的数据

    -Theorem surjective_pairing' : (n m : nat),
    +Theorem surjective_pairing' : (n m : nat),
      (n,m) = (fst (n,m), snd (n,m)).
    Proof.
      reflexivity. Qed.
    @@ -180,7 +180,7 @@

    Lists使用结构化的数据

    -Theorem surjective_pairing_stuck : (p : natprod),
    +Theorem surjective_pairing_stuck : (p : natprod),
      p = (fst p, snd p).
    Proof.
      simpl. (* 啥也没有归约! *)
    @@ -193,7 +193,7 @@

    Lists使用结构化的数据

    -Theorem surjective_pairing : (p : natprod),
    +Theorem surjective_pairing : (p : natprod),
      p = (fst p, snd p).
    Proof.
      intros p. destruct p as [n m]. simpl. reflexivity. Qed.
    @@ -204,11 +204,11 @@

    Lists使用结构化的数据 一个子目标。这是因为 natprod 只有一种构造方法。
    -

    练习:1 星 (snd_fst_is_swap)

    +

    练习:1 星, standard (snd_fst_is_swap)

    -Theorem snd_fst_is_swap : (p : natprod),
    +Theorem snd_fst_is_swap : (p : natprod),
      (snd p, fst p) = swap_pair p.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -218,11 +218,11 @@

    Lists使用结构化的数据
    -

    练习:1 星, optional (fst_swap_is_snd)

    +

    练习:1 星, standard, optional (fst_swap_is_snd)

    -Theorem fst_swap_is_snd : (p : natprod),
    +Theorem fst_swap_is_snd : (p : natprod),
      fst (swap_pair p) = snd p.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -231,7 +231,7 @@

    Lists使用结构化的数据
    -

    数值列表

    +

    数值列表

    @@ -307,7 +307,7 @@

    Lists使用结构化的数据 以及将它们翻译成嵌套的二元构造子序列的方法。
    -

    Repeat

    +

    Repeat

    @@ -324,7 +324,7 @@

    Lists使用结构化的数据

    -

    Length

    +

    Length

    @@ -340,7 +340,7 @@

    Lists使用结构化的数据

    -

    Append

    +

    Append

    @@ -371,7 +371,7 @@

    Lists使用结构化的数据

    -

    Head(带默认值)与 Tail

    +

    Head(带默认值)与 Tail

    @@ -400,11 +400,11 @@

    Lists使用结构化的数据

    -

    练习

    +

    练习

    -

    练习:2 星, recommended (list_funs)

    +

    练习:2 星, standard, recommended (list_funs)

    完成以下 nonzerosoddmemberscountoddmembers 的定义, 你可以查看测试函数来理解这些函数应该做什么。
    @@ -437,7 +437,7 @@

    Lists使用结构化的数据
    -

    练习:3 星, advanced (alternate)

    +

    练习:3 星, advanced (alternate)

    完成 alternate 的定义,它从两个列表中交替地取出元素并合并为一个列表, 就像把拉链“拉”起来一样。更多具体示例见后面的测试。 @@ -469,7 +469,7 @@

    Lists使用结构化的数据
    -

    用列表实现口袋(Bag)

    +

    用列表实现口袋(Bag)

    @@ -482,7 +482,7 @@

    Lists使用结构化的数据

    -

    练习:3 星, recommended (bag_functions)

    +

    练习:3 星, standard, recommended (bag_functions)

    为袋子完成以下 countsumadd、和 member 函数的定义。
    @@ -539,7 +539,7 @@

    Lists使用结构化的数据
    -

    练习:3 星, optional (bag_more_functions)

    +

    练习:3 星, standard, optional (bag_more_functions)

    你可以把下面这些和 bag 有关的函数当作额外的练习
    @@ -585,7 +585,7 @@

    Lists使用结构化的数据
    -

    练习:2 星, recommended (bag_theorem)

    +

    练习:2 星, standard, recommended (bag_theorem)

    写一个你认为有趣的关于袋子的定理 bag_theorem,然后证明它; 这个定理需要用到 countadd。注意,这是个开放性问题。 也许你写下的定理是正确的,但它可能会涉及到你尚未学过的技巧因而无法证明。 @@ -609,7 +609,7 @@

    Lists使用结构化的数据
    -

    有关列表的论证

    +

    有关列表的论证

    @@ -618,7 +618,7 @@

    Lists使用结构化的数据

    -Theorem nil_app : l:natlist,
    +Theorem nil_app : l:natlist,
      [] ++ l = l.
    Proof. reflexivity. Qed.
    @@ -632,7 +632,7 @@

    Lists使用结构化的数据

    -Theorem tl_length_pred : l:natlist,
    +Theorem tl_length_pred : l:natlist,
      pred (length l) = length (tl l).
    Proof.
      intros l. destruct l as [| n l'].
    @@ -652,7 +652,7 @@

    Lists使用结构化的数据

    -

    一点点说教

    +

    一点点说教

    @@ -662,7 +662,7 @@

    Lists使用结构化的数据

    -

    对列表进行归纳

    +

    对列表进行归纳

    @@ -700,7 +700,7 @@

    Lists使用结构化的数据

    -Theorem app_assoc : l1 l2 l3 : natlist,
    +Theorem app_assoc : l1 l2 l3 : natlist,
      (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
    Proof.
      intros l1 l2 l3. induction l1 as [| n l1' IHl1'].
    @@ -778,7 +778,7 @@

    Lists使用结构化的数据
    -

    反转列表

    +

    反转列表

    @@ -799,7 +799,7 @@

    Lists使用结构化的数据

    -

    rev 的性质

    +

    rev 的性质

    @@ -810,7 +810,7 @@

    Lists使用结构化的数据

    -Theorem rev_length_firsttry : l : natlist,
    +Theorem rev_length_firsttry : l : natlist,
      length (rev l) = length l.
    Proof.
      intros l. induction l as [| n l' IHl'].
    @@ -833,7 +833,7 @@

    Lists使用结构化的数据

    -Theorem app_length : l1 l2 : natlist,
    +Theorem app_length : l1 l2 : natlist,
      length (l1 ++ l2) = (length l1) + (length l2).
    Proof.
      (* 课上已完成 *)
    @@ -854,7 +854,7 @@

    Lists使用结构化的数据

    -Theorem rev_length : l : natlist,
    +Theorem rev_length : l : natlist,
      length (rev l) = length l.
    Proof.
      intros l. induction l as [| n l' IHl'].
    @@ -1006,7 +1006,7 @@

    Lists使用结构化的数据

    -

    Search 搜索

    +

    Search 搜索

    @@ -1035,24 +1035,24 @@

    Lists使用结构化的数据

    -

    列表练习,第一部分

    +

    列表练习,第一部分

    -

    练习:3 星 (list_exercises)

    +

    练习:3 星, standard (list_exercises)

    更多有关列表的实践:
    -Theorem app_nil_r : l : natlist,
    +Theorem app_nil_r : l : natlist,
      l ++ [] = l.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem rev_app_distr: l1 l2 : natlist,
    +Theorem rev_app_distr: l1 l2 : natlist,
      rev (l1 ++ l2) = rev l2 ++ rev l1.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem rev_involutive : l : natlist,
    +Theorem rev_involutive : l : natlist,
      rev (rev l) = l.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1064,7 +1064,7 @@

    Lists使用结构化的数据

    -Theorem app_assoc4 : l1 l2 l3 l4 : natlist,
    +Theorem app_assoc4 : l1 l2 l3 l4 : natlist,
      l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1075,7 +1075,7 @@

    Lists使用结构化的数据

    -Lemma nonzeros_app : l1 l2 : natlist,
    +Lemma nonzeros_app : l1 l2 : natlist,
      nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1085,7 +1085,7 @@

    Lists使用结构化的数据
    -

    练习:2 星 (eqblist)

    +

    练习:2 星, standard (eqblist)

    填写 eqblist 的定义,它通过比较列表中的数字来判断是否相等。 证明对于所有列表 leqblist l l 返回 true
    @@ -1102,7 +1102,7 @@

    Lists使用结构化的数据 Example test_eqblist3 :
      eqblist [1;2;3] [1;2;4] = false.
     (* 请在此处解答 *) Admitted.

    -Theorem eqblist_refl : l:natlist,
    +Theorem eqblist_refl : l:natlist,
      true = eqblist l l.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1111,18 +1111,18 @@

    Lists使用结构化的数据
    -

    列表练习, 第二部分

    +

    列表练习, 第二部分

    下面这组简单的定理用于证明你之前关于袋子的定义。
    -

    练习:1 星 (count_member_nonzero)

    +

    练习:1 星, standard (count_member_nonzero)

    -Theorem count_member_nonzero : (s : bag),
    +Theorem count_member_nonzero : (s : bag),
      1 <=? (count 1 (1 :: s)) = true.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1136,7 +1136,7 @@

    Lists使用结构化的数据

    -Theorem leb_n_Sn : n,
    +Theorem leb_n_Sn : n,
      n <=? (S n) = true.
    Proof.
      intros n. induction n as [| n' IHn'].
    @@ -1148,11 +1148,11 @@

    Lists使用结构化的数据
    Before doing the next exercise, make sure you've filled in the - definition of remove_one above.

    练习:3 星, advanced (remove_does_not_increase_count)

    + definition of remove_one above.

    练习:3 星, advanced (remove_does_not_increase_count)

    -Theorem remove_does_not_increase_count: (s : bag),
    +Theorem remove_does_not_increase_count: (s : bag),
      (count 0 (remove_one 0 s)) <=? (count 0 s) = true.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1162,7 +1162,7 @@

    Lists使用结构化的数据
    -

    练习:3 星, optional (bag_count_sum)

    +

    练习:3 星, standard, optional (bag_count_sum)

    写下一个用到函数 countsum 的,关于袋子的有趣定理 bag_count_sum, 然后证明它。(你可能会发现该证明的难度取决于你如何定义 count!)
    @@ -1174,13 +1174,13 @@

    Lists使用结构化的数据
    -

    练习:4 星, advanced (rev_injective)

    +

    练习:4 星, advanced (rev_injective)

    求证 rev 是单射函数,即:
    -     (l1 l2 : natlist), rev l1 = rev l2 → l1 = l2. +    (l1 l2 : natlist), rev l1 = rev l2 → l1 = l2.
    @@ -1196,7 +1196,7 @@

    Lists使用结构化的数据
    -

    Options 可选类型

    +

    Options 可选类型

    @@ -1298,7 +1298,7 @@

    Lists使用结构化的数据

    -

    练习:2 星 (hd_error)

    +

    练习:2 星, standard (hd_error)

    用同样的思路修正之前的 hd 函数,使我们无需为 nil 的情况提供默认元素。
    @@ -1317,12 +1317,12 @@

    Lists使用结构化的数据
    -

    练习:1 星, optional (option_elim_hd)

    +

    练习:1 星, standard, optional (option_elim_hd)

    此练习能帮助你在新的 hd_error 和旧的 hd 之间建立联系。
    -Theorem option_elim_hd : (l:natlist) (default:nat),
    +Theorem option_elim_hd : (l:natlist) (default:nat),
      hd default l = option_elim default (hd_error l).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1335,7 +1335,7 @@

    Lists使用结构化的数据

    -

    偏映射(Partial Maps)

    +

    偏映射(Partial Maps)

    @@ -1367,11 +1367,11 @@

    Lists使用结构化的数据

    -

    练习:1 星 (eqb_id_refl)

    +

    练习:1 星, standard (eqb_id_refl)

    -Theorem eqb_id_refl : x, true = eqb_id x x.
    +Theorem eqb_id_refl : x, true = eqb_id x x.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1425,12 +1425,12 @@

    Lists使用结构化的数据

    -

    练习:1 星 (update_eq)

    +

    练习:1 星, standard (update_eq)

    Theorem update_eq :
    -   (d : partial_map) (x : id) (v: nat),
    +  (d : partial_map) (x : id) (v: nat),
        find x (update d x v) = Some v.
    Proof.
     (* 请在此处解答 *) Admitted.
    @@ -1440,12 +1440,12 @@

    Lists使用结构化的数据
    -

    练习:1 星 (update_neq)

    +

    练习:1 星, standard (update_neq)

    Theorem update_neq :
    -   (d : partial_map) (x y : id) (o: nat),
    +  (d : partial_map) (x y : id) (o: nat),
        eqb_id x y = falsefind x (update d y o) = find x d.
    Proof.
     (* 请在此处解答 *) Admitted.
    @@ -1457,7 +1457,7 @@

    Lists使用结构化的数据

    -

    练习:2 星 (baz_num_elts)

    +

    练习:2 星, standard (baz_num_elts)

    考虑以下归纳定义:
    @@ -1478,6 +1478,10 @@

    Lists使用结构化的数据

    +
    + +(* Sat Jan 26 15:14:45 UTC 2019 *)
    +

    diff --git a/lf-current/Lists.v b/lf-current/Lists.v index 095e6cd6..b1c2ce49 100644 --- a/lf-current/Lists.v +++ b/lf-current/Lists.v @@ -123,14 +123,14 @@ Proof. (** 注意:不同于解构自然数产生两个子目标,[destruct] 在此只产生 一个子目标。这是因为 [natprod] 只有一种构造方法。 *) -(** **** 练习:1 星 (snd_fst_is_swap) *) +(** **** 练习:1 星, standard (snd_fst_is_swap) *) Theorem snd_fst_is_swap : forall (p : natprod), (snd p, fst p) = swap_pair p. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星, optional (fst_swap_is_snd) *) +(** **** 练习:1 星, standard, optional (fst_swap_is_snd) *) Theorem fst_swap_is_snd : forall (p : natprod), fst (swap_pair p) = snd p. Proof. @@ -261,8 +261,9 @@ Proof. reflexivity. Qed. (* ----------------------------------------------------------------- *) (** *** 练习 *) -(** **** 练习:2 星, recommended (list_funs) *) -(** 完成以下 [nonzeros]、[oddmembers] 和 [countoddmembers] 的定义, +(** **** 练习:2 星, standard, recommended (list_funs) + + 完成以下 [nonzeros]、[oddmembers] 和 [countoddmembers] 的定义, 你可以查看测试函数来理解这些函数应该做什么。 *) Fixpoint nonzeros (l:natlist) : natlist @@ -295,8 +296,9 @@ Example test_countoddmembers3: (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced (alternate) *) -(** 完成 [alternate] 的定义,它从两个列表中交替地取出元素并合并为一个列表, +(** **** 练习:3 星, advanced (alternate) + + 完成 [alternate] 的定义,它从两个列表中交替地取出元素并合并为一个列表, 就像把拉链“拉”起来一样。更多具体示例见后面的测试。 (注意:[alternate] 有一种自然而优雅的定义,但是这一定义无法满足 Coq @@ -332,8 +334,9 @@ Example test_alternate4: Definition bag := natlist. -(** **** 练习:3 星, recommended (bag_functions) *) -(** 为袋子完成以下 [count]、[sum]、[add]、和 [member] 函数的定义。 *) +(** **** 练习:3 星, standard, recommended (bag_functions) + + 为袋子完成以下 [count]、[sum]、[add]、和 [member] 函数的定义。 *) Fixpoint count (v:nat) (s:bag) : nat (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -381,8 +384,9 @@ Example test_member2: member 2 [1;4;1] = false. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (bag_more_functions) *) -(** 你可以把下面这些和 [bag] 有关的函数当作额外的练习 *) +(** **** 练习:3 星, standard, optional (bag_more_functions) + + 你可以把下面这些和 [bag] 有关的函数当作额外的练习 *) (** 倘若某口袋不包含所要移除的数字,那么将 [remove_one] 作用其上不应改变其内容。 (本练习为选做,但高级班的学生为了完成后面的练习,需要写出 [remove_one] @@ -428,8 +432,9 @@ Example test_subset2: subset [1;2;2] [2;1;4;1] = false. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, recommended (bag_theorem) *) -(** 写一个你认为有趣的关于袋子的定理 [bag_theorem],然后证明它; +(** **** 练习:2 星, standard, recommended (bag_theorem) + + 写一个你认为有趣的关于袋子的定理 [bag_theorem],然后证明它; 这个定理需要用到 [count] 和 [add]。注意,这是个开放性问题。 也许你写下的定理是正确的,但它可能会涉及到你尚未学过的技巧因而无法证明。 如果你遇到麻烦了,欢迎提问! *) @@ -445,8 +450,9 @@ Qed. Definition manual_grade_for_bag_theorem : option (nat*string) := None. (* Note to instructors: For silly technical reasons, in this file (only) you will need to write [Some (Datatypes.pair 3 ""%string)] - rather than [Some (3,""%string)] to enter your grade and comments. *) -(** [] *) + rather than [Some (3,""%string)] to enter your grade and comments. + + [] *) (* ################################################################# *) (** * 有关列表的论证 *) @@ -687,7 +693,6 @@ Proof. 以及当前的证明与读者熟悉的证明之间的相似度都会影响到这一点。 对于我们现在的目的而言,最好先用更加冗长的方式。 *) - (** ** [Search] 搜索*) (** 我们已经见过很多需要使用之前证明过的结论(例如通过 [rewrite])来证明的定理了。 @@ -708,8 +713,9 @@ Proof. (* ================================================================= *) (** ** 列表练习,第一部分 *) -(** **** 练习:3 星 (list_exercises) *) -(** 更多有关列表的实践: *) +(** **** 练习:3 星, standard (list_exercises) + + 更多有关列表的实践: *) Theorem app_nil_r : forall l : natlist, l ++ [] = l. @@ -742,8 +748,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (eqblist) *) -(** 填写 [eqblist] 的定义,它通过比较列表中的数字来判断是否相等。 +(** **** 练习:2 星, standard (eqblist) + + 填写 [eqblist] 的定义,它通过比较列表中的数字来判断是否相等。 证明对于所有列表 [l],[eqblist l l] 返回 [true]。 *) Fixpoint eqblist (l1 l2 : natlist) : bool @@ -772,7 +779,7 @@ Proof. (** 下面这组简单的定理用于证明你之前关于袋子的定义。 *) -(** **** 练习:1 星 (count_member_nonzero) *) +(** **** 练习:1 星, standard (count_member_nonzero) *) Theorem count_member_nonzero : forall (s : bag), 1 <=? (count 1 (1 :: s)) = true. Proof. @@ -799,14 +806,17 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (bag_count_sum) *) -(** 写下一个用到函数 [count] 和 [sum] 的,关于袋子的有趣定理 [bag_count_sum], +(** **** 练习:3 星, standard, optional (bag_count_sum) + + 写下一个用到函数 [count] 和 [sum] 的,关于袋子的有趣定理 [bag_count_sum], 然后证明它。(你可能会发现该证明的难度取决于你如何定义 [count]!) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 -(** **** 练习:4 星, advanced (rev_injective) *) -(** 求证 [rev] 是单射函数,即: + [] *) + +(** **** 练习:4 星, advanced (rev_injective) + + 求证 [rev] 是单射函数,即: forall (l1 l2 : natlist), rev l1 = rev l2 -> l1 = l2. @@ -867,7 +877,6 @@ Proof. reflexivity. Qed. 本例也是个介绍 Coq 编程语言更多细微特性的机会,比如条件表达式... *) - Fixpoint nth_error' (l:natlist) (n:nat) : natoption := match l with | nil => None @@ -889,7 +898,7 @@ Definition option_elim (d : nat) (o : natoption) : nat := | None => d end. -(** **** 练习:2 星 (hd_error) *) +(** **** 练习:2 星, standard (hd_error) *) (** 用同样的思路修正之前的 [hd] 函数,使我们无需为 [nil] 的情况提供默认元素。 *) Definition hd_error (l : natlist) : natoption @@ -905,7 +914,7 @@ Example test_hd_error3 : hd_error [5;6] = Some 5. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星, optional (option_elim_hd) *) +(** **** 练习:1 星, standard, optional (option_elim_hd) *) (** 此练习能帮助你在新的 [hd_error] 和旧的 [hd] 之间建立联系。 *) Theorem option_elim_hd : forall (l:natlist) (default:nat), @@ -937,7 +946,7 @@ Definition eqb_id (x1 x2 : id) := | Id n1, Id n2 => n1 =? n2 end. -(** **** 练习:1 星 (eqb_id_refl) *) +(** **** 练习:1 星, standard (eqb_id_refl) *) Theorem eqb_id_refl : forall x, true = eqb_id x x. Proof. (* 请在此处解答 *) Admitted. @@ -976,7 +985,7 @@ Fixpoint find (x : id) (d : partial_map) : natoption := else find x d' end. -(** **** 练习:1 星 (update_eq) *) +(** **** 练习:1 星, standard (update_eq) *) Theorem update_eq : forall (d : partial_map) (x : id) (v: nat), find x (update d x v) = Some v. @@ -984,7 +993,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (update_neq) *) +(** **** 练习:1 星, standard (update_neq) *) Theorem update_neq : forall (d : partial_map) (x y : id) (o: nat), eqb_id x y = false -> find x (update d y o) = find x d. @@ -993,8 +1002,9 @@ Proof. (** [] *) End PartialMap. -(** **** 练习:2 星 (baz_num_elts) *) -(** 考虑以下归纳定义: *) +(** **** 练习:2 星, standard (baz_num_elts) + + 考虑以下归纳定义: *) Inductive baz : Type := | Baz1 (x : baz) @@ -1008,3 +1018,4 @@ Inductive baz : Type := Definition manual_grade_for_baz_num_elts : option (nat*string) := None. (** [] *) +(* Sat Jan 26 15:14:45 UTC 2019 *) diff --git a/lf-current/ListsTest.v b/lf-current/ListsTest.v index 5569520e..0f8df109 100644 --- a/lf-current/ListsTest.v +++ b/lf-current/ListsTest.v @@ -472,3 +472,5 @@ Print Assumptions NatList.remove_does_not_increase_count. idtac "---------- rev_injective ---------". idtac "MANUAL". Abort. + +(* Sat Jan 26 15:14:49 UTC 2019 *) diff --git a/lf-current/Logic.html b/lf-current/Logic.html index c2f6f799..1fc1de93 100644 --- a/lf-current/Logic.html +++ b/lf-current/Logic.html @@ -43,7 +43,7 @@

    LogicCoq 中的逻辑系统命题) 以及如何用证据展示其正确性(即证明)的例子了。特别是, 我们证明了大量形如 e1 = e2相等关系命题、形如 P Q - 的蕴含式、以及形如 x, P x 的量化命题。 + 的蕴含式、以及形如 x, P x 的量化命题。
    @@ -57,7 +57,7 @@

    LogicCoq 中的逻辑系统Check 3 = 3.
    (* ===> Prop *)

    -Check n m : nat, n + m = m + n.
    +Check n m : nat, n + m = m + n.
    (* ===> Prop *)

    @@ -71,7 +71,7 @@

    LogicCoq 中的逻辑系统Check 2 = 2.
    (* ===> Prop *)

    -Check n : nat, n = 2.
    +Check n : nat, n = 2.
    (* ===> Prop *)

    Check 3 = 4.
    (* ===> Prop *)
    @@ -126,7 +126,7 @@

    LogicCoq 中的逻辑系统Definition is_three (n : nat) : Prop :=
      n = 3.
    Check is_three.
    -(* ===> nat -> Prop *)
    +(* ===> nat -> Prop *)

    @@ -139,7 +139,7 @@

    LogicCoq 中的逻辑系统 Definition injective {A B} (f : AB) :=
    -   x y : A, f x = f yx = y.

    +  x y : A, f x = f yx = y.

    Lemma succ_inj : injective S.
    Proof.
      intros n m H. injection H as H1. apply H1.
    @@ -157,7 +157,7 @@

    LogicCoq 中的逻辑系统 Check @eq.
    -(* ===> forall A : Type, A -> A -> Prop *)
    +(* ===> forall A : Type, A -> A -> Prop *)

    @@ -166,11 +166,11 @@

    LogicCoq 中的逻辑系统
    -

    逻辑联结词

    +

    逻辑联结词

    -

    合取

    +

    合取

    @@ -188,7 +188,6 @@

    LogicCoq 中的逻辑系统 Proof.
    -  (* 课上已完成 *)
      split.
      - (* 3 + 4 = 7 *) reflexivity.
      - (* 2 + 2 = 4 *) reflexivity.
    @@ -201,7 +200,7 @@

    LogicCoq 中的逻辑系统
    -Lemma and_intro : A B : Prop, ABAB.
    +Lemma and_intro : A B : Prop, ABAB.
    Proof.
      intros A B HA HB. split.
      - apply HA.
    @@ -224,12 +223,12 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星 (and_exercise)

    +

    练习:2 星, standard (and_exercise)

    Example and_exercise :
    -   n m : nat, n + m = 0 → n = 0 ∧ m = 0.
    +  n m : nat, n + m = 0 → n = 0 ∧ m = 0.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -250,7 +249,7 @@

    LogicCoq 中的逻辑系统 Lemma and_example2 :
    -   n m : nat, n = 0 ∧ m = 0 → n + m = 0.
    +  n m : nat, n = 0 ∧ m = 0 → n + m = 0.
    Proof.
      (* 课上已完成 *)
      intros n m H.
    @@ -267,7 +266,7 @@

    LogicCoq 中的逻辑系统 Lemma and_example2' :
    -   n m : nat, n = 0 ∧ m = 0 → n + m = 0.
    +  n m : nat, n = 0 ∧ m = 0 → n + m = 0.
    Proof.
      intros n m [Hn Hm].
      rewrite Hn. rewrite Hm.
    @@ -282,7 +281,7 @@

    LogicCoq 中的逻辑系统 Lemma and_example2'' :
    -   n m : nat, n = 0 → m = 0 → n + m = 0.
    +  n m : nat, n = 0 → m = 0 → n + m = 0.
    Proof.
      intros n m Hn Hm.
      rewrite Hn. rewrite Hm.
    @@ -298,7 +297,7 @@

    LogicCoq 中的逻辑系统 Lemma and_example3 :
    -   n m : nat, n + m = 0 → n * m = 0.
    +  n m : nat, n + m = 0 → n * m = 0.
    Proof.
      (* 课上已完成 *)
      intros n m H.
    @@ -315,7 +314,7 @@

    LogicCoq 中的逻辑系统
    -Lemma proj1 : P Q : Prop,
    +Lemma proj1 : P Q : Prop,
      PQP.
    Proof.
      intros P Q [HP HQ].
    @@ -323,11 +322,11 @@

    LogicCoq 中的逻辑系统
    -

    练习:1 星, optional (proj2)

    +

    练习:1 星, standard, optional (proj2)

    -Lemma proj2 : P Q : Prop,
    +Lemma proj2 : P Q : Prop,
      PQQ.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -342,7 +341,7 @@

    LogicCoq 中的逻辑系统
    -Theorem and_commut : P Q : Prop,
    +Theorem and_commut : P Q : Prop,
      PQQP.
    Proof.
      intros P Q [HP HQ].
    @@ -352,14 +351,14 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星 (and_assoc)

    +

    练习:2 星, standard (and_assoc)

    (在以下结合律的证明中,注意嵌套intros 模式是如何将 H : P (Q R) 拆分为 HP : PHQ : QHR : R 的。 请从那里开始完成证明。)
    -Theorem and_assoc : P Q R : Prop,
    +Theorem and_assoc : P Q R : Prop,
      P ∧ (QR) → (PQ) ∧ R.
    Proof.
      intros P Q R [HP [HQ HR]].
    @@ -376,27 +375,27 @@

    LogicCoq 中的逻辑系统 Check and.
    -(* ===> and : Prop -> Prop -> Prop *)
    +(* ===> and : Prop -> Prop -> Prop *)

    -

    析取

    +

    析取

    另一个重要的联结词是_析取_,即两个命题的逻辑或:若 AB - 二者之一为真,则 A B 为真。(我们也可以写作 or A B,其中 + 二者之一为真,则 A B 为真。(这中中缀记法表示 or A B,其中 or : Prop Prop Prop。)
    为了在证明中使用析取前提,我们需要分类讨论,它与 nat - 或其它数据类型一样,都可以通过 destructintros 来拆分。 - 下面就是个例子: + 或其它数据类型一样,都可以显示地通过 destruct 或隐式地通过 intros + 模式来拆分:
    Lemma or_example :
    -   n m : nat, n = 0 ∨ m = 0 → n * m = 0.
    +  n m : nat, n = 0 ∨ m = 0 → n * m = 0.
    Proof.
      (* Hn | Hm 会隐式地对 n = 0 m = 0 进行分类讨论 *)
      intros n m [Hn | Hm].
    @@ -416,7 +415,7 @@

    LogicCoq 中的逻辑系统
    -Lemma or_intro : A B : Prop, AAB.
    +Lemma or_intro : A B : Prop, AAB.
    Proof.
      intros A B HA.
      left.
    @@ -425,12 +424,12 @@

    LogicCoq 中的逻辑系统
    -...而更有趣的例子则同时需要 leftright: +...而这个更有趣的例子则同时需要 leftright
    Lemma zero_or_succ :
    -   n : nat, n = 0 ∨ n = S (pred n).
    +  n : nat, n = 0 ∨ n = S (pred n).
    Proof.
      (* 课上已完成 *)
      intros [|n].
    @@ -440,37 +439,42 @@

    LogicCoq 中的逻辑系统
    -

    假命题与否定

    +

    假命题与否定

    目前为止,我们主要都在证明某些东西是的:加法满足结合律, 列表的连接满足结合律,等等。当然,我们也关心否定的结果, - 即证明某些命题不是真的。在 Coq 中,这样的否定语句使用否定运算符 + 即证明某些给定的命题不是真的。在 Coq 中,这样的否定语句使用否定运算符 ¬ 来表达。
    - 为了理解否定背后的原理,我们需要回想一下Tactics一章中对爆炸原理的讨论。 - 爆炸原理断言,当我们假设了矛盾存在时,就能推出任何命题。遵循这一直觉, - 我们可以可以将 ¬ P(即非 P)定义为 Q, P Q。 - 不过 Coq 选择了稍有些不同的做法,它将 ¬ P 定义为 P False,而 + 为了理解否定背后的原理,我们需要回想一下Tactics一章中的爆炸原理。 + 爆炸原理断言,当我们假设了矛盾存在时,就能推出任何命题。 + +
    + + 遵循这一直觉,我们可以可以将 ¬ P(即非 P)定义为 Q, P Q。 + +
    + + 不过 Coq 选择了稍有些不同(但等价)的做法,它将 ¬ P 定义为 P False,而 False 是在标准库中特别定义的矛盾性命题。
    Module MyNot.

    Definition not (P:Prop) := PFalse.

    -Notation "¬ x" := (not x) : type_scope.

    +Notation "¬x" := (not x) : type_scope.

    Check not.
    -(* ===> Prop -> Prop *)

    +(* ===> Prop -> Prop *)

    End MyNot.
    由于 False 是个矛盾性命题,因此爆炸原理对它也适用。如果我们让 False - 进入到了证明的上下文中,可以对它使用 destruct(或 discriminate) - 来完成任何待证目标。 + 进入到了证明的上下文中,可以对它使用 destruct 来完成任何待证目标。
    -Theorem ex_falso_quodlibet : (P:Prop),
    +Theorem ex_falso_quodlibet : (P:Prop),
      FalseP.
    Proof.
      (* 课上已完成 *)
    @@ -483,13 +487,13 @@

    LogicCoq 中的逻辑系统

    -

    练习:2 星, optional (not_implies_our_not)

    +

    练习:2 星, standard, optional (not_implies_our_not)

    证明 Coq 对否定的定义蕴含前面提到的直觉上的定义:
    -Fact not_implies_our_not : (P:Prop),
    -  ¬ P → ( (Q:Prop), PQ).
    +Fact not_implies_our_not : (P:Prop),
    +  ¬P → ((Q:Prop), PQ).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -498,26 +502,48 @@

    LogicCoq 中的逻辑系统
    - 下面我们用 not 陈述了 01 是不同的 nat 元素: + 不等性是十分常见的否定句的例子,,它有一个特别的记法 x y: + +
    + +
    +      Notation "x ≠ y" := (~(x = y)). +
    + +
    + +
    + + 我们可以用 not 来陈述 01 是不同的 nat 元素:

    -Theorem zero_not_one : ~(0 = 1).
    +Theorem zero_not_one : 0 ≠ 1.
    Proof.
    -  intros contra. discriminate contra.
    -Qed.
    -这样的不等性表述频繁出现,足以让我们为其定义一种特殊的记法 x y: +性质 0 1 就是 ~(0 = 1),即 not (0 = 1), + 它会展开为 (0 = 1) False。(这里显式地用 unfold not + 展示了这一点,不过一般可以忽略。
    +  unfold not.
    +
    -Check (0 ≠ 1).
    -(* ===> Prop *)

    -Theorem zero_not_one' : 0 ≠ 1.
    -Proof.
    -  intros H. discriminate H.
    +
    +要证明不等性,我们可以反过来假设其相等... +
    +
    +  intros contra.
    +
    + +
    +... 然后从中推出矛盾。在这里,等式 O = S O 与构造子 OS + 的不交性相矛盾,因此用 discriminate 就能解决它。 +
    +
    +  discriminate contra.
    Qed.
    @@ -529,16 +555,16 @@

    LogicCoq 中的逻辑系统 Theorem not_False :
    -  ¬ False.
    +  ¬False.
    Proof.
      unfold not. intros H. destruct H. Qed.

    -Theorem contradiction_implies_anything : P Q : Prop,
    +Theorem contradiction_implies_anything : P Q : Prop,
      (P ∧ ¬P) → Q.
    Proof.
      (* 课上已完成 *)
      intros P Q [HP HNA]. unfold not in HNA.
      apply HNA in HP. destruct HP. Qed.

    -Theorem double_neg : P : Prop,
    +Theorem double_neg : P : Prop,
      P → ~~P.
    Proof.
      (* 课上已完成 *)
    @@ -546,7 +572,7 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星, advanced (double_neg_inf)

    +

    练习:2 星, advanced (double_neg_inf)

    请写出 double_neg 的非形式化证明:
    @@ -564,11 +590,11 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星, recommended (contrapositive)

    +

    练习:2 星, standard, recommended (contrapositive)

    -Theorem contrapositive : (P Q : Prop),
    +Theorem contrapositive : (P Q : Prop),
      (PQ) → (¬Q → ¬P).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -578,12 +604,12 @@

    LogicCoq 中的逻辑系统
    -

    练习:1 星 (not_both_true_and_false)

    +

    练习:1 星, standard (not_both_true_and_false)

    -Theorem not_both_true_and_false : P : Prop,
    -  ¬ (P ∧ ¬P).
    +Theorem not_both_true_and_false : P : Prop,
    +  ¬(P ∧ ¬P).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -592,8 +618,8 @@

    LogicCoq 中的逻辑系统
    -

    练习:1 星, advanced (informal_not_PNP)

    - 请写出 P : Prop, ~(P ¬P) 的非形式化证明。 +

    练习:1 星, advanced (informal_not_PNP)

    + 请写出 P : Prop, ~(P ¬P) 的非形式化证明。
    @@ -614,7 +640,7 @@

    LogicCoq 中的逻辑系统
    -Theorem not_true_is_false : b : bool,
    +Theorem not_true_is_false : b : bool,
      btrueb = false.
    Proof.
      intros [] H.
    @@ -633,7 +659,7 @@

    LogicCoq 中的逻辑系统
    -Theorem not_true_is_false' : b : bool,
    +Theorem not_true_is_false' : b : bool,
      btrueb = false.
    Proof.
      intros [] H.
    @@ -646,7 +672,7 @@

    LogicCoq 中的逻辑系统
    -

    真值

    +

    真值

    @@ -665,7 +691,7 @@

    LogicCoq 中的逻辑系统True 的这类用法。
    -

    逻辑等价

    +

    逻辑等价

    @@ -680,31 +706,31 @@

    LogicCoq 中的逻辑系统at level 95, no associativity)
                          : type_scope.

    End MyIff.

    -Theorem iff_sym : P Q : Prop,
    +Theorem iff_sym : P Q : Prop,
      (PQ) → (QP).
    Proof.
      (* 课上已完成 *)
      intros P Q [HAB HBA].
      split.
    -  - (* -> *) apply HBA.
    +  - (* -> *) apply HBA.
      - (* <- *) apply HAB. Qed.

    -Lemma not_true_iff_false : b,
    +Lemma not_true_iff_false : b,
      btrueb = false.
    Proof.
      (* 课上已完成 *)
      intros b. split.
    -  - (* -> *) apply not_true_is_false.
    +  - (* -> *) apply not_true_is_false.
      - (* <- *)
        intros H. rewrite H. intros H'. discriminate H'.
    Qed.

    -

    练习:3 星 (or_distributes_over_and)

    +

    练习:3 星, standard (or_distributes_over_and)

    -Theorem or_distributes_over_and : P Q R : Prop,
    +Theorem or_distributes_over_and : P Q R : Prop,
      P ∨ (QR) ↔ (PQ) ∧ (PR).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -720,7 +746,7 @@

    LogicCoq 中的逻辑系统
    -Require Import Coq.Setoids.Setoid.
    +From Coq Require Import Setoids.Setoid.
    @@ -729,7 +755,7 @@

    LogicCoq 中的逻辑系统
    -Lemma mult_0 : n m, n * m = 0 ↔ n = 0 ∨ m = 0.
    +Lemma mult_0 : n m, n * m = 0 ↔ n = 0 ∨ m = 0.
    Proof.
    @@ -741,7 +767,7 @@

    LogicCoq 中的逻辑系统 Lemma or_assoc :
    -   P Q R : Prop, P ∨ (QR) ↔ (PQ) ∨ R.
    +  P Q R : Prop, P ∨ (QR) ↔ (PQ) ∨ R.
    Proof.
    @@ -766,7 +792,7 @@

    LogicCoq 中的逻辑系统 Lemma mult_0_3 :
    -   n m p, n * m * p = 0 ↔ n = 0 ∨ m = 0 ∨ p = 0.
    +  n m p, n * m * p = 0 ↔ n = 0 ∨ m = 0 ∨ p = 0.
    Proof.
      intros n m p.
      rewrite mult_0. rewrite mult_0. rewrite or_assoc.
    @@ -781,61 +807,61 @@

    LogicCoq 中的逻辑系统 Lemma apply_iff_example :
    -   n m : nat, n * m = 0 → n = 0 ∨ m = 0.
    +  n m : nat, n * m = 0 → n = 0 ∨ m = 0.
    Proof.
      intros n m H. apply mult_0. apply H.
    Qed.

    -

    存在量化

    +

    存在量化

    存在量化也是十分重要的逻辑联结词。我们说存在某个类型为 T - 的 x,使得某些性质 P 对于 x 成立,写作 x : T, P。 - 和 一样,如果 Coq 能从上下文中推断出 x 的类型,那么类型标注 + 的 x,使得某些性质 P 对于 x 成立,写作 x : T, P。 + 和 一样,如果 Coq 能从上下文中推断出 x 的类型,那么类型标注 : T 就可以省略。
    - 为了证明形如 x, P 的语句,我们必须证明 P 对于某些特定的 + 为了证明形如 x, P 的语句,我们必须证明 P 对于某些特定的 x 成立,这些特定的 x 被称作存在性的例证。证明分为两步: - 首先,我们调用 t 策略向 Coq 指出已经知道了使 P + 首先,我们调用 t 策略向 Coq 指出已经知道了使 P 成立的例证 t,然后证明将所有出现的 x 替换成 t 的命题 P
    -Lemma four_is_even : n : nat, 4 = n + n.
    +Lemma four_is_even : n : nat, 4 = n + n.
    Proof.
    -   2. reflexivity.
    +  2. reflexivity.
    Qed.
    -反之,如果我们的的上下文中有形如 x, P 的存在前提, +反之,如果我们的的上下文中有形如 x, P 的存在前提, 可以将其解构得到一个例证 x 和一个陈述 P 对于 x 成立的前提。
    -Theorem exists_example_2 : n,
    -  ( m, n = 4 + m) →
    -  ( o, n = 2 + o).
    +Theorem exists_example_2 : n,
    +  (m, n = 4 + m) →
    +  (o, n = 2 + o).
    Proof.
      (* 课上已完成 *)
      intros n [m Hm]. (* 注意这里隐式使用了 destruct *)
    -   (2 + m).
    +  (2 + m).
      apply Hm. Qed.
    -

    练习:1 星, recommended (dist_not_exists)

    +

    练习:1 星, standard, recommended (dist_not_exists)

    请证明“P 对所有 x 成立”蕴含“不存在 x 使 P 不成立。” (提示:destruct H as [x E] 可以用于存在假设!)
    -Theorem dist_not_exists : (X:Type) (P : XProp),
    -  ( x, P x) → ¬ ( x, ¬ P x).
    +Theorem dist_not_exists : (X:Type) (P : XProp),
    +  (x, P x) → ¬(x, ¬P x).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -844,13 +870,13 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星 (dist_exists_or)

    +

    练习:2 星, standard (dist_exists_or)

    请证明存在量化对析取满足分配律。
    -Theorem dist_exists_or : (X:Type) (P Q : XProp),
    -  ( x, P xQ x) ↔ ( x, P x) ∨ ( x, Q x).
    +Theorem dist_exists_or : (X:Type) (P Q : XProp),
    +  (x, P xQ x) ↔ (x, P x) ∨ (x, Q x).
    Proof.
       (* 请在此处解答 *) Admitted.
    @@ -858,7 +884,7 @@

    LogicCoq 中的逻辑系统
    -

    使用命题编程

    +

    使用命题编程

    @@ -906,14 +932,14 @@

    LogicCoq 中的逻辑系统simpl. right. right. right. left. reflexivity.
    Qed.

    Example In_example_2 :
    -   n, In n [2; 4] →
    -   n', n = 2 * n'.
    +  n, In n [2; 4] →
    +  n', n = 2 * n'.
    Proof.
      (* 课上已完成 *)
      simpl.
      intros n [H | [H | []]].
    -  - 1. rewrite <- H. reflexivity.
    -  - 2. rewrite <- H. reflexivity.
    +  - 1. rewrite <- H. reflexivity.
    +  - 2. rewrite <- H. reflexivity.
    Qed.

    @@ -931,7 +957,7 @@

    LogicCoq 中的逻辑系统 Lemma In_map :
    -   (A B : Type) (f : AB) (l : list A) (x : A),
    +  (A B : Type) (f : AB) (l : list A) (x : A),
        In x l
        In (f x) (map f l).
    Proof.
    @@ -953,14 +979,14 @@

    LogicCoq 中的逻辑系统

    -

    练习:2 星 (In_map_iff)

    +

    练习:2 星, standard (In_map_iff)

    Lemma In_map_iff :
    -   (A B : Type) (f : AB) (l : list A) (y : B),
    +  (A B : Type) (f : AB) (l : list A) (y : B),
        In y (map f l) ↔
    -     x, f x = yIn x l.
    +    x, f x = yIn x l.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -969,11 +995,11 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星 (In_app_iff)

    +

    练习:2 星, standard (In_app_iff)

    -Lemma In_app_iff : A l l' (a:A),
    +Lemma In_app_iff : A l l' (a:A),
      In a (l++l') ↔ In a lIn a l'.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -983,7 +1009,7 @@

    LogicCoq 中的逻辑系统
    -

    练习:3 星, recommended (All)

    +

    练习:3 星, standard, recommended (All)

    回忆一下,返回命题的函数可以视作对其参数性质的定义。例如,若 P 的类型为 nat Prop,那么 P n 就陈述了性质 Pn 成立。 @@ -998,8 +1024,8 @@

    LogicCoq 中的逻辑系统Fixpoint All {T : Type} (P : TProp) (l : list T) : Prop
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    Lemma All_In :
    -   T (P : TProp) (l : list T),
    -    ( x, In x lP x) ↔
    +  T (P : TProp) (l : list T),
    +    (x, In x lP x) ↔
        All P l.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1009,7 +1035,7 @@

    LogicCoq 中的逻辑系统
    -

    练习:3 星 (combine_odd_even)

    +

    练习:3 星, standard (combine_odd_even)

    完成以下 combine_odd_even 函数的定义。它接受两个对数字成立的性质 PoddPeven,返回性质 P 使得当 n 为奇数时 P n 等价于 Podd n, 否则等价于 Peven n。 @@ -1026,21 +1052,21 @@

    LogicCoq 中的逻辑系统 Theorem combine_odd_even_intro :
    -   (Podd Peven : natProp) (n : nat),
    +  (Podd Peven : natProp) (n : nat),
        (oddb n = truePodd n) →
        (oddb n = falsePeven n) →
        combine_odd_even Podd Peven n.
    Proof.
      (* 请在此处解答 *) Admitted.

    Theorem combine_odd_even_elim_odd :
    -   (Podd Peven : natProp) (n : nat),
    +  (Podd Peven : natProp) (n : nat),
        combine_odd_even Podd Peven n
        oddb n = true
        Podd n.
    Proof.
      (* 请在此处解答 *) Admitted.

    Theorem combine_odd_even_elim_even :
    -   (Podd Peven : natProp) (n : nat),
    +  (Podd Peven : natProp) (n : nat),
        combine_odd_even Podd Peven n
        oddb n = false
        Peven n.
    @@ -1051,15 +1077,16 @@

    LogicCoq 中的逻辑系统
    -

    对参数应用定理

    +

    对参数应用定理

    - Coq 拥有一个不同于其它证明助理的特性,即它将证明本身也作为一等对象。 + Coq 拥有一个不同于其它的证明助理(如 ACL2 和 Isabelle)的特性, + 即它将证明本身也作为一等对象。
    - 关于这一点有很多地方值得着墨,不过详细了解它对于使用 Coq 来说不是必须的。 + 关于这一点有很多地方值得着墨,不过了解所有的细节对于使用 Coq 来说不是必须的。 本节点到为止,深入的探讨参见 ProofObjectsIndPrinciples
    @@ -1078,7 +1105,7 @@

    LogicCoq 中的逻辑系统

    原因在于标识符 plus_comm 其实指代的是被称作证明对象的数据结构, - 它表示在命题 n m : nat, n + m = m + n 的真实性上建立的逻辑推导。 + 它表示在命题 n m : nat, n + m = m + n 的真实性上建立的逻辑推导。 此对象的类型就是其所证命题的陈述。
    @@ -1095,7 +1122,7 @@

    LogicCoq 中的逻辑系统 Lemma plus_comm3 :
    -   x y z, x + (y + z) = (z + y) + x.
    +  x y z, x + (y + z) = (z + y) + x.

    @@ -1105,6 +1132,7 @@

    LogicCoq 中的逻辑系统 Proof.
    +  (* 课上已完成 *)
      intros x y z.
      rewrite plus_comm.
      rewrite plus_comm.
    @@ -1119,7 +1147,7 @@

    LogicCoq 中的逻辑系统 Lemma plus_comm3_take2 :
    -   x y z, x + (y + z) = (z + y) + x.
    +  x y z, x + (y + z) = (z + y) + x.
    Proof.
      intros x y z.
      rewrite plus_comm.
    @@ -1137,7 +1165,7 @@

    LogicCoq 中的逻辑系统 Lemma plus_comm3_take3 :
    -   x y z, x + (y + z) = (z + y) + x.
    +  x y z, x + (y + z) = (z + y) + x.
    Proof.
      intros x y z.
      rewrite plus_comm.
    @@ -1146,15 +1174,80 @@

    LogicCoq 中的逻辑系统Qed.

    +
    +我们来展示另一个像函数那样使用定理或引理的例子。以下定理说明: + 任何包含元素的列表 l 一定非空。 +
    +
    + +Lemma in_not_nil :
    +  A (x : A) (l : list A), In x ll ≠ [].
    +Proof.
    +  intros A x l H. unfold not. intro Hl. destruct l.
    +  - simpl in H. destruct H.
    +  - discriminate Hl.
    +Qed.
    +
    + +
    +有趣的地方是一个量化的变量(x)没有出现在结论(l [])中。 +
    + + 我们可以用此引理来证明 x42 的特殊情况。直接用 apply in_not_nil + 会失败,因为它无法推出 x 的值。有一些方法可以绕开它... +
    +
    + +Lemma in_not_nil_42 :
    +  l : list nat, In 42 ll ≠ [].
    +Proof.
    +  (* 课上已完成 *)
    +  intros l H.
    +  Fail apply in_not_nil.
    +Abort.

    +(* apply ... with ... *)
    +Lemma in_not_nil_42_take2 :
    +  l : list nat, In 42 ll ≠ [].
    +Proof.
    +  intros l H.
    +  apply in_not_nil with (x := 42).
    +  apply H.
    +Qed.

    +(* apply ... in ... *)
    +Lemma in_not_nil_42_take3 :
    +  l : list nat, In 42 ll ≠ [].
    +Proof.
    +  intros l H.
    +  apply in_not_nil in H.
    +  apply H.
    +Qed.

    +(* 显式地对 x 的值应用引理。 *)
    +Lemma in_not_nil_42_take4 :
    +  l : list nat, In 42 ll ≠ [].
    +Proof.
    +  intros l H.
    +  apply (in_not_nil nat 42).
    +  apply H.
    +Qed.

    +(* 显式地对假设应用引理。 *)
    +Lemma in_not_nil_42_take5 :
    +  l : list nat, In 42 ll ≠ [].
    +Proof.
    +  intros l H.
    +  apply (in_not_nil _ _ _ H).
    +Qed.
    +
    +
    对于几乎所有将定理名作为参数的策略而言,你都可以“将定理作为函数”来使用。 注意,定理应用与函数应用使用了同样的类型推导机制,所以你可以将通配符作为定理的参数, - 或者为定理声明默认的隐式前提。这些特性在以下证明中展示。 + 或者为定理声明默认的隐式前提。这些特性在以下证明中展示。(此证明如何工作的细节 + 不必关心,这里的目标只是为了展示它的用途。)
    Example lemma_application_ex :
    -   {n : nat} {ns : list nat},
    +  {n : nat} {ns : list nat},
        In n (map (fun mm * 0) ns) →
        n = 0.
    Proof.
    @@ -1170,7 +1263,7 @@

    LogicCoq 中的逻辑系统
    -

    Coq vs. 集合论

    +

    Coq vs. 集合论

    @@ -1180,7 +1273,7 @@

    LogicCoq 中的逻辑系统n - 属于偶数集合,而是说 ev n 成立,其中的 ev : nat Prop 描述了偶数的性质。 + 属于偶数集合,而是说 even n 成立,其中的 even : nat Prop 描述了偶数的性质。
    @@ -1189,7 +1282,7 @@

    LogicCoq 中的逻辑系统

    -

    函数的外延性

    +

    函数的外延性

    @@ -1199,7 +1292,8 @@

    LogicCoq 中的逻辑系统
    -Example function_equality_ex1 : plus 3 = plus (pred 4).
    +Example function_equality_ex1 :
    +  (fun x ⇒ 3 + x) = (fun x ⇒ (pred 4) + x).
    Proof. reflexivity. Qed.
    @@ -1213,7 +1307,7 @@

    LogicCoq 中的逻辑系统

    -    ( xf x = g x) → f = g +    (xf x = g x) → f = g
    @@ -1232,7 +1326,7 @@

    LogicCoq 中的逻辑系统Example function_equality_ex2 :
      (fun xplus x 1) = (fun xplus 1 x).
    Proof.
    -   (* Stuck *)
    +   (* 卡住了 *)
    Abort.

    @@ -1241,9 +1335,9 @@

    LogicCoq 中的逻辑系统
    -Axiom functional_extensionality : {X Y: Type}
    +Axiom functional_extensionality : {X Y: Type}
                                        {f g : XY},
    -  ( (x:X), f x = g x) → f = g.
    +  ((x:X), f x = g x) → f = g.
    @@ -1265,12 +1359,13 @@

    LogicCoq 中的逻辑系统 当然,在为 Coq 添加公理时必须十分小心,因为这有可能会导致系统 - 不一致,而当系统不一致的,任何命题都能在其中证明,包括 False! + 不一致,而当系统不一致的,任何命题都能在其中证明,包括 False + 和 2+2=5
    不幸的是,并没有一种简单的方式能够判断添加某条公理是否安全: - 一般来说,确认任何一组公理的一致性都需要付出艰辛的努力。 + 一般来说,确认任何一组公理的一致性都需要训练有素的专家付出艰辛的努力。
    @@ -1285,12 +1380,12 @@

    LogicCoq 中的逻辑系统(* ===>
         Axioms:
         functional_extensionality :
    -         forall (X Y : Type) (f g : X -> Y),
    -                (forall x : X, f x = g x) -> f = g *)
    +         forall (X Y : Type) (f g : X -> Y),
    +                (forall x : X, f x = g x) -> f = g *)

    -

    练习:4 星 (tr_rev_correct)

    +

    练习:4 星, standard (tr_rev_correct)

    列表反转函数 rev 的定义有一个问题,它会在每一步都执行一次 app 调用,而运行 app 所需时间与列表的大小线性渐近,也就是说 rev 的时间复杂度与列表长度成平方关系。我们可以用以下定义来改进它: @@ -1313,7 +1408,7 @@

    LogicCoq 中的逻辑系统
    -Lemma tr_rev_correct : X, @tr_rev X = @rev X.
    +Lemma tr_rev_correct : X, @tr_rev X = @rev X.
    (* 请在此处解答 *) Admitted.
    @@ -1321,7 +1416,7 @@

    LogicCoq 中的逻辑系统
    -

    命题与布尔值

    +

    命题与布尔值

    @@ -1330,81 +1425,105 @@

    LogicCoq 中的逻辑系统

    - 例如,我们可以通过以下两种方式来断言 n 为偶数: - + 例如,我们可以通过以下两种方式来断言 n 为偶数:
    -
      -
    • (1) evenb n 返回 true,或者 - -
    • -
    • (2) 存在某个 k 使得 n = double k。 - 这两种对偶数的定义确实是等价的,我们可以通过一些辅助引理来证明它。 - -
    • -
    + evenb n 求值为 true: +

    +
    +Example even_42_bool : evenb 42 = true.
    +
    +
    +Proof. reflexivity. Qed.
    +
    +
    -
    +
    +或者存在某个 k 使得 n = double k: +
    +
    +Example even_42_prop : k, 42 = double k.
    +
    +
    +Proof. 21. reflexivity. Qed.
    +
    +
    - 当然,如果二者对偶数的刻画描述的并是不同一个自然数集,那会非常奇怪! - 幸运的是,我们可以证明二者确实等价... +
    +当然,如果二者刻画的偶数性描述的不是同一个自然数集合,那么会非常奇怪! + 幸运的是,我们确实可以证明二者相同...
    首先我们需要两个辅助引理。
    -Theorem evenb_double : k, evenb (double k) = true.
    +Theorem evenb_double : k, evenb (double k) = true.
    +
    +
    Proof.
      intros k. induction k as [|k' IHk'].
      - reflexivity.
      - simpl. apply IHk'.
    Qed.
    +
    -

    练习:3 星 (evenb_double_conv)

    +

    练习:3 星, standard (evenb_double_conv)

    -Theorem evenb_double_conv : n,
    -   k, n = if evenb n then double k
    +Theorem evenb_double_conv : n,
    +  k, n = if evenb n then double k
                    else S (double k).
    +
    +
    Proof.
      (* 提示:使用 Induction.v 中的 evenb_S 引理。  *)
      (* 请在此处解答 *) Admitted.
    -
    -Theorem even_bool_prop : n,
    -  evenb n = true k, n = double k.
    -
    -
    +
    +Theorem even_bool_prop : n,
    +  evenb n = truek, n = double k.
    +
    +
    Proof.
      intros n. split.
      - intros H. destruct (evenb_double_conv n) as [k Hk].
    -    rewrite Hk. rewrite H. k. reflexivity.
    +    rewrite Hk. rewrite H. k. reflexivity.
      - intros [k Hk]. rewrite Hk. apply evenb_double.
    Qed.
    -此定理说明,逻辑命题 k, n = double k 的真伪对应布尔计算 evenb n +此定理说明,逻辑命题 k, n = double k 的真伪对应布尔计算 evenb n 的真值。
    - 类似地,以下两种描述 nm 相等的表达方式等价: - (一)n =? m 值为 true; - (二)n = m。 + 类似地,以下两种 nm 相等的表述等价: + +
    + +
      +
    • (1) n =? m 值为 true; + +
    • +
    • (2) n = m。 + +
    • +
    + 同样,二者的记法也等价。
    -Theorem eqb_eq : n1 n2 : nat,
    +Theorem eqb_eq : n1 n2 : nat,
      n1 =? n2 = truen1 = n2.
    -
    -
    +
    +
    Proof.
      intros n1 n2. split.
      - apply eqb_true.
    @@ -1415,20 +1534,14 @@

    LogicCoq 中的逻辑系统 然而,即便布尔值和某个断言的命题式在逻辑上是等价的,但它们在操作上 - 并不一样。 - -
    - - 相等关系就是一个极端的例子:就涉及 nm 的证明的中间步骤而言, - 知道 n =? m = true 通常没什么帮助。然而,如果我们可以将此陈述 - 转换成 n = m 的形式,就能用它来改写证明。 + 也可能不一样。
    - 偶数也是个有趣的例子。回想一下,在证明 even_bool_prop - 的反向部分(即 evenb_double,从命题到布尔表达式的方向)时,我们对 + 在前面的偶数例子中,证明 even_bool_prop 的反向部分(即 + evenb_double,从命题到布尔表达式的方向)时,我们对 k 进行了简单的归纳。而反方向的证明(即练习 evenb_double_conv) - 则需要一种聪明的一般化方法,因为我们无法直接证明 (k, n = - double k) evenb n = true。 + 则需要一种聪明的一般化方法,因为我们无法直接证明 + ( k, n = double k) evenb n = true
    对于这些例子来说,命题式的声明比与之对应的布尔表达式要更为有用, @@ -1467,7 +1580,7 @@

    LogicCoq 中的逻辑系统
    -Example even_1000 : k, 1000 = double k.
    +Example even_1000 : k, 1000 = double k.
    @@ -1475,7 +1588,7 @@

    LogicCoq 中的逻辑系统
    -Proof. 500. reflexivity. Qed.
    +Proof. 500. reflexivity. Qed.
    @@ -1493,28 +1606,79 @@

    LogicCoq 中的逻辑系统
    -Example even_1000'' : k, 1000 = double k.
    +Example even_1000'' : k, 1000 = double k.
    Proof. apply even_bool_prop. reflexivity. Qed.
    -尽管此例的证明的长度并未因此而减少,然而更大的证明通常可通过 +尽管此例的证明脚本的长度并未因此而减少,然而更大的证明通常可通过 这种互映的方式来显著化简。举一个极端的例子,在用 Coq 证明著名的 - 四色定理时,人们使用互映技巧将几百种不同的情况归约成了一个布尔计算。 - 我们不会详细地介绍互映技巧,然而对于展示布尔计算与一般命题的互补优势而言, + 四色定理时,人们使用互映技巧将几百种不同的情况归约成了一个布尔计算。 +
    + + 另一点明显的不同是“布尔事实”的否定可以被直白地陈述并证明, + 只需翻转预期的布尔值结果即可。 +
    +
    + +Example not_even_1001 : evenb 1001 = false.
    +Proof.
    +  (* 课上已完成 *)
    +  reflexivity.
    +Qed.
    +
    + +
    +相反,命题的否定形式可能更难以掌握。 +
    +
    + +Example not_even_1001' : ~(k, 1001 = double k).
    +Proof.
    +  (* 课上已完成 *)
    +  rewrite <- even_bool_prop.
    +  unfold not.
    +  simpl.
    +  intro H.
    +  discriminate H.
    +Qed.
    +
    + +
    +相等性补充了另一个例子。在涉及 nm 的证明中,知道 n =? m = true + 通常会有一点直接的帮助。然而如果我们将该语句转换为等价的 n = m 形式, + 那么我们可以对它进行改写。 + +
    +
    + +Lemma plus_eqb_example : n m p : nat,
    +    n =? m = truen + p =? m + p = true.
    +Proof.
    +  (* 课上已完成 *)
    +  intros n m p H.
    +    rewrite eqb_eq in H.
    +  rewrite H.
    +  rewrite eqb_eq.
    +  reflexivity.
    +Qed.
    +
    + +
    +我们不会详细地介绍互映技巧,然而对于展示布尔计算与一般命题的互补优势而言, 它是个很好的例子。
    -

    练习:2 星 (logical_connectives)

    +

    练习:2 星, standard (logical_connectives)

    以下引理将本章中讨论的命题联结词与对应的布尔操作关联了起来。
    -Lemma andb_true_iff : b1 b2:bool,
    +Lemma andb_true_iff : b1 b2:bool,
      b1 && b2 = trueb1 = trueb2 = true.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Lemma orb_true_iff : b1 b2,
    +Lemma orb_true_iff : b1 b2,
      b1 || b2 = trueb1 = trueb2 = true.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1524,13 +1688,13 @@

    LogicCoq 中的逻辑系统
    -

    练习:1 星 (eqb_neq)

    +

    练习:1 星, standard (eqb_neq)

    以下定理为等价式 eqb_eq 的“否定”版本, 在某些场景中使用它会更方便些(后面的章节中会讲到这方面的例子)。
    -Theorem eqb_neq : x y : nat,
    +Theorem eqb_neq : x y : nat,
      x =? y = falsexy.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1540,7 +1704,7 @@

    LogicCoq 中的逻辑系统
    -

    练习:3 星 (eqb_list)

    +

    练习:3 星, standard (eqb_list)

    给定一个用于测试类型为 A 的元素相等关系的布尔操作符 eqb, 我们可以定义函数 eqb_list 来测试元素类型为 A 的列表的相等关系。 请完成以下 eqb_list 函数的定义。要确定你的定义是否正确,请证明引理 @@ -1552,9 +1716,9 @@

    LogicCoq 中的逻辑系统l1 l2 : list A) : bool
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    Lemma eqb_list_true_iff :
    -   A (eqb : AAbool),
    -    ( a1 a2, eqb a1 a2 = truea1 = a2) →
    -     l1 l2, eqb_list eqb l1 l2 = truel1 = l2.
    +  A (eqb : AAbool),
    +    (a1 a2, eqb a1 a2 = truea1 = a2) →
    +    l1 l2, eqb_list eqb l1 l2 = truel1 = l2.
    Proof.
    (* 请在此处解答 *) Admitted.

    @@ -1563,7 +1727,7 @@

    LogicCoq 中的逻辑系统
    -

    练习:2 星, recommended (All_forallb)

    +

    练习:2 星, standard, recommended (All_forallb)

    回忆一下Tactics一章中练习 forall_exists_challenge 的函数 forallb
    @@ -1581,7 +1745,7 @@

    LogicCoq 中的逻辑系统
    -Theorem forallb_true_iff : X test (l : list X),
    +Theorem forallb_true_iff : X test (l : list X),
       forallb test l = trueAll (fun xtest x = true) l.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1599,7 +1763,7 @@

    LogicCoq 中的逻辑系统
    -

    经典逻辑 vs. 构造逻辑

    +

    经典逻辑 vs. 构造逻辑

    @@ -1609,8 +1773,8 @@

    LogicCoq 中的逻辑系统
    -Definition excluded_middle := P : Prop,
    -  P ∨ ¬ P.
    +Definition excluded_middle := P : Prop,
    +  P ∨ ¬P.
    @@ -1626,8 +1790,8 @@

    LogicCoq 中的逻辑系统
    -Theorem restricted_excluded_middle : P b,
    -  (Pb = true) → P ∨ ¬ P.
    +Theorem restricted_excluded_middle : P b,
    +  (Pb = true) → P ∨ ¬P.
    Proof.
      intros P [] H.
      - left. rewrite H. reflexivity.
    @@ -1640,7 +1804,7 @@

    LogicCoq 中的逻辑系统
    -Theorem restricted_excluded_middle_eq : (n m : nat),
    +Theorem restricted_excluded_middle_eq : (n m : nat),
      n = mnm.
    Proof.
      intros n m.
    @@ -1654,7 +1818,7 @@

    LogicCoq 中的逻辑系统x, P x 的 Coq 证明,那么我们就能直接给出一个使 P x + 如果存在 x, P x 的 Coq 证明,那么我们就能直接给出一个使 P x 得证的值 x。换言之,任何关于存在性的证明必定是构造性的。
    @@ -1697,19 +1861,19 @@

    LogicCoq 中的逻辑系统x 具有某种性质 P,即存在 P x。我们先假设结论为假, - 也就是说 ¬ x, P x。根据此前提,不难推出 x, ¬ P x。 + 也就是说 ¬ x, P x。根据此前提,不难推出 x, ¬ P x。 如果我们能够根据此中间事实得到矛盾,就能得到一个存在性证明而完全不必指出一个 x 的值使得 P x 成立!
    从构造性的角度来看,这里存在着技术上的瑕疵,即我们试图通过对 - ¬ ¬ (x, P x) 的证明来证明 x, P x。从以下练习中我们会看到, + ¬ ¬ ( x, P x) 的证明来证明 x, P x。从以下练习中我们会看到, 允许自己从任意陈述中去掉双重否定等价于引入排中律。因此,只要我们不引入排中律, 就无法在 Coq 中编码此推理。
    -

    练习:3 星 (excluded_middle_irrefutable)

    +

    练习:3 星, standard (excluded_middle_irrefutable)

    证明通用排中律公理与 Coq 的一致性需要复杂的推理,而且并不能在 Coq 自身中进行。然而,以下定理蕴含了假设可判定性公理(即排中律的一个特例) 成立对于任何具体的命题 P 而言总是安全的。之所以如此, @@ -1719,8 +1883,8 @@

    LogicCoq 中的逻辑系统
    -Theorem excluded_middle_irrefutable: (P:Prop),
    -  ¬ ¬ (P ∨ ¬ P).
    +Theorem excluded_middle_irrefutable: (P:Prop),
    +  ¬¬(P ∨ ¬P).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1729,14 +1893,14 @@

    LogicCoq 中的逻辑系统
    -

    练习:3 星, advanced (not_exists_dist)

    +

    练习:3 星, advanced (not_exists_dist)

    在经典逻辑中有这样一条定理,它断言以下两条命题是等价的:
    -    ¬ ( x, ¬ P x)
    -     xP x +    ¬(x, ¬P x)
    +    xP x
    @@ -1747,8 +1911,8 @@

    LogicCoq 中的逻辑系统Theorem not_exists_dist :
      excluded_middle
    -   (X:Type) (P : XProp),
    -    ¬ ( x, ¬ P x) → ( x, P x).
    +  (X:Type) (P : XProp),
    +    ¬(x, ¬P x) → (x, P x).
    Proof.
      (* 请在此处解答 *) Admitted.

    @@ -1757,7 +1921,7 @@

    LogicCoq 中的逻辑系统
    -

    练习:5 星, optional (classical_axioms)

    +

    练习:5 星, standard, optional (classical_axioms)

    对于喜欢挑战的读者,以下练习来自于 Bertot 与 Casteran 所著的 Coq'Art 一书中第 123 页。以下四条陈述的每一条,加上 excluded_middle 可以认为刻画了经典逻辑。我们无法在 Coq 中证明其中的任意一条, @@ -1770,18 +1934,22 @@

    LogicCoq 中的逻辑系统
    -Definition peirce := P Q: Prop,
    +Definition peirce := P Q: Prop,
      ((PQ)→P)→P.

    -Definition double_negation_elimination := P:Prop,
    +Definition double_negation_elimination := P:Prop,
      ~~PP.

    -Definition de_morgan_not_and_not := P Q:Prop,
    +Definition de_morgan_not_and_not := P Q:Prop,
      ~(~P ∧ ¬Q) → PQ.

    -Definition implies_to_or := P Q:Prop,
    +Definition implies_to_or := P Q:Prop,
      (PQ) → (¬PQ).

    (* 请在此处解答 *)
    +
    + +(* Sat Jan 26 15:14:45 UTC 2019 *)
    +

    diff --git a/lf-current/Logic.v b/lf-current/Logic.v index 45a72432..9667f778 100644 --- a/lf-current/Logic.v +++ b/lf-current/Logic.v @@ -107,7 +107,6 @@ Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4. (** 证明合取的命题通常使用 [split] 策略。它会分别为语句的两部分生成两个子目标: *) Proof. - (* 课上已完成 *) split. - (* 3 + 4 = 7 *) reflexivity. - (* 2 + 2 = 4 *) reflexivity. @@ -133,7 +132,7 @@ Proof. - (* 2 + 2 = 4 *) reflexivity. Qed. -(** **** 练习:2 星 (and_exercise) *) +(** **** 练习:2 星, standard (and_exercise) *) Example and_exercise : forall n m : nat, n + m = 0 -> n = 0 /\ m = 0. Proof. @@ -203,7 +202,7 @@ Proof. intros P Q [HP HQ]. apply HP. Qed. -(** **** 练习:1 星, optional (proj2) *) +(** **** 练习:1 星, standard, optional (proj2) *) Lemma proj2 : forall P Q : Prop, P /\ Q -> Q. Proof. @@ -221,8 +220,9 @@ Proof. - (* left *) apply HQ. - (* right *) apply HP. Qed. -(** **** 练习:2 星 (and_assoc) *) -(** (在以下结合律的证明中,注意_'嵌套'_的 [intros] 模式是如何将 +(** **** 练习:2 星, standard (and_assoc) + + (在以下结合律的证明中,注意_'嵌套'_的 [intros] 模式是如何将 [H : P /\ (Q /\ R)] 拆分为 [HP : P]、[HQ : Q] 和 [HR : R] 的。 请从那里开始完成证明。) *) @@ -243,12 +243,12 @@ Check and. (** ** 析取 *) (** 另一个重要的联结词是_析取_,即两个命题的_'逻辑或'_:若 [A] 或 [B] - 二者之一为真,则 [A \/ B] 为真。(我们也可以写作 [or A B],其中 + 二者之一为真,则 [A \/ B] 为真。(这中中缀记法表示 [or A B],其中 [or : Prop -> Prop -> Prop]。) *) (** 为了在证明中使用析取前提,我们需要分类讨论,它与 [nat] - 或其它数据类型一样,都可以通过 [destruct] 或 [intros] 来拆分。 - 下面就是个例子: *) + 或其它数据类型一样,都可以显示地通过 [destruct] 或隐式地通过 [intros] + 模式来拆分: *) Lemma or_example : forall n m : nat, n = 0 \/ m = 0 -> n * m = 0. @@ -274,7 +274,7 @@ Proof. apply HA. Qed. -(** ...而更有趣的例子则同时需要 [left] 和 [right]: *) +(** ...而这个更有趣的例子则同时需要 [left] 和 [right]: *) Lemma zero_or_succ : forall n : nat, n = 0 \/ n = S (pred n). @@ -285,14 +285,14 @@ Proof. - right. reflexivity. Qed. -(** **** 练习:1 星 (mult_eq_0) *) +(** **** 练习:1 星, standard (mult_eq_0) *) Lemma mult_eq_0 : forall n m, n * m = 0 -> n = 0 \/ m = 0. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (or_commut) *) +(** **** 练习:1 星, standard (or_commut) *) Theorem or_commut : forall P Q : Prop, P \/ Q -> Q \/ P. Proof. @@ -300,16 +300,19 @@ Proof. (** [] *) (* ================================================================= *) -(** ** 假命题与否定 *) -(** 目前为止,我们主要都在证明某些东西是_'真'_的:加法满足结合律, +(** ** 假命题与否定 + + 目前为止,我们主要都在证明某些东西是_'真'_的:加法满足结合律, 列表的连接满足结合律,等等。当然,我们也关心_'否定'_的结果, - 即证明某些命题_'不是'_真的。在 Coq 中,这样的否定语句使用否定运算符 + 即证明某些给定的命题_'不是'_真的。在 Coq 中,这样的否定语句使用否定运算符 [~] 来表达。 *) -(** 为了理解否定背后的原理,我们需要回想一下[Tactics]一章中对_'爆炸原理'_的讨论。 - 爆炸原理断言,当我们假设了矛盾存在时,就能推出任何命题。遵循这一直觉, - 我们可以可以将 [~ P](即非 [P])定义为 [forall Q, P -> Q]。 - 不过 Coq 选择了稍有些不同的做法,它将 [~ P] 定义为 [P -> False],而 +(** 为了理解否定背后的原理,我们需要回想一下[Tactics]一章中的_'爆炸原理'_。 + 爆炸原理断言,当我们假设了矛盾存在时,就能推出任何命题。 + + 遵循这一直觉,我们可以可以将 [~ P](即非 [P])定义为 [forall Q, P -> Q]。 + + 不过 Coq 选择了稍有些不同(但等价)的做法,它将 [~ P] 定义为 [P -> False],而 [False] 是在标准库中特别定义的矛盾性命题。 *) Module MyNot. @@ -324,8 +327,7 @@ Check not. End MyNot. (** 由于 [False] 是个矛盾性命题,因此爆炸原理对它也适用。如果我们让 [False] - 进入到了证明的上下文中,可以对它使用 [destruct](或 [discriminate]) - 来完成任何待证目标。 *) + 进入到了证明的上下文中,可以对它使用 [destruct] 来完成任何待证目标。 *) Theorem ex_falso_quodlibet : forall (P:Prop), False -> P. @@ -337,8 +339,9 @@ Proof. (** 拉丁文 _'ex falso quodlibet'_ 的字面意思是“从谬误出发, 你能够证明任何你想要的”,这也是爆炸原理的另一个广为人知的名字。 *) -(** **** 练习:2 星, optional (not_implies_our_not) *) -(** 证明 Coq 对否定的定义蕴含前面提到的直觉上的定义: *) +(** **** 练习:2 星, standard, optional (not_implies_our_not) + + 证明 Coq 对否定的定义蕴含前面提到的直觉上的定义: *) Fact not_implies_our_not : forall (P:Prop), ~ P -> (forall (Q:Prop), P -> Q). @@ -346,21 +349,24 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 下面我们用 [not] 陈述了 [0] 和 [1] 是不同的 [nat] 元素: *) +(** 不等性是十分常见的否定句的例子,,它有一个特别的记法 [x <> y]: -Theorem zero_not_one : ~(0 = 1). -Proof. - intros contra. discriminate contra. -Qed. + Notation "x <> y" := (~(x = y)). +*) -(** 这样的不等性表述频繁出现,足以让我们为其定义一种特殊的记法 [x <> y]: *) +(** 我们可以用 [not] 来陈述 [0] 和 [1] 是不同的 [nat] 元素: *) -Check (0 <> 1). -(* ===> Prop *) - -Theorem zero_not_one' : 0 <> 1. +Theorem zero_not_one : 0 <> 1. Proof. - intros H. discriminate H. + (** 性质 [0 <> 1] 就是 [~(0 = 1)],即 [not (0 = 1)], + 它会展开为 [(0 = 1) -> False]。(这里显式地用 [unfold not] + 展示了这一点,不过一般可以忽略。 *) + unfold not. + (** 要证明不等性,我们可以反过来假设其相等... *) + intros contra. + (** ... 然后从中推出矛盾。在这里,等式 [O = S O] 与构造子 [O] 和 [S] + 的不交性相矛盾,因此用 [discriminate] 就能解决它。 *) + discriminate contra. Qed. (** 为了习惯用 Coq 处理否定命题,我们需要一些练习。 @@ -385,8 +391,9 @@ Proof. (* 课上已完成 *) intros P H. unfold not. intros G. apply G. apply H. Qed. -(** **** 练习:2 星, advanced (double_neg_inf) *) -(** 请写出 [double_neg] 的非形式化证明: +(** **** 练习:2 星, advanced (double_neg_inf) + + 请写出 [double_neg] 的非形式化证明: _'定理'_:对于任何命题 [P] 而言,[P] 蕴含 [~~P]。 *) @@ -396,22 +403,23 @@ Proof. Definition manual_grade_for_double_neg_inf : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, recommended (contrapositive) *) +(** **** 练习:2 星, standard, recommended (contrapositive) *) Theorem contrapositive : forall (P Q : Prop), (P -> Q) -> (~Q -> ~P). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (not_both_true_and_false) *) +(** **** 练习:1 星, standard (not_both_true_and_false) *) Theorem not_both_true_and_false : forall P : Prop, ~ (P /\ ~P). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星, advanced (informal_not_PNP) *) -(** 请写出 [forall P : Prop, ~(P /\ ~P)] 的非形式化证明。 *) +(** **** 练习:1 星, advanced (informal_not_PNP) + + 请写出 [forall P : Prop, ~(P /\ ~P)] 的非形式化证明。 *) (* 请在此处解答 *) @@ -461,8 +469,9 @@ Lemma True_is_true : True. Proof. apply I. Qed. (** 与经常使用的 [False] 不同,[True] 很少使用,因为它作为证明目标来说过于平凡, - 而作为前提又不携带任何有用的信息。 *) -(** 然而在使用条件从句定义复杂的 [Prop],或者作为高阶 [Prop] 的参数时, + 而作为前提又不携带任何有用的信息。 + + 然而在使用条件从句定义复杂的 [Prop],或者作为高阶 [Prop] 的参数时, 它还是挺有用的。之后我们会看到 [True] 的这类用法。 *) (* ================================================================= *) @@ -500,8 +509,9 @@ Proof. intros H. rewrite H. intros H'. discriminate H'. Qed. -(** **** 练习:1 星, optional (iff_properties) *) -(** 参照上面对 [<->] 对称性([iff_sym])的证明, +(** **** 练习:1 星, standard, optional (iff_properties) + + 参照上面对 [<->] 对称性([iff_sym])的证明, 请证明它同时也有自反性和传递性。 *) Theorem iff_refl : forall P : Prop, @@ -515,7 +525,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (or_distributes_over_and) *) +(** **** 练习:3 星, standard (or_distributes_over_and) *) Theorem or_distributes_over_and : forall P Q R : Prop, P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R). Proof. @@ -526,7 +536,7 @@ Proof. 特别来说,[rewrite] 和 [reflexivity] 不仅可以用于相等关系,还可用于 [iff] 语句。为了开启此行为,我们需要导入一个 Coq 的库来支持它: *) -Require Import Coq.Setoids.Setoid. +From Coq Require Import Setoids.Setoid. (** 下面是一个简单的例子,它展示了这些策略如何使用 [iff]。 首先,我们来证明一些基本的 [iff] 等价关系命题... *) @@ -603,8 +613,9 @@ Proof. exists (2 + m). apply Hm. Qed. -(** **** 练习:1 星, recommended (dist_not_exists) *) -(** 请证明“[P] 对所有 [x] 成立”蕴含“不存在 [x] 使 [P] 不成立。” +(** **** 练习:1 星, standard, recommended (dist_not_exists) + + 请证明“[P] 对所有 [x] 成立”蕴含“不存在 [x] 使 [P] 不成立。” (提示:[destruct H as [x E]] 可以用于存在假设!) *) Theorem dist_not_exists : forall (X:Type) (P : X -> Prop), @@ -613,8 +624,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (dist_exists_or) *) -(** 请证明存在量化对析取满足分配律。 *) +(** **** 练习:2 星, standard (dist_exists_or) + + 请证明存在量化对析取满足分配律。 *) 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). @@ -627,10 +639,12 @@ Proof. (** 我们学过的逻辑联结词为我们提供了丰富的用简单命题构造复杂命题的词汇。 为了说明,我们来看一下如何表达“元素 [x] 出现在列表 [l] 中”这一断言。 - 注意此性质有着简单的递归结构: *) -(** - 若 [l] 为空列表,则 [x] 无法在其中出现,因此性质“[x] 出现在 [l] 中” - 为假。 *) -(** - 否则,若 [l] 的形式为 [x' :: l'],此时 [x] 是否出现在 [l] 中, + 注意此性质有着简单的递归结构: + + - 若 [l] 为空列表,则 [x] 无法在其中出现,因此性质“[x] 出现在 [l] 中” + 为假。 + + - 否则,若 [l] 的形式为 [x' :: l'],此时 [x] 是否出现在 [l] 中, 取决于它是否等于 [x'] 或出现在 [l'] 中。 *) (** 我们可以将此定义直接翻译成递归函数,它接受一个元素和一个列表, @@ -687,7 +701,7 @@ Qed. “明显会终止”的。在下一章中,我们会了解如何_'归纳地'_定义命题, 这是一种与之不同的技巧,有着其独特的优势和限制。 *) -(** **** 练习:2 星 (In_map_iff) *) +(** **** 练习:2 星, standard (In_map_iff) *) Lemma In_map_iff : forall (A B : Type) (f : A -> B) (l : list A) (y : B), In y (map f l) <-> @@ -696,15 +710,16 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (In_app_iff) *) +(** **** 练习:2 星, standard (In_app_iff) *) Lemma In_app_iff : forall A l l' (a:A), In a (l++l') <-> In a l \/ In a l'. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, recommended (All) *) -(** 回忆一下,返回命题的函数可以视作对其参数_'性质'_的定义。例如,若 +(** **** 练习:3 星, standard, recommended (All) + + 回忆一下,返回命题的函数可以视作对其参数_'性质'_的定义。例如,若 [P] 的类型为 [nat -> Prop],那么 [P n] 就陈述了性质 [P] 对 [n] 成立。 以 [In] 作为参考,请写出递归函数 [All],它陈述某个 [P] 对列表 [l] @@ -722,8 +737,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (combine_odd_even) *) -(** 完成以下 [combine_odd_even] 函数的定义。它接受两个对数字成立的性质 +(** **** 练习:3 星, standard (combine_odd_even) + + 完成以下 [combine_odd_even] 函数的定义。它接受两个对数字成立的性质 [Podd] 与 [Peven],返回性质 [P] 使得当 [n] 为奇数时 [P n] 等价于 [Podd n], 否则等价于 [Peven n]。*) @@ -760,9 +776,10 @@ Proof. (* ################################################################# *) (** * 对参数应用定理 *) -(** Coq 拥有一个不同于其它证明助理的特性,即它将_'证明'_本身也作为一等对象。 +(** Coq 拥有一个不同于其它的证明助理(如 ACL2 和 Isabelle)的特性, + 即它将_'证明'_本身也作为一等对象。 - 关于这一点有很多地方值得着墨,不过详细了解它对于使用 Coq 来说不是必须的。 + 关于这一点有很多地方值得着墨,不过了解所有的细节对于使用 Coq 来说不是必须的。 本节点到为止,深入的探讨参见 [ProofObjects] 和 [IndPrinciples]。 *) (** 我们已经知道 [Check] 可以用来显式表达式的类型了, @@ -794,6 +811,7 @@ Lemma plus_comm3 : 然而问题是,第二次 [rewrite] 会抵消第一次的效果。 *) Proof. + (* 课上已完成 *) intros x y z. rewrite plus_comm. rewrite plus_comm. @@ -826,9 +844,69 @@ Proof. reflexivity. Qed. +(** 我们来展示另一个像函数那样使用定理或引理的例子。以下定理说明: + 任何包含元素的列表 [l] 一定非空。 *) + +Lemma in_not_nil : + forall A (x : A) (l : list A), In x l -> l <> []. +Proof. + intros A x l H. unfold not. intro Hl. destruct l. + - simpl in H. destruct H. + - discriminate Hl. +Qed. + +(** 有趣的地方是一个量化的变量([x])没有出现在结论([l <> []])中。 *) + +(** 我们可以用此引理来证明 [x] 为 [42] 的特殊情况。直接用 [apply in_not_nil] + 会失败,因为它无法推出 [x] 的值。有一些方法可以绕开它... *) + +Lemma in_not_nil_42 : + forall l : list nat, In 42 l -> l <> []. +Proof. + (* 课上已完成 *) + intros l H. + Fail apply in_not_nil. +Abort. + +(* [apply ... with ...] *) +Lemma in_not_nil_42_take2 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply in_not_nil with (x := 42). + apply H. +Qed. + +(* [apply ... in ...] *) +Lemma in_not_nil_42_take3 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply in_not_nil in H. + apply H. +Qed. + +(* 显式地对 [x] 的值应用引理。 *) +Lemma in_not_nil_42_take4 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply (in_not_nil nat 42). + apply H. +Qed. + +(* 显式地对假设应用引理。 *) +Lemma in_not_nil_42_take5 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply (in_not_nil _ _ _ H). +Qed. + (** 对于几乎所有将定理名作为参数的策略而言,你都可以“将定理作为函数”来使用。 注意,定理应用与函数应用使用了同样的类型推导机制,所以你可以将通配符作为定理的参数, - 或者为定理声明默认的隐式前提。这些特性在以下证明中展示。 *) + 或者为定理声明默认的隐式前提。这些特性在以下证明中展示。(此证明如何工作的细节 + 不必关心,这里的目标只是为了展示它的用途。) *) Example lemma_application_ex : forall {n : nat} {ns : list nat}, @@ -852,7 +930,7 @@ Qed. 一个数学对象可同时属于不同的集合;而在 Coq 的逻辑中,一个项最多只属于一个类型。 这些不同之处需要人们用稍微不同的方式来描述非形式化的数学概念,但总的来说, 它们都是非常自然而易于使用的。例如,在 Coq 中我们一般不说某个自然数 [n] - 属于偶数集合,而是说 [ev n] 成立,其中的 [ev : nat -> Prop] 描述了偶数的性质。 + 属于偶数集合,而是说 [even n] 成立,其中的 [even : nat -> Prop] 描述了偶数的性质。 然而在某些情况下,将标准的数学论证翻译到 Coq 中会十分繁琐甚至是不可能的, 除非我们引入新的公理来丰富其逻辑核心。作为本章的结尾, @@ -865,7 +943,8 @@ Qed. (如 [nat]、[bool] 等等)。然而由于 Coq 的相等关系运算符是多态的, 因此它们并不是唯一的可能。特别是,我们可以写出宣称_'两个函数相等'_的命题: *) -Example function_equality_ex1 : plus 3 = plus (pred 4). +Example function_equality_ex1 : + (fun x => 3 + x) = (fun x => (pred 4) + x). Proof. reflexivity. Qed. (** 在一般的数学研究中,对于任意的两个函数 [f] 和 [g],只要它们产生的结果相等, @@ -884,7 +963,7 @@ Proof. reflexivity. Qed. Example function_equality_ex2 : (fun x => plus x 1) = (fun x => plus 1 x). Proof. - (* Stuck *) + (* 卡住了 *) Abort. (** 然而,我们可以用 [Axiom] 指令将函数的外延性添加到 Coq 的核心逻辑系统中。 *) @@ -906,10 +985,11 @@ Proof. Qed. (** 当然,在为 Coq 添加公理时必须十分小心,因为这有可能会导致系统 - _'不一致'_,而当系统不一致的,任何命题都能在其中证明,包括 [False]! + _'不一致'_,而当系统不一致的,任何命题都能在其中证明,包括 [False] + 和 [2+2=5]! 不幸的是,并没有一种简单的方式能够判断添加某条公理是否安全: - 一般来说,确认任何一组公理的一致性都需要付出艰辛的努力。 + 一般来说,确认任何一组公理的一致性都需要训练有素的专家付出艰辛的努力。 然而,我们已经知道了添加函数外延性后的公理系统_'确实是'_一致的。 *) @@ -922,8 +1002,9 @@ Print Assumptions function_equality_ex2. forall (X Y : Type) (f g : X -> Y), (forall x : X, f x = g x) -> f = g *) -(** **** 练习:4 星 (tr_rev_correct) *) -(** 列表反转函数 [rev] 的定义有一个问题,它会在每一步都执行一次 [app] +(** **** 练习:4 星, standard (tr_rev_correct) + + 列表反转函数 [rev] 的定义有一个问题,它会在每一步都执行一次 [app] 调用,而运行 [app] 所需时间与列表的大小线性渐近,也就是说 [rev] 的时间复杂度与列表长度成平方关系。我们可以用以下定义来改进它: *) @@ -950,13 +1031,18 @@ Lemma tr_rev_correct : forall X, @tr_rev X = @rev X. (** 我们已经知道在 Coq 中有两种编码逻辑事实的方式了,即使用_'布尔值'_ (类型为 [bool])和_'命题'_(类型为 [Prop])。 - 例如,我们可以通过以下两种方式来断言 [n] 为偶数: - - (1) [evenb n] 返回 [true],或者 - - (2) 存在某个 [k] 使得 [n = double k]。 - 这两种对偶数的定义确实是等价的,我们可以通过一些辅助引理来证明它。 + 例如,我们可以通过以下两种方式来断言 [n] 为偶数: *) + +(** [evenb n] 求值为 [true]: *) +Example even_42_bool : evenb 42 = true. +Proof. reflexivity. Qed. + +(** 或者存在某个 [k] 使得 [n = double k]: *) +Example even_42_prop : exists k, 42 = double k. +Proof. exists 21. reflexivity. Qed. - 当然,如果二者对偶数的刻画描述的并是不同一个自然数集,那会非常奇怪! - 幸运的是,我们可以证明二者确实等价... *) +(** 当然,如果二者刻画的偶数性描述的不是同一个自然数集合,那么会非常奇怪! + 幸运的是,我们确实可以证明二者相同... *) (** 首先我们需要两个辅助引理。 *) Theorem evenb_double : forall k, evenb (double k) = true. @@ -966,7 +1052,7 @@ Proof. - simpl. apply IHk'. Qed. -(** **** 练习:3 星 (evenb_double_conv) *) +(** **** 练习:3 星, standard (evenb_double_conv) *) Theorem evenb_double_conv : forall n, exists k, n = if evenb n then double k else S (double k). @@ -987,9 +1073,10 @@ Qed. (** 此定理说明,逻辑命题 [exists k, n = double k] 的真伪对应布尔计算 [evenb n] 的真值。 *) -(** 类似地,以下两种描述 [n] 与 [m] 相等的表达方式等价: - (一)[n =? m] 值为 [true]; - (二)[n = m]。 *) +(** 类似地,以下两种 [n] 与 [m] 相等的表述等价: + - (1) [n =? m] 值为 [true]; + - (2) [n = m]。 + 同样,二者的记法也等价。 *) Theorem eqb_eq : forall n1 n2 : nat, n1 =? n2 = true <-> n1 = n2. @@ -1000,17 +1087,13 @@ Proof. Qed. (** 然而,即便布尔值和某个断言的命题式在逻辑上是等价的,但它们在_'操作上'_ - 并不一样。 - - 相等关系就是一个极端的例子:就涉及 [n] 和 [m] 的证明的中间步骤而言, - 知道 [n =? m = true] 通常没什么帮助。然而,如果我们可以将此陈述 - 转换成 [n = m] 的形式,就能用它来改写证明。 *) + 也可能不一样。 *) -(** 偶数也是个有趣的例子。回想一下,在证明 [even_bool_prop] - 的反向部分(即 [evenb_double],从命题到布尔表达式的方向)时,我们对 +(** 在前面的偶数例子中,证明 [even_bool_prop] 的反向部分(即 + [evenb_double],从命题到布尔表达式的方向)时,我们对 [k] 进行了简单的归纳。而反方向的证明(即练习 [evenb_double_conv]) - 则需要一种聪明的一般化方法,因为我们无法直接证明 [(exists k, n = - double k) -> evenb n = true]。 *) + 则需要一种聪明的一般化方法,因为我们无法直接证明 + [(exists k, n = double k) -> evenb n = true]。 *) (** 对于这些例子来说,命题式的声明比与之对应的布尔表达式要更为有用, 但并非总是如此。例如,我们无法在函数的定义中测试一般的命题是否为真, @@ -1055,14 +1138,53 @@ Proof. reflexivity. Qed. Example even_1000'' : exists k, 1000 = double k. Proof. apply even_bool_prop. reflexivity. Qed. -(** 尽管此例的证明的长度并未因此而减少,然而更大的证明通常可通过 +(** 尽管此例的证明脚本的长度并未因此而减少,然而更大的证明通常可通过 这种互映的方式来显著化简。举一个极端的例子,在用 Coq 证明著名的 - _'四色定理'_时,人们使用互映技巧将几百种不同的情况归约成了一个布尔计算。 - 我们不会详细地介绍互映技巧,然而对于展示布尔计算与一般命题的互补优势而言, + _'四色定理'_时,人们使用互映技巧将几百种不同的情况归约成了一个布尔计算。 *) + +(** 另一点明显的不同是“布尔事实”的否定可以被直白地陈述并证明, + 只需翻转预期的布尔值结果即可。 *) + +Example not_even_1001 : evenb 1001 = false. +Proof. + (* 课上已完成 *) + reflexivity. +Qed. + +(** 相反,命题的否定形式可能更难以掌握。 *) + +Example not_even_1001' : ~(exists k, 1001 = double k). +Proof. + (* 课上已完成 *) + rewrite <- even_bool_prop. + unfold not. + simpl. + intro H. + discriminate H. +Qed. + +(** 相等性补充了另一个例子。在涉及 [n] 和 [m] 的证明中,知道 [n =? m = true] + 通常会有一点直接的帮助。然而如果我们将该语句转换为等价的 [n = m] 形式, + 那么我们可以对它进行改写。 + *) + +Lemma plus_eqb_example : forall n m p : nat, + n =? m = true -> n + p =? m + p = true. +Proof. + (* 课上已完成 *) + intros n m p H. + rewrite eqb_eq in H. + rewrite H. + rewrite eqb_eq. + reflexivity. +Qed. + +(** 我们不会详细地介绍互映技巧,然而对于展示布尔计算与一般命题的互补优势而言, 它是个很好的例子。 *) -(** **** 练习:2 星 (logical_connectives) *) -(** 以下引理将本章中讨论的命题联结词与对应的布尔操作关联了起来。 *) +(** **** 练习:2 星, standard (logical_connectives) + + 以下引理将本章中讨论的命题联结词与对应的布尔操作关联了起来。 *) Lemma andb_true_iff : forall b1 b2:bool, b1 && b2 = true <-> b1 = true /\ b2 = true. @@ -1075,8 +1197,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (eqb_neq) *) -(** 以下定理为等价式 [eqb_eq] 的“否定”版本, +(** **** 练习:1 星, standard (eqb_neq) + + 以下定理为等价式 [eqb_eq] 的“否定”版本, 在某些场景中使用它会更方便些(后面的章节中会讲到这方面的例子)。 *) Theorem eqb_neq : forall x y : nat, @@ -1085,8 +1208,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (eqb_list) *) -(** 给定一个用于测试类型为 [A] 的元素相等关系的布尔操作符 [eqb], +(** **** 练习:3 星, standard (eqb_list) + + 给定一个用于测试类型为 [A] 的元素相等关系的布尔操作符 [eqb], 我们可以定义函数 [eqb_list] 来测试元素类型为 [A] 的列表的相等关系。 请完成以下 [eqb_list] 函数的定义。要确定你的定义是否正确,请证明引理 [eqb_list_true_iff]。 *) @@ -1103,8 +1227,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, recommended (All_forallb) *) -(** 回忆一下[Tactics]一章中练习 [forall_exists_challenge] 的函数 +(** **** 练习:2 星, standard, recommended (All_forallb) + + 回忆一下[Tactics]一章中练习 [forall_exists_challenge] 的函数 [forallb]: *) Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool := @@ -1122,8 +1247,9 @@ Proof. (** 函数 [forallb] 是否还存在尚未被此规范捕获的重要性质? *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** 经典逻辑 vs. 构造逻辑 *) @@ -1204,8 +1330,9 @@ Qed. 允许自己从任意陈述中去掉双重否定等价于引入排中律。因此,只要我们不引入排中律, 就无法在 Coq 中编码此推理。 *) -(** **** 练习:3 星 (excluded_middle_irrefutable) *) -(** 证明通用排中律公理与 Coq 的一致性需要复杂的推理,而且并不能在 Coq +(** **** 练习:3 星, standard (excluded_middle_irrefutable) + + 证明通用排中律公理与 Coq 的一致性需要复杂的推理,而且并不能在 Coq 自身中进行。然而,以下定理蕴含了假设可判定性公理(即排中律的一个特例) 成立对于任何_'具体的'_命题 [P] 而言总是安全的。之所以如此, 是因为我们无法证明这类公理的否定命题。假如我们可以的话,就会同时有 @@ -1218,8 +1345,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced (not_exists_dist) *) -(** 在经典逻辑中有这样一条定理,它断言以下两条命题是等价的: +(** **** 练习:3 星, advanced (not_exists_dist) + + 在经典逻辑中有这样一条定理,它断言以下两条命题是等价的: ~ (exists x, ~ P x) forall x, P x @@ -1235,8 +1363,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, optional (classical_axioms) *) -(** 对于喜欢挑战的读者,以下练习来自于 Bertot 与 Casteran 所著的 +(** **** 练习:5 星, standard, optional (classical_axioms) + + 对于喜欢挑战的读者,以下练习来自于 Bertot 与 Casteran 所著的 Coq'Art 一书中第 123 页。以下四条陈述的每一条,加上 [excluded_middle] 可以认为刻画了经典逻辑。我们无法在 Coq 中证明其中的任意一条, 不过如果我们希望在经典逻辑下工作的话,可以安全地将其中任意一条作为公理添加到 @@ -1256,6 +1385,8 @@ Definition de_morgan_not_and_not := forall P Q:Prop, Definition implies_to_or := forall P Q:Prop, (P->Q) -> (~P\/Q). -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) +(* Sat Jan 26 15:14:45 UTC 2019 *) diff --git a/lf-current/LogicTest.v b/lf-current/LogicTest.v index c0d768d8..5856ab32 100644 --- a/lf-current/LogicTest.v +++ b/lf-current/LogicTest.v @@ -389,3 +389,5 @@ idtac "MANUAL". idtac "---------- not_exists_dist ---------". Print Assumptions not_exists_dist. Abort. + +(* Sat Jan 26 15:14:52 UTC 2019 *) diff --git a/lf-current/Makefile b/lf-current/Makefile index b28e665f..0824765c 100644 --- a/lf-current/Makefile +++ b/lf-current/Makefile @@ -797,4 +797,3 @@ debug: .PHONY: debug .DEFAULT_GOAL := all -include .depend diff --git a/lf-current/Maps.html b/lf-current/Maps.html index 9f5f4beb..80668822 100644 --- a/lf-current/Maps.html +++ b/lf-current/Maps.html @@ -49,7 +49,7 @@

    Maps全映射与偏映射

    -

    Coq 标准库

    +

    Coq 标准库

    @@ -65,11 +65,11 @@

    Maps全映射与偏映射

    -Require Import Coq.Arith.Arith.
    -Require Import Coq.Bool.Bool.
    +From Coq Require Import Arith.Arith.
    +From Coq Require Import Bool.Bool.
    Require Export Coq.Strings.String.
    -Require Import Coq.Logic.FunctionalExtensionality.
    -Require Import Coq.Lists.List.
    +From Coq Require Import Logic.FunctionalExtensionality.
    +From Coq Require Import Lists.List.
    Import ListNotations.
    @@ -83,23 +83,21 @@

    Maps全映射与偏映射

    -

    标识符

    +

    标识符

    - First, we need a type for the keys that we use to index into our - maps. In Lists.v we introduced a fresh type id for this - purpose; for the rest of _Software Foundations_ we will use the - string type from Coq's standard library. + 首先我们需要键的类型来对映射进行索引。在 Lists.v 中, + 我们为类似的目的引入了 id 类型。而在《软件基础》后面的部分, + 我们会使用 Coq 标准库中的 string 类型。
    - To compare strings, we define the function eqb_string, which - internally uses the function string_dec from Coq's string - library. + 为了比较字符串,我们定义了 eqb_string 函数,它在内部使用 Coq + 字符串库中的 string_dec 函数。
    -Definition eqb_string x y :=
    +Definition eqb_string (x y : string) : bool :=
      if string_dec x y then true else false.
    @@ -113,10 +111,10 @@

    Maps全映射与偏映射

    bool。)
    - Now we need a few basic properties of string equality... + 现在我们需要一些关于字符串相等性的基本性质...
    -Theorem eqb_string_refl : s, true = eqb_string s s.
    +Theorem eqb_string_refl : s : string, true = eqb_string s s.
    Proof. intros s. unfold eqb_string. destruct (string_dec s s) as [|Hs].
    @@ -127,13 +125,12 @@

    Maps全映射与偏映射

    -The following useful property follows from an analogous - lemma about strings: +以下有用的性质可由类似的字符串引理推出:
    -Theorem eqb_string_true_iff : x y : string,
    -  eqb_string x y = truex = y.
    +Theorem eqb_string_true_iff : x y : string,
    +    eqb_string x y = truex = y.
    Proof.
    @@ -153,9 +150,8 @@

    Maps全映射与偏映射

    -Theorem eqb_string_false_iff : x y : string,
    -  eqb_string x y = false
    -  ↔ xy.
    +Theorem eqb_string_false_iff : x y : string,
    +    eqb_string x y = falsexy.
    Proof.
    @@ -165,11 +161,11 @@

    Maps全映射与偏映射

    -This handy variant follows just by rewriting: +以下方便使用的变体只需通过改写就能得出:
    -Theorem false_eqb_string : x y : string,
    +Theorem false_eqb_string : x y : string,
       xyeqb_string x y = false.
    @@ -180,7 +176,7 @@

    Maps全映射与偏映射

    -

    全映射

    +

    全映射

    @@ -200,7 +196,7 @@

    Maps全映射与偏映射

    -Definition total_map (A:Type) := stringA.
    +Definition total_map (A : Type) := stringA.
    @@ -213,7 +209,7 @@

    Maps全映射与偏映射

    -Definition t_empty {A:Type} (v : A) : total_map A :=
    +Definition t_empty {A : Type} (v : A) : total_map A :=
      (fun _v).
    @@ -224,7 +220,7 @@

    Maps全映射与偏映射

    -Definition t_update {A:Type} (m : total_map A)
    +Definition t_update {A : Type} (m : total_map A)
                        (x : string) (v : A) :=
      fun x'if eqb_string x x' then v else m x'.
    @@ -251,30 +247,17 @@

    Maps全映射与偏映射

    -Notation "{ --> d }" := (t_empty d) (at level 0).
    +Notation "'_' '!->' v" := (t_empty v)
    +  (at level 100, right associativity).

    +Example example_empty := (_ !-> false).
    然后,我们引入一种方便的记法,通过一些绑定来扩展现有的映射。 -
    - - (这种记法的定义有点丑,因为 Coq 的记法机制不太适应递归记法, - 这是我们能做到最好的了。)
    - -Notation "m '&' { a --> x }" :=
    -  (t_update m a x) (at level 20).
    -Notation "m '&' { a --> x ; b --> y }" :=
    -  (t_update (m & { a --> x }) b y) (at level 20).
    -Notation "m '&' { a --> x ; b --> y ; c --> z }" :=
    -  (t_update (m & { a --> x ; b --> y }) c z) (at level 20).
    -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t }" :=
    -    (t_update (m & { a --> x ; b --> y ; c --> z }) d t) (at level 20).
    -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" :=
    -    (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 20).
    -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" :=
    -    (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 20).
    +Notation "x '!->' v ';' m" := (t_update m x v)
    +                              (at level 100, v at next level, right associativity).
    @@ -283,7 +266,10 @@

    Maps全映射与偏映射

    Definition examplemap' :=
    -  { --> false } & { "foo" --> true ; "bar" --> true }.
    +  ( "bar" !-> true;
    +    "foo" !-> true;
    +    _ !-> false
    +  ).
    @@ -301,12 +287,13 @@

    Maps全映射与偏映射

    Logic一节中讨论过它)。
    -

    练习:1 星, optional (t_apply_empty)

    +

    练习:1 星, standard, optional (t_apply_empty)

    首先,空映射对于所有的键都会返回默认元素(即,空映射总是返回默认元素):
    -Lemma t_apply_empty: (A:Type) (x: string) (v: A), { --> v } x = v.
    +Lemma t_apply_empty : (A : Type) (x : string) (v : A),
    +    (_ !-> v) x = v.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -315,15 +302,15 @@

    Maps全映射与偏映射

    -

    练习:2 星, optional (t_update_eq)

    +

    练习:2 星, standard, optional (t_update_eq)

    接着,如果将映射 m 的键 x 关联的值更新为 v,然后在 update 产生的新映射中查找 x,就会得到 v(即,更新某个键的映射, 查找它就会得到更新后的值):
    -Lemma t_update_eq : A (m: total_map A) x v,
    -  (m & {x --> v}) x = v.
    +Lemma t_update_eq : (A : Type) (m : total_map A) x v,
    +    (x !-> v ; m) x = v.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -332,17 +319,16 @@

    Maps全映射与偏映射

    -

    练习:2 星, optional (t_update_neq)

    +

    练习:2 星, standard, optional (t_update_neq)

    此外,如果将映射 m 的键 x1 更新后在返回的结果中查找另一个x2,那么得到的结果与在 m 中查找它的结果相同 (即,更新某个键的映射,不影响其它键的映射):
    -Theorem t_update_neq : (X:Type) v x1 x2
    -                         (m : total_map X),
    -  x1x2
    -  (m & {x1 --> v}) x2 = m x2.
    +Theorem t_update_neq : (A : Type) (m : total_map A) x1 x2 v,
    +    x1x2
    +    (x1 !-> v ; m) x2 = m x2.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -351,15 +337,15 @@

    Maps全映射与偏映射

    -

    练习:2 星, optional (t_update_shadow)

    +

    练习:2 星, standard, optional (t_update_shadow)

    如果将映射 m 的键 x 关联的值更新为 v1 后,又将同一个键 x 更新为另一个值 v2,那么产生的映射与仅将第二次 update 应用于 m 所得到的映射表现一致(即二者应用到同一键时产生的结果相同):
    -Lemma t_update_shadow : A (m: total_map A) v1 v2 x,
    -    m & {x --> v1 ; x --> v2} = m & {x --> v2}.
    +Lemma t_update_shadow : (A : Type) (m : total_map A) x v1 v2,
    +    (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -373,12 +359,13 @@

    Maps全映射与偏映射

    id 上的相等关系命题与布尔函数 eqb_id 关联起来。
    -

    练习:2 星, optional (eqb_stringP)

    +

    练习:2 星, standard, optional (eqb_stringP)

    请仿照IndProp一章中对 eqb_natP 的证明来证明以下引理:
    -Lemma eqb_stringP : x y, reflect (x = y) (eqb_string x y).
    +Lemma eqb_stringP : x y : string,
    +    reflect (x = y) (eqb_string x y).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -387,22 +374,22 @@

    Maps全映射与偏映射

    - 现在,给定 string 类型的字符串 x1x2,我们可以在使用 + 现在,给定 string 类型的字符串 x1x2,我们可以在使用策略 destruct (eqb_stringP x1 x2)eqb_string x1 x2 的结果进行分类讨论的同时,生成关于 x1x2 (在 = 的意义上) 的相等关系前提。
    -

    练习:2 星 (t_update_same)

    +

    练习:2 星, standard (t_update_same)

    请仿照IndProp一章中的示例,用 eqb_stringP 来证明以下定理, 它陈述了:如果我们用映射 m 中已经与键 x 相关联的值更新了 x, 那么其结果与 m 相等:
    -Theorem t_update_same : X x (m : total_map X),
    -    m & { x --> m x } = m.
    -  Proof.
    +Theorem t_update_same : (A : Type) (m : total_map A) x,
    +    (x !-> m x ; m) = m.
    +Proof.
      (* 请在此处解答 *) Admitted.
    @@ -410,17 +397,18 @@

    Maps全映射与偏映射

    -

    练习:3 星, recommended (t_update_permute)

    +

    练习:3 星, standard, recommended (t_update_permute)

    使用 eqb_stringP 来证明最后一个 update 函数的性质: 如果我们更新了映射 m 中两个不同的键,那么更新的顺序无关紧要。
    -Theorem t_update_permute : (X:Type) v1 v2 x1 x2
    -                             (m : total_map X),
    -  x2x1
    -  m & { x2 --> v2 ; x1 --> v1 }
    -  = m & { x1 --> v1 ; x2 --> v2 }.
    +Theorem t_update_permute : (A : Type) (m : total_map A)
    +                                  v1 v2 x1 x2,
    +    x2x1
    +    (x1 !-> v1 ; x2 !-> v2 ; m)
    +    =
    +    (x2 !-> v2 ; x1 !-> v1 ; m).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -428,7 +416,7 @@

    Maps全映射与偏映射

    -

    偏映射

    +

    偏映射

    @@ -437,31 +425,30 @@

    Maps全映射与偏映射

    -Definition partial_map (A:Type) := total_map (option A).

    -Definition empty {A:Type} : partial_map A :=
    +Definition partial_map (A : Type) := total_map (option A).

    +Definition empty {A : Type} : partial_map A :=
      t_empty None.

    -Definition update {A:Type} (m : partial_map A)
    +Definition update {A : Type} (m : partial_map A)
               (x : string) (v : A) :=
    -  m & { x --> (Some v) }.
    +  (x !-> Some v ; m).
    -我们用双花括号为偏映射引入类似的记法。 +我们为偏映射引入类似的记法。
    +Notation "x '>' v ';' m" := (update m x v)
    +  (at level 100, v at next level, right associativity).
    +
    -Notation "m '&' {{ a --> x }}" :=
    -  (update m a x) (at level 20).
    -Notation "m '&' {{ a --> x ; b --> y }}" :=
    -  (update (m & {{ a --> x }}) b y) (at level 20).
    -Notation "m '&' {{ a --> x ; b --> y ; c --> z }}" :=
    -  (update (m & {{ a --> x ; b --> y }}) c z) (at level 20).
    -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t }}" :=
    -    (update (m & {{ a --> x ; b --> y ; c --> z }}) d t) (at level 20).
    -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}" :=
    -    (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t }}) e u) (at level 20).
    -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }}" :=
    -    (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}) f v) (at level 20).
    +
    +当最后一种情况为空时,我们也可以隐藏它。 +
    +
    +Notation "x '>' v" := (update empty x v)
    +  (at level 100).

    +Example examplepmap :=
    +  ("Church" > true ; "Turing" > false).
    @@ -469,7 +456,8 @@

    Maps全映射与偏映射

    -Lemma apply_empty : (A: Type) (x: string), @empty A x = None.
    +Lemma apply_empty : (A : Type) (x : string),
    +    @empty A x = None.
    Proof.
    @@ -479,8 +467,8 @@

    Maps全映射与偏映射


    -Lemma update_eq : A (m: partial_map A) x v,
    -    (m & {{ x --> v }}) x = Some v.
    +Lemma update_eq : (A : Type) (m : partial_map A) x v,
    +    (x > v ; m) x = Some v.
    Proof.
    @@ -490,54 +478,55 @@

    Maps全映射与偏映射


    -Theorem update_neq : (X:Type) v x1 x2
    -                       (m : partial_map X),
    -  x2x1
    -  (m & {{ x2 --> v }}) x1 = m x1.
    +Theorem update_neq : (A : Type) (m : partial_map A) x1 x2 v,
    +    x2x1
    +    (x2 > v ; m) x1 = m x1.
    Proof.
    -  intros X v x1 x2 m H.
    +  intros A m x1 x2 v H.
      unfold update. rewrite t_update_neq. reflexivity.
      apply H. Qed.

    -Lemma update_shadow : A (m: partial_map A) v1 v2 x,
    -    m & {{ x --> v1 ; x --> v2 }} = m & {{x --> v2}}.
    +Lemma update_shadow : (A : Type) (m : partial_map A) x v1 v2,
    +    (x > v2 ; x > v1 ; m) = (x > v2 ; m).
    Proof.
    -  intros A m v1 v2 x1. unfold update. rewrite t_update_shadow.
    +  intros A m x v1 v2. unfold update. rewrite t_update_shadow.
      reflexivity.
    Qed.

    -Theorem update_same : X v x (m : partial_map X),
    -  m x = Some v
    -  m & {{x --> v}} = m.
    +Theorem update_same : (A : Type) (m : partial_map A) x v,
    +    m x = Some v
    +    (x > v ; m) = m.
    Proof.
    -  intros X v x m H. unfold update. rewrite <- H.
    +  intros A m x v H. unfold update. rewrite <- H.
      apply t_update_same.
    Qed.

    -Theorem update_permute : (X:Type) v1 v2 x1 x2
    -                                (m : partial_map X),
    -  x2x1
    -  m & {{x2 --> v2 ; x1 --> v1}}
    -  = m & {{x1 --> v1 ; x2 --> v2}}.
    +Theorem update_permute : (A : Type) (m : partial_map A)
    +                                x1 x2 v1 v2,
    +    x2x1
    +    (x1 > v1 ; x2 > v2 ; m) = (x2 > v2 ; x1 > v1 ; m).
    Proof.
    -  intros X v1 v2 x1 x2 m. unfold update.
    +  intros A m x1 x2 v1 v2. unfold update.
      apply t_update_permute.
    Qed.
    + +
    +(* Sat Jan 26 15:14:46 UTC 2019 *)
    diff --git a/lf-current/Maps.v b/lf-current/Maps.v index 23ab3229..076a578a 100644 --- a/lf-current/Maps.v +++ b/lf-current/Maps.v @@ -20,11 +20,11 @@ 因为我们一直小心地将自己的定义和定理的命名与标准库中的部分保持一致, 无论它们在哪里重复。 *) -Require Import Coq.Arith.Arith. -Require Import Coq.Bool.Bool. +From Coq Require Import Arith.Arith. +From Coq Require Import Bool.Bool. Require Export Coq.Strings.String. -Require Import Coq.Logic.FunctionalExtensionality. -Require Import Coq.Lists.List. +From Coq Require Import Logic.FunctionalExtensionality. +From Coq Require Import Lists.List. Import ListNotations. (** 标准库的文档见 @@ -35,16 +35,14 @@ Import ListNotations. (* ################################################################# *) (** * 标识符 *) -(** First, we need a type for the keys that we use to index into our - maps. In [Lists.v] we introduced a fresh type [id] for this - purpose; for the rest of _Software Foundations_ we will use the - [string] type from Coq's standard library. *) +(** 首先我们需要键的类型来对映射进行索引。在 [Lists.v] 中, + 我们为类似的目的引入了 [id] 类型。而在_'《软件基础》'_后面的部分, + 我们会使用 Coq 标准库中的 [string] 类型。 *) -(** To compare strings, we define the function [eqb_string], which - internally uses the function [string_dec] from Coq's string - library. *) +(** 为了比较字符串,我们定义了 [eqb_string] 函数,它在内部使用 Coq + 字符串库中的 [string_dec] 函数。 *) -Definition eqb_string x y := +Definition eqb_string (x y : string) : bool := if string_dec x y then true else false. (** (函数 [string_dec] 来自于 Coq 的字符串标准库。如果你查看 @@ -55,18 +53,17 @@ Definition eqb_string x y := 与一个标签一起来指出具体是哪一个。不过就目前来说,你可以把它当做一个 花哨的 [bool]。) *) -(** Now we need a few basic properties of string equality... *) -Theorem eqb_string_refl : forall s, true = eqb_string s s. +(** 现在我们需要一些关于字符串相等性的基本性质... *) +Theorem eqb_string_refl : forall s : string, true = eqb_string s s. Proof. intros s. unfold eqb_string. destruct (string_dec s s) as [|Hs]. - reflexivity. - destruct Hs. reflexivity. Qed. -(** The following useful property follows from an analogous - lemma about strings: *) +(** 以下有用的性质可由类似的字符串引理推出: *) Theorem eqb_string_true_iff : forall x y : string, - eqb_string x y = true <-> x = y. + eqb_string x y = true <-> x = y. Proof. intros x y. unfold eqb_string. @@ -80,13 +77,12 @@ Qed. (** 类似地: *) Theorem eqb_string_false_iff : forall x y : string, - eqb_string x y = false - <-> x <> y. + eqb_string x y = false <-> x <> y. Proof. intros x y. rewrite <- eqb_string_true_iff. rewrite not_true_iff_false. reflexivity. Qed. -(** This handy variant follows just by rewriting: *) +(** 以下方便使用的变体只需通过改写就能得出: *) Theorem false_eqb_string : forall x y : string, x <> y -> eqb_string x y = false. @@ -108,7 +104,7 @@ Proof. (** 我们会分两步构建偏映射。首先,我们定义一个_'全映射'_类型, 它在某个映射中查找不存在的键时会返回默认值。 *) -Definition total_map (A:Type) := string -> A. +Definition total_map (A : Type) := string -> A. (** 直观上来说,一个元素类型为 [A] 的全映射不过就是个根据 [string] 来查找 [A] 的函数。 *) @@ -116,14 +112,14 @@ Definition total_map (A:Type) := string -> A. (** 给定函数 [t_empty] 一个默认元素,它会产生一个空的全映射。 此映射在应用到任何字符串时都会返回默认元素。 *) -Definition t_empty {A:Type} (v : A) : total_map A := +Definition t_empty {A : Type} (v : A) : total_map A := (fun _ => v). (** 更有趣的是 [update] 函数,它和之前一样,接受一个映射 [m]、一个键 [x] 以及一个值 [v],并返回一个将 [x] 映射到 [v] 的新映射;其它键则与 [m] 中原来的保持一致。 *) -Definition t_update {A:Type} (m : total_map A) +Definition t_update {A : Type} (m : total_map A) (x : string) (v : A) := fun x' => if eqb_string x x' then v else m x'. @@ -140,30 +136,22 @@ Definition examplemap := (** 接下来,我们引入一些新的记法来方便映射的使用。 *) (** 首先,我们会使用以下记法,根据一个默认值来创建空的全映射。 *) -Notation "{ --> d }" := (t_empty d) (at level 0). +Notation "'_' '!->' v" := (t_empty v) + (at level 100, right associativity). -(** 然后,我们引入一种方便的记法,通过一些绑定来扩展现有的映射。 *) +Example example_empty := (_ !-> false). -(** (这种记法的定义有点丑,因为 Coq 的记法机制不太适应递归记法, - 这是我们能做到最好的了。) *) - -Notation "m '&' { a --> x }" := - (t_update m a x) (at level 20). -Notation "m '&' { a --> x ; b --> y }" := - (t_update (m & { a --> x }) b y) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z }" := - (t_update (m & { a --> x ; b --> y }) c z) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t }" := - (t_update (m & { a --> x ; b --> y ; c --> z }) d t) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" := - (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" := - (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 20). +(** 然后,我们引入一种方便的记法,通过一些绑定来扩展现有的映射。 *) +Notation "x '!->' v ';' m" := (t_update m x v) + (at level 100, v at next level, right associativity). (** 前面的 [examplemap] 现在可以定义如下: *) Definition examplemap' := - { --> false } & { "foo" --> true ; "bar" --> true }. + ( "bar" !-> true; + "foo" !-> true; + _ !-> false + ). (** 到这里就完成了全映射的定义。注意我们无需定义 [find] 操作, 因为它不过就是个函数应用! *) @@ -186,45 +174,49 @@ Proof. reflexivity. Qed. (** (其中有些证明需要函数的外延性公理,我们在[Logic]一节中讨论过它)。 *) -(** **** 练习:1 星, optional (t_apply_empty) *) -(** 首先,空映射对于所有的键都会返回默认元素(即,空映射总是返回默认元素): *) +(** **** 练习:1 星, standard, optional (t_apply_empty) -Lemma t_apply_empty: forall (A:Type) (x: string) (v: A), { --> v } x = v. + 首先,空映射对于所有的键都会返回默认元素(即,空映射总是返回默认元素): *) + +Lemma t_apply_empty : forall (A : Type) (x : string) (v : A), + (_ !-> v) x = v. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_eq) *) -(** 接着,如果将映射 [m] 的键 [x] 关联的值更新为 [v],然后在 [update] +(** **** 练习:2 星, standard, optional (t_update_eq) + + 接着,如果将映射 [m] 的键 [x] 关联的值更新为 [v],然后在 [update] 产生的新映射中查找 [x],就会得到 [v](即,更新某个键的映射, 查找它就会得到更新后的值): *) -Lemma t_update_eq : forall A (m: total_map A) x v, - (m & {x --> v}) x = v. +Lemma t_update_eq : forall (A : Type) (m : total_map A) x v, + (x !-> v ; m) x = v. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_neq) *) -(** 此外,如果将映射 [m] 的键 [x1] 更新后在返回的结果中查找_'另一个'_键 +(** **** 练习:2 星, standard, optional (t_update_neq) + + 此外,如果将映射 [m] 的键 [x1] 更新后在返回的结果中查找_'另一个'_键 [x2],那么得到的结果与在 [m] 中查找它的结果相同 (即,更新某个键的映射,不影响其它键的映射): *) -Theorem t_update_neq : forall (X:Type) v x1 x2 - (m : total_map X), - x1 <> x2 -> - (m & {x1 --> v}) x2 = m x2. +Theorem t_update_neq : forall (A : Type) (m : total_map A) x1 x2 v, + x1 <> x2 -> + (x1 !-> v ; m) x2 = m x2. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_shadow) *) -(** 如果将映射 [m] 的键 [x] 关联的值更新为 [v1] 后,又将同一个键 [x] +(** **** 练习:2 星, standard, optional (t_update_shadow) + + 如果将映射 [m] 的键 [x] 关联的值更新为 [v1] 后,又将同一个键 [x] 更新为另一个值 [v2],那么产生的映射与仅将第二次 [update] 应用于 [m] 所得到的映射表现一致(即二者应用到同一键时产生的结果相同): *) -Lemma t_update_shadow : forall A (m: total_map A) v1 v2 x, - m & {x --> v1 ; x --> v2} = m & {x --> v2}. +Lemma t_update_shadow : forall (A : Type) (m : total_map A) x v1 v2, + (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -233,39 +225,44 @@ Proof. (Reflection idioms)来证明会十分方便。我们首先通过证明基本的_'互映引理'_, 将 [id] 上的相等关系命题与布尔函数 [eqb_id] 关联起来。*) -(** **** 练习:2 星, optional (eqb_stringP) *) -(** 请仿照[IndProp]一章中对 [eqb_natP] 的证明来证明以下引理: *) +(** **** 练习:2 星, standard, optional (eqb_stringP) + + 请仿照[IndProp]一章中对 [eqb_natP] 的证明来证明以下引理: *) -Lemma eqb_stringP : forall x y, reflect (x = y) (eqb_string x y). +Lemma eqb_stringP : forall x y : string, + reflect (x = y) (eqb_string x y). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 现在,给定 [string] 类型的字符串 [x1] 和 [x2],我们可以在使用 +(** 现在,给定 [string] 类型的字符串 [x1] 和 [x2],我们可以在使用策略 [destruct (eqb_stringP x1 x2)] 对 [eqb_string x1 x2] 的结果进行分类讨论的同时,生成关于 [x1] 和 [x2] (在 [=] 的意义上) 的相等关系前提。 *) -(** **** 练习:2 星 (t_update_same) *) -(** 请仿照[IndProp]一章中的示例,用 [eqb_stringP] 来证明以下定理, +(** **** 练习:2 星, standard (t_update_same) + + 请仿照[IndProp]一章中的示例,用 [eqb_stringP] 来证明以下定理, 它陈述了:如果我们用映射 [m] 中已经与键 [x] 相关联的值更新了 [x], 那么其结果与 [m] 相等: *) -Theorem t_update_same : forall X x (m : total_map X), - m & { x --> m x } = m. - Proof. +Theorem t_update_same : forall (A : Type) (m : total_map A) x, + (x !-> m x ; m) = m. +Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, recommended (t_update_permute) *) -(** 使用 [eqb_stringP] 来证明最后一个 [update] 函数的性质: +(** **** 练习:3 星, standard, recommended (t_update_permute) + + 使用 [eqb_stringP] 来证明最后一个 [update] 函数的性质: 如果我们更新了映射 [m] 中两个不同的键,那么更新的顺序无关紧要。 *) -Theorem t_update_permute : forall (X:Type) v1 v2 x1 x2 - (m : total_map X), - x2 <> x1 -> - m & { x2 --> v2 ; x1 --> v1 } - = m & { x1 --> v1 ; x2 --> v2 }. +Theorem t_update_permute : forall (A : Type) (m : total_map A) + v1 v2 x1 x2, + x2 <> x1 -> + (x1 !-> v1 ; x2 !-> v2 ; m) + = + (x2 !-> v2 ; x1 !-> v1 ; m). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -276,77 +273,72 @@ Proof. (** 最后,我们在全映射之上定义_'偏映射'_。元素类型为 [A] 的偏映射不过就是个 元素类型为 [option A],默认元素为 [None] 的全映射。 *) -Definition partial_map (A:Type) := total_map (option A). +Definition partial_map (A : Type) := total_map (option A). -Definition empty {A:Type} : partial_map A := +Definition empty {A : Type} : partial_map A := t_empty None. -Definition update {A:Type} (m : partial_map A) +Definition update {A : Type} (m : partial_map A) (x : string) (v : A) := - m & { x --> (Some v) }. - -(** 我们用双花括号为偏映射引入类似的记法。 **) - -Notation "m '&' {{ a --> x }}" := - (update m a x) (at level 20). -Notation "m '&' {{ a --> x ; b --> y }}" := - (update (m & {{ a --> x }}) b y) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z }}" := - (update (m & {{ a --> x ; b --> y }}) c z) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t }}" := - (update (m & {{ a --> x ; b --> y ; c --> z }}) d t) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}" := - (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t }}) e u) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }}" := - (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}) f v) (at level 20). + (x !-> Some v ; m). + +(** 我们为偏映射引入类似的记法。 **) +Notation "x '|->' v ';' m" := (update m x v) + (at level 100, v at next level, right associativity). + +(** 当最后一种情况为空时,我们也可以隐藏它。 *) +Notation "x '|->' v" := (update empty x v) + (at level 100). + +Example examplepmap := + ("Church" |-> true ; "Turing" |-> false). (** 现在我们将所有关于全映射的基本引理直接转换成对应的偏映射引理。 *) -Lemma apply_empty : forall (A: Type) (x: string), @empty A x = None. +Lemma apply_empty : forall (A : Type) (x : string), + @empty A x = None. Proof. intros. unfold empty. rewrite t_apply_empty. reflexivity. Qed. -Lemma update_eq : forall A (m: partial_map A) x v, - (m & {{ x --> v }}) x = Some v. +Lemma update_eq : forall (A : Type) (m : partial_map A) x v, + (x |-> v ; m) x = Some v. Proof. intros. unfold update. rewrite t_update_eq. reflexivity. Qed. -Theorem update_neq : forall (X:Type) v x1 x2 - (m : partial_map X), - x2 <> x1 -> - (m & {{ x2 --> v }}) x1 = m x1. +Theorem update_neq : forall (A : Type) (m : partial_map A) x1 x2 v, + x2 <> x1 -> + (x2 |-> v ; m) x1 = m x1. Proof. - intros X v x1 x2 m H. + intros A m x1 x2 v H. unfold update. rewrite t_update_neq. reflexivity. apply H. Qed. -Lemma update_shadow : forall A (m: partial_map A) v1 v2 x, - m & {{ x --> v1 ; x --> v2 }} = m & {{x --> v2}}. +Lemma update_shadow : forall (A : Type) (m : partial_map A) x v1 v2, + (x |-> v2 ; x |-> v1 ; m) = (x |-> v2 ; m). Proof. - intros A m v1 v2 x1. unfold update. rewrite t_update_shadow. + intros A m x v1 v2. unfold update. rewrite t_update_shadow. reflexivity. Qed. -Theorem update_same : forall X v x (m : partial_map X), - m x = Some v -> - m & {{x --> v}} = m. +Theorem update_same : forall (A : Type) (m : partial_map A) x v, + m x = Some v -> + (x |-> v ; m) = m. Proof. - intros X v x m H. unfold update. rewrite <- H. + intros A m x v H. unfold update. rewrite <- H. apply t_update_same. Qed. -Theorem update_permute : forall (X:Type) v1 v2 x1 x2 - (m : partial_map X), - x2 <> x1 -> - m & {{x2 --> v2 ; x1 --> v1}} - = m & {{x1 --> v1 ; x2 --> v2}}. +Theorem update_permute : forall (A : Type) (m : partial_map A) + x1 x2 v1 v2, + x2 <> x1 -> + (x1 |-> v1 ; x2 |-> v2 ; m) = (x2 |-> v2 ; x1 |-> v1 ; m). Proof. - intros X v1 v2 x1 x2 m. unfold update. + intros A m x1 x2 v1 v2. unfold update. apply t_update_permute. Qed. - +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/MapsTest.v b/lf-current/MapsTest.v index 74bfc8e2..3e78b902 100644 --- a/lf-current/MapsTest.v +++ b/lf-current/MapsTest.v @@ -38,7 +38,7 @@ idtac " ". idtac "#> t_update_same". idtac "Possible points: 2". check_type @t_update_same ( -(forall (X : Type) (x : string) (m : total_map X), m & {x --> m x} = m)). +(forall (A : Type) (m : total_map A) (x : string), (x !-> m x; m) = m)). idtac "Assumptions:". Abort. Print Assumptions t_update_same. @@ -51,8 +51,8 @@ idtac " ". idtac "#> t_update_permute". idtac "Possible points: 3". check_type @t_update_permute ( -(forall (X : Type) (v1 v2 : X) (x1 x2 : string) (m : total_map X), - x2 <> x1 -> m & {x2 --> v2; x1 --> v1} = m & {x1 --> v1; x2 --> v2})). +(forall (A : Type) (m : total_map A) (v1 v2 : A) (x1 x2 : string), + x2 <> x1 -> (x1 !-> v1; x2 !-> v2; m) = (x2 !-> v2; x1 !-> v1; m))). idtac "Assumptions:". Abort. Print Assumptions t_update_permute. @@ -74,3 +74,5 @@ Print Assumptions t_update_permute. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:14:55 UTC 2019 *) diff --git a/lf-current/Poly.html b/lf-current/Poly.html index 737a7a10..db8e6d40 100644 --- a/lf-current/Poly.html +++ b/lf-current/Poly.html @@ -40,7 +40,7 @@

    Poly多态与高阶函数

    -

    多态

    +

    多态

    @@ -49,7 +49,7 @@

    Poly多态与高阶函数

    -

    多态列表

    +

    多态列表

    @@ -97,7 +97,7 @@

    Poly多态与高阶函数

    Check list.
    -(* ===> list : Type -> Type *)
    +(* ===> list : Type -> Type *)
    @@ -128,7 +128,7 @@

    Poly多态与高阶函数

    nil 的类型可能是什么?我们可以从定义中看到 list X 的类型, 它忽略了 list 的形参 X 的绑定。Type list X 并没有解释 X 的含义,(X : Type) list X 则比较接近。Coq 对这种情况的记法为 - X : Type, list X: + X : Type, list X
    @@ -138,12 +138,12 @@

    Poly多态与高阶函数

    类似地,定义中 cons 看起来像 X list X list X - 然而以此约定来解释 X 的含义则是类型 X, X list X list X。 + 然而以此约定来解释 X 的含义则是类型 X, X list X list X
    Check cons.
    -(* ===> cons : forall X : Type, X -> list X -> list X *)
    +(* ===> cons : forall X : Type, X -> list X -> list X *)
    @@ -201,7 +201,7 @@

    Poly多态与高阶函数

    -

    练习:2 星 (mumble_grumble)

    +

    练习:2 星, standard (mumble_grumble)

    考虑以下两个归纳定义的类型:
    @@ -256,7 +256,7 @@

    Poly多态与高阶函数

    -

    类型标注的推断

    +

    类型标注的推断

    @@ -278,9 +278,9 @@

    Poly多态与高阶函数

    Check repeat'.
    -(* ===> forall X : Type, X -> nat -> list X *)
    +(* ===> forall X : Type, X -> nat -> list X *)
    Check repeat.
    -(* ===> forall X : Type, X -> nat -> list X *)
    +(* ===> forall X : Type, X -> nat -> list X *)
    @@ -299,7 +299,7 @@

    Poly多态与高阶函数

    -

    类型参数的推断

    +

    类型参数的推断

    @@ -376,7 +376,7 @@

    Poly多态与高阶函数

    -

    隐式参数

    +

    隐式参数

    @@ -471,7 +471,7 @@

    Poly多态与高阶函数

    -

    显式提供类型参数

    +

    显式提供类型参数

    @@ -533,25 +533,25 @@

    Poly多态与高阶函数

    -

    练习

    +

    练习

    -

    练习:2 星, optional (poly_exercises)

    +

    练习:2 星, standard, optional (poly_exercises)

    下面是一些简单的练习,和 Lists 一章中的一样。 为了实践多态,请完成下面的证明。
    -Theorem app_nil_r : (X:Type), l:list X,
    +Theorem app_nil_r : (X:Type), l:list X,
      l ++ [] = l.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem app_assoc : A (l m n:list A),
    +Theorem app_assoc : A (l m n:list A),
      l ++ m ++ n = (l ++ m) ++ n.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Lemma app_length : (X:Type) (l1 l2 : list X),
    +Lemma app_length : (X:Type) (l1 l2 : list X),
      length (l1 ++ l2) = length l1 + length l2.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -561,16 +561,16 @@

    Poly多态与高阶函数

    -

    练习:2 星, optional (more_poly_exercises)

    +

    练习:2 星, standard, optional (more_poly_exercises)

    这儿有些更有趣的东西...
    -Theorem rev_app_distr: X (l1 l2 : list X),
    +Theorem rev_app_distr: X (l1 l2 : list X),
      rev (l1 ++ l2) = rev l2 ++ rev l1.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem rev_involutive : X : Type, l : list X,
    +Theorem rev_involutive : X : Type, l : list X,
      rev (rev l) = l.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -579,7 +579,7 @@

    Poly多态与高阶函数

    -

    多态序对

    +

    多态序对

    @@ -653,7 +653,7 @@

    Poly多态与高阶函数

    -

    练习:1 星, optional (combine_checks)

    +

    练习:1 星, standard, optional (combine_checks)

    请尝试在纸上回答以下问题并在 Coq 中检验你的解答:
    @@ -677,7 +677,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, recommended (split)

    +

    练习:2 星, standard, recommended (split)

    函数 splitcombine 的右逆(right inverse): 它接受一个序对的列表并返回一个列表的序对。 在很多函数式语言中,它被称作 unzip。 @@ -700,7 +700,7 @@

    Poly多态与高阶函数

    -

    多态候选

    +

    多态候选

    @@ -751,7 +751,7 @@

    Poly多态与高阶函数

    -

    练习:1 星, optional (hd_error_poly)

    +

    练习:1 星, standard, optional (hd_error_poly)

    请完成上一章中 hd_error 的多态定义,确保它能通过下方的单元测试。
    @@ -775,7 +775,7 @@

    Poly多态与高阶函数

    -

    函数作为数据

    +

    函数作为数据

    @@ -785,7 +785,7 @@

    Poly多态与高阶函数

    -

    高阶函数

    +

    高阶函数

    @@ -804,7 +804,7 @@

    Poly多态与高阶函数

    Check @doit3times.
    -(* ===> doit3times : forall X : Type, (X -> X) -> X -> X *)

    +(* ===> 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.
    @@ -812,7 +812,7 @@

    Poly多态与高阶函数

    -

    过滤器

    +

    过滤器

    @@ -865,7 +865,7 @@

    Poly多态与高阶函数

    -

    匿名函数

    +

    匿名函数

    @@ -902,7 +902,7 @@

    Poly多态与高阶函数

    -

    练习:2 星 (filter_even_gt7)

    +

    练习:2 星, standard (filter_even_gt7)

    使用 filter(而非 Fixpoint)来编写 Coq 函数 filter_even_gt7, 它接受一个自然数列表作为输入,返回一个只包含大于 7 的偶数的列表。
    @@ -922,13 +922,13 @@

    Poly多态与高阶函数

    -

    练习:3 星 (partition)

    +

    练习:3 星, standard (partition)

    使用 filter 编写一个 Coq 函数 partition
    -      partition :  X : Type,
    +      partition : X : Type,
                      (X → bool) → list X → list X * list X
    @@ -954,7 +954,7 @@

    Poly多态与高阶函数

    -

    映射

    +

    映射

    @@ -1005,16 +1005,16 @@

    Poly多态与高阶函数

    -

    习题

    +

    习题

    -

    练习:3 星 (map_rev)

    +

    练习:3 星, standard (map_rev)

    请证明 maprev 可交换。你可能需要定义一个辅助引力
    -Theorem map_rev : (X Y : Type) (f : XY) (l : list X),
    +Theorem map_rev : (X Y : Type) (f : XY) (l : list X),
      map f (rev l) = rev (map f l).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1024,7 +1024,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, recommended (flat_map)

    +

    练习:2 星, standard, recommended (flat_map)

    函数 map 通过一个类型为 X Y 的函数将 list X 映射到 list Y。 我们可以定义一个类似的函数 flat_map,它通过一个类型为 X list Y 的函数 flist X 映射到 list Y。你的定义应当可以“压扁”f @@ -1069,7 +1069,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, optional (implicit_args)

    +

    练习:2 星, standard, optional (implicit_args)

    filtermap 的定义和应用在很多地方使用了隐式参数。 请将隐式参数外层的花括号替换为圆括号,然后在必要的地方补充显式类型形参并用 Coq 检查你做的是否正确。(本练习并不会打分,你可以在本文件的副本中做它, @@ -1078,7 +1078,7 @@

    Poly多态与高阶函数

    -

    折叠

    +

    折叠

    @@ -1122,7 +1122,7 @@

    Poly多态与高阶函数

    Check (fold andb).
    -(* ===> fold andb : list bool -> bool -> bool *)

    +(* ===> fold andb : list bool -> bool -> bool *)

    Example fold_example1 :
      fold mult [1;2;3;4] 1 = 24.
    @@ -1148,7 +1148,7 @@

    Poly多态与高阶函数

    -

    练习:1 星, advanced (fold_types_different)

    +

    练习:1 星, advanced (fold_types_different)

    我们观察到 foldXY两个类型变量参数化,形参 f 则是个接受 XY 并返回 Y 的二元操作符。你能想出一种 XY 不同时的应用情景吗? @@ -1163,7 +1163,7 @@

    Poly多态与高阶函数

    -

    用函数构造函数

    +

    用函数构造函数

    @@ -1198,7 +1198,7 @@

    Poly多态与高阶函数

    Check plus.
    -(* ==> nat -> nat -> nat *)
    +(* ==> nat -> nat -> nat *)
    @@ -1223,7 +1223,7 @@

    Poly多态与高阶函数

    -

    附加练习

    +

    附加练习

    @@ -1233,7 +1233,7 @@

    Poly多态与高阶函数

    -

    练习:2 星 (fold_length)

    +

    练习:2 星, standard (fold_length)

    列表的很多通用函数都可以通过 fold 来实现。例如,下面是 length 的另一种实现:
    @@ -1249,11 +1249,13 @@

    Poly多态与高阶函数

    -请证明 fold_length 的正确性。 +请证明 fold_length 的正确性。(提示:知道 reflexivity 的化简力度比 simpl + 更大或许会有所帮助。也就是说,你或许会遇到 simpl 无法解决但 reflexivity + 可以解决的目标。)
    -Theorem fold_length_correct : X (l : list X),
    +Theorem fold_length_correct : X (l : list X),
      fold_length l = length l.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -1263,7 +1265,7 @@

    Poly多态与高阶函数

    -

    练习:3 星 (fold_map)

    +

    练习:3 星, standard (fold_map)

    我们也可以用 fold 来定义 map。请完成下面的 fold_map
    @@ -1273,7 +1275,8 @@

    Poly多态与高阶函数

    -在 Coq 中写出 fold_map_correct 来陈述 fold_map 是正确的,然后证明它。 +在 Coq 中写出 fold_map_correct 来陈述 fold_map 是正确的,然后证明它。 + (提示:再次提醒,reflexivity 的化简力度比 simpl 更强。)
    @@ -1286,7 +1289,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, advanced (currying)

    +

    练习:2 星, advanced (currying)

    在 Coq 中,函数 f : A B C 的类型其实是 A (B C)。 也就是说,如果给 f 一个类型为 A 的值,它就会给你函数 f' : B C。 如果再给 f' 一个类型为 B 的值,它就会返回一个类型为 C 的值。 @@ -1336,13 +1339,13 @@

    Poly多态与高阶函数

    Check @prod_curry.
    Check @prod_uncurry.

    -Theorem uncurry_curry : (X Y Z : Type)
    +Theorem uncurry_curry : (X Y Z : Type)
                            (f : XYZ)
                            x y,
      prod_curry (prod_uncurry f) x y = f x y.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Theorem curry_uncurry : (X Y Z : Type)
    +Theorem curry_uncurry : (X Y Z : Type)
                            (f : (X * Y) → Z) (p : X * Y),
      prod_uncurry (prod_curry f) p = f p.
    Proof.
    @@ -1353,7 +1356,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, advanced (nth_error_informal)

    +

    练习:2 星, advanced (nth_error_informal)

    回想 nth_error 函数的定义:
    @@ -1372,7 +1375,7 @@

    Poly多态与高阶函数

    -    X n llength l = n → @nth_error X l n = None +   X n llength l = n → @nth_error X l n = None
    @@ -1397,7 +1400,7 @@

    Poly多态与高阶函数

    Module Church.
    -Definition cnat := X : Type, (XX) → XX.
    +Definition cnat := X : Type, (XX) → XX.
    @@ -1443,7 +1446,7 @@

    Poly多态与高阶函数

    reflexivity 证明来确认它们能够通过对应的单元测试。
    -

    练习:1 星, advanced (church_succ)

    +

    练习:1 星, advanced (church_succ)

    @@ -1466,7 +1469,7 @@

    Poly多态与高阶函数

    -

    练习:1 星, advanced (church_plus)

    +

    练习:1 星, advanced (church_plus)

    @@ -1488,7 +1491,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, advanced (church_mult)

    +

    练习:2 星, advanced (church_mult)

    @@ -1509,7 +1512,7 @@

    Poly多态与高阶函数

    -

    练习:2 星, advanced (church_exp)

    +

    练习:2 星, advanced (church_exp)

    @@ -1537,7 +1540,8 @@

    Poly多态与高阶函数

    End Church.

    -End Exercises.
    +End Exercises.

    +(* Sat Jan 26 15:14:45 UTC 2019 *)
    diff --git a/lf-current/Poly.v b/lf-current/Poly.v index e9a1de10..28e7c702 100644 --- a/lf-current/Poly.v +++ b/lf-current/Poly.v @@ -115,9 +115,9 @@ Example test_repeat2 : Proof. reflexivity. Qed. +(** **** 练习:2 星, standard (mumble_grumble) -(** **** 练习:2 星 (mumble_grumble) *) -(** 考虑以下两个归纳定义的类型: *) + 考虑以下两个归纳定义的类型: *) Module MumbleGrumble. @@ -341,8 +341,9 @@ Definition list123''' := [1; 2; 3]. (* ----------------------------------------------------------------- *) (** *** 练习 *) -(** **** 练习:2 星, optional (poly_exercises) *) -(** 下面是一些简单的练习,和 [Lists] 一章中的一样。 +(** **** 练习:2 星, standard, optional (poly_exercises) + + 下面是一些简单的练习,和 [Lists] 一章中的一样。 为了实践多态,请完成下面的证明。 *) Theorem app_nil_r : forall (X:Type), forall l:list X, @@ -361,8 +362,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (more_poly_exercises) *) -(** 这儿有些更有趣的东西... *) +(** **** 练习:2 星, standard, optional (more_poly_exercises) + + 这儿有些更有趣的东西... *) Theorem rev_app_distr: forall X (l1 l2 : list X), rev (l1 ++ l2) = rev l2 ++ rev l1. @@ -428,17 +430,19 @@ Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y) | x :: tx, y :: ty => (x, y) :: (combine tx ty) end. -(** **** 练习:1 星, optional (combine_checks) *) -(** 请尝试在纸上回答以下问题并在 Coq 中检验你的解答: +(** **** 练习:1 星, standard, optional (combine_checks) + + 请尝试在纸上回答以下问题并在 Coq 中检验你的解答: - [combine] 的类型是什么?(即 [Check @combine] 会打印出什么?) - 以下指令会打印出什么? Compute (combine [1;2] [false;false;true;true]). -*) -(** [] *) -(** **** 练习:2 星, recommended (split) *) -(** 函数 [split] 是 [combine] 的右逆(right inverse): + [] *) + +(** **** 练习:2 星, standard, recommended (split) + + 函数 [split] 是 [combine] 的右逆(right inverse): 它接受一个序对的列表并返回一个列表的序对。 在很多函数式语言中,它被称作 [unzip]。 @@ -458,8 +462,9 @@ Proof. (** ** 多态候选 *) (** 现在介绍最后一种多态类型:_'多态候选(Polymorphic Options)'_, - 它推广了上一章中的 [natoption]: *) -(** One last polymorphic type for now: _polymorphic options_, + 它推广了上一章中的 [natoption]: + + One last polymorphic type for now: _polymorphic options_, which generalize [natoption] from the previous chapter. (We put the definition inside a module because the standard library already defines [option] and it's this one that we want to use @@ -492,8 +497,9 @@ Proof. reflexivity. Qed. Example test_nth_error3 : nth_error [true] 2 = None. Proof. reflexivity. Qed. -(** **** 练习:1 星, optional (hd_error_poly) *) -(** 请完成上一章中 [hd_error] 的多态定义,确保它能通过下方的单元测试。 *) +(** **** 练习:1 星, standard, optional (hd_error_poly) + + 请完成上一章中 [hd_error] 的多态定义,确保它能通过下方的单元测试。 *) Definition hd_error {X : Type} (l : list X) : option X (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -603,8 +609,9 @@ Example test_filter2': = [ [3]; [4]; [8] ]. Proof. reflexivity. Qed. -(** **** 练习:2 星 (filter_even_gt7) *) -(** 使用 [filter](而非 [Fixpoint])来编写 Coq 函数 [filter_even_gt7], +(** **** 练习:2 星, standard (filter_even_gt7) + + 使用 [filter](而非 [Fixpoint])来编写 Coq 函数 [filter_even_gt7], 它接受一个自然数列表作为输入,返回一个只包含大于 [7] 的偶数的列表。 *) Definition filter_even_gt7 (l : list nat) : list nat @@ -619,8 +626,9 @@ Example test_filter_even_gt7_2 : (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (partition) *) -(** 使用 [filter] 编写一个 Coq 函数 [partition]: +(** **** 练习:3 星, standard (partition) + + 使用 [filter] 编写一个 Coq 函数 [partition]: partition : forall X : Type, (X -> bool) -> list X -> list X * list X @@ -679,8 +687,9 @@ Proof. reflexivity. Qed. (* ----------------------------------------------------------------- *) (** *** 习题 *) -(** **** 练习:3 星 (map_rev) *) -(** 请证明 [map] 和 [rev] 可交换。你可能需要定义一个辅助引力 *) +(** **** 练习:3 星, standard (map_rev) + + 请证明 [map] 和 [rev] 可交换。你可能需要定义一个辅助引力 *) Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X), map f (rev l) = rev (map f l). @@ -688,8 +697,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, recommended (flat_map) *) -(** 函数 [map] 通过一个类型为 [X -> Y] 的函数将 [list X] 映射到 [list Y]。 +(** **** 练习:2 星, standard, recommended (flat_map) + + 函数 [map] 通过一个类型为 [X -> Y] 的函数将 [list X] 映射到 [list Y]。 我们可以定义一个类似的函数 [flat_map],它通过一个类型为 [X -> list Y] 的函数 [f] 将 [list X] 映射到 [list Y]。你的定义应当可以“压扁”[f] 的结果,就像这样: @@ -718,13 +728,14 @@ Definition option_map {X Y : Type} (f : X -> Y) (xo : option X) | Some x => Some (f x) end. -(** **** 练习:2 星, optional (implicit_args) *) -(** [filter] 和 [map] 的定义和应用在很多地方使用了隐式参数。 +(** **** 练习:2 星, standard, optional (implicit_args) + + [filter] 和 [map] 的定义和应用在很多地方使用了隐式参数。 请将隐式参数外层的花括号替换为圆括号,然后在必要的地方补充显式类型形参并用 Coq 检查你做的是否正确。(本练习并不会打分,你可以在本文件的_'副本'_中做它, 之后丢掉即可。) -*) -(** [] *) + + [] *) (* ================================================================= *) (** ** 折叠 *) @@ -767,8 +778,9 @@ Example fold_example3 : fold app [[1];[];[2;3];[4]] [] = [1;2;3;4]. Proof. reflexivity. Qed. -(** **** 练习:1 星, advanced (fold_types_different) *) -(** 我们观察到 [fold] 由 [X] 和 [Y] 这_'两个'_类型变量参数化,形参 [f] +(** **** 练习:1 星, advanced (fold_types_different) + + 我们观察到 [fold] 由 [X] 和 [Y] 这_'两个'_类型变量参数化,形参 [f] 则是个接受 [X] 和 [Y] 并返回 [Y] 的二元操作符。你能想出一种 [X] 和 [Y] 不同时的应用情景吗? *) @@ -826,8 +838,9 @@ Proof. reflexivity. Qed. Module Exercises. -(** **** 练习:2 星 (fold_length) *) -(** 列表的很多通用函数都可以通过 [fold] 来实现。例如,下面是 +(** **** 练习:2 星, standard (fold_length) + + 列表的很多通用函数都可以通过 [fold] 来实现。例如,下面是 [length] 的另一种实现: *) Definition fold_length {X : Type} (l : list X) : nat := @@ -836,7 +849,9 @@ Definition fold_length {X : Type} (l : list X) : nat := Example test_fold_length1 : fold_length [4;7;0] = 3. Proof. reflexivity. Qed. -(** 请证明 [fold_length] 的正确性。 *) +(** 请证明 [fold_length] 的正确性。(提示:知道 [reflexivity] 的化简力度比 [simpl] + 更大或许会有所帮助。也就是说,你或许会遇到 [simpl] 无法解决但 [reflexivity] + 可以解决的目标。) *) Theorem fold_length_correct : forall X (l : list X), fold_length l = length l. @@ -844,13 +859,15 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (fold_map) *) -(** 我们也可以用 [fold] 来定义 [map]。请完成下面的 [fold_map]。 *) +(** **** 练习:3 星, standard (fold_map) + + 我们也可以用 [fold] 来定义 [map]。请完成下面的 [fold_map]。 *) Definition fold_map {X Y: Type} (f: X -> Y) (l: list X) : list Y (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. -(** 在 Coq 中写出 [fold_map_correct] 来陈述 [fold_map] 是正确的,然后证明它。 *) +(** 在 Coq 中写出 [fold_map_correct] 来陈述 [fold_map] 是正确的,然后证明它。 + (提示:再次提醒,[reflexivity] 的化简力度比 [simpl] 更强。) *) (* 请在此处解答 *) @@ -858,8 +875,9 @@ Definition fold_map {X Y: Type} (f: X -> Y) (l: list X) : list Y Definition manual_grade_for_fold_map : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, advanced (currying) *) -(** 在 Coq 中,函数 [f : A -> B -> C] 的类型其实是 [A -> (B -> C)]。 +(** **** 练习:2 星, advanced (currying) + + 在 Coq 中,函数 [f : A -> B -> C] 的类型其实是 [A -> (B -> C)]。 也就是说,如果给 [f] 一个类型为 [A] 的值,它就会给你函数 [f' : B -> C]。 如果再给 [f'] 一个类型为 [B] 的值,它就会返回一个类型为 [C] 的值。 这为我们提供了 [plus3] 中的那种偏应用能力。 @@ -906,8 +924,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, advanced (nth_error_informal) *) -(** 回想 [nth_error] 函数的定义: +(** **** 练习:2 星, advanced (nth_error_informal) + + 回想 [nth_error] 函数的定义: Fixpoint nth_error {X : Type} (l : list X) (n : nat) : option X := match l with @@ -1041,3 +1060,4 @@ End Church. End Exercises. +(* Sat Jan 26 15:14:45 UTC 2019 *) diff --git a/lf-current/PolyTest.v b/lf-current/PolyTest.v index d1d460e0..33a8e8d6 100644 --- a/lf-current/PolyTest.v +++ b/lf-current/PolyTest.v @@ -420,3 +420,5 @@ Print Assumptions Exercises.Church.exp_2. idtac "---------- Exercises.Church.exp_3 ---------". Print Assumptions Exercises.Church.exp_3. Abort. + +(* Sat Jan 26 15:14:50 UTC 2019 *) diff --git a/lf-current/Postscript.html b/lf-current/Postscript.html index 72f75190..ca6644df 100644 --- a/lf-current/Postscript.html +++ b/lf-current/Postscript.html @@ -39,7 +39,7 @@

    Postscript后记

    恭喜,课程终于顺利结束了!
    -

    回顾一下

    +

    回顾一下

    @@ -117,7 +117,7 @@

    Postscript后记

    -

    继续前行

    +

    继续前行

    @@ -143,7 +143,7 @@

    Postscript后记

    -

    其它资源

    +

    其它资源

    @@ -221,6 +221,10 @@

    Postscript后记

    +
    +
    + +(* Sat Jan 26 15:14:46 UTC 2019 *)
    diff --git a/lf-current/Postscript.v b/lf-current/Postscript.v index 4dd76711..f250cfb4 100644 --- a/lf-current/Postscript.v +++ b/lf-current/Postscript.v @@ -19,7 +19,6 @@ --------- ~ ------------------ 软件工程 机械工程/土木工程 - - 归纳定义的集合和关系 - 归纳证明 - 证明对象 *) @@ -81,3 +80,5 @@ 夏令营的课程与相关资料。 https://deepspec.org/event/dsss17/index.html *) + +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/PostscriptTest.v b/lf-current/PostscriptTest.v index 0d13dd89..f949d1cf 100644 --- a/lf-current/PostscriptTest.v +++ b/lf-current/PostscriptTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:05 UTC 2019 *) diff --git a/lf-current/Preface.html b/lf-current/Preface.html index 2c7b3895..c49be78f 100644 --- a/lf-current/Preface.html +++ b/lf-current/Preface.html @@ -306,7 +306,7 @@

    Preface前言

    • 安装近期版本的 Coq,它可以从 Coq 主页获得。本书中的文件均已通过了 - Coq 8.8.0 的测试。 + Coq 8.8.1 的测试。
      @@ -331,7 +331,20 @@

      Preface前言

    • CoqIDE 是个更加简单的独立 IDE。它随 Coq 一起发布, 所以如果你安装了 Coq,它应该就能用。你也可以从头编译安装它, - 不过在某些平台上还需要额外安装 GUI 之类的库。 + 不过在某些平台上还需要额外安装 GUI 之类的库。 + +
      + + 用户在运行 CoqIDE 时可以考虑关闭“异步”和“错误恢复”模式: + +
      + +
      +coqide -async-proofs off -async-proofs-command-error-resilience off Foo.v & +
      + +
      +
    @@ -406,20 +419,34 @@

    Preface前言

    (如果你是在一门课程中使用本书的,那么你的教授可能会让你使用本地的修改版, - 此时你应当使用它们而非发布版。) + 此时你应当使用它们而非发布版,这样你可以获得所有该学期的本地更新。) +
    + +
    +

    资源

    + +
    + +

    模拟题

    + +
    + + 宾夕法尼亚大学的 CIS500(软件基础)课程提供了大量的考试大纲,可访问 + https://www.seas.upenn.edu/~cis500/current/exams/index.html 获取。 + 近年来书中的记法有所变动,但大部分问题仍与本文对应。
    -

    课程视频

    +

    课程视频

    - 《逻辑基础》暑期加强班的课程讲义可访问 - https://deepspec.org/event/dsss17/coq_intensive.html 获取。 - 开始的视频清晰度不高,但在之后的课程中会更好。 + 《逻辑基础》夏季加强班(DeepSpec 夏季班系列之一)的课程讲义可访问 + https://deepspec.org/event/dsss17https://deepspec.org/event/dsss18/ + 获取。2017 年的视频清晰度不高,但在之后的课程中会更好。
    -

    对授课员的要求

    +

    对授课员的要求

    @@ -468,7 +495,7 @@

    Preface前言

    -

    译本

    +

    译本

    @@ -478,7 +505,7 @@

    Preface前言

    -

    鸣谢

    +

    鸣谢

    @@ -486,6 +513,10 @@

    Preface前言

    (National Science Foundation)在 NSF 科研赞助 1521523 号 深度规范科学 下提供支持。
    +
    + +(* Sat Jan 26 15:14:44 UTC 2019 *)
    +
    diff --git a/lf-current/Preface.v b/lf-current/Preface.v index 9cff4c02..e00cdcb2 100644 --- a/lf-current/Preface.v +++ b/lf-current/Preface.v @@ -20,7 +20,6 @@ 本书为第一卷_'《逻辑基础》'_,它向读者介绍了函数式编程的基本概念、构造逻辑以及 Coq 证明助理,为其它卷本的学习奠定了基础。 *) - (* ################################################################# *) (** * 概览 *) @@ -165,7 +164,6 @@ 当我们更加深入地审视它时,会发现 Coq 的这两方面其实基于完全相同的底层机制 -- _'命题即类型,程序即证明'_,可谓殊途同归。 *) - (* ================================================================= *) (** ** 扩展阅读 *) @@ -188,7 +186,7 @@ (** Coq 可以在 Windows、Linux 和 macOS 上运行。我们需要: - 安装近期版本的 Coq,它可以从 Coq 主页获得。本书中的文件均已通过了 - Coq 8.8.0 的测试。 + Coq 8.8.1 的测试。 - 一个能跟 Coq 交互的 IDE。目前有两种选择: @@ -200,7 +198,12 @@ - CoqIDE 是个更加简单的独立 IDE。它随 Coq 一起发布, 所以如果你安装了 Coq,它应该就能用。你也可以从头编译安装它, - 不过在某些平台上还需要额外安装 GUI 之类的库。 *) + 不过在某些平台上还需要额外安装 GUI 之类的库。 + + 用户在运行 CoqIDE 时可以考虑关闭“异步”和“错误恢复”模式: + + coqide -async-proofs off -async-proofs-command-error-resilience off Foo.v & +*) (* ================================================================= *) (** ** 练习 *) @@ -237,14 +240,24 @@ 本书的中文版和压缩包可访问 https://github.com/Coq-zh/SF-zh 获取。 (如果你是在一门课程中使用本书的,那么你的教授可能会让你使用本地的修改版, - 此时你应当使用它们而非发布版。) *) + 此时你应当使用它们而非发布版,这样你可以获得所有该学期的本地更新。) *) + +(* ################################################################# *) +(** * 资源 *) + +(* ================================================================= *) +(** ** 模拟题 *) + +(** 宾夕法尼亚大学的 CIS500(软件基础)课程提供了大量的考试大纲,可访问 + https://www.seas.upenn.edu/~cis500/current/exams/index.html 获取。 + 近年来书中的记法有所变动,但大部分问题仍与本文对应。 *) (* ================================================================= *) (** ** 课程视频 *) -(** _'《逻辑基础》'_暑期加强班的课程讲义可访问 - https://deepspec.org/event/dsss17/coq_intensive.html 获取。 - 开始的视频清晰度不高,但在之后的课程中会更好。 *) +(** _'《逻辑基础》'_夏季加强班(DeepSpec 夏季班系列之一)的课程讲义可访问 + https://deepspec.org/event/dsss17 和 https://deepspec.org/event/dsss18/ + 获取。2017 年的视频清晰度不高,但在之后的课程中会更好。 *) (* ################################################################# *) (** * 对授课员的要求 *) @@ -293,3 +306,5 @@ (** _'《软件基础》'_ 系列的开发,部分由国家科学基金会 (National Science Foundation)在 NSF 科研赞助 1521523 号 _'深度规范科学'_ 下提供支持。 *) + +(* Sat Jan 26 15:14:44 UTC 2019 *) diff --git a/lf-current/PrefaceTest.v b/lf-current/PrefaceTest.v index 06635477..f5216847 100644 --- a/lf-current/PrefaceTest.v +++ b/lf-current/PrefaceTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:14:47 UTC 2019 *) diff --git a/lf-current/ProofObjects.html b/lf-current/ProofObjects.html index e652c790..8cbbc502 100644 --- a/lf-current/ProofObjects.html +++ b/lf-current/ProofObjects.html @@ -43,7 +43,7 @@

    ProofObjects柯里-霍华德对应

    前文已讨论过 Coq 既可以用 natlist 等归纳类型及其函数编程,又可 - 以用归纳命题(如 ev)、蕴含式、全称量词等工具证明程序的性质。我们一直 + 以用归纳命题(如 even)、蕴含式、全称量词等工具证明程序的性质。我们一直 以来区别对待此两种用法,在很多情况下确实可以这样。但也有迹象表明在 Coq 中编 程与证明紧密相关。例如,关键字 Inductive 同时用于声明数据类型和命题,以及 同时用于描述函数类型和逻辑蕴含式。这可并不是语法上的巧合!事实上,在 Coq @@ -68,22 +68,22 @@

    ProofObjects柯里-霍华德对应

    - 回顾一下 ev 这个性质的形式化定义。 + 回顾一下 even 这个性质的形式化定义。
    -Print ev.
    +Print even.
    (* ==>
    -  Inductive ev : nat -> Prop :=
    -    | ev_0 : ev 0
    -    | ev_SS : forall n, ev n -> ev (S (S n)).
    +  Inductive even : nat -> Prop :=
    +    | ev_0 : even 0
    +    | ev_SS : forall n, even n -> even (S (S n)).
    *)

    -试以另一种方式解读“:”:以“是……的证明”取代“具有……类型”。例如将定义第二行的 - ev_0 : ev 0 读作“ev_0ev 0 的证明”以代替“ev_0 具有 ev 0 类型”。 - +试以另一种方式解读“:”:以“是……的证明”取代“具有……类型”。例如将定义 even + 第二行的 ev_0 : even 0 读作“ev_0[even] 0 的证明”以代替“ev_0 具有 + [even] 0 类型”。
    此处 : 既在类型层面表达“具有……类型”,又在命题层面表示“证明了……”。这种双关 @@ -105,20 +105,20 @@

    ProofObjects柯里-霍华德对应Check ev_SS.
    (* ===> ev_SS : forall n,
    -                  ev n ->
    -                  ev (S (S n)) *)

    +                  even n ->
    +                  even (S (S n)) *)

    -可以将其读作“ev_SS 构造子接受两个参数——数字 n 以及命题 ev n 的证明——并 - 产生 ev (S (S n)) 的证明。” +可以将其读作“ev_SS 构造子接受两个参数——数字 n 以及命题 even n + 的证明——并产生 even (S (S n)) 的证明。”
    - 现在让我们回顾一下之前有关 ev 的一个证明。 + 现在让我们回顾一下之前有关 even 的一个证明。
    -Theorem ev_4 : ev 4.
    +Theorem ev_4 : even 4.
    Proof.
      apply ev_SS. apply ev_SS. apply ev_0. Qed.
    @@ -131,7 +131,7 @@

    ProofObjects柯里-霍华德对应Print ev_4.
    (* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0)
    -     : ev 4  *)

    +     : even 4  *)

    @@ -140,15 +140,24 @@

    ProofObjects柯里-霍华德对应 Check (ev_SS 2 (ev_SS 0 ev_0)).
    -(* ===> ev 4 *)
    +(* ===> even 4 *)

    表达式 ev_SS 2 (ev_SS 0 ev_0) 可视为向构造子 ev_SS 传入参数 2 和 0 - 等参数,以及对应的 ev 2ev 0 之依据所构造的证明。或言之,视 ev_SS + 等参数,以及对应的 even 2even 0 之依据所构造的证明。或言之,视 ev_SS 为“构造证明”之原语,需要给定一个数字,并进一步提供该数为偶数之依据以构造证明。 - 其类型表明了它的功能:[ n, ev n ev (S (S n)) ];类似地,多态类型 X, - list X 表明可以将 nil 视为从某类型到由该类型元素组成的空列表的函数。 + 其类型表明了它的功能: + +
    + +
    +    neven n → even (S (S n)) +
    + +
    + 类似地,多态类型 X, list X 表明可以将 nil + 视为从某类型到由该类型元素组成的空列表的函数。
    我们在 Logic 这一章中已经了解到,我们可以使用函数应用 @@ -157,14 +166,14 @@

    ProofObjects柯里-霍华德对应
    -Theorem ev_4': ev 4.
    +Theorem ev_4': even 4.
    Proof.
      apply (ev_SS 2 (ev_SS 0 ev_0)).
    Qed.
    -

    证明脚本

    +

    证明脚本

    @@ -176,7 +185,7 @@

    ProofObjects柯里-霍华德对应
    -Theorem ev_4'' : ev 4.
    +Theorem ev_4'' : even 4.
    Proof.
      Show Proof.
      apply ev_SS.
    @@ -204,7 +213,7 @@

    ProofObjects柯里-霍华德对应
    -Definition ev_4''' : ev 4 :=
    +Definition ev_4''' : even 4 :=
      ev_SS 2 (ev_SS 0 ev_0).
    @@ -214,32 +223,32 @@

    ProofObjects柯里-霍华德对应 Print ev_4.
    -(* ===> ev_4    =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
    +(* ===> ev_4    =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
    Print ev_4'.
    -(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
    +(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
    Print ev_4''.
    -(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
    +(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
    Print ev_4'''.
    -(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : ev 4 *)
    +(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)

    -

    练习:2 星 (eight_is_even)

    - 写出对应 ev 8 的策略证明和证明对象。 +

    练习:2 星, standard (eight_is_even)

    + 写出对应 even 8 的策略证明和证明对象。
    -Theorem ev_8 : ev 8.
    +Theorem ev_8 : even 8.
    Proof.
      (* 请在此处解答 *) Admitted.

    -Definition ev_8' : ev 8
    +Definition ev_8' : even 8
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.
    -

    量词,蕴含式,函数

    +

    量词,蕴含式,函数

    @@ -258,7 +267,7 @@

    ProofObjects柯里-霍华德对应
    -Theorem ev_plus4 : n, ev nev (4 + n).
    +Theorem ev_plus4 : n, even neven (4 + n).
    Proof.
      intros n H. simpl.
      apply ev_SS.
    @@ -272,7 +281,7 @@

    ProofObjects柯里-霍华德对应

    - 我们在寻找一个类型(Type)n, ev n ev (4 + n) 的表达式——也 + 我们在寻找一个类型(Type) n, even n even (4 + n) 的表达式——也 就是说,一个接受两个参数(一个数字和一个证据)并返回一个证据的 函数(Function)! @@ -282,8 +291,8 @@

    ProofObjects柯里-霍华德对应
    -Definition ev_plus4' : n, ev nev (4 + n) :=
    -  fun (n : nat) ⇒ fun (H : ev n) ⇒
    +Definition ev_plus4' : n, even neven (4 + n) :=
    +  fun (n : nat) ⇒ fun (H : even n) ⇒
        ev_SS (S (S n)) (ev_SS n H).
    @@ -294,17 +303,17 @@

    ProofObjects柯里-霍华德对应
    -Definition ev_plus4'' (n : nat) (H : ev n)
    -                    : ev (4 + n) :=
    +Definition ev_plus4'' (n : nat) (H : even n)
    +                    : even (4 + n) :=
      ev_SS (S (S n)) (ev_SS n H).

    Check ev_plus4''.
    (* ===>
    -     : forall n : nat, ev n -> ev (4 + n) *)

    +     : forall n : nat, even n -> even (4 + n) *)
    当我们将 ev_plus4 证明的命题视为一个函数类型时,我们可以发现一个 - 有趣的现象:第二个参数的类型,ev n,依赖于第一个参数 n。 + 有趣的现象:第二个参数的类型,even n,依赖于第一个参数 n
    @@ -320,8 +329,8 @@

    ProofObjects柯里-霍华德对应

    -            (x:nat), nat
    -        =   (_:nat), nat
    +           (x:nat), nat
    +        =  (_:nat), nat
            =  nat → nat
    @@ -334,7 +343,7 @@

    ProofObjects柯里-霍华德对应 Definition ev_plus2 : Prop :=
    -   n, (E : ev n), ev (n + 2).
    +  n, (E : even n), even (n + 2).

    @@ -346,7 +355,7 @@

    ProofObjects柯里-霍华德对应 Definition ev_plus2' : Prop :=
    -   n, (_ : ev n), ev (n + 2).
    +  n, (_ : even n), even (n + 2).

    @@ -355,21 +364,21 @@

    ProofObjects柯里-霍华德对应 Definition ev_plus2'' : Prop :=
    -   n, ev nev (n + 2).
    +  n, even neven (n + 2).

    -总的来说,"P Q"只是 "(_:P), Q"的语法糖。 +总的来说,"P Q"只是 " (_:P), Q"的语法糖。
    -

    使用策略编程

    +

    使用策略编程

    如果我们可以通过显式地给出项,而不是执行策略脚本,来构造证明,你可 能会好奇我们是否可以通过策略,而不是显式地给出项,来构造程序。 - 自然地,答案是可以! + 自然地,答案是可以!
    @@ -382,7 +391,7 @@

    ProofObjects柯里-霍华德对应Print add1.
    (* ==>
        add1 = fun n : nat => S n
    -         : nat -> nat
    +         : nat -> nat
    *)


    Compute add1 2.
    (* ==> 3 : nat *)
    @@ -403,12 +412,12 @@

    ProofObjects柯里-霍华德对应
    -

    逻辑联结词作为归纳类型

    +

    逻辑联结词作为归纳类型

    - 归纳定义足够用于表达我们目前为止遇到的大多数的联结词和量词。事实上, - 只有全称量化(因此也包括蕴含式)是Coq内置的,所有其他的都是被归纳 + 归纳定义足够用于表达我们目前为止遇到的大多数的联结词。事实上, + 只有全称量化(以及作为特殊情况的蕴含式)是Coq内置的,所有其他的都是被归纳 定义的。在这一节中我们会看到它们的定义。
    @@ -417,12 +426,11 @@

    ProofObjects柯里-霍华德对应
    -

    合取

    - +

    合取

    - 为了证明P Q成立,我们必须同时给出PQ的证据。因此,我们可 + 为了证明P Q成立,我们必须同时给出PQ的证据。因此,我们可 以合理地将P Q的证明对象定义为包含两个证明的元祖:一个是P的 证明,另一个是Q的证明。即我们拥有如下定义。
    @@ -443,18 +451,22 @@

    ProofObjects柯里-霍华德对应Print prod.
    (* ===>
       Inductive prod (X Y : Type) : Type :=
    -   | pair : X -> Y -> X * Y. *)

    +   | pair : X -> Y -> X * Y. *)

    这个定义能够解释为什么destructintros模式能用于一个合取前提。 情况分析允许我们考虑所有P Q可能被证明的方式——只有一种方式(即 - conj构造子)。类似地,split策略能够用于所有只有一个构造子的归 + conj构造子)。 + +
    + + 类似地,split策略能够用于所有只有一个构造子的归 纳定义命题。特别地,它能够用于and
    -Lemma and_comm : P Q : Prop, PQQP.
    +Lemma and_comm : P Q : Prop, PQQP.
    Proof.
      intros P Q. split.
      - intros [HP HQ]. split.
    @@ -472,7 +484,7 @@

    ProofObjects柯里-霍华德对应
    -Definition and_comm'_aux P Q (H : PQ) :=
    +Definition and_comm'_aux P Q (H : PQ) : QP :=
      match H with
      | conj HP HQconj HQ HP
      end.

    @@ -481,12 +493,12 @@

    ProofObjects柯里-霍华德对应
    -

    练习:2 星, optional (conj_fact)

    +

    练习:2 星, standard, optional (conj_fact)

    构造一个证明对象来证明下列命题。
    -Definition conj_fact : P Q R, PQQRPR
    +Definition conj_fact : P Q R, PQQRPR
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.
    @@ -494,12 +506,11 @@

    ProofObjects柯里-霍华德对应
    -

    析取

    - +

    析取

    - 析取的归纳定义有两个构造子,分别用于析取的两边: + 析取的归纳定义有两个构造子,分别用于析取的两边:

    @@ -519,13 +530,13 @@

    ProofObjects柯里-霍华德对应or的定义的证明对象。
    -

    练习:2 星, optional (or_commut'')

    +

    练习:2 星, standard, optional (or_commut'')

    尝试写下or_commut的显式证明对象。(不要使用Print来偷看我们已经 定义的版本!)
    -Definition or_comm : P Q, PQQP
    +Definition or_comm : P Q, PQQP
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.
    @@ -533,18 +544,17 @@

    ProofObjects柯里-霍华德对应
    -

    存在量化

    - +

    存在量化

    - 为了给出存在量词的证据,我们将一个证据类型xx满足性质P的证明打包在一起: + 为了给出存在量词的证据,我们将一个证据类型xx满足性质P的证明打包在一起:

    Module Ex.

    Inductive ex {A : Type} (P : AProp) : Prop :=
    -| ex_intro : x : A, P xex P.

    +| ex_intro : x : A, P xex P.

    End Ex.
    @@ -555,12 +565,12 @@

    ProofObjects柯里-霍华德对应xP x的证 明,可以构造ex P的证据的方式。
    - 我们更加熟悉的类型x, P x可以转换为一个涉及ex的表达式: + 我们更加熟悉的类型 x, P x可以转换为一个涉及ex的表达式:

    -Check ex (fun nev n).
    -(* ===> exists n : nat, ev n
    +Check ex (fun neven n).
    +(* ===> exists n : nat, even n
            : Prop *)

    @@ -569,17 +579,17 @@

    ProofObjects柯里-霍华德对应
    -Definition some_nat_is_even : n, ev n :=
    -  ex_intro ev 4 (ev_SS 2 (ev_SS 0 ev_0)).
    +Definition some_nat_is_even : n, even n :=
    +  ex_intro even 4 (ev_SS 2 (ev_SS 0 ev_0)).
    -

    练习:2 星, optional (ex_ev_Sn)

    +

    练习:2 星, standard, optional (ex_ev_Sn)

    完成下列证明对象的定义:
    -Definition ex_ev_Sn : ex (fun nev (S n))
    +Definition ex_ev_Sn : ex (fun neven (S n))
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.
    @@ -587,7 +597,7 @@

    ProofObjects柯里-霍华德对应
    -

    TrueFalse

    +

    TrueFalse

    @@ -609,7 +619,7 @@

    ProofObjects柯里-霍华德对应
    -Inductive False : Prop :=.
    +Inductive False : Prop := .
    @@ -622,7 +632,7 @@

    ProofObjects柯里-霍华德对应
    -

    相等关系

    +

    相等关系

    @@ -634,7 +644,7 @@

    ProofObjects柯里-霍华德对应Module MyEquality.

    Inductive eq {X:Type} : XXProp :=
    -| eq_refl : x, eq x x.

    +| eq_refl : x, eq x x.

    Notation "x == y" := (eq x y)
                        (at level 70, no associativity)
                        : type_scope.
    @@ -643,8 +653,12 @@

    ProofObjects柯里-霍华德对应 我们可以这样理解这个定义,给定一个集合X,它定义了由X的一对值 (xy)所索引的“xy相等”的一系列(Family)的命题。只有 - 一种方式能够构造该系列中任意成员的证据:将构造子eq_refl应用到一 - 个类型X和一个值x:X,产生一个x等于x的证据。 + 一种方式能够构造该系列中成员的证据:将构造子eq_refl应用到类型X + 和值x:X,产生一个x等于x的证据。 + +
    + + 其它形如 eq x y 的类型中的 xy 并不相同,因此是非居留的。
    我们可以使用eq_refl来构造证据,比如说,2 = 2。那么我们能否使用 @@ -685,20 +699,20 @@

    ProofObjects柯里-霍华德对应Definition four' : 2 + 2 == 1 + 3 :=
      eq_refl 4.

    -Definition singleton : (X:Type) (x:X), []++[x] == x::[] :=
    +Definition singleton : (X:Type) (x:X), []++[x] == x::[] :=
      fun (X:Type) (x:X) ⇒ eq_refl [x].

    -

    练习:2 星 (equality__leibniz_equality)

    +

    练习:2 星, standard (equality__leibniz_equality)

    相等关系的归纳定义隐含了Leibniz相等关系(Leibniz equality):当我们 说“xy相等的时候”,我们意味着所有x满足的性质P,对于y 来说也满足。
    -Lemma equality__leibniz_equality : (X : Type) (x y: X),
    -  x == y P:XProp, P xP y.
    +Lemma equality__leibniz_equality : (X : Type) (x y: X),
    +  x == yP:XProp, P xP y.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -707,14 +721,14 @@

    ProofObjects柯里-霍华德对应
    -

    练习:5 星, optional (leibniz_equality__equality)

    +

    练习:5 星, standard, optional (leibniz_equality__equality)

    请说明,事实上,相等关系的归纳定义和Leibniz相等关系是 等价的(equivalent)

    -Lemma leibniz_equality__equality : (X : Type) (x y: X),
    -  ( P:XProp, P xP y) → x == y.
    +Lemma leibniz_equality__equality : (X : Type) (x y: X),
    +  (P:XProp, P xP y) → x == y.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -726,7 +740,7 @@

    ProofObjects柯里-霍华德对应
    -

    反演, 再一次

    +

    再论反演

    @@ -803,6 +817,10 @@

    ProofObjects柯里-霍华德对应eq的两个参数必须是一样的。于是inversion策 略会将这个事实加入到上下文中。

    +
    + +(* Sat Jan 26 15:14:46 UTC 2019 *)
    +

    diff --git a/lf-current/ProofObjects.v b/lf-current/ProofObjects.v index cf830123..88b91854 100644 --- a/lf-current/ProofObjects.v +++ b/lf-current/ProofObjects.v @@ -6,7 +6,7 @@ From LF Require Export IndProp. (** "_'算法是证明的计算性内容。'_" --Robert Harper *) (** 前文已讨论过 Coq 既可以用 [nat]、[list] 等归纳类型及其函数_'编程'_,又可 - 以用归纳命题(如 [ev])、蕴含式、全称量词等工具_'证明'_程序的性质。我们一直 + 以用归纳命题(如 [even])、蕴含式、全称量词等工具_'证明'_程序的性质。我们一直 以来区别对待此两种用法,在很多情况下确实可以这样。但也有迹象表明在 Coq 中编 程与证明紧密相关。例如,关键字 [Inductive] 同时用于声明数据类型和命题,以及 [->] 同时用于描述函数类型和逻辑蕴含式。这可并不是语法上的巧合!事实上,在 Coq @@ -23,24 +23,23 @@ From LF Require Export IndProp. 答曰:类型也! *) -(** 回顾一下 [ev] 这个性质的形式化定义。 *) +(** 回顾一下 [even] 这个性质的形式化定义。 *) -Print ev. +Print even. (* ==> - Inductive ev : nat -> Prop := - | ev_0 : ev 0 - | ev_SS : forall n, ev n -> ev (S (S n)). + Inductive even : nat -> Prop := + | ev_0 : even 0 + | ev_SS : forall n, even n -> even (S (S n)). *) -(** 试以另一种方式解读“[:]”:以“是……的证明”取代“具有……类型”。例如将定义第二行的 - [ev_0 : ev 0] 读作“[ev_0] 是 [ev 0] 的证明”以代替“[ev_0] 具有 [ev 0] 类型”。 - *) +(** 试以另一种方式解读“[:]”:以“是……的证明”取代“具有……类型”。例如将定义 [even] + 第二行的 [ev_0 : even 0] 读作“[ev_0] 是 [[even] 0] 的证明”以代替“[ev_0] 具有 + [[even] 0] 类型”。 *) (** 此处 [:] 既在类型层面表达“具有……类型”,又在命题层面表示“证明了……”。这种双关 称为_'柯里-霍华德同构(Curry-Howard correspondence)'_。它指出了逻辑与计算之 间的深层关联: - 命题 ~ 类型 证明 ~ 数据值 @@ -50,15 +49,15 @@ Print ev. Check ev_SS. (* ===> ev_SS : forall n, - ev n -> - ev (S (S n)) *) + even n -> + even (S (S n)) *) -(** 可以将其读作“[ev_SS] 构造子接受两个参数——数字 [n] 以及命题 [ev n] 的证明——并 - 产生 [ev (S (S n))] 的证明。” *) +(** 可以将其读作“[ev_SS] 构造子接受两个参数——数字 [n] 以及命题 [even n] + 的证明——并产生 [even (S (S n))] 的证明。” *) -(** 现在让我们回顾一下之前有关 [ev] 的一个证明。 *) +(** 现在让我们回顾一下之前有关 [even] 的一个证明。 *) -Theorem ev_4 : ev 4. +Theorem ev_4 : even 4. Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed. @@ -67,24 +66,28 @@ Proof. Print ev_4. (* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) - : ev 4 *) + : even 4 *) (** 实际上,我们也可以不借助脚本_'直接'_写出表达式作为证明。 *) Check (ev_SS 2 (ev_SS 0 ev_0)). -(* ===> ev 4 *) +(* ===> even 4 *) (** 表达式 [ev_SS 2 (ev_SS 0 ev_0)] 可视为向构造子 [ev_SS] 传入参数 2 和 0 - 等参数,以及对应的 [ev 2] 与 [ev 0] 之依据所构造的证明。或言之,视 [ev_SS] + 等参数,以及对应的 [even 2] 与 [even 0] 之依据所构造的证明。或言之,视 [ev_SS] 为“构造证明”之原语,需要给定一个数字,并进一步提供该数为偶数之依据以构造证明。 - 其类型表明了它的功能:[[ forall n, ev n -> ev (S (S n)) ]];类似地,多态类型 [forall X, - list X] 表明可以将 [nil] 视为从某类型到由该类型元素组成的空列表的函数。 *) + 其类型表明了它的功能: + + forall n, even n -> even (S (S n)) + + 类似地,多态类型 [forall X, list X] 表明可以将 [nil] + 视为从某类型到由该类型元素组成的空列表的函数。 *) (** 我们在 [Logic] 这一章中已经了解到,我们可以使用函数应用 的语法来实例化引理中的全称量化变量,也可以使用该语法提供引理所要求 的假设。例如: *) -Theorem ev_4': ev 4. +Theorem ev_4': even 4. Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed. @@ -98,8 +101,7 @@ Qed. Coq如何构造该项。为了了解这个过程是如何进行的,在下面的策略证明里, 我们在多个地方使用 [Show Proof] 指令来显示当前证明树的状态。 *) - -Theorem ev_4'' : ev 4. +Theorem ev_4'' : even 4. Proof. Show Proof. apply ev_SS. @@ -120,28 +122,29 @@ Qed. 手动构造想要的证据,如下所示。此处我们可以通过 [Definition] (而不 是 [Theorem])来直接给这个证据一个全局名称。 *) -Definition ev_4''' : ev 4 := +Definition ev_4''' : even 4 := ev_SS 2 (ev_SS 0 ev_0). (** 所有这些构造证明的不同方式,对应的存储在全局环境中的证明是完全一样的。 *) Print ev_4. -(* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +(* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) : even 4 *) Print ev_4'. -(* ===> ev_4' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +(* ===> ev_4' = ev_SS 2 (ev_SS 0 ev_0) : even 4 *) Print ev_4''. -(* ===> ev_4'' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +(* ===> ev_4'' = ev_SS 2 (ev_SS 0 ev_0) : even 4 *) Print ev_4'''. -(* ===> ev_4''' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +(* ===> ev_4''' = ev_SS 2 (ev_SS 0 ev_0) : even 4 *) + +(** **** 练习:2 星, standard (eight_is_even) -(** **** 练习:2 星 (eight_is_even) *) -(** 写出对应 [ev 8] 的策略证明和证明对象。 *) + 写出对应 [even 8] 的策略证明和证明对象。 *) -Theorem ev_8 : ev 8. +Theorem ev_8 : even 8. Proof. (* 请在此处解答 *) Admitted. -Definition ev_8' : ev 8 +Definition ev_8' : even 8 (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. (** [] *) @@ -158,7 +161,7 @@ Definition ev_8' : ev 8 (** 例如,考虑下列陈述: *) -Theorem ev_plus4 : forall n, ev n -> ev (4 + n). +Theorem ev_plus4 : forall n, even n -> even (4 + n). Proof. intros n H. simpl. apply ev_SS. @@ -168,30 +171,30 @@ Qed. (** 对应 [ev_plus4] 的证明对象是什么? - 我们在寻找一个_'类型(Type)'_是 [forall n, ev n -> ev (4 + n)] 的表达式——也 + 我们在寻找一个_'类型(Type)'_是 [forall n, even n -> even (4 + n)] 的表达式——也 就是说,一个接受两个参数(一个数字和一个证据)并返回一个证据的 _'函数(Function)'_! 它的证据对象: *) -Definition ev_plus4' : forall n, ev n -> ev (4 + n) := - fun (n : nat) => fun (H : ev n) => +Definition ev_plus4' : forall n, even n -> even (4 + n) := + fun (n : nat) => fun (H : even n) => ev_SS (S (S n)) (ev_SS n H). (** 回顾 [fun n => blah] 意味着“一个函数,给定 [n],产生 [blah]”, 并且Coq认为 [4 + n] 和 [S (S (S (S n)))] 是同义词,所以另一种写出 这个定义的方式是: *) -Definition ev_plus4'' (n : nat) (H : ev n) - : ev (4 + n) := +Definition ev_plus4'' (n : nat) (H : even n) + : even (4 + n) := ev_SS (S (S n)) (ev_SS n H). Check ev_plus4''. (* ===> - : forall n : nat, ev n -> ev (4 + n) *) + : forall n : nat, even n -> even (4 + n) *) (** 当我们将 [ev_plus4] 证明的命题视为一个函数类型时,我们可以发现一个 - 有趣的现象:第二个参数的类型,[ev n],依赖于第一个参数 [n] 的_'值'_。 + 有趣的现象:第二个参数的类型,[even n],依赖于第一个参数 [n] 的_'值'_。 虽然这样的_'依赖类型 (Dependent types)'_在传统的编程语言中并不存在, 但是它们对于编程来说有时候非常有用。最近它们在函数式编程社区里的活 @@ -206,11 +209,10 @@ Check ev_plus4''. = nat -> nat *) - (** 例如,考虑下列命题: *) Definition ev_plus2 : Prop := - forall n, forall (E : ev n), ev (n + 2). + forall n, forall (E : even n), even (n + 2). (** 这个命题的一个证明项会是一个拥有两个参数的函数:一个数字[n] 和一个表明[n]是偶数的证据[E]。但是对于这个证据来说,名字[E]并没有 @@ -218,12 +220,12 @@ Definition ev_plus2 : Prop := 义。因此我们可以使用虚拟标志符[_]来替换真实的名字: *) Definition ev_plus2' : Prop := - forall n, forall (_ : ev n), ev (n + 2). + forall n, forall (_ : even n), even (n + 2). (** 或者,等同地,我们可以使用更加熟悉的记号: *) Definition ev_plus2'' : Prop := - forall n, ev n -> ev (n + 2). + forall n, even n -> even (n + 2). (** 总的来说,"[P -> Q]"只是 "[forall (_:P), Q]"的语法糖。 *) @@ -232,7 +234,7 @@ Definition ev_plus2'' : Prop := (** 如果我们可以通过显式地给出项,而不是执行策略脚本,来构造证明,你可 能会好奇我们是否可以通过_'策略'_,而不是显式地给出项,来构造_'程序'_。 - 自然地,答案是可以!*) + 自然地,答案是可以! *) Definition add1 : nat -> nat. intro n. @@ -260,20 +262,19 @@ Compute add1 2. 这个特性主要是在定义拥有依赖类型的函数时非常有用。我们不会在本书中 详细讨论后者。但是它确实表明了Coq里面基本思想的一致性和正交性。 *) - (* ################################################################# *) (** * 逻辑联结词作为归纳类型 *) -(** 归纳定义足够用于表达我们目前为止遇到的大多数的联结词和量词。事实上, - 只有全称量化(因此也包括蕴含式)是Coq内置的,所有其他的都是被归纳 +(** 归纳定义足够用于表达我们目前为止遇到的大多数的联结词。事实上, + 只有全称量化(以及作为特殊情况的蕴含式)是Coq内置的,所有其他的都是被归纳 定义的。在这一节中我们会看到它们的定义。 *) - Module Props. -(** ** 合取 +(* ================================================================= *) +(** ** 合取 *) - 为了证明[P /\ Q]成立,我们必须同时给出[P]和[Q]的证据。因此,我们可 +(** 为了证明[P /\ Q]成立,我们必须同时给出[P]和[Q]的证据。因此,我们可 以合理地将[P /\ Q]的证明对象定义为包含两个证明的元祖:一个是[P]的 证明,另一个是[Q]的证明。即我们拥有如下定义。 *) @@ -294,7 +295,9 @@ Print prod. (** 这个定义能够解释为什么[destruct]和[intros]模式能用于一个合取前提。 情况分析允许我们考虑所有[P /\ Q]可能被证明的方式——只有一种方式(即 - [conj]构造子)。类似地,[split]策略能够用于所有只有一个构造子的归 + [conj]构造子)。 + + 类似地,[split]策略能够用于所有只有一个构造子的归 纳定义命题。特别地,它能够用于[and]: *) Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P. @@ -311,7 +314,7 @@ Qed. (** 这解释了为什么一直以来我们能够使用策略来操作[and]的归纳定义。我们 也可以使用模式匹配来用它直接构造证明。例如: *) -Definition and_comm'_aux P Q (H : P /\ Q) := +Definition and_comm'_aux P Q (H : P /\ Q) : Q /\ P := match H with | conj HP HQ => conj HQ HP end. @@ -319,18 +322,18 @@ Definition and_comm'_aux P Q (H : P /\ Q) := Definition and_comm' P Q : P /\ Q <-> Q /\ P := conj (and_comm'_aux P Q) (and_comm'_aux Q P). -(** **** 练习:2 星, optional (conj_fact) *) -(** 构造一个证明对象来证明下列命题。 *) +(** **** 练习:2 星, standard, optional (conj_fact) + + 构造一个证明对象来证明下列命题。 *) Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. (** [] *) +(* ================================================================= *) +(** ** 析取 *) - -(** ** 析取 - - 析取的归纳定义有两个构造子,分别用于析取的两边: *) +(** 析取的归纳定义有两个构造子,分别用于析取的两边: *) Module Or. @@ -345,17 +348,19 @@ End Or. 又一次地,我们可以不使用策略,直接写出涉及[or]的定义的证明对象。 *) -(** **** 练习:2 星, optional (or_commut'') *) -(** 尝试写下[or_commut]的显式证明对象。(不要使用[Print]来偷看我们已经 +(** **** 练习:2 星, standard, optional (or_commut'') + + 尝试写下[or_commut]的显式证明对象。(不要使用[Print]来偷看我们已经 定义的版本!) *) Definition or_comm : forall P Q, P \/ Q -> Q \/ P (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. (** [] *) -(** ** 存在量化 +(* ================================================================= *) +(** ** 存在量化 *) - 为了给出存在量词的证据,我们将一个证据类型[x]和[x]满足性质[P]的证明打包在一起: *) +(** 为了给出存在量词的证据,我们将一个证据类型[x]和[x]满足性质[P]的证明打包在一起: *) Module Ex. @@ -371,19 +376,20 @@ End Ex. (** 我们更加熟悉的类型[exists x, P x]可以转换为一个涉及[ex]的表达式: *) -Check ex (fun n => ev n). -(* ===> exists n : nat, ev n +Check ex (fun n => even n). +(* ===> exists n : nat, even n : Prop *) (** 下面是我们如何定义一个涉及[ex]的显式证明对象: *) -Definition some_nat_is_even : exists n, ev n := - ex_intro ev 4 (ev_SS 2 (ev_SS 0 ev_0)). +Definition some_nat_is_even : exists n, even n := + ex_intro even 4 (ev_SS 2 (ev_SS 0 ev_0)). + +(** **** 练习:2 星, standard, optional (ex_ev_Sn) -(** **** 练习:2 星, optional (ex_ev_Sn) *) -(** 完成下列证明对象的定义: *) + 完成下列证明对象的定义: *) -Definition ex_ev_Sn : ex (fun n => ev (S n)) +Definition ex_ev_Sn : ex (fun n => even (S n)) (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. (** [] *) @@ -401,7 +407,7 @@ Inductive True : Prop := (** [False]也一样的简单——事实上,它是如此简单,以致于第一眼看上去像是一个 语法错误。 *) -Inductive False : Prop :=. +Inductive False : Prop := . (** 也就是说, [False]是一个_'没有'_构造子的归纳类型--即,没有任何方式能 够构造一个它的证明。 *) @@ -426,8 +432,10 @@ Notation "x == y" := (eq x y) (** 我们可以这样理解这个定义,给定一个集合[X],它定义了由[X]的一对值 ([x]和[y])所索引的“[x]与[y]相等”的一_'系列(Family)'_的命题。只有 - 一种方式能够构造该系列中任意成员的证据:将构造子[eq_refl]应用到一 - 个类型[X]和一个值[x:X],产生一个[x]等于[x]的证据。 *) + 一种方式能够构造该系列中成员的证据:将构造子[eq_refl]应用到类型[X] + 和值[x:X],产生一个[x]等于[x]的证据。 + + 其它形如 [eq x y] 的类型中的 [x] 和 [y] 并不相同,因此是非居留的。 *) (** 我们可以使用[eq_refl]来构造证据,比如说,[2 = 2]。那么我们能否使用 它来构造证据[1 + 1 = 2]呢?答案是肯定的。事实上,它就是同一个证据! @@ -457,9 +465,9 @@ Definition four' : 2 + 2 == 1 + 3 := Definition singleton : forall (X:Type) (x:X), []++[x] == x::[] := fun (X:Type) (x:X) => eq_refl [x]. +(** **** 练习:2 星, standard (equality__leibniz_equality) -(** **** 练习:2 星 (equality__leibniz_equality) *) -(** 相等关系的归纳定义隐含了_'Leibniz相等关系(Leibniz equality)'_:当我们 + 相等关系的归纳定义隐含了_'Leibniz相等关系(Leibniz equality)'_:当我们 说“[x]和[y]相等的时候”,我们意味着所有[x]满足的性质[P],对于[y] 来说也满足。 *) @@ -469,8 +477,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, optional (leibniz_equality__equality) *) -(** 请说明,事实上,相等关系的归纳定义和Leibniz相等关系是 +(** **** 练习:5 星, standard, optional (leibniz_equality__equality) + + 请说明,事实上,相等关系的归纳定义和Leibniz相等关系是 _'等价的(equivalent)'_。 *) Lemma leibniz_equality__equality : forall (X : Type) (x y: X), @@ -482,9 +491,8 @@ Proof. End MyEquality. - (* ================================================================= *) -(** ** 反演, 再一次 *) +(** ** 再论反演 *) (** 我们曾经见过[inversion]被同时用于相等关系前提,和关于被归纳定义的命 题的前提。现在我们明白了实际上它们是同一件事情。那么我们现在可以细 @@ -523,3 +531,4 @@ End MyEquality. 略会将这个事实加入到上下文中。 *) +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/ProofObjectsTest.v b/lf-current/ProofObjectsTest.v index ab66e0df..113a272f 100644 --- a/lf-current/ProofObjectsTest.v +++ b/lf-current/ProofObjectsTest.v @@ -37,7 +37,7 @@ idtac " ". idtac "#> ev_8". idtac "Possible points: 1". -check_type @ev_8 ((ev 8)). +check_type @ev_8 ((even 8)). idtac "Assumptions:". Abort. Print Assumptions ev_8. @@ -46,7 +46,7 @@ idtac " ". idtac "#> ev_8'". idtac "Possible points: 1". -check_type @ev_8' ((ev 8)). +check_type @ev_8' ((even 8)). idtac "Assumptions:". Abort. Print Assumptions ev_8'. @@ -84,3 +84,5 @@ Print Assumptions MyEquality.equality__leibniz_equality. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:14:56 UTC 2019 *) diff --git a/lf-current/Rel.html b/lf-current/Rel.html index ec968b67..f8ff3562 100644 --- a/lf-current/Rel.html +++ b/lf-current/Rel.html @@ -49,7 +49,7 @@

    Rel关系的性质

    -

    关系

    +

    关系

    @@ -75,9 +75,9 @@

    Rel关系的性质

    Print le.
    -(* ====> Inductive le (n : nat) : nat -> Prop :=
    +(* ====> Inductive le (n : nat) : nat -> Prop :=
                 le_n : n <= n
    -           | le_S : forall m : nat, n <= m -> n <= S m *)

    +           | le_S : forall m : nat, n <= m -> n <= S m *)

    Check le : natnatProp.
    Check le : relation nat.
    @@ -89,7 +89,7 @@

    Rel关系的性质

    -

    基本性质

    +

    基本性质

    @@ -98,7 +98,7 @@

    Rel关系的性质

    如何从一种关系构造出另一种关系等等。例如:
    -

    偏函数

    +

    偏函数

    @@ -109,7 +109,7 @@

    Rel关系的性质

    Definition partial_function {X: Type} (R: relation X) :=
    -   x y1 y2 : X, R x y1R x y2y1 = y2.
    +  x y1 y2 : X, R x y1R x y2y1 = y2.
    @@ -118,7 +118,7 @@

    Rel关系的性质

    Print next_nat.
    -(* ====> Inductive next_nat (n : nat) : nat -> Prop :=
    +(* ====> Inductive next_nat (n : nat) : nat -> Prop :=
               nn : next_nat n (S n) *)

    Check next_nat : relation nat.

    Theorem next_nat_partial_function :
    @@ -141,7 +141,7 @@

    Rel关系的性质

    Theorem le_not_a_partial_function :
    -  ¬ (partial_function le).
    +  ¬(partial_function le).
    Proof.
    @@ -155,8 +155,8 @@

    Rel关系的性质

    -

    练习:2 星, optional (total_relation_not_partial)

    - 请证明之前定义的 total_relation 不是偏函数。 +

    练习:2 星, standard, optional (total_relation_not_partial)

    + 请证明 IndProp 一章练习题中定义的 total_relation 不是偏函数。
    @@ -167,8 +167,8 @@

    Rel关系的性质

    -

    练习:2 星, optional (empty_relation_partial)

    - 请证明之前定义的 empty_relation 是偏函数。 +

    练习:2 星, standard, optional (empty_relation_partial)

    + 请证明 IndProp 一章练习题中定义的 empty_relation 是偏函数。
    @@ -179,7 +179,7 @@

    Rel关系的性质

    -

    自反关系

    +

    自反关系

    @@ -188,7 +188,7 @@

    Rel关系的性质

    Definition reflexive {X: Type} (R: relation X) :=
    -   a : X, R a a.

    +  a : X, R a a.

    Theorem le_reflexive :
      reflexive le.
    @@ -199,7 +199,7 @@

    Rel关系的性质

    -

    传递关系

    +

    传递关系

    @@ -208,7 +208,7 @@

    Rel关系的性质

    Definition transitive {X: Type} (R: relation X) :=
    -   a b c : X, (R a b) → (R b c) → (R a c).

    +  a b c : X, (R a b) → (R b c) → (R a c).

    Theorem le_trans :
      transitive le.
    @@ -236,7 +236,7 @@

    Rel关系的性质

    -

    练习:2 星, optional (le_trans_hard_way)

    +

    练习:2 星, standard, optional (le_trans_hard_way)

    我们也可以不用 le_trans,直接通过归纳法来证明 lt_trans, 不过这会耗费更多精力。请完成以下定理的证明。
    @@ -256,7 +256,7 @@

    Rel关系的性质

    -

    练习:2 星, optional (lt_trans'')

    +

    练习:2 星, standard, optional (lt_trans'')

    再将此定理证明一遍,不过这次要对 o 使用归纳法。
    @@ -282,7 +282,7 @@

    Rel关系的性质

    -Theorem le_Sn_le : n m, S nmnm.
    +Theorem le_Sn_le : n m, S nmnm.
    Proof.
    @@ -294,11 +294,11 @@

    Rel关系的性质

    -

    练习:1 星, optional (le_S_n)

    +

    练习:1 星, standard, optional (le_S_n)

    -Theorem le_S_n : n m,
    +Theorem le_S_n : n m,
      (S nS m) → (nm).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -308,7 +308,7 @@

    Rel关系的性质

    -

    练习:2 星, optional (le_Sn_n_inf)

    +

    练习:2 星, standard, optional (le_Sn_n_inf)

    请提写出以下定理的非形式化证明:
    @@ -332,12 +332,12 @@

    Rel关系的性质

    -

    练习:1 星, optional (le_Sn_n)

    +

    练习:1 星, standard, optional (le_Sn_n)

    -Theorem le_Sn_n : n,
    -  ¬ (S nn).
    +Theorem le_Sn_n : n,
    +  ¬(S nn).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -350,7 +350,7 @@

    Rel关系的性质

    我们先看一些其它的概念,作为在 Coq 中对关系进行操作的练习...
    -

    对称关系与反对称关系

    +

    对称关系与反对称关系

    @@ -359,16 +359,16 @@

    Rel关系的性质

    Definition symmetric {X: Type} (R: relation X) :=
    -   a b : X, (R a b) → (R b a).
    +  a b : X, (R a b) → (R b a).
    -

    练习:2 星, optional (le_not_symmetric)

    +

    练习:2 星, standard, optional (le_not_symmetric)

    Theorem le_not_symmetric :
    -  ¬ (symmetric le).
    +  ¬(symmetric le).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -382,11 +382,11 @@

    Rel关系的性质

    Definition antisymmetric {X: Type} (R: relation X) :=
    -   a b : X, (R a b) → (R b a) → a = b.
    +  a b : X, (R a b) → (R b a) → a = b.
    -

    练习:2 星, optional (le_antisymmetric)

    +

    练习:2 星, standard, optional (le_antisymmetric)

    @@ -400,11 +400,11 @@

    Rel关系的性质

    -

    练习:2 星, optional (le_step)

    +

    练习:2 星, standard, optional (le_step)

    -Theorem le_step : n m p,
    +Theorem le_step : n m p,
      n < m
      mS p
      np.
    @@ -416,7 +416,7 @@

    Rel关系的性质

    -

    等价关系

    +

    等价关系

    @@ -429,7 +429,7 @@

    Rel关系的性质

    -

    偏序关系与预序关系

    +

    偏序关系与预序关系

    @@ -463,7 +463,7 @@

    Rel关系的性质

    -

    自反传递闭包

    +

    自反传递闭包

    @@ -486,13 +486,13 @@

    Rel关系的性质

    -Theorem next_nat_closure_is_le : n m,
    +Theorem next_nat_closure_is_le : n m,
      (nm) ↔ ((clos_refl_trans next_nat) n m).
    Proof.
      intros n m. split.
    -  - (* -> *)
    +  - (* -> *)
        intro H. induction H.
        + (* le_n *) apply rt_refl.
        + (* le_S *)
    @@ -541,7 +541,7 @@

    Rel关系的性质

    -Lemma rsc_R : (X:Type) (R:relation X) (x y : X),
    +Lemma rsc_R : (X:Type) (R:relation X) (x y : X),
           R x yclos_refl_trans_1n R x y.
    @@ -552,12 +552,12 @@

    Rel关系的性质

    -

    练习:2 星, optional (rsc_trans)

    +

    练习:2 星, standard, optional (rsc_trans)

    Lemma rsc_trans :
    -   (X:Type) (R: relation X) (x y z : X),
    +  (X:Type) (R: relation X) (x y z : X),
          clos_refl_trans_1n R x y
          clos_refl_trans_1n R y z
          clos_refl_trans_1n R x z.
    @@ -573,18 +573,22 @@

    Rel关系的性质

    传递性封闭确实定义了同样的关系。
    -

    练习:3 星, optional (rtc_rsc_coincide)

    +

    练习:3 星, standard, optional (rtc_rsc_coincide)

    Theorem rtc_rsc_coincide :
    -          (X:Type) (R: relation X) (x y : X),
    +         (X:Type) (R: relation X) (x y : X),
      clos_refl_trans R x yclos_refl_trans_1n R x y.
    Proof.
      (* 请在此处解答 *) Admitted.
    +
    + +(* Sat Jan 26 15:14:46 UTC 2019 *)
    +
    diff --git a/lf-current/Rel.v b/lf-current/Rel.v index e915757c..be491428 100644 --- a/lf-current/Rel.v +++ b/lf-current/Rel.v @@ -82,17 +82,21 @@ Proof. - apply le_S. apply le_n. } discriminate Nonsense. Qed. -(** **** 练习:2 星, optional (total_relation_not_partial) *) -(** 请证明之前定义的 [total_relation] 不是偏函数。 *) +(** **** 练习:2 星, standard, optional (total_relation_not_partial) -(* 请在此处解答 *) -(** [] *) + 请证明 [IndProp] 一章练习题中定义的 [total_relation] 不是偏函数。 *) -(** **** 练习:2 星, optional (empty_relation_partial) *) -(** 请证明之前定义的 [empty_relation] 是偏函数。 *) +(* 请在此处解答 -(* 请在此处解答 *) -(** [] *) + [] *) + +(** **** 练习:2 星, standard, optional (empty_relation_partial) + + 请证明 [IndProp] 一章练习题中定义的 [empty_relation] 是偏函数。 *) + +(* 请在此处解答 + + [] *) (* ----------------------------------------------------------------- *) (** *** 自反关系 *) @@ -133,8 +137,9 @@ Proof. apply Hnm. apply Hmo. Qed. -(** **** 练习:2 星, optional (le_trans_hard_way) *) -(** 我们也可以不用 [le_trans],直接通过归纳法来证明 [lt_trans], +(** **** 练习:2 星, standard, optional (le_trans_hard_way) + + 我们也可以不用 [le_trans],直接通过归纳法来证明 [lt_trans], 不过这会耗费更多精力。请完成以下定理的证明。 *) Theorem lt_trans' : @@ -147,8 +152,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (lt_trans'') *) -(** 再将此定理证明一遍,不过这次要对 [o] 使用归纳法。 *) +(** **** 练习:2 星, standard, optional (lt_trans'') + + 再将此定理证明一遍,不过这次要对 [o] 使用归纳法。 *) Theorem lt_trans'' : transitive lt. @@ -169,15 +175,16 @@ Proof. - apply H. Qed. -(** **** 练习:1 星, optional (le_S_n) *) +(** **** 练习:1 星, standard, optional (le_S_n) *) Theorem le_S_n : forall n m, (S n <= S m) -> (n <= m). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (le_Sn_n_inf) *) -(** 请提写出以下定理的非形式化证明: +(** **** 练习:2 星, standard, optional (le_Sn_n_inf) + + 请提写出以下定理的非形式化证明: Theorem: For every [n], [~ (S n <= n)] @@ -185,10 +192,11 @@ Proof. 不过在做形式化证明之前请先尝试写出非形式化的证明。 证明: *) - (* 请在此处解答 *) -(** [] *) + (* 请在此处解答 + + [] *) -(** **** 练习:1 星, optional (le_Sn_n) *) +(** **** 练习:1 星, standard, optional (le_Sn_n) *) Theorem le_Sn_n : forall n, ~ (S n <= n). Proof. @@ -206,7 +214,7 @@ Proof. Definition symmetric {X: Type} (R: relation X) := forall a b : X, (R a b) -> (R b a). -(** **** 练习:2 星, optional (le_not_symmetric) *) +(** **** 练习:2 星, standard, optional (le_not_symmetric) *) Theorem le_not_symmetric : ~ (symmetric le). Proof. @@ -218,14 +226,14 @@ Proof. Definition antisymmetric {X: Type} (R: relation X) := forall a b : X, (R a b) -> (R b a) -> a = b. -(** **** 练习:2 星, optional (le_antisymmetric) *) +(** **** 练习:2 星, standard, optional (le_antisymmetric) *) Theorem le_antisymmetric : antisymmetric le. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (le_step) *) +(** **** 练习:2 星, standard, optional (le_step) *) Theorem le_step : forall n m p, n < m -> m <= S p -> @@ -327,7 +335,7 @@ Proof. intros X R x y H. apply rt1n_trans with y. apply H. apply rt1n_refl. Qed. -(** **** 练习:2 星, optional (rsc_trans) *) +(** **** 练习:2 星, standard, optional (rsc_trans) *) Lemma rsc_trans : forall (X:Type) (R: relation X) (x y z : X), clos_refl_trans_1n R x y -> @@ -340,7 +348,7 @@ Proof. (** 接着再用这些事实来证明这两个定义的自反性、 传递性封闭确实定义了同样的关系。 *) -(** **** 练习:3 星, optional (rtc_rsc_coincide) *) +(** **** 练习:3 星, standard, optional (rtc_rsc_coincide) *) Theorem rtc_rsc_coincide : forall (X:Type) (R: relation X) (x y : X), clos_refl_trans R x y <-> clos_refl_trans_1n R x y. @@ -348,3 +356,4 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) +(* Sat Jan 26 15:14:46 UTC 2019 *) diff --git a/lf-current/RelTest.v b/lf-current/RelTest.v index 68e94ed4..eceadf04 100644 --- a/lf-current/RelTest.v +++ b/lf-current/RelTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:14:58 UTC 2019 *) diff --git a/lf-current/Tactics.html b/lf-current/Tactics.html index 7fb686e7..d034af32 100644 --- a/lf-current/Tactics.html +++ b/lf-current/Tactics.html @@ -63,7 +63,7 @@

    Tactics更多基本策略

    -

    apply 策略

    +

    apply 策略

    @@ -71,7 +71,7 @@

    Tactics更多基本策略

    -Theorem silly1 : (n m o p : nat),
    +Theorem silly1 : (n m o p : nat),
         n = m
         [n;o] = [n;p] →
         [n;o] = [m;p].
    @@ -95,9 +95,9 @@

    Tactics更多基本策略

    -Theorem silly2 : (n m o p : nat),
    +Theorem silly2 : (n m o p : nat),
         n = m
    -     ( (q r : nat), q = r → [q;o] = [r;p]) →
    +     ((q r : nat), q = r → [q;o] = [r;p]) →
         [n;o] = [m;p].
    Proof.
      intros n m o p eq1 eq2.
    @@ -106,16 +106,16 @@

    Tactics更多基本策略

    通常,当我们使用 apply H 时,语句 H 会以一个绑定了某些 - 通用变量(Universal Variables)开始。在 Coq 针对 H + 通用变量(Universal Variables) 开始。在 Coq 针对 H 的结论匹配当前目标时,它会尝试为这些变量查找适当的值。例如, 当我们在以下证明中执行 apply eq2 时,eq2 中的通用变量 q 会以 n 实例化,而 r 会以 m 实例化。
    -Theorem silly2a : (n m : nat),
    +Theorem silly2a : (n m : nat),
         (n,n) = (m,m) →
    -     ( (q r : nat), (q,q) = (r,r) → [q] = [r]) →
    +     ((q r : nat), (q,q) = (r,r) → [q] = [r]) →
         [n] = [m].
    Proof.
      intros n m eq1 eq2.
    @@ -123,13 +123,13 @@

    Tactics更多基本策略

    -

    练习:2 星, optional (silly_ex)

    +

    练习:2 星, standard, optional (silly_ex)

    请完成以下证明,不要使用 simpl
    Theorem silly_ex :
    -     ( n, evenb n = trueoddb (S n) = true) →
    +     (n, evenb n = trueoddb (S n) = true) →
         oddb 3 = true
         evenb 4 = true.
    Proof.
    @@ -145,7 +145,7 @@

    Tactics更多基本策略

    -Theorem silly3_firsttry : (n : nat),
    +Theorem silly3_firsttry : (n : nat),
         true = (n =? 5) →
         (S (S n)) =? 7 = true.
    Proof.
    @@ -169,13 +169,13 @@

    Tactics更多基本策略

    -

    练习:3 星 (apply_exercise1)

    +

    练习:3 星, standard (apply_exercise1)

    提示:你可以配合之前定义的引理来使用 apply,不仅限于当前上下文中的前提。 记住 Search 是你的朋友。)
    -Theorem rev_exercise1 : (l l' : list nat),
    +Theorem rev_exercise1 : (l l' : list nat),
         l = rev l'
         l' = rev l.
    Proof.
    @@ -186,7 +186,7 @@

    Tactics更多基本策略

    -

    练习:1 星, optional (apply_rewrite)

    +

    练习:1 星, standard, optional (apply_rewrite)

    简述 applyrewrite 策略之区别。哪些情况下二者均可有效利用?
    @@ -197,7 +197,7 @@

    Tactics更多基本策略

    -

    apply with 策略

    +

    apply with 策略

    @@ -205,7 +205,7 @@

    Tactics更多基本策略

    -Example trans_eq_example : (a b c d e f : nat),
    +Example trans_eq_example : (a b c d e f : nat),
         [a;b] = [c;d] →
         [c;d] = [e;f] →
         [a;b] = [e;f].
    @@ -220,7 +220,7 @@

    Tactics更多基本策略

    -Theorem trans_eq : (X:Type) (n m o : X),
    +Theorem trans_eq : (X:Type) (n m o : X),
      n = mm = on = o.
    Proof.
      intros X n m o eq1 eq2. rewriteeq1. rewriteeq2.
    @@ -233,7 +233,7 @@

    Tactics更多基本策略

    -Example trans_eq_example' : (a b c d e f : nat),
    +Example trans_eq_example' : (a b c d e f : nat),
         [a;b] = [c;d] →
         [c;d] = [e;f] →
         [a;b] = [e;f].
    @@ -260,11 +260,11 @@

    Tactics更多基本策略

    apply trans_eq with [c;d]
    -

    练习:3 星, optional (apply_with_exercise)

    +

    练习:3 星, standard, optional (apply_with_exercise)

    -Example trans_eq_exercise : (n m o p : nat),
    +Example trans_eq_exercise : (n m o p : nat),
         m = (minustwo o) →
         (n + p) = m
         (n + p) = (minustwo o).
    @@ -275,7 +275,7 @@

    Tactics更多基本策略

    -

    The injection and discriminate Tactics

    +

    The injection and discriminate Tactics

    @@ -322,7 +322,7 @@

    Tactics更多基本策略

    -Theorem S_injective : (n m : nat),
    +Theorem S_injective : (n m : nat),
      S n = S m
      n = m.
    Proof.
    @@ -343,7 +343,7 @@

    Tactics更多基本策略

    -Theorem S_injective' : (n m : nat),
    +Theorem S_injective' : (n m : nat),
      S n = S m
      n = m.
    Proof.
    @@ -369,7 +369,7 @@

    Tactics更多基本策略

    -Theorem injection_ex1 : (n m o : nat),
    +Theorem injection_ex1 : (n m o : nat),
      [n; m] = [o; o] →
      [n] = [m].
    Proof.
    @@ -385,7 +385,7 @@

    Tactics更多基本策略

    -Theorem injection_ex2 : (n m : nat),
    +Theorem injection_ex2 : (n m : nat),
      [n] = [m] →
      n = m.
    Proof.
    @@ -395,11 +395,11 @@

    Tactics更多基本策略

    -

    练习:1 星 (injection_ex3)

    +

    练习:1 星, standard (injection_ex3)

    -Example injection_ex3 : (X : Type) (x y z : X) (l j : list X),
    +Example injection_ex3 : (X : Type) (x y z : X) (l j : list X),
      x :: y :: l = z :: j
      y :: l = x :: j
      x = y.
    @@ -431,7 +431,7 @@

    Tactics更多基本策略

    -Theorem eqb_0_l : n,
    +Theorem eqb_0_l : n,
       0 =? n = truen = 0.
    Proof.
      intros n.
    @@ -475,12 +475,12 @@

    Tactics更多基本策略

    -Theorem discriminate_ex1 : (n : nat),
    +Theorem discriminate_ex1 : (n : nat),
      S n = O
      2 + 2 = 5.
    Proof.
      intros n contra. discriminate contra. Qed.

    -Theorem discriminate_ex2 : (n m : nat),
    +Theorem discriminate_ex2 : (n m : nat),
      false = true
      [n] = [m].
    Proof.
    @@ -496,12 +496,12 @@

    Tactics更多基本策略

    -

    练习:1 星 (discriminate_ex3)

    +

    练习:1 星, standard (discriminate_ex3)

    Example discriminate_ex3 :
    -   (X : Type) (x y z : X) (l j : list X),
    +  (X : Type) (x y z : X) (l j : list X),
        x :: y :: l = [] →
        x = z.
    Proof.
    @@ -512,19 +512,19 @@

    Tactics更多基本策略

    - 构造子的单射性允许我们论证 (n m : nat), S n = S m n = m。 + 构造子的单射性允许我们论证 (n m : nat), S n = S m n = m。 此蕴含式的交流(converse)是一个更加一般的关于构造子和函数的事实的实例, 在后面的几个地方我们会发现它很方便:
    -Theorem f_equal : (A B : Type) (f: AB) (x y: A),
    +Theorem f_equal : (A B : Type) (f: AB) (x y: A),
      x = yf x = f y.
    Proof. intros A B f x y eq. rewrite eq. reflexivity. Qed.
    -

    对前提使用策略

    +

    对前提使用策略

    @@ -537,7 +537,7 @@

    Tactics更多基本策略

    -Theorem S_inj : (n m : nat) (b : bool),
    +Theorem S_inj : (n m : nat) (b : bool),
         (S n) =? (S m) = b
         n =? m = b.
    Proof.
    @@ -563,7 +563,7 @@

    Tactics更多基本策略

    -Theorem silly3' : (n : nat),
    +Theorem silly3' : (n : nat),
      (n =? 5 = true → (S (S n)) =? 7 = true) →
      true = (n =? 5) →
      true = ((S (S n)) =? 7).
    @@ -585,12 +585,12 @@

    Tactics更多基本策略

    -

    练习:3 星, recommended (plus_n_n_injective)

    +

    练习:3 星, standard, recommended (plus_n_n_injective)

    请在此证明中练习使用“in”形式的变体。(提示:使用 plus_n_Sm。)
    -Theorem plus_n_n_injective : n m,
    +Theorem plus_n_n_injective : n m,
         n + n = m + m
         n = m.
    Proof.
    @@ -601,7 +601,7 @@

    Tactics更多基本策略

    -

    变换归纳原理

    +

    变换归纳原理

    @@ -613,7 +613,7 @@

    Tactics更多基本策略

    -       Theorem double_injective n m,
    +       Theorem double_injectiven m,
             double n = double m → n = m.
    @@ -640,7 +640,7 @@

    Tactics更多基本策略

    -Theorem double_injective_FAILED : n m,
    +Theorem double_injective_FAILED : n m,
         double n = double m
         n = m.
    Proof.
    @@ -778,7 +778,7 @@

    Tactics更多基本策略

    -Theorem double_injective : n m,
    +Theorem double_injective : n m,
         double n = double m
         n = m.
    Proof.
    @@ -841,11 +841,11 @@

    Tactics更多基本策略

    -

    练习:2 星 (eqb_true)

    +

    练习:2 星, standard (eqb_true)

    -Theorem eqb_true : n m,
    +Theorem eqb_true : n m,
        n =? m = truen = m.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -855,7 +855,7 @@

    Tactics更多基本策略

    -

    练习:2 星, advanced (eqb_true_informal)

    +

    练习:2 星, advanced (eqb_true_informal)

    给出一个详细的 eqb_true 的非形式化证明,量词要尽可能明确。
    @@ -875,7 +875,7 @@

    Tactics更多基本策略

    -Theorem double_injective_take2_FAILED : n m,
    +Theorem double_injective_take2_FAILED : n m,
         double n = double m
         n = m.
    Proof.
    @@ -906,7 +906,7 @@

    Tactics更多基本策略

    -Theorem double_injective_take2 : n m,
    +Theorem double_injective_take2 : n m,
         double n = double m
         n = m.
    Proof.
    @@ -985,7 +985,7 @@

    Tactics更多基本策略

    -Theorem eqb_id_true : x y,
    +Theorem eqb_id_true : x y,
      eqb_id x y = truex = y.
    Proof.
      intros [m] [n]. simpl. intros H.
    @@ -995,12 +995,12 @@

    Tactics更多基本策略

    -

    练习:3 星, recommended (gen_dep_practice)

    +

    练习:3 星, standard, recommended (gen_dep_practice)

    通过对 l 进行归纳来证明它。
    -Theorem nth_error_after_last: (n : nat) (X : Type) (l : list X),
    +Theorem nth_error_after_last: (n : nat) (X : Type) (l : list X),
         length l = n
         nth_error l n = None.
    Proof.
    @@ -1010,7 +1010,7 @@

    Tactics更多基本策略

    -

    展开定义

    +

    展开定义

    @@ -1028,7 +1028,7 @@

    Tactics更多基本策略

    -Lemma square_mult : n m, square (n * m) = square n * square m.
    +Lemma square_mult : n m, square (n * m) = square n * square m.
    Proof.
      intros n m.
      simpl.
    @@ -1080,7 +1080,7 @@

    Tactics更多基本策略

    -Fact silly_fact_1 : m, foo m + 1 = foo (m + 1) + 1.
    +Fact silly_fact_1 : m, foo m + 1 = foo (m + 1) + 1.
    Proof.
      intros m.
      simpl.
    @@ -1105,7 +1105,7 @@

    Tactics更多基本策略

    -Fact silly_fact_2_FAILED : m, bar m + 1 = bar (m + 1) + 1.
    +Fact silly_fact_2_FAILED : m, bar m + 1 = bar (m + 1) + 1.
    Proof.
      intros m.
      simpl. (* 啥也没做! *)
    @@ -1126,7 +1126,7 @@

    Tactics更多基本策略

    -Fact silly_fact_2 : m, bar m + 1 = bar (m + 1) + 1.
    +Fact silly_fact_2 : m, bar m + 1 = bar (m + 1) + 1.
    Proof.
      intros m.
      destruct m eqn:E.
    @@ -1144,7 +1144,7 @@

    Tactics更多基本策略

    -Fact silly_fact_2' : m, bar m + 1 = bar (m + 1) + 1.
    +Fact silly_fact_2' : m, bar m + 1 = bar (m + 1) + 1.
    Proof.
      intros m.
      unfold bar.
    @@ -1163,7 +1163,7 @@

    Tactics更多基本策略

    -

    对复合表达式使用 destruct

    +

    对复合表达式使用 destruct

    @@ -1181,7 +1181,7 @@

    Tactics更多基本策略

    if n =? 3 then false
      else if n =? 5 then false
      else false.

    -Theorem sillyfun_false : (n : nat),
    +Theorem sillyfun_false : (n : nat),
      sillyfun n = false.
    Proof.
      intros n. unfold sillyfun.
    @@ -1205,7 +1205,7 @@

    Tactics更多基本策略

    e 都会被替换成 c
    -

    练习:3 星, optional (combine_split)

    +

    练习:3 星, standard, optional (combine_split)

    以下是 Poly 一章中出现过的 split 函数的实现:
    @@ -1226,7 +1226,7 @@

    Tactics更多基本策略

    -Theorem combine_split : X Y (l : list (X * Y)) l1 l2,
    +Theorem combine_split : X Y (l : list (X * Y)) l1 l2,
      split l = (l1, l2) →
      combine l1 l2 = l.
    Proof.
    @@ -1264,7 +1264,7 @@

    Tactics更多基本策略

    -Theorem sillyfun1_odd_FAILED : (n : nat),
    +Theorem sillyfun1_odd_FAILED : (n : nat),
         sillyfun1 n = true
         oddb n = true.
    Proof.
    @@ -1293,7 +1293,7 @@

    Tactics更多基本策略

    -Theorem sillyfun1_odd : (n : nat),
    +Theorem sillyfun1_odd : (n : nat),
         sillyfun1 n = true
         oddb n = true.
    Proof.
    @@ -1314,12 +1314,12 @@

    Tactics更多基本策略

    -

    练习:2 星 (destruct_eqn_practice)

    +

    练习:2 星, standard (destruct_eqn_practice)

    Theorem bool_fn_applied_thrice :
    -   (f : boolbool) (b : bool),
    +  (f : boolbool) (b : bool),
      f (f (f b)) = f b.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1328,7 +1328,7 @@

    Tactics更多基本策略

    -

    复习

    +

    复习

    @@ -1469,15 +1469,15 @@

    Tactics更多基本策略

    -

    附加练习

    +

    附加练习

    -

    练习:3 星 (eqb_sym)

    +

    练习:3 星, standard (eqb_sym)

    -Theorem eqb_sym : (n m : nat),
    +Theorem eqb_sym : (n m : nat),
      (n =? m) = (m =? n).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1487,7 +1487,7 @@

    Tactics更多基本策略

    -

    练习:3 星, advanced, optional (eqb_sym_informal)

    +

    练习:3 星, advanced, optional (eqb_sym_informal)

    根据前面你对该引理的形式化证明,给出与它对应的非形式化证明:
    @@ -1506,11 +1506,11 @@

    Tactics更多基本策略

    -

    练习:3 星, optional (eqb_trans)

    +

    练习:3 星, standard, optional (eqb_trans)

    -Theorem eqb_trans : n m p,
    +Theorem eqb_trans : n m p,
      n =? m = true
      m =? p = true
      n =? p = true.
    @@ -1522,7 +1522,7 @@

    Tactics更多基本策略

    -

    练习:3 星, advanced (split_combine)

    +

    练习:3 星, advanced (split_combine)

    在前面的练习中,我们证明了对于所有序对的列表,combinesplit 的反函数。你如何形式化陈述 splitcombine 的反函数?何时此性质成立? @@ -1550,12 +1550,12 @@

    Tactics更多基本策略

    -

    练习:3 星, advanced (filter_exercise)

    +

    练习:3 星, advanced (filter_exercise)

    本练习有点难度。为你的归纳假设的形式花点心思。
    -Theorem filter_exercise : (X : Type) (test : Xbool)
    +Theorem filter_exercise : (X : Type) (test : Xbool)
                                 (x : X) (l lf : list X),
         filter test l = x :: lf
         test x = true.
    @@ -1567,7 +1567,7 @@

    Tactics更多基本策略

    -

    练习:4 星, advanced, recommended (forall_exists_challenge)

    +

    练习:4 星, advanced, recommended (forall_exists_challenge)

    定义两个递归的 Fixpointsforallbexistsb。 第一个检查列表中的每一个元素是否均满足给定的断言: @@ -1629,12 +1629,16 @@

    Tactics更多基本策略

    Proof. (* 请在此处解答 *) Admitted.

    Definition existsb' {X : Type} (test : Xbool) (l : list X) : bool
      (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    -Theorem existsb_existsb' : (X : Type) (test : Xbool) (l : list X),
    +Theorem existsb_existsb' : (X : Type) (test : Xbool) (l : list X),
      existsb test l = existsb' test l.
    Proof. (* 请在此处解答 *) Admitted.
    +
    + +(* Sat Jan 26 15:14:45 UTC 2019 *)
    +
    diff --git a/lf-current/Tactics.v b/lf-current/Tactics.v index 7c19cbf8..809c4f4e 100644 --- a/lf-current/Tactics.v +++ b/lf-current/Tactics.v @@ -54,8 +54,9 @@ Proof. intros n m eq1 eq2. apply eq2. apply eq1. Qed. -(** **** 练习:2 星, optional (silly_ex) *) -(** 请完成以下证明,不要使用 [simpl]。 *) +(** **** 练习:2 星, standard, optional (silly_ex) + + 请完成以下证明,不要使用 [simpl]。 *) Theorem silly_ex : (forall n, evenb n = true -> oddb (S n) = true) -> @@ -81,8 +82,9 @@ Proof. simpl. (** (此处的 [simpl] 是可选的,因为 [apply] 会在需要时先进行化简。) *) apply H. Qed. -(** **** 练习:3 星 (apply_exercise1) *) -(** (_'提示'_:你可以配合之前定义的引理来使用 [apply],不仅限于当前上下文中的前提。 +(** **** 练习:3 星, standard (apply_exercise1) + + (_'提示'_:你可以配合之前定义的引理来使用 [apply],不仅限于当前上下文中的前提。 记住 [Search] 是你的朋友。) *) Theorem rev_exercise1 : forall (l l' : list nat), @@ -92,11 +94,13 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星, optional (apply_rewrite) *) -(** 简述 [apply] 与 [rewrite] 策略之区别。哪些情况下二者均可有效利用? *) +(** **** 练习:1 星, standard, optional (apply_rewrite) -(* 请在此处解答 *) -(** [] *) + 简述 [apply] 与 [rewrite] 策略之区别。哪些情况下二者均可有效利用? *) + +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * [apply with] 策略 *) @@ -143,7 +147,7 @@ Proof. 一般足够聪明来确定我们给出的实例。我们也可以写成: [apply trans_eq with [c;d]]。 *) -(** **** 练习:3 星, optional (apply_with_exercise) *) +(** **** 练习:3 星, standard, optional (apply_with_exercise) *) Example trans_eq_exercise : forall (n m o p : nat), m = (minustwo o) -> (n + p) = m -> @@ -236,7 +240,7 @@ Proof. injection H as Hnm. rewrite Hnm. reflexivity. Qed. -(** **** 练习:1 星 (injection_ex3) *) +(** **** 练习:1 星, standard (injection_ex3) *) Example injection_ex3 : forall (X : Type) (x y z : X) (l j : list X), x :: y :: l = z :: j -> y :: l = x :: j -> @@ -306,7 +310,7 @@ Proof. then the nonsensical conclusion would follow. We'll explore the principle of explosion of more detail in the next chapter. *) -(** **** 练习:1 星 (discriminate_ex3) *) +(** **** 练习:1 星, standard (discriminate_ex3) *) Example discriminate_ex3 : forall (X : Type) (x y z : X) (l j : list X), x :: y :: l = [] -> @@ -366,8 +370,9 @@ Proof. 它们使用的应该是正向推理。通常,Coq 习惯上倾向于使用反向推理, 但在某些情况下,正向推理更易于思考。 *) -(** **** 练习:3 星, recommended (plus_n_n_injective) *) -(** 请在此证明中练习使用“in”形式的变体。(提示:使用 [plus_n_Sm]。) *) +(** **** 练习:3 星, standard, recommended (plus_n_n_injective) + + 请在此证明中练习使用“in”形式的变体。(提示:使用 [plus_n_Sm]。) *) Theorem plus_n_n_injective : forall n m, n + n = m + m -> @@ -512,15 +517,16 @@ Proof. (** 以下练习需要同样的模式。 *) -(** **** 练习:2 星 (eqb_true) *) +(** **** 练习:2 星, standard (eqb_true) *) Theorem eqb_true : forall n m, n =? m = true -> n = m. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, advanced (eqb_true_informal) *) -(** 给出一个详细的 [eqb_true] 的非形式化证明,量词要尽可能明确。 *) +(** **** 练习:2 星, advanced (eqb_true_informal) + + 给出一个详细的 [eqb_true] 的非形式化证明,量词要尽可能明确。 *) (* 请在此处解答 *) @@ -617,8 +623,9 @@ Proof. rewrite H'. reflexivity. Qed. -(** **** 练习:3 星, recommended (gen_dep_practice) *) -(** 通过对 [l] 进行归纳来证明它。 *) +(** **** 练习:3 星, standard, recommended (gen_dep_practice) + + 通过对 [l] 进行归纳来证明它。 *) Theorem nth_error_after_last: forall (n : nat) (X : Type) (l : list X), length l = n -> @@ -762,8 +769,9 @@ Proof. [c],[destruct e] 都会生成一个子目标,其中(即目标和上下文中)所有的 [e] 都会被替换成 [c]。*) -(** **** 练习:3 星, optional (combine_split) *) -(** 以下是 [Poly] 一章中出现过的 [split] 函数的实现: *) +(** **** 练习:3 星, standard, optional (combine_split) + + 以下是 [Poly] 一章中出现过的 [split] 函数的实现: *) Fixpoint split {X Y : Type} (l : list (X*Y)) : (list X) * (list Y) := @@ -791,8 +799,9 @@ Proof. When [destruct]ing compound expressions, however, the information recorded by the [eqn:] can actually be critical: if we leave it out, then [destruct] can sometimes erase information we need to - complete a proof. *) -(** 例如,假设函数 [sillyfun1] 定义如下: *) + complete a proof. + + 例如,假设函数 [sillyfun1] 定义如下: *) Definition sillyfun1 (n : nat) : bool := if n =? 3 then true @@ -846,7 +855,7 @@ Proof. rewrite -> Heqe5. reflexivity. + (* e5 = false *) discriminate eq. Qed. -(** **** 练习:2 星 (destruct_eqn_practice) *) +(** **** 练习:2 星, standard (destruct_eqn_practice) *) Theorem bool_fn_applied_thrice : forall (f : bool -> bool) (b : bool), f (f (f b)) = f b. @@ -911,23 +920,25 @@ Proof. (* ################################################################# *) (** * 附加练习 *) -(** **** 练习:3 星 (eqb_sym) *) +(** **** 练习:3 星, standard (eqb_sym) *) Theorem eqb_sym : forall (n m : nat), (n =? m) = (m =? n). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced, optional (eqb_sym_informal) *) -(** 根据前面你对该引理的形式化证明,给出与它对应的非形式化证明: +(** **** 练习:3 星, advanced, optional (eqb_sym_informal) + + 根据前面你对该引理的形式化证明,给出与它对应的非形式化证明: 定理:对于任何自然数 [n] [m],[n =? m = m =? n]. 证明: *) - (* 请在此处解答 *) -(** [] *) + (* 请在此处解答 -(** **** 练习:3 星, optional (eqb_trans) *) + [] *) + +(** **** 练习:3 星, standard, optional (eqb_trans) *) Theorem eqb_trans : forall n m p, n =? m = true -> m =? p = true -> @@ -936,8 +947,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced (split_combine) *) -(** 在前面的练习中,我们证明了对于所有序对的列表,[combine] 是 [split] +(** **** 练习:3 星, advanced (split_combine) + + 在前面的练习中,我们证明了对于所有序对的列表,[combine] 是 [split] 的反函数。你如何形式化陈述 [split] 是 [combine] 的反函数?何时此性质成立? 请完成下面 [split_combine_statement] 的定义,其性质指出 [split] @@ -958,8 +970,9 @@ Proof. Definition manual_grade_for_split_combine : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, advanced (filter_exercise) *) -(** 本练习有点难度。为你的归纳假设的形式花点心思。 *) +(** **** 练习:3 星, advanced (filter_exercise) + + 本练习有点难度。为你的归纳假设的形式花点心思。 *) Theorem filter_exercise : forall (X : Type) (test : X -> bool) (x : X) (l lf : list X), @@ -969,8 +982,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced, recommended (forall_exists_challenge) *) -(** 定义两个递归的 [Fixpoints],[forallb] 和 [existsb]。 +(** **** 练习:4 星, advanced, recommended (forall_exists_challenge) + + 定义两个递归的 [Fixpoints],[forallb] 和 [existsb]。 第一个检查列表中的每一个元素是否均满足给定的断言: forallb oddb [1;3;5;7;9] = true @@ -1036,3 +1050,4 @@ Proof. (* 请在此处解答 *) Admitted. +(* Sat Jan 26 15:14:45 UTC 2019 *) diff --git a/lf-current/TacticsTest.v b/lf-current/TacticsTest.v index 569d2907..cb7b2e5a 100644 --- a/lf-current/TacticsTest.v +++ b/lf-current/TacticsTest.v @@ -218,3 +218,5 @@ Print Assumptions filter_exercise. idtac "---------- existsb_existsb' ---------". Print Assumptions existsb_existsb'. Abort. + +(* Sat Jan 26 15:14:51 UTC 2019 *) diff --git a/lf-current/common/css/sf.css b/lf-current/common/css/sf.css index be9fcb10..12d4abc1 100644 --- a/lf-current/common/css/sf.css +++ b/lf-current/common/css/sf.css @@ -489,6 +489,9 @@ tr.infrulemiddle hr { color: rgb(0%,0%,0%); } +.nowrap { + white-space: nowrap; +} /* TOC */ diff --git a/lf-current/common/css/slides.css b/lf-current/common/css/slides.css index 0f1fc55a..b9d0327d 100644 --- a/lf-current/common/css/slides.css +++ b/lf-current/common/css/slides.css @@ -34,5 +34,7 @@ h1.libtitle { line-height: 34px; } - +body { + background: white; +} diff --git a/lf-current/coqindex.html b/lf-current/coqindex.html index 9e0faf77..3262ae1a 100644 --- a/lf-current/coqindex.html +++ b/lf-current/coqindex.html @@ -60,7 +60,7 @@ Z : _ -(1231 entries) +(1238 entries) Notation Index @@ -92,7 +92,7 @@ Z : _ -(82 entries) +(68 entries) Module Index @@ -123,7 +123,7 @@ Y Z _ -(24 entries) +(25 entries) Library Index @@ -185,7 +185,7 @@ Y Z _ -(350 entries) +(359 entries) Constructor Index @@ -216,7 +216,7 @@ Y Z _ -(207 entries) +(211 entries) Axiom Index @@ -278,38 +278,7 @@ Y Z _ -(74 entries) - - -Abbreviation Index -A -B -C -D -E -F -G -H -I -J -K -L -M -N -O -P -Q -R -S -T -U -V -W -X -Y -Z -_ -(4 entries) +(76 entries) Definition Index @@ -340,7 +309,7 @@ Y Z _ -(470 entries) +(479 entries)
    @@ -387,6 +356,12 @@

    Global Index

    AExp.aevalR_first_try.E_AMult [constructor, in LF.Imp]
    AExp.aevalR_first_try.E_ANum [constructor, in LF.Imp]
    AExp.aevalR_first_try.E_APlus [constructor, in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead [module, in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.aevalR [inductive, in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_AMinus [constructor, in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_AMult [constructor, in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_ANum [constructor, in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_APlus [constructor, in LF.Imp]
    AExp.aevalR_first_try.:type_scope:x_'\\'_x [notation, in LF.Imp]
    AExp.aeval_iff_aevalR [lemma, in LF.Imp]
    AExp.aeval_iff_aevalR' [lemma, in LF.Imp]
    @@ -413,6 +388,7 @@

    Global Index

    AExp.foo' [lemma, in LF.Imp]
    AExp.In10 [lemma, in LF.Imp]
    AExp.In10' [lemma, in LF.Imp]
    +AExp.manual_grade_for_beval_rules [definition, in LF.Imp]
    AExp.optimize_0plus [definition, in LF.Imp]
    AExp.optimize_0plus_b [definition, in LF.Imp]
    AExp.optimize_0plus_b_sound [lemma, in LF.Imp]
    @@ -499,8 +475,8 @@

    Global Index

    black [constructor, in LF.Basics]
    BLe [constructor, in LF.Imp]
    bleaf [constructor, in LF.IndPrinciples]
    -blue [constructor, in LF.Basics]
    blue [constructor, in LF.IndPrinciples]
    +blue [constructor, in LF.Basics]
    BNot [constructor, in LF.Imp]
    bool [inductive, in LF.Basics]
    boollist [inductive, in LF.Poly]
    @@ -526,12 +502,12 @@

    Global Index

    BreakImp.while_break_true [lemma, in LF.Imp]
    BreakImp.while_continue [lemma, in LF.Imp]
    BreakImp.while_stops_on_break [lemma, in LF.Imp]
    -BreakImp.::x_'/'_x_'\\'_x_'/'_x [notation, in LF.Imp]
    BreakImp.::x_'::='_x [notation, in LF.Imp]
    BreakImp.::x_';;'_x [notation, in LF.Imp]
    +BreakImp.::x_'=['_x_']=>'_x_'/'_x [notation, in LF.Imp]
    BreakImp.::'BREAK' [notation, in LF.Imp]
    -BreakImp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in LF.Imp]
    BreakImp.::'SKIP' [notation, in LF.Imp]
    +BreakImp.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in LF.Imp]
    BreakImp.::'WHILE'_x_'DO'_x_'END' [notation, in LF.Imp]
    BTrue [constructor, in LF.Imp]
    byntree [inductive, in LF.IndPrinciples]
    @@ -543,8 +519,8 @@

    Global Index

    ceval [inductive, in LF.Imp]
    ceval'_example1 [definition, in LF.Auto]
    ceval_and_ceval_step_coincide [lemma, in LF.ImpCEvalFun]
    -ceval_deterministic [lemma, in LF.Auto]
    ceval_deterministic [lemma, in LF.Imp]
    +ceval_deterministic [lemma, in LF.Auto]
    ceval_deterministic' [lemma, in LF.Auto]
    ceval_deterministic' [lemma, in LF.ImpCEvalFun]
    ceval_deterministic'' [lemma, in LF.Auto]
    @@ -618,13 +594,14 @@

    Global Index



    E

    eauto_example [definition, in LF.Auto]
    eg1 [definition, in LF.ImpParser]
    +eg2 [definition, in LF.ImpParser]
    empty [definition, in LF.Maps]
    EmptySet [constructor, in LF.IndProp]
    EmptyStr [constructor, in LF.IndProp]
    empty_is_empty [lemma, in LF.IndProp]
    empty_matches_eps [lemma, in LF.IndProp]
    empty_nomatch_ne [lemma, in LF.IndProp]
    -empty_state [definition, in LF.Extraction]
    +empty_st [definition, in LF.Imp]
    eqb [definition, in LF.Basics]
    eqbP [lemma, in LF.IndProp]
    eqbP_practice [lemma, in LF.IndProp]
    @@ -646,24 +623,26 @@

    Global Index

    eqb_true [lemma, in LF.Tactics]
    eqb_0_l [lemma, in LF.Tactics]
    equivalence [definition, in LF.Rel]
    -ev [inductive, in LF.IndProp]
    +even [inductive, in LF.IndProp]
    evenb [definition, in LF.Basics]
    evenb_double [lemma, in LF.Logic]
    evenb_double_conv [lemma, in LF.Logic]
    evenb_S [lemma, in LF.Induction]
    +even' [inductive, in LF.IndProp]
    +even'_ev [lemma, in LF.IndProp]
    +even'_sum [constructor, in LF.IndProp]
    +even'_0 [constructor, in LF.IndProp]
    +even'_2 [constructor, in LF.IndProp]
    even5_nonsense [lemma, in LF.IndProp]
    even_bool_prop [lemma, in LF.Logic]
    even_1000 [definition, in LF.Logic]
    even_1000' [definition, in LF.Logic]
    even_1000'' [definition, in LF.Logic]
    +even_42_bool [definition, in LF.Logic]
    +even_42_prop [definition, in LF.Logic]
    evSS_ev [lemma, in LF.IndProp]
    evSS_ev [lemma, in LF.IndProp]
    evSS_ev' [lemma, in LF.IndProp]
    -ev' [inductive, in LF.IndProp]
    -ev'_ev [lemma, in LF.IndProp]
    -ev'_sum [constructor, in LF.IndProp]
    -ev'_0 [constructor, in LF.IndProp]
    -ev'_2 [constructor, in LF.IndProp]
    ev_double [lemma, in LF.IndProp]
    ev_even [lemma, in LF.IndProp]
    ev_even_firsttry [lemma, in LF.IndProp]
    @@ -693,6 +672,10 @@

    Global Index

    ev_8' [definition, in LF.ProofObjects]
    examplemap [definition, in LF.Maps]
    examplemap' [definition, in LF.Maps]
    +examplepmap [definition, in LF.Maps]
    +example_aexp [definition, in LF.Imp]
    +example_bexp [definition, in LF.Imp]
    +example_empty [definition, in LF.Maps]
    excluded_middle [definition, in LF.Logic]
    excluded_middle_irrefutable [lemma, in LF.Logic]
    Exercises [module, in LF.Poly]
    @@ -777,13 +760,13 @@

    Global Index

    function_equality_ex2 [definition, in LF.Logic]
    f_equal [lemma, in LF.Tactics]


    G

    -green [constructor, in LF.IndPrinciples]
    green [constructor, in LF.Basics]
    +green [constructor, in LF.IndPrinciples]


    H

    hd_error [definition, in LF.Poly]


    I

    -Id [constructor, in LF.Lists]
    id [inductive, in LF.Lists]
    +Id [constructor, in LF.Lists]
    identity_fn_applied_twice [lemma, in LF.Basics]
    iff_refl [lemma, in LF.Logic]
    iff_reflect [lemma, in LF.IndProp]
    @@ -809,6 +792,12 @@

    Global Index

    In_example_2 [definition, in LF.Logic]
    In_map [lemma, in LF.Logic]
    In_map_iff [lemma, in LF.Logic]
    +in_not_nil [lemma, in LF.Logic]
    +in_not_nil_42 [lemma, in LF.Logic]
    +in_not_nil_42_take2 [lemma, in LF.Logic]
    +in_not_nil_42_take3 [lemma, in LF.Logic]
    +in_not_nil_42_take4 [lemma, in LF.Logic]
    +in_not_nil_42_take5 [lemma, in LF.Logic]
    in_re_match [lemma, in LF.IndProp]
    in_split [lemma, in LF.IndProp]
    isAlpha [definition, in LF.ImpParser]
    @@ -887,7 +876,6 @@

    Global Index

    manual_grade_for_pal_pal_app_rev_pal_rev [definition, in LF.IndProp]
    manual_grade_for_plus_comm_informal [definition, in LF.Induction]
    manual_grade_for_split_combine [definition, in LF.Tactics]
    -manual_grade_for_subsequence [definition, in LF.IndProp]
    manual_grade_for_XtimesYinZ_spec [definition, in LF.Imp]
    many [definition, in LF.ImpParser]
    many_helper [definition, in LF.ImpParser]
    @@ -945,7 +933,7 @@

    Global Index

    MyEquality.:type_scope:x_'=='_x [notation, in LF.ProofObjects]
    MyIff [module, in LF.Logic]
    MyIff.iff [definition, in LF.Logic]
    -MyIff.:type_scope:x_'<->'_x [notation, in LF.Logic]
    +->'_x">MyIff.:type_scope:x_'<->'_x [notation, in LF.Logic]
    mynil [definition, in LF.Poly]
    mynil [definition, in LF.Poly]
    mynil' [definition, in LF.Poly]
    @@ -954,8 +942,8 @@

    Global Index

    MyNot.:type_scope:'~'_x [notation, in LF.Logic]


    N

    nandb [definition, in LF.Basics]
    -NatList [module, in LF.Lists]
    natlist [inductive, in LF.IndPrinciples]
    +NatList [module, in LF.Lists]
    NatList.add [definition, in LF.Lists]
    NatList.alternate [definition, in LF.Lists]
    NatList.app [definition, in LF.Lists]
    @@ -1106,6 +1094,8 @@

    Global Index

    nostutter [inductive, in LF.IndProp]
    not_both_true_and_false [lemma, in LF.Logic]
    not_equiv_false [lemma, in LF.IndProp]
    +not_even_1001 [definition, in LF.Logic]
    +not_even_1001' [definition, in LF.Logic]
    not_exists_dist [lemma, in LF.Logic]
    not_False [lemma, in LF.Logic]
    not_implies_our_not [lemma, in LF.Logic]
    @@ -1192,11 +1182,11 @@

    Global Index

    plus_comm3 [lemma, in LF.Logic]
    plus_comm3_take2 [lemma, in LF.Logic]
    plus_comm3_take3 [lemma, in LF.Logic]
    +plus_eqb_example [lemma, in LF.Logic]
    plus_fact [definition, in LF.Logic]
    plus_fact_is_true [lemma, in LF.Logic]
    plus_id_example [lemma, in LF.Basics]
    plus_id_exercise [lemma, in LF.Basics]
    -plus_leb_compat_l [abbreviation, in LF.Induction]
    plus_lt [lemma, in LF.IndProp]
    plus_n_n_injective [lemma, in LF.Tactics]
    plus_n_O [lemma, in LF.Induction]
    @@ -1258,8 +1248,8 @@

    Global Index

    P_m0r' [definition, in LF.IndPrinciples]


    R

    R [module, in LF.IndProp]
    -red [constructor, in LF.IndPrinciples]
    red [constructor, in LF.Basics]
    +red [constructor, in LF.IndPrinciples]
    reflect [inductive, in LF.IndProp]
    ReflectF [constructor, in LF.IndProp]
    ReflectT [constructor, in LF.IndProp]
    @@ -1302,12 +1292,12 @@

    Global Index

    Repeat.E_Skip [constructor, in LF.Auto]
    Repeat.E_WhileFalse [constructor, in LF.Auto]
    Repeat.E_WhileTrue [constructor, in LF.Auto]
    -Repeat.::x_'/'_x_'\\'_x [notation, in LF.Auto]
    Repeat.::x_'::='_x [notation, in LF.Auto]
    Repeat.::x_';'_x [notation, in LF.Auto]
    -Repeat.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in LF.Auto]
    +Repeat.::x_'=['_x_']=>'_x [notation, in LF.Auto]
    Repeat.::'REPEAT'_x_'UNTIL'_x_'END' [notation, in LF.Auto]
    Repeat.::'SKIP' [notation, in LF.Auto]
    +Repeat.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in LF.Auto]
    Repeat.::'WHILE'_x_'DO'_x_'END' [notation, in LF.Auto]
    restricted_excluded_middle [lemma, in LF.Logic]
    restricted_excluded_middle_eq [lemma, in LF.Logic]
    @@ -1383,6 +1373,10 @@

    Global Index

    string_of_list [definition, in LF.ImpParser]
    st12 [definition, in LF.Auto]
    st21 [definition, in LF.Auto]
    +subseq [inductive, in LF.IndProp]
    +subseq_app [lemma, in LF.IndProp]
    +subseq_refl [lemma, in LF.IndProp]
    +subseq_trans [lemma, in LF.IndProp]
    subtract_slowly [definition, in LF.Imp]
    subtract_slowly_body [definition, in LF.Imp]
    subtract_3_from_5_slowly [definition, in LF.Imp]
    @@ -1399,7 +1393,6 @@

    Global Index

    S_injective [lemma, in LF.Tactics]
    S_injective' [lemma, in LF.Tactics]
    S_nbeq_0 [lemma, in LF.Induction]
    -S_neqb_0 [abbreviation, in LF.Induction]


    T

    Tactics [library]
    testParsing [definition, in LF.ImpParser]
    @@ -1534,71 +1527,54 @@

    Global Index

    yes [constructor, in LF.IndPrinciples]
    yesno [inductive, in LF.IndPrinciples]


    Z

    -Z [definition, in LF.Imp]
    Z [constructor, in LF.Basics]
    +Z [definition, in LF.Imp]
    zero_nbeq_plus_1 [lemma, in LF.Basics]
    zero_nbeq_S [lemma, in LF.Induction]
    -zero_neqb_plus_1 [abbreviation, in LF.Basics]
    -zero_neqb_S [abbreviation, in LF.Induction]
    zero_not_one [lemma, in LF.Logic]
    -zero_not_one' [lemma, in LF.Logic]
    zero_or_succ [lemma, in LF.Logic]


    :

    -:aexp_scope:x_'*'_x [notation, in LF.Imp]
    -:aexp_scope:x_'+'_x [notation, in LF.Imp]
    -:aexp_scope:x_'-'_x [notation, in LF.Imp]
    -:bexp_scope:x_'&&'_x [notation, in LF.Imp]
    -:bexp_scope:x_'<='_x [notation, in LF.Imp]
    -:bexp_scope:x_'='_x [notation, in LF.Imp]
    -:bexp_scope:'!'_x [notation, in LF.Imp]
    -:com_scope:x_'::='_x [notation, in LF.Imp]
    -:com_scope:x_';;'_x [notation, in LF.Imp]
    -:com_scope:'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in LF.Imp]
    -:com_scope:'SKIP' [notation, in LF.Imp]
    -:com_scope:'WHILE'_x_'DO'_x_'END' [notation, in LF.Imp]
    +:imp_scope:x_'&&'_x [notation, in LF.Imp]
    +:imp_scope:x_'*'_x [notation, in LF.Imp]
    +:imp_scope:x_'+'_x [notation, in LF.Imp]
    +:imp_scope:x_'-'_x [notation, in LF.Imp]
    +:imp_scope:x_'::='_x [notation, in LF.Imp]
    +:imp_scope:x_';;'_x [notation, in LF.Imp]
    +:imp_scope:x_'<='_x [notation, in LF.Imp]
    +:imp_scope:x_'='_x [notation, in LF.Imp]
    +:imp_scope:'SKIP' [notation, in LF.Imp]
    +:imp_scope:'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in LF.Imp]
    +:imp_scope:'WHILE'_x_'DO'_x_'END' [notation, in LF.Imp]
    +:imp_scope:'~'_x [notation, in LF.Imp]
    :nat_scope:x_'*'_x [notation, in LF.Basics]
    :nat_scope:x_'*'_x [notation, in LF.Basics]
    :nat_scope:x_'+'_x [notation, in LF.Basics]
    :nat_scope:x_'+'_x [notation, in LF.Basics]
    :nat_scope:x_'-'_x [notation, in LF.Basics]
    -:nat_scope:x_'<=?'_x [notation, in LF.Basics]
    :nat_scope:x_'<=?'_x [notation, in LF.ImpParser]
    +:nat_scope:x_'<=?'_x [notation, in LF.Basics]
    :nat_scope:x_' [notation, in LF.Basics]
    :nat_scope:x_'=?'_x [notation, in LF.Basics]
    :type_scope:x_'*'_x [notation, in LF.Poly]
    +->'_x">::x_'!->'_x [notation, in LF.Imp]
    +->'_x_';'_x">::x_'!->'_x_';'_x [notation, in LF.Maps]
    ::x_'&&'_x [notation, in LF.Basics]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Maps]
    --->'_x_'}'">::x_'&'_'{'_x_'-->'_x_'}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [notation, in LF.Maps]
    --->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_'}}' [notation, in LF.Maps]
    --->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_'}}' [notation, in LF.Maps]
    ::x_'++'_x [notation, in LF.Poly]
    -::x_'/'_x_'\\'_x [notation, in LF.Imp]
    ::x_'::'_x [notation, in LF.Poly]
    ::x_'<'_x [notation, in LF.IndProp]
    ::x_'<='_x [notation, in LF.IndPrinciples]
    +::x_'=['_x_']=>'_x [notation, in LF.Imp]
    ::x_'=~'_x [notation, in LF.IndProp]
    +>'_x">::x_'>'_x [notation, in LF.Maps]
    +>'_x_';'_x">::x_'>'_x_';'_x [notation, in LF.Maps]
    ::x_'||'_x [notation, in LF.Basics]
    -::'DO'_'('_x_','_x_')'_'<--'_x_';'_x_'OR'_x [notation, in LF.ImpParser]
    -::'DO'_'('_x_','_x_')'_'<=='_x_';'_x [notation, in LF.ImpParser]
    ::'LETOPT'_x_'<=='_x_'IN'_x [notation, in LF.ImpCEvalFun]
    +::'TRY'_''''_x_'<-'_x_';;'_x_'OR'_x [notation, in LF.ImpParser]
    +::''''_x_'<-'_x_';;'_x [notation, in LF.ImpParser]
    +->'_x">::'''_'''_'!->'_x [notation, in LF.Maps]
    ::'('_x_','_x_')' [notation, in LF.Poly]
    ::'['_x_';'_'..'_';'_x_']' [notation, in LF.Poly]
    ::'['_']' [notation, in LF.Poly]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Imp]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Imp]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Imp]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Imp]
    --->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_'}' [notation, in LF.Imp]
    --->'_x_'}'">::'{'_x_'-->'_x_'}' [notation, in LF.Imp]
    --->'_x_'}'">::'{'_'-->'_x_'}' [notation, in LF.Maps]



    Notation Index

    A

    @@ -1607,16 +1583,16 @@

    Notation Index

    AExp.aevalR_first_try.:type_scope:x_'\\'_x [in LF.Imp]
    AExp.:type_scope:x_'\\'_x [in LF.Imp]


    B

    -BreakImp.::x_'/'_x_'\\'_x_'/'_x [in LF.Imp]
    BreakImp.::x_'::='_x [in LF.Imp]
    BreakImp.::x_';;'_x [in LF.Imp]
    +BreakImp.::x_'=['_x_']=>'_x_'/'_x [in LF.Imp]
    BreakImp.::'BREAK' [in LF.Imp]
    -BreakImp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in LF.Imp]
    BreakImp.::'SKIP' [in LF.Imp]
    +BreakImp.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in LF.Imp]
    BreakImp.::'WHILE'_x_'DO'_x_'END' [in LF.Imp]


    M

    MyEquality.:type_scope:x_'=='_x [in LF.ProofObjects]
    -MyIff.:type_scope:x_'<->'_x [in LF.Logic]
    +->'_x">MyIff.:type_scope:x_'<->'_x [in LF.Logic]
    MyNot.:type_scope:'~'_x [in LF.Logic]


    N

    NatList.::x_'++'_x [in LF.Lists]
    @@ -1627,69 +1603,55 @@

    Notation Index



    P

    Playground.::x_'<='_x [in LF.IndProp]


    R

    -Repeat.::x_'/'_x_'\\'_x [in LF.Auto]
    Repeat.::x_'::='_x [in LF.Auto]
    Repeat.::x_';'_x [in LF.Auto]
    -Repeat.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in LF.Auto]
    +Repeat.::x_'=['_x_']=>'_x [in LF.Auto]
    Repeat.::'REPEAT'_x_'UNTIL'_x_'END' [in LF.Auto]
    Repeat.::'SKIP' [in LF.Auto]
    +Repeat.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in LF.Auto]
    Repeat.::'WHILE'_x_'DO'_x_'END' [in LF.Auto]


    :

    -:aexp_scope:x_'*'_x [in LF.Imp]
    -:aexp_scope:x_'+'_x [in LF.Imp]
    -:aexp_scope:x_'-'_x [in LF.Imp]
    -:bexp_scope:x_'&&'_x [in LF.Imp]
    -:bexp_scope:x_'<='_x [in LF.Imp]
    -:bexp_scope:x_'='_x [in LF.Imp]
    -:bexp_scope:'!'_x [in LF.Imp]
    -:com_scope:x_'::='_x [in LF.Imp]
    -:com_scope:x_';;'_x [in LF.Imp]
    -:com_scope:'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in LF.Imp]
    -:com_scope:'SKIP' [in LF.Imp]
    -:com_scope:'WHILE'_x_'DO'_x_'END' [in LF.Imp]
    +:imp_scope:x_'&&'_x [in LF.Imp]
    +:imp_scope:x_'*'_x [in LF.Imp]
    +:imp_scope:x_'+'_x [in LF.Imp]
    +:imp_scope:x_'-'_x [in LF.Imp]
    +:imp_scope:x_'::='_x [in LF.Imp]
    +:imp_scope:x_';;'_x [in LF.Imp]
    +:imp_scope:x_'<='_x [in LF.Imp]
    +:imp_scope:x_'='_x [in LF.Imp]
    +:imp_scope:'SKIP' [in LF.Imp]
    +:imp_scope:'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in LF.Imp]
    +:imp_scope:'WHILE'_x_'DO'_x_'END' [in LF.Imp]
    +:imp_scope:'~'_x [in LF.Imp]
    :nat_scope:x_'*'_x [in LF.Basics]
    :nat_scope:x_'*'_x [in LF.Basics]
    :nat_scope:x_'+'_x [in LF.Basics]
    :nat_scope:x_'+'_x [in LF.Basics]
    :nat_scope:x_'-'_x [in LF.Basics]
    -:nat_scope:x_'<=?'_x [in LF.Basics]
    :nat_scope:x_'<=?'_x [in LF.ImpParser]
    +:nat_scope:x_'<=?'_x [in LF.Basics]
    :nat_scope:x_' [in LF.Basics]
    :nat_scope:x_'=?'_x [in LF.Basics]
    :type_scope:x_'*'_x [in LF.Poly]
    +->'_x">::x_'!->'_x [in LF.Imp]
    +->'_x_';'_x">::x_'!->'_x_';'_x [in LF.Maps]
    ::x_'&&'_x [in LF.Basics]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_'}'">::x_'&'_'{'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Maps]
    --->'_x_'}'">::x_'&'_'{'_x_'-->'_x_'}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}}' [in LF.Maps]
    --->'_x_';'_x_'-->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_';'_x_'-->'_x_'}}' [in LF.Maps]
    --->'_x_'}}'">::x_'&'_'{{'_x_'-->'_x_'}}' [in LF.Maps]
    ::x_'++'_x [in LF.Poly]
    -::x_'/'_x_'\\'_x [in LF.Imp]
    ::x_'::'_x [in LF.Poly]
    ::x_'<'_x [in LF.IndProp]
    ::x_'<='_x [in LF.IndPrinciples]
    +::x_'=['_x_']=>'_x [in LF.Imp]
    ::x_'=~'_x [in LF.IndProp]
    +>'_x">::x_'>'_x [in LF.Maps]
    +>'_x_';'_x">::x_'>'_x_';'_x [in LF.Maps]
    ::x_'||'_x [in LF.Basics]
    -::'DO'_'('_x_','_x_')'_'<--'_x_';'_x_'OR'_x [in LF.ImpParser]
    -::'DO'_'('_x_','_x_')'_'<=='_x_';'_x [in LF.ImpParser]
    ::'LETOPT'_x_'<=='_x_'IN'_x [in LF.ImpCEvalFun]
    +::'TRY'_''''_x_'<-'_x_';;'_x_'OR'_x [in LF.ImpParser]
    +::''''_x_'<-'_x_';;'_x [in LF.ImpParser]
    +->'_x">::'''_'''_'!->'_x [in LF.Maps]
    ::'('_x_','_x_')' [in LF.Poly]
    ::'['_x_';'_'..'_';'_x_']' [in LF.Poly]
    ::'['_']' [in LF.Poly]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Imp]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Imp]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Imp]
    --->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Imp]
    --->'_x_';'_x_'-->'_x_'}'">::'{'_x_'-->'_x_';'_x_'-->'_x_'}' [in LF.Imp]
    --->'_x_'}'">::'{'_x_'-->'_x_'}' [in LF.Imp]
    --->'_x_'}'">::'{'_'-->'_x_'}' [in LF.Maps]



    Module Index

    A

    @@ -1697,6 +1659,7 @@

    Module Index

    aevalR_extended [in LF.Imp]
    AExp [in LF.Imp]
    AExp.aevalR_first_try [in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead [in LF.Imp]


    B

    BreakImp [in LF.Imp]


    E

    @@ -1803,8 +1766,8 @@

    Lemma Index

    BreakImp.while_stops_on_break [in LF.Imp]


    C

    ceval_and_ceval_step_coincide [in LF.ImpCEvalFun]
    -ceval_deterministic [in LF.Auto]
    ceval_deterministic [in LF.Imp]
    +ceval_deterministic [in LF.Auto]
    ceval_deterministic' [in LF.Auto]
    ceval_deterministic' [in LF.ImpCEvalFun]
    ceval_deterministic'' [in LF.Auto]
    @@ -1858,12 +1821,12 @@

    Lemma Index

    evenb_double [in LF.Logic]
    evenb_double_conv [in LF.Logic]
    evenb_S [in LF.Induction]
    +even'_ev [in LF.IndProp]
    even5_nonsense [in LF.IndProp]
    even_bool_prop [in LF.Logic]
    evSS_ev [in LF.IndProp]
    evSS_ev [in LF.IndProp]
    evSS_ev' [in LF.IndProp]
    -ev'_ev [in LF.IndProp]
    ev_double [in LF.IndProp]
    ev_even [in LF.IndProp]
    ev_even_firsttry [in LF.IndProp]
    @@ -1910,6 +1873,12 @@

    Lemma Index

    In_app_iff [in LF.Logic]
    In_map [in LF.Logic]
    In_map_iff [in LF.Logic]
    +in_not_nil [in LF.Logic]
    +in_not_nil_42 [in LF.Logic]
    +in_not_nil_42_take2 [in LF.Logic]
    +in_not_nil_42_take3 [in LF.Logic]
    +in_not_nil_42_take4 [in LF.Logic]
    +in_not_nil_42_take5 [in LF.Logic]
    in_re_match [in LF.IndProp]
    in_split [in LF.IndProp]


    L

    @@ -2028,6 +1997,7 @@

    Lemma Index

    plus_comm3 [in LF.Logic]
    plus_comm3_take2 [in LF.Logic]
    plus_comm3_take3 [in LF.Logic]
    +plus_eqb_example [in LF.Logic]
    plus_fact_is_true [in LF.Logic]
    plus_id_example [in LF.Basics]
    plus_id_exercise [in LF.Basics]
    @@ -2094,6 +2064,9 @@

    Lemma Index

    star_app [in LF.IndProp]
    star_app [in LF.IndProp]
    star_ne [in LF.IndProp]
    +subseq_app [in LF.IndProp]
    +subseq_refl [in LF.IndProp]
    +subseq_trans [in LF.IndProp]
    succ_inj [in LF.Logic]
    s_compile_correct [in LF.Imp]
    S_inj [in LF.Tactics]
    @@ -2121,7 +2094,6 @@

    Lemma Index

    zero_nbeq_plus_1 [in LF.Basics]
    zero_nbeq_S [in LF.Induction]
    zero_not_one [in LF.Logic]
    -zero_not_one' [in LF.Logic]
    zero_or_succ [in LF.Logic]



    Constructor Index

    @@ -2151,6 +2123,10 @@

    Constructor Index

    AExp.aevalR_first_try.E_AMult [in LF.Imp]
    AExp.aevalR_first_try.E_ANum [in LF.Imp]
    AExp.aevalR_first_try.E_APlus [in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_AMinus [in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_AMult [in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_ANum [in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.E_APlus [in LF.Imp]
    AExp.AMinus [in LF.Imp]
    AExp.AMult [in LF.Imp]
    AExp.ANum [in LF.Imp]
    @@ -2184,8 +2160,8 @@

    Constructor Index

    black [in LF.Basics]
    BLe [in LF.Imp]
    bleaf [in LF.IndPrinciples]
    -blue [in LF.Basics]
    blue [in LF.IndPrinciples]
    +blue [in LF.Basics]
    BNot [in LF.Imp]
    bool_cons [in LF.Poly]
    bool_nil [in LF.Poly]
    @@ -2217,9 +2193,9 @@

    Constructor Index



    E

    EmptySet [in LF.IndProp]
    EmptyStr [in LF.IndProp]
    -ev'_sum [in LF.IndProp]
    -ev'_0 [in LF.IndProp]
    -ev'_2 [in LF.IndProp]
    +even'_sum [in LF.IndProp]
    +even'_0 [in LF.IndProp]
    +even'_2 [in LF.IndProp]
    ev_SS [in LF.IndProp]
    ev_0 [in LF.IndProp]
    E_Ass [in LF.Imp]
    @@ -2233,8 +2209,8 @@

    Constructor Index

    false [in LF.Basics]
    friday [in LF.Basics]


    G

    -green [in LF.IndPrinciples]
    green [in LF.Basics]
    +green [in LF.IndPrinciples]


    I

    Id [in LF.Lists]


    L

    @@ -2296,8 +2272,8 @@

    Constructor Index

    Props.Or.or_introl [in LF.ProofObjects]
    Props.Or.or_intror [in LF.ProofObjects]


    R

    -red [in LF.IndPrinciples]
    red [in LF.Basics]
    +red [in LF.IndPrinciples]
    ReflectF [in LF.IndProp]
    ReflectT [in LF.IndProp]
    Repeat.CAsgn [in LF.Auto]
    @@ -2366,6 +2342,7 @@

    Inductive Index

    aexp [in LF.Imp]
    AExp.aevalR [in LF.Imp]
    AExp.aevalR_first_try.aevalR [in LF.Imp]
    +AExp.aevalR_first_try.TooHardToRead.aevalR [in LF.Imp]
    AExp.aexp [in LF.Imp]
    AExp.bevalR [in LF.Imp]
    AExp.bexp [in LF.Imp]
    @@ -2390,8 +2367,8 @@

    Inductive Index



    D

    day [in LF.Basics]


    E

    -ev [in LF.IndProp]
    -ev' [in LF.IndProp]
    +even [in LF.IndProp]
    +even' [in LF.IndProp]
    exp_match [in LF.IndProp]
    ExSet [in LF.IndPrinciples]


    F

    @@ -2443,6 +2420,7 @@

    Inductive Index



    S

    sinstr [in LF.Imp]
    square_of [in LF.IndProp]
    +subseq [in LF.IndProp]


    T

    tree [in LF.IndPrinciples]


    W

    @@ -2450,21 +2428,13 @@

    Inductive Index



    Y

    yesno [in LF.IndPrinciples]



    -

    Abbreviation Index

    -

    P

    -plus_leb_compat_l [in LF.Induction]
    -

    S

    -S_neqb_0 [in LF.Induction]
    -

    Z

    -zero_neqb_plus_1 [in LF.Basics]
    -zero_neqb_S [in LF.Induction]
    -


    Definition Index

    A

    add1 [in LF.ProofObjects]
    aeval [in LF.Imp]
    AExp.aeval [in LF.Imp]
    AExp.beval [in LF.Imp]
    +AExp.manual_grade_for_beval_rules [in LF.Imp]
    AExp.optimize_0plus [in LF.Imp]
    AExp.optimize_0plus_b [in LF.Imp]
    AExp.silly_presburger_example [in LF.Imp]
    @@ -2527,8 +2497,9 @@

    Definition Index



    E

    eauto_example [in LF.Auto]
    eg1 [in LF.ImpParser]
    +eg2 [in LF.ImpParser]
    empty [in LF.Maps]
    -empty_state [in LF.Extraction]
    +empty_st [in LF.Imp]
    eqb [in LF.Basics]
    eqb_id [in LF.Lists]
    eqb_list [in LF.Logic]
    @@ -2538,6 +2509,8 @@

    Definition Index

    even_1000 [in LF.Logic]
    even_1000' [in LF.Logic]
    even_1000'' [in LF.Logic]
    +even_42_bool [in LF.Logic]
    +even_42_prop [in LF.Logic]
    ev_plus2 [in LF.ProofObjects]
    ev_plus2' [in LF.ProofObjects]
    ev_plus2'' [in LF.ProofObjects]
    @@ -2547,6 +2520,10 @@

    Definition Index

    ev_8' [in LF.ProofObjects]
    examplemap [in LF.Maps]
    examplemap' [in LF.Maps]
    +examplepmap [in LF.Maps]
    +example_aexp [in LF.Imp]
    +example_bexp [in LF.Imp]
    +example_empty [in LF.Maps]
    excluded_middle [in LF.Logic]
    Exercises.Church.cnat [in LF.Poly]
    Exercises.Church.exp [in LF.Poly]
    @@ -2655,7 +2632,6 @@

    Definition Index

    manual_grade_for_pal_pal_app_rev_pal_rev [in LF.IndProp]
    manual_grade_for_plus_comm_informal [in LF.Induction]
    manual_grade_for_split_combine [in LF.Tactics]
    -manual_grade_for_subsequence [in LF.IndProp]
    manual_grade_for_XtimesYinZ_spec [in LF.Imp]
    many [in LF.ImpParser]
    many_helper [in LF.ImpParser]
    @@ -2759,6 +2735,8 @@

    Definition Index

    nat_to_bin [in LF.Induction]
    negb [in LF.Basics]
    next_weekday [in LF.Basics]
    +not_even_1001 [in LF.Logic]
    +not_even_1001' [in LF.Logic]
    no_whiles [in LF.Imp]
    nth_error [in LF.Poly]


    O

    @@ -2982,7 +2960,7 @@

    Definition Index

    Z : _ -(1231 entries) +(1238 entries) Notation Index @@ -3014,7 +2992,7 @@

    Definition Index

    Z : _ -(82 entries) +(68 entries) Module Index @@ -3045,7 +3023,7 @@

    Definition Index

    Y Z _ -(24 entries) +(25 entries) Library Index @@ -3107,7 +3085,7 @@

    Definition Index

    Y Z _ -(350 entries) +(359 entries) Constructor Index @@ -3138,7 +3116,7 @@

    Definition Index

    Y Z _ -(207 entries) +(211 entries) Axiom Index @@ -3200,38 +3178,7 @@

    Definition Index

    Y Z _ -(74 entries) - - -Abbreviation Index -A -B -C -D -E -F -G -H -I -J -K -L -M -N -O -P -Q -R -S -T -U -V -W -X -Y -Z -_ -(4 entries) +(76 entries) Definition Index @@ -3262,7 +3209,7 @@

    Definition Index

    Y Z _ -(470 entries) +(479 entries)
    diff --git a/lf-current/imp.ml b/lf-current/imp.ml index 859b00a5..0df05a9a 100644 --- a/lf-current/imp.ml +++ b/lf-current/imp.ml @@ -323,6 +323,11 @@ let rec beval st = function | BNot b1 -> negb (beval st b1) | BAnd (b1, b2) -> (&&) (beval st b1) (beval st b2) +(** val empty_st : int total_map **) + +let empty_st = + t_empty 0 + type com = | CSkip | CAss of char list * aexp @@ -1637,7 +1642,7 @@ let rec parseAtomicExp steps xs = (match expect ('f'::('a'::('l'::('s'::('e'::[]))))) xs with | SomeE x -> let (_, rest) = x in SomeE (BFalse, rest) | NoneE _ -> - (match firstExpect ('!'::[]) (parseAtomicExp steps') xs with + (match firstExpect ('~'::[]) (parseAtomicExp steps') xs with | SomeE x -> let (e, rest) = x in SomeE ((BNot e), rest) | NoneE _ -> (match firstExpect ('('::[]) (parseConjunctionExp steps') xs with @@ -1702,7 +1707,7 @@ let rec parseSimpleCommand steps xs = match expect ('S'::('K'::('I'::('P'::[])))) xs with | SomeE x -> let (_, rest) = x in SomeE (CSkip, rest) | NoneE _ -> - (match firstExpect ('I'::('F'::('B'::[]))) (parseBExp steps') xs with + (match firstExpect ('T'::('E'::('S'::('T'::[])))) (parseBExp steps') xs with | SomeE x -> let (e, rest) = x in (match firstExpect ('T'::('H'::('E'::('N'::[])))) @@ -1737,11 +1742,14 @@ let rec parseSimpleCommand steps xs = (match parseIdentifier xs with | SomeE x -> let (i, rest) = x in - (match firstExpect (':'::('='::[])) (parseAExp steps') rest with + (match firstExpect (':'::(':'::('='::[]))) (parseAExp steps') + rest with | SomeE x0 -> let (e, rest') = x0 in SomeE ((CAss (i, e)), rest') | NoneE err -> NoneE err) - | NoneE err -> NoneE err)))) + | NoneE _ -> + NoneE + ('E'::('x'::('p'::('e'::('c'::('t'::('i'::('n'::('g'::(' '::('a'::(' '::('c'::('o'::('m'::('m'::('a'::('n'::('d'::[]))))))))))))))))))))))) steps (** val parseSequencedCommand : @@ -2017,12 +2025,18 @@ let bignumber = ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) ((fun x -> x + 1) 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) -(** val parse : char list -> (com * token list) optionE **) +(** val parse : char list -> com optionE **) let parse str = - let tokens = tokenize str in parseSequencedCommand bignumber tokens - -(** val empty_state : int total_map **) - -let empty_state = - t_empty 0 + let tokens = tokenize str in + (match parseSequencedCommand bignumber tokens with + | SomeE x -> + let (c, l) = x in + (match l with + | [] -> SomeE c + | t :: _ -> + NoneE + (append + ('T'::('r'::('a'::('i'::('l'::('i'::('n'::('g'::(' '::('t'::('o'::('k'::('e'::('n'::('s'::(' '::('r'::('e'::('m'::('a'::('i'::('n'::('i'::('n'::('g'::(':'::(' '::[]))))))))))))))))))))))))))) + t)) + | NoneE err -> NoneE err) diff --git a/lf-current/imp.mli b/lf-current/imp.mli index 228bae8c..6ec599fa 100644 --- a/lf-current/imp.mli +++ b/lf-current/imp.mli @@ -102,6 +102,8 @@ val aeval : state -> aexp -> int val beval : state -> bexp -> bool +val empty_st : int total_map + type com = | CSkip | CAss of char list * aexp @@ -177,6 +179,4 @@ val parseSequencedCommand : int -> token list -> (com * token list) optionE val bignumber : int -val parse : char list -> (com * token list) optionE - -val empty_state : int total_map +val parse : char list -> com optionE diff --git a/lf-current/impdriver.ml b/lf-current/impdriver.ml index 4869207e..4788c025 100644 --- a/lf-current/impdriver.ml +++ b/lf-current/impdriver.ml @@ -10,9 +10,9 @@ let test s = let parse_res = parse (explode s) in (match parse_res with NoneE _ -> print_endline ("Syntax error"); - | SomeE (c, _) -> + | SomeE c -> let fuel = 1000 in - match (ceval_step empty_state c fuel) with + match (ceval_step empty_st c fuel) with None -> print_endline ("Still running after " ^ string_of_int fuel ^ " steps") diff --git a/lf-current/index.html b/lf-current/index.html index 6a382460..1d6cd57b 100644 --- a/lf-current/index.html +++ b/lf-current/index.html @@ -50,6 +50,7 @@ Anthony Cowley, Jeffrey Foster, Dmitri Garbuzov, + Olek Gierczak, Michael Hicks, Ranjit Jhala, Greg Morrisett, @@ -60,6 +61,7 @@ Andrew Tolmach, Philip Wadler, Stephanie Weirich, + Li-Yao Xia, and Steve Zdancewic
    @@ -84,7 +86,7 @@
    -

    版本 5.6 (07 Dec 2018, Coq 8.8.0)

    +

    版本 5.7 (26 Jan 2019, Coq 8.8.1)

    diff --git a/lf-current/lf.tgz b/lf-current/lf.tgz index 884c5d51..20717940 100644 Binary files a/lf-current/lf.tgz and b/lf-current/lf.tgz differ diff --git a/lf-current/toc.html b/lf-current/toc.html index 90c9bbc0..a1de4c77 100644 --- a/lf-current/toc.html +++ b/lf-current/toc.html @@ -105,20 +105,30 @@

    前言    (Preface)下载 Coq 文件 -
  • 课程视频 + +
  • + + +
  • 资源 +
  • -
  • 对授课员的要求 +
  • 对授课员的要求
  • -
  • 译本 +
  • 译本
  • -
  • 鸣谢 +
  • 鸣谢
  • @@ -127,59 +137,59 @@

    Coq 函数式编程    (Basics<
    @@ -188,16 +198,16 @@

    归纳证明    (Induction @@ -206,45 +216,45 @@

    使用结构化的数据    (Lis
    @@ -253,48 +263,48 @@

    多态与高阶函数    (Poly @@ -303,31 +313,31 @@

    更多基本策略    (Tactics
    @@ -336,47 +346,47 @@

    Coq 中的逻辑系统    (Logic
    • 页首 -
    • 逻辑联结词 +
    • 逻辑联结词
    • -
    • 使用命题编程 +
    • 使用命题编程
    • -
    • 对参数应用定理 +
    • 对参数应用定理
    • -
    • Coq vs. 集合论 +
    • Coq vs. 集合论
      @@ -389,42 +399,49 @@

      归纳定义的命题    (IndP
      • 页首 -
      • 归纳定义的命题 +
      • 归纳定义的命题 + + +
      • +
      • 在证明中使用证据
      • -
      • 归纳关系 +
      • 归纳关系
      • -
      • 案例学习:正则表达式 +
      • 案例学习:正则表达式
      • -
      • 案例学习:改进互映 +
      • 案例学习:改进互映
      • -
      • 额外练习 +
      • 额外练习
        @@ -437,16 +454,16 @@

        全映射与偏映射    (Maps @@ -455,38 +472,38 @@

        柯里-霍华德对应    (<
        • 页首 -
        • 证明脚本 +
        • 证明脚本
        • -
        • 量词,蕴含式,函数 +
        • 量词,蕴含式,函数
        • -
        • 使用策略编程 +
        • 使用策略编程
        • -
        • 逻辑联结词作为归纳类型 +
        • 逻辑联结词作为归纳类型
        • -
        • 相等关系 +
        • 相等关系
          @@ -499,28 +516,28 @@

          归纳原理    (IndPrin
          • 页首 -
          • 基础 +
          • 基础
          • -
          • 多态 +
          • 多态
          • -
          • 归纳假设 +
          • 归纳假设
          • -
          • 深入 induction 策略 +
          • 深入 induction 策略
          • -
          • Prop 中的归纳原理 +
          • Prop 中的归纳原理
          • -
          • 形式化 vs. 非形式化的归纳证明 +
          • 形式化 vs. 非形式化的归纳证明
            @@ -533,13 +550,13 @@

            关系的性质    (Rel) @@ -548,109 +565,115 @@

            简单的指令式程序    (Imp @@ -659,20 +682,20 @@

            用 Coq 实现词法分析和语法分析 &nbs
            @@ -681,16 +704,16 @@

            Imp 的求值函数    (Im
            @@ -699,19 +722,19 @@

            从 Coq 中提取 ML    (Ex
            @@ -720,13 +743,13 @@

            更多的自动化    (Auto)<
            • 页首 -
            • auto 策略 +
            • auto 策略
            • -
            • 搜索前提 +
            • 搜索前提
              @@ -739,13 +762,13 @@

              后记    (Postscript)<
              @@ -754,7 +777,7 @@

              参考文献    (Bib)

              diff --git a/plf-current/.coqdeps.d b/plf-current/.coqdeps.d index 4e9b4ab2..42aa23bd 100644 --- a/plf-current/.coqdeps.d +++ b/plf-current/.coqdeps.d @@ -6,18 +6,18 @@ Preface.vo Preface.glob Preface.v.beautified: Preface.v Preface.vio: Preface.v Equiv.vo Equiv.glob Equiv.v.beautified: Equiv.v Maps.vo Imp.vo Equiv.vio: Equiv.v Maps.vio Imp.vio -Hoare.vo Hoare.glob Hoare.v.beautified: Hoare.v Imp.vo Maps.vo -Hoare.vio: Hoare.v Imp.vio Maps.vio -Hoare2.vo Hoare2.glob Hoare2.v.beautified: Hoare2.v Maps.vo Imp.vo Hoare.vo -Hoare2.vio: Hoare2.v Maps.vio Imp.vio Hoare.vio +Hoare.vo Hoare.glob Hoare.v.beautified: Hoare.v Maps.vo Imp.vo +Hoare.vio: Hoare.v Maps.vio Imp.vio +Hoare2.vo Hoare2.glob Hoare2.v.beautified: Hoare2.v Maps.vo Hoare.vo Imp.vo +Hoare2.vio: Hoare2.v Maps.vio Hoare.vio Imp.vio HoareAsLogic.vo HoareAsLogic.glob HoareAsLogic.v.beautified: HoareAsLogic.v Imp.vo Hoare.vo HoareAsLogic.vio: HoareAsLogic.v Imp.vio Hoare.vio Smallstep.vo Smallstep.glob Smallstep.v.beautified: Smallstep.v Maps.vo Imp.vo Smallstep.vio: Smallstep.v Maps.vio Imp.vio Types.vo Types.glob Types.v.beautified: Types.v Maps.vo Imp.vo Smallstep.vo Types.vio: Types.v Maps.vio Imp.vio Smallstep.vio -Stlc.vo Stlc.glob Stlc.v.beautified: Stlc.v Maps.vo Smallstep.vo Types.vo -Stlc.vio: Stlc.v Maps.vio Smallstep.vio Types.vio +Stlc.vo Stlc.glob Stlc.v.beautified: Stlc.v Maps.vo Smallstep.vo +Stlc.vio: Stlc.v Maps.vio Smallstep.vio StlcProp.vo StlcProp.glob StlcProp.v.beautified: StlcProp.v Maps.vo Types.vo Stlc.vo Smallstep.vo StlcProp.vio: StlcProp.v Maps.vio Types.vio Stlc.vio Smallstep.vio MoreStlc.vo MoreStlc.glob MoreStlc.v.beautified: MoreStlc.v Maps.vo Types.vo Smallstep.vo Stlc.vo @@ -40,8 +40,8 @@ UseTactics.vo UseTactics.glob UseTactics.v.beautified: UseTactics.v Maps.vo Imp. UseTactics.vio: UseTactics.v Maps.vio Imp.vio Types.vio Smallstep.vio LibTactics.vio Stlc.vio Equiv.vio References.vio Hoare.vio Sub.vio UseAuto.vo UseAuto.glob UseAuto.v.beautified: UseAuto.v Maps.vo Smallstep.vo Stlc.vo LibTactics.vo Imp.vo StlcProp.vo References.vo Sub.vo UseAuto.vio: UseAuto.v Maps.vio Smallstep.vio Stlc.vio LibTactics.vio Imp.vio StlcProp.vio References.vio Sub.vio -PE.vo PE.glob PE.v.beautified: PE.v Maps.vo Imp.vo Smallstep.vo -PE.vio: PE.v Maps.vio Imp.vio Smallstep.vio +PE.vo PE.glob PE.v.beautified: PE.v Maps.vo Smallstep.vo Imp.vo +PE.vio: PE.v Maps.vio Smallstep.vio Imp.vio Postscript.vo Postscript.glob Postscript.v.beautified: Postscript.v Postscript.vio: Postscript.v Bib.vo Bib.glob Bib.v.beautified: Bib.v diff --git a/plf-current/Bib.html b/plf-current/Bib.html index 84269b25..e178cb55 100644 --- a/plf-current/Bib.html +++ b/plf-current/Bib.html @@ -36,7 +36,7 @@

              Bib参考文献

              -

              本卷中出现的引用

              +

              本卷中出现的引用

              @@ -91,6 +91,10 @@

              Bib参考文献

              +
              +
              + +(* Sat Jan 26 15:15:47 UTC 2019 *)
              diff --git a/plf-current/Bib.v b/plf-current/Bib.v index 0c809497..68d614f2 100644 --- a/plf-current/Bib.v +++ b/plf-current/Bib.v @@ -39,3 +39,4 @@ (** $Date$ *) +(* Sat Jan 26 15:15:47 UTC 2019 *) diff --git a/plf-current/BibTest.v b/plf-current/BibTest.v index 25fd4cbc..f6459e11 100644 --- a/plf-current/BibTest.v +++ b/plf-current/BibTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:51 UTC 2019 *) diff --git a/plf-current/Equiv.html b/plf-current/Equiv.html index d2e7f5c6..7be279c3 100644 --- a/plf-current/Equiv.html +++ b/plf-current/Equiv.html @@ -35,16 +35,16 @@

              Equiv程序的等价关系 Set Warnings "-notation-overridden,-parsing".
              -Require Import Coq.Bool.Bool.
              -Require Import Coq.Arith.Arith.
              -Require Import Coq.Init.Nat.
              -Require Import Coq.Arith.PeanoNat. Import Nat.
              -Require Import Coq.Arith.EqNat.
              -Require Import Coq.omega.Omega.
              -Require Import Coq.Lists.List.
              -Require Import Coq.Logic.FunctionalExtensionality.
              -Import ListNotations.
              From PLF Require Import Maps.
              +From Coq Require Import Bool.Bool.
              +From Coq Require Import Arith.Arith.
              +From Coq Require Import Init.Nat.
              +From Coq Require Import Arith.PeanoNat. Import Nat.
              +From Coq Require Import Arith.EqNat.
              +From Coq Require Import omega.Omega.
              +From Coq Require Import Lists.List.
              +From Coq Require Import Logic.FunctionalExtensionality.
              +Import ListNotations.
              From PLF Require Import Imp.

              @@ -109,10 +109,10 @@

              Equiv程序的等价关系 Definition aequiv (a1 a2 : aexp) : Prop :=
              -   (st:state),
              +  (st : state),
                  aeval st a1 = aeval st a2.

              Definition bequiv (b1 b2 : bexp) : Prop :=
              -   (st:state),
              +  (st : state),
                  beval st b1 = beval st b2.

            @@ -121,8 +121,7 @@

            Equiv程序的等价关系
            -Theorem aequiv_example:
            -  aequiv (X - X) 0.
            +Theorem aequiv_example: aequiv (X - X) 0.
            Proof.
            @@ -131,8 +130,7 @@

            Equiv程序的等价关系
            -Theorem bequiv_example:
            -  bequiv (X - X = 0) true.
            +Theorem bequiv_example: bequiv (X - X = 0)%imp true.
            Proof.
            @@ -153,8 +151,8 @@

            Equiv程序的等价关系 Definition cequiv (c1 c2 : com) : Prop :=
            -   (st st' : state),
            -    (c1 / st \\ st') ↔ (c2 / st \\ st').
            +  (st st' : state),
            +    (st =[ c1 ]⇒ st') ↔ (st =[ c2 ]⇒ st').

            @@ -166,15 +164,15 @@

            Equiv程序的等价关系
            -Theorem skip_left: c,
            +Theorem skip_left : c,
              cequiv
            -     (SKIP;; c)
            -     c.
            +    (SKIP;; c)
            +    c.
            Proof.
              (* 课上已完成 *)
              intros c st st'.
              split; intros H.
            -  - (* -> *)
            +  - (* -> *)
                inversion H; subst.
                inversion H2. subst.
                assumption.
            @@ -186,12 +184,12 @@

            Equiv程序的等价关系
            -

            练习:2 星 (skip_right)

            +

            练习:2 星, standard (skip_right)

            请证明在某条指令之后添加 SKIP 后,两程序会等价
            -Theorem skip_right: c,
            +Theorem skip_right : c,
              cequiv
                (c ;; SKIP)
                c.
            @@ -203,20 +201,20 @@

            Equiv程序的等价关系
            - 同样,下面是一个优化 IFB 的简单程序变换: + 同样,下面是一个优化 TEST 的简单程序变换:

            -Theorem IFB_true_simple: c1 c2,
            +Theorem TEST_true_simple : c1 c2,
              cequiv
            -    (IFB BTrue THEN c1 ELSE c2 FI)
            +    (TEST true THEN c1 ELSE c2 FI)
                c1.
            Proof.
              intros c1 c2.
              split; intros H.
            -  - (* -> *)
            +  - (* -> *)
                inversion H; subst. assumption. inversion H5.
              - (* <- *)
                apply E_IfTrue. reflexivity. assumption. Qed.
            @@ -224,8 +222,8 @@

            Equiv程序的等价关系
            -当然,人类程序员是不会写把断言(guard)直接写成 BTrue 的条件分支的。 - 有趣的是当断言等价于真的情况: 定理:若 b 等价于 BTrue,则 IFB b THEN c1 ELSE c2 FI 等价于 c1。 +当然,人类程序员是不会写把断言(guard)直接写成 true 的条件分支的。 + 不过当断言等价于真的情况时就会写出来: 定理:若 b 等价于 BTrue,则 TEST b THEN c1 ELSE c2 FI 等价于 c1
            证明: @@ -233,27 +231,27 @@

            Equiv程序的等价关系

              -
            • () 我们必须证明,对于所有的 stst',若 IFB b - THEN c1 ELSE c2 FI / st \\ st'c1 / st \\ st'。 +
            • () 我们必须证明,对于所有的 stst',若 st =[ + TEST b THEN c1 ELSE c2 FI ]⇒ st'st =[ c1 ]⇒ st'
              - 能够应用于 IFB b THEN c1 ELSE c2 FI / st \\ st' 的证明规则只有两条: + 能够应用于 st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st' 的证明规则只有两条: E_IfTrueE_IfFalse
                -
              • 假设 IFB b THEN c1 ELSE c2 FI / st \\ st' 证明自 E_IfTrue - 这条证明规则。若使用证明规则 E_IfTrue 其必备的前提条件 c1 / st \\ st' +
              • 假设 st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st' 证明自 E_IfTrue + 这条证明规则。若使用证明规则 E_IfTrue 其必备的前提条件 st =[ c1 ]⇒ st' 必为真,而这正好是我们的证明所需要的条件。
              • -
              • 另一方面, 假设 IFB b THEN c1 ELSE c2 FI / st \\ st' 证明自 - E_IfFalse。我们能得知 beval st b = falsec2 / st \\ st'。 +
              • 另一方面, 假设 st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st' 证明自 + E_IfFalse。我们能得知 beval st b = falsest =[ c2 ]⇒ st'
                @@ -269,14 +267,14 @@

                Equiv程序的等价关系

              • -
              • (<-) 我们必须证明,对于所有 stst',若 c1 / st \\ st' +
              • (<-) 我们必须证明,对于所有 stst',若st =[ c1 ]⇒ st'IFB b THEN c1 ELSE c2 FI / st \\ st'
                已知 b 等价于 BTrue,我们知道 beval st b = beval st BTrue = true。 - 结合 c1 / st \\ st' 这条假设,我们能应用 E_IfTrue 来证明出 IFB b THEN - c1 ELSE c2 FI / st \\ st' + 结合 st =[ c1 ]⇒ st' 这条假设,我们能应用 E_IfTrue 来证明 + st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              @@ -287,17 +285,17 @@

              Equiv程序的等价关系
              -Theorem IFB_true: b c1 c2,
              -     bequiv b BTrue
              -     cequiv
              -       (IFB b THEN c1 ELSE c2 FI)
              -       c1.
              +Theorem TEST_true: b c1 c2,
              +  bequiv b BTrue
              +  cequiv
              +    (TEST b THEN c1 ELSE c2 FI)
              +    c1.
              Proof.
                intros b c1 c2 Hb.
                split; intros H.
              -  - (* -> *)
              +  - (* -> *)
                  inversion H; subst.
                  + (* b 求值为 true *)
                    assumption.
              @@ -313,14 +311,14 @@

              Equiv程序的等价关系
              -

              练习:2 星, recommended (IFB_false)

              +

              练习:2 星, standard, recommended (TEST_false)

              -Theorem IFB_false: b c1 c2,
              -  bequiv b BFalse
              +Theorem TEST_false : b c1 c2,
              +  bequiv b BFalse
                cequiv
              -    (IFB b THEN c1 ELSE c2 FI)
              +    (TEST b THEN c1 ELSE c2 FI)
                  c2.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -330,15 +328,15 @@

              Equiv程序的等价关系
              -

              练习:3 星 (swap_if_branches)

              +

              练习:3 星, standard (swap_if_branches)

              证明我们可以通过对断言取反来交换 IF 的两个分支
              -Theorem swap_if_branches: b e1 e2,
              +Theorem swap_if_branches : b e1 e2,
                cequiv
              -    (IFB b THEN e1 ELSE e2 FI)
              -    (IFB BNot b THEN e2 ELSE e1 FI).
              +    (TEST b THEN e1 ELSE e2 FI)
              +    (TEST BNot b THEN e2 ELSE e1 FI).
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -353,7 +351,7 @@

              Equiv程序的等价关系
              -Theorem WHILE_false : b c,
              +Theorem WHILE_false : b c,
                bequiv b BFalse
                cequiv
                  (WHILE b DO c END)
              @@ -362,7 +360,7 @@

              Equiv程序的等价关系 Proof.
                intros b c Hb. split; intros H.
              -  - (* -> *)
              +  - (* -> *)
                  inversion H; subst.
                  + (* E_WhileFalse *)
                    apply E_Skip.
              @@ -390,48 +388,49 @@

              Equiv程序的等价关系

              - 引理:若 b 等价于 BTrue,则无法出现 (WHILE b DO c END) / - st \\ st' 的情况。 + 引理:若 b 等价于 BTrue,则无法出现 + st =[ WHILE b DO c END ]⇒ st' 的情况。
              - 证明:假设 (WHILE b DO c END) / st \\ st'。我们将证明通过对 - (WHILE b DO c END) / st \\ st' 使用归纳法会导出矛盾。 + 证明:假设 st =[ WHILE b DO c END ]⇒ st'。我们将证明通过对 + st =[ WHILE b DO c END ]⇒ st' 使用归纳法会导出矛盾。需要考虑只有 + E_WhileFalseE_WhileTrue 两种情况,其它情况则矛盾。
                -
              • 假设 (WHILE b DO c END) / st \\ st' 使用规则 E_WhileFalse 证明。 +
              • 假设 st =[ WHILE b DO c END ]⇒ st' 使用规则 E_WhileFalse 证明。 那么根据假设得出 beval st b = false。但它与 b 等价于 BTrue 矛盾。
              • -
              • 假设 (WHILE b DO c END) / st \\ st' 使用规则 E_WhileTrue证明。 - 那么我们就给出了一个和 (WHILE b DO c END) / st \\ st' 矛盾的假设, - 它刚好就是我们要证明的那个! - -
                +
              • 假设 st =[ WHILE b DO c END ]⇒ st' 使用规则 E_WhileTrue证明。 + 我们必有: - -
              • -
              • 由于只有以上几条规则可用于证明 (WHILE b DO c END) / st \\ st', - 因此归纳时的其它情况可直接得出矛盾。
              + 1. beval st b = true, + 2. 存在某个 st0 使得 st =[ c ]⇒ st0 且 + st0 =[ WHILE b DO c END ]⇒ st', + 3. 以及我们给出了导致矛盾的归纳假设 st0 =[ WHILE b DO c END ]⇒ st', +
              + + 我们根据 2 和 3 会得到矛盾。

              -Lemma WHILE_true_nonterm : b c st st',
              +Lemma WHILE_true_nonterm : b c st st',
                bequiv b BTrue
              -  ~( (WHILE b DO c END) / st \\ st' ).
              +  ~( st =[ WHILE b DO c END ]⇒ st' ).
              Proof.
                (* 课上已完成 *)
                intros b c st st' Hb.
                intros H.
              -  remember (WHILE b DO c END) as cw eqn:Heqcw.
              +  remember (WHILE b DO c END)%imp as cw eqn:Heqcw.
                induction H;
                (* 大多数证明规则无法应用,我们可通过反演(inversion)来去除它们: *)
                inversion Heqcw; subst; clear Heqcw.
              @@ -445,7 +444,7 @@

              Equiv程序的等价关系
              -

              练习:2 星, optional (WHILE_true_nonterm_informal)

              +

              练习:2 星, standard, optional (WHILE_true_nonterm_informal)

              试解释 WHILE_true_nonterm 的含义。
              @@ -454,12 +453,12 @@

              Equiv程序的等价关系
              -

              练习:2 星, recommended (WHILE_true)

              +

              练习:2 星, standard, recommended (WHILE_true)

              请证明以下定理。提示:你可能需要使用 WHILE_true_nonterm
              -Theorem WHILE_true: b c,
              +Theorem WHILE_true : b c,
                bequiv b true
                cequiv
                  (WHILE b DO c END)
              @@ -477,17 +476,17 @@

              Equiv程序的等价关系
              -Theorem loop_unrolling: b c,
              +Theorem loop_unrolling : b c,
                cequiv
                  (WHILE b DO c END)
              -    (IFB b THEN (c ;; WHILE b DO c END) ELSE SKIP FI).
              +    (TEST b THEN (c ;; WHILE b DO c END) ELSE SKIP FI).
              Proof.
                (* 课上已完成 *)
                intros b c st st'.
                split; intros Hce.
              -  - (* -> *)
              +  - (* -> *)
                  inversion Hce; subst.
                  + (* 不执行循环 *)
                    apply E_IfFalse. assumption. apply E_Skip.
              @@ -506,11 +505,11 @@

              Equiv程序的等价关系
              -

              练习:2 星, optional (seq_assoc)

              +

              练习:2 星, standard, optional (seq_assoc)

              -Theorem seq_assoc : c1 c2 c3,
              +Theorem seq_assoc : c1 c2 c3,
                cequiv ((c1;;c2);;c3) (c1;;(c2;;c3)).
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -520,38 +519,37 @@

              Equiv程序的等价关系
              - 证明涉及赋值的程序属性经常会用到函数的外延公理。 + 证明涉及赋值的程序的属性经常会用到这一事实,即程序状态会根据其外延性 + (如 x !-> m x ; mm 是相等的映射)来对待。

              -Theorem identity_assignment : (X:string),
              +Theorem identity_assignment : x,
                cequiv
              -    (X ::= X)
              +    (x ::= x)
                  SKIP.
              Proof.
              -   intros. split; intro H.
              -     - (* -> *)
              -       inversion H; subst. simpl.
              -       replace (st & { X --> st X }) with st.
              -       + constructor.
              -       + apply functional_extensionality. intro.
              -         rewrite t_update_same; reflexivity.
              -     - (* <- *)
              -       replace st' with (st' & { X --> aeval st' X }).
              -       + inversion H. subst. apply E_Ass. reflexivity.
              -       + apply functional_extensionality. intro.
              -         rewrite t_update_same. reflexivity.
              +  intros.
              +  split; intro H; inversion H; subst.
              +  - (* -> *)
              +    rewrite t_update_same.
              +    apply E_Skip.
              +  - (* <- *)
              +    assert (Hx : st' =[ x ::= x ]⇒ (x !-> st' x ; st')).
              +    { apply E_Ass. reflexivity. }
              +    rewrite t_update_same in Hx.
              +    apply Hx.
              Qed.
              -

              练习:2 星, recommended (assign_aequiv)

              +

              练习:2 星, standard, recommended (assign_aequiv)

              -Theorem assign_aequiv : (X:string) e,
              -  aequiv X e
              -  cequiv SKIP (X ::= e).
              +Theorem assign_aequiv : (x : string) e,
              +  aequiv x e
              +  cequiv SKIP (x ::= e).
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -560,7 +558,7 @@

              Equiv程序的等价关系
              -

              练习:2 星 (equiv_classes)

              +

              练习:2 星, standard (equiv_classes)

              @@ -581,43 +579,43 @@

              Equiv程序的等价关系 Definition prog_a : com :=
              -  WHILE ! (X ≤ 0) DO
              +  (WHILE ~(X ≤ 0) DO
                  X ::= X + 1
              -  END.

              +  END)%imp.

              Definition prog_b : com :=
              -  IFB X = 0 THEN
              +  (TEST X = 0 THEN
                  X ::= X + 1;;
                  Y ::= 1
                ELSE
                  Y ::= 0
                FI;;
                X ::= X - Y;;
              -  Y ::= 0.

              +  Y ::= 0)%imp.

              Definition prog_c : com :=
              -  SKIP.

              +  SKIP%imp.

              Definition prog_d : com :=
              -  WHILE ! (X = 0) DO
              +  (WHILE ~(X = 0) DO
                  X ::= (X * Y) + 1
              -  END.

              +  END)%imp.

              Definition prog_e : com :=
              -  Y ::= 0.

              +  (Y ::= 0)%imp.

              Definition prog_f : com :=
              -  Y ::= X + 1;;
              -  WHILE ! (X = Y) DO
              +  (Y ::= X + 1;;
              +  WHILE ~(X = Y) DO
                  Y ::= X + 1
              -  END.

              +  END)%imp.

              Definition prog_g : com :=
              -  WHILE true DO
              +  (WHILE true DO
                  SKIP
              -  END.

              +  END)%imp.

              Definition prog_h : com :=
              -  WHILE ! (X = X) DO
              +  (WHILE ~(X = X) DO
                  X ::= X + 1
              -  END.

              +  END)%imp.

              Definition prog_i : com :=
              -  WHILE ! (X = Y) DO
              +  (WHILE ~(X = Y) DO
                  X ::= Y + 1
              -  END.

              +  END)%imp.

              Definition equiv_classes : list (list com)
                (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              (* 请勿修改下面这一行: *)
              @@ -645,7 +643,7 @@

              Equiv程序的等价关系
              -Lemma refl_aequiv : (a : aexp), aequiv a a.
              +Lemma refl_aequiv : (a : aexp), aequiv a a.
              Proof.
              @@ -653,7 +651,7 @@

              Equiv程序的等价关系
              -Lemma sym_aequiv : (a1 a2 : aexp),
              +Lemma sym_aequiv : (a1 a2 : aexp),
                aequiv a1 a2aequiv a2 a1.
              @@ -662,7 +660,7 @@

              Equiv程序的等价关系
              -Lemma trans_aequiv : (a1 a2 a3 : aexp),
              +Lemma trans_aequiv : (a1 a2 a3 : aexp),
                aequiv a1 a2aequiv a2 a3aequiv a1 a3.
              @@ -672,7 +670,7 @@

              Equiv程序的等价关系
              -Lemma refl_bequiv : (b : bexp), bequiv b b.
              +Lemma refl_bequiv : (b : bexp), bequiv b b.
              Proof.
              @@ -680,7 +678,7 @@

              Equiv程序的等价关系
              -Lemma sym_bequiv : (b1 b2 : bexp),
              +Lemma sym_bequiv : (b1 b2 : bexp),
                bequiv b1 b2bequiv b2 b1.
              @@ -689,7 +687,7 @@

              Equiv程序的等价关系
              -Lemma trans_bequiv : (b1 b2 b3 : bexp),
              +Lemma trans_bequiv : (b1 b2 b3 : bexp),
                bequiv b1 b2bequiv b2 b3bequiv b1 b3.
              @@ -699,7 +697,7 @@

              Equiv程序的等价关系
              -Lemma refl_cequiv : (c : com), cequiv c c.
              +Lemma refl_cequiv : (c : com), cequiv c c.
              Proof.
              @@ -707,20 +705,20 @@

              Equiv程序的等价关系
              -Lemma sym_cequiv : (c1 c2 : com),
              +Lemma sym_cequiv : (c1 c2 : com),
                cequiv c1 c2cequiv c2 c1.
              Proof.
                unfold cequiv. intros c1 c2 H st st'.
              -  assert (c1 / st \\ st'c2 / st \\ st') as H'.
              +  assert (st =[ c1 ]⇒ st'st =[ c2 ]⇒ st') as H'.
                { (* Proof of assertion *) apply H. }
                apply iff_sym. assumption.
              Qed.

              -Lemma iff_trans : (P1 P2 P3 : Prop),
              +Lemma iff_trans : (P1 P2 P3 : Prop),
                (P1P2) → (P2P3) → (P1P3).
              @@ -733,13 +731,13 @@

              Equiv程序的等价关系
              -Lemma trans_cequiv : (c1 c2 c3 : com),
              +Lemma trans_cequiv : (c1 c2 c3 : com),
                cequiv c1 c2cequiv c2 c3cequiv 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.
              +  apply iff_trans with (st =[ c2 ]⇒ st'). apply H12. apply H23. Qed.

              @@ -761,7 +759,7 @@

              Equiv程序的等价关系
              - cequiv (i ::= a1) (i ::= a1') + cequiv (x ::= a1) (x ::= a1')
              @@ -796,15 +794,15 @@

              Equiv程序的等价关系
              -Theorem CAss_congruence : i a1 a1',
              +Theorem CAss_congruence : x a1 a1',
                aequiv a1 a1'
              -  cequiv (CAss i a1) (CAss i a1').
              +  cequiv (CAss x a1) (CAss x a1').
              Proof.
              -  intros i a1 a2 Heqv st st'.
              +  intros x a1 a2 Heqv st st'.
                split; intros Hceval.
              -  - (* -> *)
              +  - (* -> *)
                  inversion Hceval. subst. apply E_Ass.
                  rewrite Heqv. reflexivity.
                - (* <- *)
              @@ -824,14 +822,14 @@

              Equiv程序的等价关系

              证明: 假设 b1 等价于 b1'c1 等价于 c1'。我们必须证明, - 对于每个 stst'WHILE b1 DO c1 END / st \\ st' 当且仅当 - WHILE b1' DO c1' END / st \\ st'。我们把两个方向分开考虑。 + 对于每个 stst'st =[ WHILE b1 DO c1 END ]⇒ st' 当且仅当 + st =[ WHILE b1' DO c1' END ]⇒ st'。我们把两个方向分开考虑。
                -
              • () 我们通过对 WHILE b1 DO c1 END / st \\ st' 使用归纳法证明 - WHILE b1 DO c1 END / st \\ st' 蕴含 WHILE b1' DO c1' END / st \\ st'。 +
              • () 我们通过对 st =[ WHILE b1 DO c1 END ]⇒ st' 使用归纳法证明 + st =[ WHILE b1 DO c1 END ]⇒ st' 蕴含 st =[ WHILE b1' DO c1' END ]⇒ st'。 只有推导的最后所使用的规则为 E_WhileFalseE_WhileTrue 时才需要进行特别讨论。 @@ -841,21 +839,21 @@

                Equiv程序的等价关系 E_WhileFalse:此时我们拥有假设的必备条件 beval st b1 = falsest = st'。但是,由于 b1b1' 等价,我们有 beval st b1' = false,然后应用 E-WhileFalse 得出我们需要的 - WHILE b1' DO c1' END / st \\ st'。 + st =[ WHILE b1' DO c1' END ]⇒ st'

              • E_WhileTrue:此时我们拥有假设的必备条件 beval st b1 = true,以及 - 对于某些状态 st'0c1 / st \\ st'0WHILE b1 DO c1 END / st'0 - \\ st',还有归纳假设 WHILE b1' DO c1' END / st'0 \\ st'。 + 对于某些状态 st'0st =[ c1 ]⇒ st'0st'0 =[ WHILE b1 DO c1 + END ]⇒ st',还有归纳假设 st'0 =[ WHILE b1' DO c1' END ]⇒ st'
                - 由于 c1c1' 等价,我们有 c1' / st \\ st'0; + 由于 c1c1' 等价,我们有 st =[ c1' ]⇒ st'0; 由于 b1b1' 等价,我们有 beval st b1' = true。现在应用 - E-WhileTrue,得出我们所需的 WHILE b1' DO c1' END / st \\ st'。 + E-WhileTrue,得出我们所需的 st =[ WHILE b1' DO c1' END ]⇒ st'
                @@ -871,7 +869,7 @@

                Equiv程序的等价关系
                -Theorem CWhile_congruence : b1 b1' c1 c1',
                +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.
                @@ -879,8 +877,8 @@

                Equiv程序的等价关系unfold bequiv,cequiv.
                  intros b1 b1' c1 c1' Hb1e Hc1e st st'.
                  split; intros Hce.
                -  - (* -> *)
                -    remember (WHILE b1 DO c1 END) as cwhile
                +  - (* -> *)
                +    remember (WHILE b1 DO c1 END)%imp as cwhile
                      eqn:Heqcwhile.
                    induction Hce; inversion Heqcwhile; subst.
                    + (* E_WhileFalse *)
                @@ -893,7 +891,7 @@

                Equiv程序的等价关系(* 执行之后的循环 *)
                        apply IHHce2. reflexivity.
                  - (* <- *)
                -    remember (WHILE b1' DO c1' END) as c'while
                +    remember (WHILE b1' DO c1' END)%imp as c'while
                      eqn:Heqc'while.
                    induction Hce; inversion Heqc'while; subst.
                    + (* E_WhileFalse *)
                @@ -908,29 +906,33 @@

                Equiv程序的等价关系
                -

                练习:3 星, optional (CSeq_congruence)

                +

                练习:3 星, standard, optional (CSeq_congruence)

                -Theorem CSeq_congruence : c1 c1' c2 c2',
                +Theorem CSeq_congruence : c1 c1' c2 c2',
                  cequiv c1 c1'cequiv c2 c2'
                  cequiv (c1;;c2) (c1';;c2').
                +
                +
                Proof.
                  (* 请在此处解答 *) Admitted.
                -
                -
                -

                练习:3 星 (CIf_congruence)

                +
                +
                + +
                +

                练习:3 星, standard (CIf_congruence)

                -Theorem CIf_congruence : b b' c1 c1' c2 c2',
                +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).
                +  cequiv (TEST b THEN c1 ELSE c2 FI)
                +         (TEST b' THEN c1' ELSE c2' FI).
                Proof.
                  (* 请在此处解答 *) Admitted.
                @@ -947,7 +949,7 @@

                Equiv程序的等价关系cequiv
                    (* 程序 1: *)
                    (X ::= 0;;
                -     IFB X = 0
                +     TEST X = 0
                     THEN
                       Y ::= 0
                     ELSE
                @@ -955,7 +957,7 @@

                Equiv程序的等价关系FI)
                    (* 程序 1: *)
                    (X ::= 0;;
                -     IFB X = 0
                +     TEST X = 0
                     THEN
                       Y ::= X - X (* <--- 这里不同 *)
                     ELSE
                @@ -963,12 +965,12 @@

                Equiv程序的等价关系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.
                +  - apply refl_cequiv.
                +  - apply CIf_congruence.
                +    + apply refl_bequiv.
                +    + apply CAss_congruence. unfold aequiv. simpl.
                +      * symmetry. apply minus_diag.
                +    + apply refl_cequiv.
                Qed.

                @@ -999,13 +1001,13 @@

                Equiv程序的等价关系 Definition atrans_sound (atrans : aexpaexp) : Prop :=
                -   (a : aexp),
                +  (a : aexp),
                    aequiv a (atrans a).

                Definition btrans_sound (btrans : bexpbexp) : Prop :=
                -   (b : bexp),
                +  (b : bexp),
                    bequiv b (btrans b).

                Definition ctrans_sound (ctrans : comcom) : Prop :=
                -   (c : com),
                +  (c : com),
                    cequiv c (ctrans c).

                @@ -1025,33 +1027,34 @@

                Equiv程序的等价关系Fixpoint fold_constants_aexp (a : aexp) : aexp :=
                  match a with
                  | ANum nANum n
                -  | AId iAId i
                +  | AId xAId x
                  | APlus a1 a2
                -    match (fold_constants_aexp a1, fold_constants_aexp 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)
                +    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)
                +    match (fold_constants_aexp a1,
                +           fold_constants_aexp a2)
                    with
                    | (ANum n1, ANum n2) ⇒ ANum (n1 * n2)
                    | (a1', a2') ⇒ AMult a1' a2'
                    end
                  end.

                -(* 解析下面的示例时要用 *)
                -Local Open Scope aexp_scope.
                -Local Open Scope bexp_scope.

                Example fold_aexp_ex1 :
                -    fold_constants_aexp ((1 + 2) * X) = (3 * X).
                -
                -
                +    fold_constants_aexp ((1 + 2) * X)
                +  = (3 * X)%imp.
                +
                +
                Proof. reflexivity. Qed.
                @@ -1064,9 +1067,9 @@

                Equiv程序的等价关系 Example fold_aexp_ex2 :
                -  fold_constants_aexp (X - ((0 * 6) + Y)) = (X - (0 + Y)).
                -
                -
                +  fold_constants_aexp (X - ((0 * 6) + Y))%imp = (X - (0 + Y))%imp.
                +
                +
                Proof. reflexivity. Qed.
                @@ -1082,14 +1085,16 @@

                Equiv程序的等价关系BTrue ⇒ BTrue
                  | BFalseBFalse
                  | BEq a1 a2
                -      match (fold_constants_aexp a1, fold_constants_aexp a2) with
                +      match (fold_constants_aexp a1,
                +             fold_constants_aexp a2) with
                      | (ANum n1, ANum n2) ⇒
                          if 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
                +      match (fold_constants_aexp a1,
                +             fold_constants_aexp a2) with
                      | (ANum n1, ANum n2) ⇒
                          if n1 <=? n2 then BTrue else BFalse
                      | (a1', a2') ⇒
                @@ -1102,7 +1107,8 @@

                Equiv程序的等价关系b1' ⇒ BNot b1'
                      end
                  | BAnd b1 b2
                -      match (fold_constants_bexp b1, fold_constants_bexp b2) with
                +      match (fold_constants_bexp b1,
                +             fold_constants_bexp b2) with
                      | (BTrue, BTrue) ⇒ BTrue
                      | (BTrue, BFalse) ⇒ BFalse
                      | (BFalse, BTrue) ⇒ BFalse
                @@ -1111,18 +1117,19 @@

                Equiv程序的等价关系end
                  end.

                Example fold_bexp_ex1 :
                -  fold_constants_bexp (true && ! (false && true)) = true.
                -
                -
                +  fold_constants_bexp (true && ~(false && true))%imp
                +  = true.
                +
                +
                Proof. reflexivity. Qed.

                Example fold_bexp_ex2 :
                -  fold_constants_bexp ((X = Y) && (0 = (2 - (1 + 1)))) =
                -  ((X = Y) && true).
                -
                -
                +  fold_constants_bexp ((X = Y) && (0 = (2 - (1 + 1))))%imp
                +  = ((X = Y) && true)%imp.
                +
                +
                Proof. reflexivity. Qed.
                @@ -1132,19 +1139,20 @@

                Equiv程序的等价关系
                +Open Scope imp.
                Fixpoint fold_constants_com (c : com) : com :=
                  match c with
                  | SKIP
                      SKIP
                -  | i ::= a
                -      CAss i (fold_constants_aexp a)
                +  | x ::= a
                +      x ::= (fold_constants_aexp a)
                  | c1 ;; c2
                      (fold_constants_com c1) ;; (fold_constants_com c2)
                -  | IFB b THEN c1 ELSE c2 FI
                +  | TEST b THEN c1 ELSE c2 FI
                      match fold_constants_bexp b with
                -      | BTruefold_constants_com c1
                +      | BTruefold_constants_com c1
                      | BFalsefold_constants_com c2
                -      | b'IFB b' THEN fold_constants_com c1
                +      | b'TEST b' THEN fold_constants_com c1
                                     ELSE fold_constants_com c2 FI
                      end
                  | WHILE b DO c END
                @@ -1153,40 +1161,31 @@

                Equiv程序的等价关系BFalse ⇒ SKIP
                      | b'WHILE b' DO (fold_constants_com c) END
                      end
                -  end.

                +  end.
                +Close Scope imp.

                Example fold_com_ex1 :
                  fold_constants_com
                    (* 原程序: *)
                    (X ::= 4 + 5;;
                     Y ::= X - 3;;
                -     IFB (X - Y) = (2 + 4) THEN
                -       SKIP
                -     ELSE
                -       Y ::= 0
                -     FI;;
                -     IFB 0 ≤ (4 - (2 + 1))
                -     THEN
                -       Y ::= 0
                -     ELSE
                -       SKIP
                -     FI;;
                +     TEST (X - Y) = (2 + 4) THEN SKIP
                +     ELSE Y ::= 0 FI;;
                +     TEST 0 ≤ (4 - (2 + 1)) THEN Y ::= 0
                +     ELSE SKIP FI;;
                     WHILE Y = 0 DO
                       X ::= X + 1
                -     END)
                +     END)%imp
                  = (* 常量折叠后: *)
                    (X ::= 9;;
                     Y ::= X - 3;;
                -     IFB (X - Y) = 6 THEN
                -       SKIP
                -     ELSE
                -       Y ::= 0
                -     FI;;
                +     TEST (X - Y) = 6 THEN SKIP
                +     ELSE Y ::= 0 FI;;
                     Y ::= 0;;
                     WHILE Y = 0 DO
                       X ::= X + 1
                -     END).
                -
                -
                +     END)%imp.
                +
                +
                Proof. reflexivity. Qed.
                @@ -1205,8 +1204,8 @@

                Equiv程序的等价关系Theorem fold_constants_aexp_sound :
                  atrans_sound fold_constants_aexp.
                -
                -
                +
                +
                Proof.
                  unfold atrans_sound. intros a. unfold aequiv. intros st.
                  induction a; simpl;
                @@ -1224,7 +1223,7 @@

                Equiv程序的等价关系
                -

                练习:3 星, optional (fold_bexp_Eq_informal)

                +

                练习:3 星, standard, optional (fold_bexp_Eq_informal)

                下面是布尔表达式常量折叠中 BEq 情况的可靠性的证明。 请认真读完它再和之后的形式化证明作比较,然后补充完 BLe 情况的形式化证明 (尽量不看之前 BEq 情况的证明)。 @@ -1236,7 +1235,7 @@

                Equiv程序的等价关系

                证明:我们必须证明对于所有的布尔表达式 bb 都等价于 - fold_constants_bexp。我们对 b 使用归纳法。这里只给出了 b + fold_constants_bexp b。我们对 b 使用归纳法。这里只给出了 b 形如 BEq a1 a2 的情况。
                @@ -1378,8 +1377,7 @@

                Equiv程序的等价关系

                - 本例证毕。 - + 本例证毕。

              @@ -1432,7 +1430,7 @@

              Equiv程序的等价关系
              -

              练习:3 星 (fold_constants_com_sound)

              +

              练习:3 星, standard (fold_constants_com_sound)

              完成以下证明的 WHILE 情况。
              @@ -1446,7 +1444,7 @@

              Equiv程序的等价关系(* ::= *) apply CAss_congruence.
                            apply fold_constants_aexp_sound.
                - (* ;; *) apply CSeq_congruence; assumption.
              -  - (* IFB *)
              +  - (* TEST *)
                  assert (bequiv b (fold_constants_bexp b)). {
                    apply fold_constants_bexp_sound. }
                  destruct (fold_constants_bexp b) eqn:Heqb;
              @@ -1455,10 +1453,10 @@

              Equiv程序的等价关系fold_constants_bexp_sound 来得出证明。) *)
                  + (* b 总为真 *)
                    apply trans_cequiv with c1; try assumption.
              -      apply IFB_true; assumption.
              +      apply TEST_true; assumption.
                  + (* b 总为假 *)
                    apply trans_cequiv with c2; try assumption.
              -      apply IFB_false; assumption.
              +      apply TEST_false; assumption.
                - (* WHILE *)
                  (* 请在此处解答 *) Admitted.

              @@ -1563,29 +1561,29 @@

              Equiv程序的等价关系 - 以下形式化的定义描述了如何在算术表达式中, - 将某个变量的所有引用都替换成另一个表达式: + 以下形式化的定义描述了如何在算术表达式 a 中, + 将某个变量 x 的所有引用都替换成另一个表达式 u
              -Fixpoint subst_aexp (i : string) (u : aexp) (a : aexp) : aexp :=
              +Fixpoint subst_aexp (x : string) (u : aexp) (a : aexp) : aexp :=
                match a with
                | ANum n
                    ANum n
              -  | AId i'
              -      if eqb_string i i' then u else AId i'
              +  | AId x'
              +      if eqb_string x x' then u else AId x'
                | APlus a1 a2
              -      APlus (subst_aexp i u a1) (subst_aexp i u a2)
              +      APlus (subst_aexp x u a1) (subst_aexp x u a2)
                | AMinus a1 a2
              -      AMinus (subst_aexp i u a1) (subst_aexp i u a2)
              +      AMinus (subst_aexp x u a1) (subst_aexp x u a2)
                | AMult a1 a2
              -      AMult (subst_aexp i u a1) (subst_aexp i u a2)
              +      AMult (subst_aexp x u a1) (subst_aexp x u a2)
                end.

              Example subst_aexp_ex :
              -  subst_aexp X (42 + 53) (Y + X)
              -  = (Y + (42 + 53)).
              -
              -
              +  subst_aexp X (42 + 53) (Y + X)%imp
              +  = (Y + (42 + 53))%imp.
              +
              +
              Proof. reflexivity. Qed.
              @@ -1596,31 +1594,31 @@

              Equiv程序的等价关系
              -Definition subst_equiv_property := i1 i2 a1 a2,
              -  cequiv (i1 ::= a1;; i2 ::= a2)
              -         (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2).
              +Definition subst_equiv_property := x1 x2 a1 a2,
              +  cequiv (x1 ::= a1;; x2 ::= a2)
              +         (x1 ::= a1;; x2 ::= subst_aexp x1 a1 a2).
              遗憾的是, 这个性质并不总是成立 — 即,它并不是对所有的 - i1i2a1a2 都成立。 + x1x2a1a2 都成立。
              -      cequiv (i1 ::= a1;; i2 ::= a2)
              -             (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). +      cequiv (x1 ::= a1;; x2 ::= a2)
              +             (x1 ::= a1;; x2 ::= subst_aexp x1 a1 a2).
              - 我们使用反证法来证明这一点。假设对于所有的 i1i2a1 + 我们使用反证法来证明这一点。假设对于所有的 x1x2a1a2,我们有
              -      cequiv (i1 ::= a1;; i2 ::= a2)
              -             (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). +      cequiv (x1 ::= a1;; x2 ::= a2)
              +             (x1 ::= a1;; x2 ::= subst_aexp x1 a1 a2).
              @@ -1629,7 +1627,7 @@

              Equiv程序的等价关系

              -       X ::= X + 1;; Y ::= X +      X ::= X + 1;; Y ::= X
              @@ -1638,12 +1636,11 @@

              Equiv程序的等价关系

              -       (X ::= X + 1;; Y ::= X)
              -       / { --> 0 } \\ st1, +      empty_st =[ X ::= X + 1;; Y ::= X ]⇒ st1,
              - 其中 st1 = { X --> 1; Y --> 1 }。 + 其中 st1 = (Y !-> 1 ; X !-> 1).
              @@ -1664,8 +1661,7 @@

              Equiv程序的等价关系
              -      (X ::= X + 1;; Y ::= X + 1
              -      / { --> 0 } \\ st1. +      empty_st =[ X ::= X + 1;; Y ::= X + 1 ]⇒ st1.
              @@ -1674,77 +1670,76 @@

              Equiv程序的等价关系
              -      (X ::= X + 1;; Y ::= X + 1)
              -      / { --> 0 } \\ st2, +      empty_st =[ X ::= X + 1;; Y ::= X + 1 ]⇒ st2,
              - 其中 st2 = { X --> 1; Y --> 2 }。但由于 ceval 是确定性的,而 - st1 st2 ,这就造成了矛盾! + 其中 st2 = (Y !-> 2 ; X !-> 1)。但由于 ceval 是确定性的,而 + st1 st2 ,这就造成了矛盾!
              Theorem subst_inequiv :
              -  ¬ subst_equiv_property.
              -
              -
              +  ¬subst_equiv_property.
              +
              +
              Proof.
                unfold subst_equiv_property.
                intros Contra.

                (* 这里有个反例:假设 subst_equiv_property
                   成立能够让我们证明以下两个程序等价... *)

                remember (X ::= X + 1;;
              -            Y ::= X)
              +            Y ::= X)%imp
                    as c1.
                remember (X ::= X + 1;;
              -            Y ::= X + 1)
              +            Y ::= X + 1)%imp
                    as c2.
                assert (cequiv c1 c2) by (subst; apply Contra).

              -  (* ...让我们证明 c2 能够在两个不同的状态下停机:
              -        st1 = {X --> 1; Y --> 1}
              -        st2 = {X --> 1; Y --> 2}. *)

              -  remember {X --> 1 ; Y --> 1} as st1.
              -  remember {X --> 1 ; Y --> 2} as st2.
              -  assert (H1: c1 / { --> 0 } \\ st1);
              -  assert (H2: c2 / { --> 0 } \\ st2);
              +  (* ...我们来证明 c2 能够在两个不同的状态下停机:
              +        st1 = (Y !-> 1 ; X !-> 1)
              +        st2 = (Y !-> 2 ; X !-> 1). *)

              +  remember (Y !-> 1 ; X !-> 1) as st1.
              +  remember (Y !-> 2 ; X !-> 1) as st2.
              +  assert (H1 : empty_st =[ c1 ]⇒ st1);
              +  assert (H2 : empty_st =[ c2 ]⇒ st2);
                try (subst;
              -       apply E_Seq with (st' := {X --> 1});
              +       apply E_Seq with (st' := (X !-> 1));
                     apply E_Ass; reflexivity).
                apply H in H1.

                (* 最后,因为程序求值的确定性而产生矛盾。 *)
              -  assert (Hcontra: st1 = st2)
              -    by (apply (ceval_deterministic c2 { --> 0 }); assumption).
              -  assert (Hcontra': st1 Y = st2 Y)
              +  assert (Hcontra : st1 = st2)
              +    by (apply (ceval_deterministic c2 empty_st); assumption).
              +  assert (Hcontra' : st1 Y = st2 Y)
                  by (rewrite Hcontra; reflexivity).
                subst. inversion Hcontra'. Qed.
              -

              练习:4 星, optional (better_subst_equiv)

              +

              练习:4 星, standard, optional (better_subst_equiv)

              之前我们思考的等价关系也不全是妄言 — 只要再增加一个条件, 即变量 X 不在第一个赋值语句的右边出现,它就是正确的了。
              -Inductive var_not_used_in_aexp (X:string) : aexpProp :=
              -  | VNUNum: n, var_not_used_in_aexp X (ANum n)
              -  | VNUId: Y, XYvar_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 (st & { i --> ni }) a = aeval st a.
              +Inductive var_not_used_in_aexp (x : string) : aexpProp :=
              +  | VNUNum : n, var_not_used_in_aexp x (ANum n)
              +  | VNUId : y, xyvar_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 : x st a ni,
              +  var_not_used_in_aexp x a
              +  aeval (x !-> ni ; st) a = aeval st a.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -1761,13 +1756,13 @@

              Equiv程序的等价关系
              -

              练习:3 星 (inequiv_exercise)

              +

              练习:3 星, standard (inequiv_exercise)

              证明无限循环不等价于 SKIP
              Theorem inequiv_exercise:
              -  ¬ cequiv (WHILE true DO SKIP END) SKIP.
              +  ¬cequiv (WHILE true DO SKIP END) SKIP.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -1841,58 +1836,61 @@

              Equiv程序的等价关系CSeq : comcomcom
                | CIf : bexpcomcomcom
                | CWhile : bexpcomcom
              -  | CHavoc : stringcom. (* <---- 新增的 *)

              +  | CHavoc : stringcom. (* <--- 新增 *)

              Notation "'SKIP'" :=
              -  CSkip.
              +  CSkip : imp_scope.
              Notation "X '::=' a" :=
              -  (CAss X a) (at level 60).
              +  (CAss X a) (at level 60) : imp_scope.
              Notation "c1 ;; c2" :=
              -  (CSeq c1 c2) (at level 80, right associativity).
              +  (CSeq c1 c2) (at level 80, right associativity) : imp_scope.
              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).
              +  (CWhile b c) (at level 80, right associativity) : imp_scope.
              +Notation "'TEST' e1 'THEN' e2 'ELSE' e3 'FI'" :=
              +  (CIf e1 e2 e3) (at level 80, right associativity) : imp_scope.
              +Notation "'HAVOC' l" :=
              +  (CHavoc l) (at level 60) : imp_scope.
              -

              练习:2 星 (himp_ceval)

              +

              练习:2 星, standard (himp_ceval)

              现在,我们必须扩展操作语义。前面我们已经提过了 ceval 关系的模版, 指定了大步语义。为了形式化 HAVOC 指令的行为,我们还需要在 ceval 的定义中添加哪些规则?
              -Reserved Notation "c1 '/' st '\\' st'"
              -                  (at level 40, st at level 39).

              +Reserved Notation "st '=[' c ']⇒' st'" (at level 40).

              +Open Scope imp_scope.
              Inductive ceval : comstatestateProp :=
              -  | E_Skip : st : state, SKIP / st \\ st
              -  | E_Ass : (st : state) (a1 : aexp) (n : nat) (X : string),
              +  | E_Skip : st,
              +      st =[ SKIP ]⇒ st
              +  | E_Ass : st a1 n x,
                    aeval st a1 = n
              -      (X ::= a1) / st \\ 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_WhileFalse : (b1 : bexp) (st : state) (c1 : com),
              -      beval st b1 = false
              -      (WHILE b1 DO c1 END) / st \\ st
              -  | E_WhileTrue : (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''
              +      st =[ x ::= a1 ]⇒ (x !-> n ; st)
              +  | E_Seq : c1 c2 st st' st'',
              +      st =[ c1 ]⇒ st'
              +      st' =[ c2 ]⇒ st''
              +      st =[ c1 ;; c2 ]⇒ st''
              +  | E_IfTrue : st st' b c1 c2,
              +      beval st b = true
              +      st =[ c1 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_IfFalse : st st' b c1 c2,
              +      beval st b = false
              +      st =[ c2 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_WhileFalse : b st c,
              +      beval st b = false
              +      st =[ WHILE b DO c END ]⇒ st
              +  | E_WhileTrue : st st' st'' b c,
              +      beval st b = true
              +      st =[ c ]⇒ st'
              +      st' =[ WHILE b DO c END ]⇒ st''
              +      st =[ WHILE b DO c END ]⇒ st''
              (* 请在此处解答 *)

              -  where "c1 '/' st '\\' st'" := (ceval c1 st st').
              +  where "st =[ c ]⇒ st'" := (ceval c st st').
              +Close Scope imp_scope.
              @@ -1900,11 +1898,11 @@

              Equiv程序的等价关系
              -Example havoc_example1 : (HAVOC X) / { --> 0 } \\ { X --> 0 }.
              +Example havoc_example1 : empty_st =[ (HAVOC X)%imp ]⇒ (X !-> 0).
              Proof.
              (* 请在此处解答 *) Admitted.

              Example havoc_example2 :
              -  (SKIP;; HAVOC Z) / { --> 0 } \\ { Z --> 42 }.
              +  empty_st =[ (SKIP;; HAVOC Z)%imp ]⇒ (Z !-> 42).
              Proof.
              (* 请在此处解答 *) Admitted.

              (* 请勿修改下面这一行: *)
              @@ -1919,23 +1917,23 @@

              Equiv程序的等价关系
              -Definition cequiv (c1 c2 : com) : Prop := st st' : state,
              -  c1 / st \\ st'c2 / st \\ st'.
              +Definition cequiv (c1 c2 : com) : Prop := st st' : state,
              +  st =[ c1 ]⇒ st'st =[ c2 ]⇒ st'.
              我们应用此定义来证明一些非确定性程序是否等价。
              -

              练习:3 星 (havoc_swap)

              +

              练习:3 星, standard (havoc_swap)

              以下两个程序是否等价?
              Definition pXY :=
              -  HAVOC X;; HAVOC Y.

              +  (HAVOC X;; HAVOC Y)%imp.

              Definition pYX :=
              -  HAVOC Y;; HAVOC X.
              +  (HAVOC Y;; HAVOC X)%imp.
              @@ -1952,15 +1950,15 @@

              Equiv程序的等价关系
              -

              练习:4 星, optional (havoc_copy)

              +

              练习:4 星, standard, optional (havoc_copy)

              以下两个程序是否等价?
              Definition ptwice :=
              -  HAVOC X;; HAVOC Y.

              +  (HAVOC X;; HAVOC Y)%imp.

              Definition pcopy :=
              -  HAVOC X;; Y ::= X.
              +  (HAVOC X;; Y ::= X)%imp.
              @@ -1991,14 +1989,14 @@

              Equiv程序的等价关系 Definition p1 : com :=
              -  WHILE ! (X = 0) DO
              +  (WHILE ¬(X = 0) DO
                  HAVOC Y;;
                  X ::= X + 1
              -  END.

              +  END)%imp.

              Definition p2 : com :=
              -  WHILE ! (X = 0) DO
              +  (WHILE ¬(X = 0) DO
                  SKIP
              -  END.
              +  END)%imp.

              @@ -2007,11 +2005,11 @@

              Equiv程序的等价关系
              -Lemma p1_may_diverge : st st', st X ≠ 0 →
              -  ¬ p1 / st \\ st'.
              +Lemma p1_may_diverge : st st', st X ≠ 0 →
              +  ¬st =[ p1 ]⇒ st'.
              Proof. (* 请在此处解答 *) Admitted.

              -Lemma p2_may_diverge : st st', st X ≠ 0 →
              -  ¬ p2 / st \\ st'.
              +Lemma p2_may_diverge : st st', st X ≠ 0 →
              +  ¬st =[ p2 ]⇒ st'.
              Proof.
              (* 请在此处解答 *) Admitted.
              @@ -2040,15 +2038,15 @@

              Equiv程序的等价关系 Definition p3 : com :=
              -  Z ::= 1;;
              -  WHILE ! (X = 0) DO
              +  (Z ::= 1;;
              +  WHILE ~(X = 0) DO
                  HAVOC X;;
                  HAVOC Z
              -  END.

              +  END)%imp.

              Definition p4 : com :=
              -  X ::= 0;;
              -  Z ::= 1.

              -Theorem p3_p4_inequiv : ¬ cequiv p3 p4.
              +  (X ::= 0;;
              +  Z ::= 1)%imp.

              +Theorem p3_p4_inequiv : ¬cequiv p3 p4.
              Proof. (* 请在此处解答 *) Admitted.

              @@ -2058,18 +2056,18 @@

              Equiv程序的等价关系

              练习:5 星, advanced, optional (p5_p6_equiv)

              证明以下指令等价。(提示:正如我们之前提到的,我们为 Himp 定义的 - cequiv 只考虑了可能的停机配置的集合:对于两个程序而言, - 当且仅当给定了相同的起始状态 st,且可能的停机状态的集合相同时,二者才等价。 + cequiv 只考虑了可能的停机配置的集合:对于两个拥有相同起始状态 st + 的程序而言,当且仅当二者可能的停机状态的集合相同时,二者才等价。 若 p5 停机,那么最终状态应当是什么?反过来说,p5 总是会停机吗?)
              Definition p5 : com :=
              -  WHILE ! (X = 1) DO
              +  (WHILE ~(X = 1) DO
                  HAVOC X
              -  END.

              +  END)%imp.

              Definition p6 : com :=
              -  X ::= 1.

              +  (X ::= 1)%imp.

              Theorem p5_p6_equiv : cequiv p5 p6.
              Proof. (* 请在此处解答 *) Admitted.
              @@ -2085,7 +2083,7 @@

              Equiv程序的等价关系

              -

              练习:4 星, optional (for_while_equiv)

              +

              练习:4 星, standard, optional (for_while_equiv)

              此练习是 Imp 一章中可选练习 add_for_loop 的扩展, 就是那个让你扩展出类似 C 风格的 for 循环指令的练习。请证明指令: @@ -2121,12 +2119,12 @@

              Equiv程序的等价关系
              -

              练习:3 星, optional (swap_noninterfering_assignments)

              +

              练习:3 星, standard, optional (swap_noninterfering_assignments)

              (提示:这里你需要 functional_extensionality。)
              -Theorem swap_noninterfering_assignments: l1 l2 a1 a2,
              +Theorem swap_noninterfering_assignments: l1 l2 a1 a2,
                l1l2
                var_not_used_in_aexp l1 a2
                var_not_used_in_aexp l2 a1
              @@ -2149,12 +2147,22 @@

              Equiv程序的等价关系
              -Definition capprox (c1 c2 : com) : Prop := (st st' : state),
              -  c1 / st \\ st'c2 / st \\ st'.
              +Definition capprox (c1 c2 : com) : Prop := (st st' : state),
              +  st =[ c1 ]⇒ st'st =[ c2 ]⇒ st'.
              -例如,程序 c1 = WHILE !(X = 1) DO X ::= X - 1 END +例如,程序 + +
              + +
              +  c1 = WHILE ~(X = 1) DO
              +         X ::= X - 1
              +       END +
              + +
              近似于 c2 = X ::= 1,但是 c2 不近似于 c1,因为 c1 不会在 X = 0 时停机,而 c2 会。如果两个程序互相近似,那么它们等价。
              @@ -2163,9 +2171,11 @@

              Equiv程序的等价关系
              -Definition c3 : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.
              -Definition c4 : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Theorem c3_c4_different : ¬ capprox c3 c4 ∧ ¬ capprox c4 c3.
              +Definition c3 : com
              +  (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.
              +Definition c4 : com
              +  (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              +Theorem c3_c4_different : ¬capprox c3 c4 ∧ ¬capprox c4 c3.
              Proof. (* 请在此处解答 *) Admitted.
              @@ -2176,7 +2186,7 @@

              Equiv程序的等价关系Definition cmin : com
                (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Theorem cmin_minimal : c, capprox cmin c.
              +Theorem cmin_minimal : c, capprox cmin c.
              Proof. (* 请在此处解答 *) Admitted.

              @@ -2187,12 +2197,16 @@

              Equiv程序的等价关系Definition zprop (c : com) : Prop
                (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Theorem zprop_preserving : c c',
              +Theorem zprop_preserving : c c',
                zprop ccapprox c c'zprop c'.
              Proof. (* 请在此处解答 *) Admitted.

              +
              + +(* Sat Jan 26 15:15:43 UTC 2019 *)
              +
              diff --git a/plf-current/Equiv.v b/plf-current/Equiv.v index 48d4c5b6..d329f69b 100644 --- a/plf-current/Equiv.v +++ b/plf-current/Equiv.v @@ -1,16 +1,16 @@ (** * Equiv: 程序的等价关系 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Bool.Bool. -Require Import Coq.Arith.Arith. -Require Import Coq.Init.Nat. -Require Import Coq.Arith.PeanoNat. Import Nat. -Require Import Coq.Arith.EqNat. -Require Import Coq.omega.Omega. -Require Import Coq.Lists.List. -Require Import Coq.Logic.FunctionalExtensionality. -Import ListNotations. From PLF Require Import Maps. +From Coq Require Import Bool.Bool. +From Coq Require Import Arith.Arith. +From Coq Require Import Init.Nat. +From Coq Require Import Arith.PeanoNat. Import Nat. +From Coq Require Import Arith.EqNat. +From Coq Require Import omega.Omega. +From Coq Require Import Lists.List. +From Coq Require Import Logic.FunctionalExtensionality. +Import ListNotations. From PLF Require Import Imp. (** *** 一些关于习题的建议: @@ -48,23 +48,21 @@ From PLF Require Import Imp. 我们就说他们的_'行为等价(behaviorally equivalent)'_。 *) Definition aequiv (a1 a2 : aexp) : Prop := - forall (st:state), + forall (st : state), aeval st a1 = aeval st a2. Definition bequiv (b1 b2 : bexp) : Prop := - forall (st:state), + forall (st : state), beval st b1 = beval st b2. (** 下面是一些算术和布尔表达式等价的简单例子。 *) -Theorem aequiv_example: - aequiv (X - X) 0. +Theorem aequiv_example: aequiv (X - X) 0. Proof. intros st. simpl. omega. Qed. -Theorem bequiv_example: - bequiv (X - X = 0) true. +Theorem bequiv_example: bequiv (X - X = 0)%imp true. Proof. intros st. unfold beval. rewrite aequiv_example. reflexivity. @@ -79,17 +77,17 @@ Qed. Definition cequiv (c1 c2 : com) : Prop := forall (st st' : state), - (c1 / st \\ st') <-> (c2 / st \\ st'). + (st =[ c1 ]=> st') <-> (st =[ c2 ]=> st'). (* ================================================================= *) (** ** 简单示例 *) (** 下面是一些指令等价的例子,我们首先从包含 [SKIP] 的简单程序变换开始: *) -Theorem skip_left: forall c, +Theorem skip_left : forall c, cequiv - (SKIP;; c) - c. + (SKIP;; c) + c. Proof. (* 课上已完成 *) intros c st st'. @@ -104,10 +102,11 @@ Proof. assumption. Qed. -(** **** 练习:2 星 (skip_right) *) -(** 请证明在某条指令之后添加 [SKIP] 后,两程序会等价 *) +(** **** 练习:2 星, standard (skip_right) -Theorem skip_right: forall c, + 请证明在某条指令之后添加 [SKIP] 后,两程序会等价 *) + +Theorem skip_right : forall c, cequiv (c ;; SKIP) c. @@ -115,11 +114,11 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 同样,下面是一个优化 [IFB] 的简单程序变换: *) +(** 同样,下面是一个优化 [TEST] 的简单程序变换: *) -Theorem IFB_true_simple: forall c1 c2, +Theorem TEST_true_simple : forall c1 c2, cequiv - (IFB BTrue THEN c1 ELSE c2 FI) + (TEST true THEN c1 ELSE c2 FI) c1. Proof. intros c1 c2. @@ -129,44 +128,44 @@ Proof. - (* <- *) apply E_IfTrue. reflexivity. assumption. Qed. -(** 当然,人类程序员是不会写把断言(guard)直接写成 [BTrue] 的条件分支的。 - 有趣的是当断言_'等价于'_真的情况: *) -(** _'定理'_:若 [b] 等价于 [BTrue],则 [IFB b THEN c1 ELSE c2 FI] 等价于 [c1]。 *) -(** +(** 当然,人类程序员是不会写把断言(guard)直接写成 [true] 的条件分支的。 + 不过当断言_'等价于真'_的情况时就会写出来: + + _'定理'_:若 [b] 等价于 [BTrue],则 [TEST b THEN c1 ELSE c2 FI] 等价于 [c1]。 _'证明'_: - - ([->]) 我们必须证明,对于所有的 [st] 和 [st'],若 [IFB b - THEN c1 ELSE c2 FI / st \\ st'] 则 [c1 / st \\ st']。 + - ([->]) 我们必须证明,对于所有的 [st] 和 [st'],若 [st =[ + TEST b THEN c1 ELSE c2 FI ]=> st'] 则 [st =[ c1 ]=> st']。 - 能够应用于 [IFB b THEN c1 ELSE c2 FI / st \\ st'] 的证明规则只有两条: + 能够应用于 [st =[ TEST b THEN c1 ELSE c2 FI ]=> st'] 的证明规则只有两条: [E_IfTrue] 和 [E_IfFalse]。 - - 假设 [IFB b THEN c1 ELSE c2 FI / st \\ st'] 证明自 [E_IfTrue] - 这条证明规则。若使用证明规则 [E_IfTrue] 其必备的前提条件 [c1 / st \\ st'] + - 假设 [st =[ TEST b THEN c1 ELSE c2 FI ]=> st'] 证明自 [E_IfTrue] + 这条证明规则。若使用证明规则 [E_IfTrue] 其必备的前提条件 [st =[ c1 ]=> st'] 必为真,而这正好是我们的证明所需要的条件。 - - 另一方面, 假设 [IFB b THEN c1 ELSE c2 FI / st \\ st'] 证明自 - [E_IfFalse]。我们能得知 [beval st b = false] 和 [c2 / st \\ st']。 + - 另一方面, 假设 [st =[ TEST b THEN c1 ELSE c2 FI ]=> st'] 证明自 + [E_IfFalse]。我们能得知 [beval st b = false] 和 [st =[ c2 ]=> st']。 之前提到 [b] 等价于 [BTrue], 即对于所有 [st],有 [beval st b = beval st BTrue]。具体来说就是 [beval st b = true] 成立,因而 [beval st BTrue = true] 成立。然而,之前假设 [E_IfFalse] 必备的前提条件 [beval st b = false] 也成立,这就构成了一组矛盾,因此不可能使用了 [E_IfFalse] 这条证明规则。 - - ([<-]) 我们必须证明,对于所有 [st] 和 [st'],若 [c1 / st \\ st'] + - ([<-]) 我们必须证明,对于所有 [st] 和 [st'],若[st =[ c1 ]=> st'] 则 [IFB b THEN c1 ELSE c2 FI / st \\ st']。 已知 [b] 等价于 [BTrue],我们知道 [beval st b] = [beval st BTrue] = [true]。 - 结合 [c1 / st \\ st'] 这条假设,我们能应用 [E_IfTrue] 来证明出 [IFB b THEN - c1 ELSE c2 FI / st \\ st']。 [] + 结合 [st =[ c1 ]=> st'] 这条假设,我们能应用 [E_IfTrue] 来证明 + [st =[ TEST b THEN c1 ELSE c2 FI ]=> st']。 [] 下面是这个证明的形式化版本: *) -Theorem IFB_true: forall b c1 c2, - bequiv b BTrue -> - cequiv - (IFB b THEN c1 ELSE c2 FI) - c1. +Theorem TEST_true: forall b c1 c2, + bequiv b BTrue -> + cequiv + (TEST b THEN c1 ELSE c2 FI) + c1. Proof. intros b c1 c2 Hb. split; intros H. @@ -183,23 +182,24 @@ Proof. unfold bequiv in Hb. simpl in Hb. rewrite Hb. reflexivity. Qed. -(** **** 练习:2 星, recommended (IFB_false) *) -Theorem IFB_false: forall b c1 c2, - bequiv b BFalse -> +(** **** 练习:2 星, standard, recommended (TEST_false) *) +Theorem TEST_false : forall b c1 c2, + bequiv b BFalse -> cequiv - (IFB b THEN c1 ELSE c2 FI) + (TEST b THEN c1 ELSE c2 FI) c2. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (swap_if_branches) *) -(** 证明我们可以通过对断言取反来交换 IF 的两个分支 *) +(** **** 练习:3 星, standard (swap_if_branches) + + 证明我们可以通过对断言取反来交换 IF 的两个分支 *) -Theorem swap_if_branches: forall b e1 e2, +Theorem swap_if_branches : forall b e1 e2, cequiv - (IFB b THEN e1 ELSE e2 FI) - (IFB BNot b THEN e2 ELSE e1 FI). + (TEST b THEN e1 ELSE e2 FI) + (TEST BNot b THEN e2 ELSE e1 FI). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -227,40 +227,45 @@ Proof. rewrite Hb. reflexivity. Qed. -(** **** 练习:2 星, advanced, optional (WHILE_false_informal) *) -(** 写出 [WHILE_false] 的非形式化证明。 +(** **** 练习:2 星, advanced, optional (WHILE_false_informal) + + 写出 [WHILE_false] 的非形式化证明。 (* 请在此处解答 *) -*) -(** [] *) + + [] *) (** 为了证明第二个定理,我们需要一个辅助引理:[WHILE] 循环在其断言等价于 [BTrue] 时不会停机。 *) -(** _'引理'_:若 [b] 等价于 [BTrue],则无法出现 [(WHILE b DO c END) / - st \\ st'] 的情况。 +(** _'引理'_:若 [b] 等价于 [BTrue],则无法出现 + [st =[ WHILE b DO c END ]=> st'] 的情况。 - _'证明'_:假设 [(WHILE b DO c END) / st \\ st']。我们将证明通过对 - [(WHILE b DO c END) / st \\ st'] 使用归纳法会导出矛盾。 + _'证明'_:假设 [st =[ WHILE b DO c END ]=> st']。我们将证明通过对 + [st =[ WHILE b DO c END ]=> st'] 使用归纳法会导出矛盾。需要考虑只有 + [E_WhileFalse] 和 [E_WhileTrue] 两种情况,其它情况则矛盾。 - - 假设 [(WHILE b DO c END) / st \\ st'] 使用规则 [E_WhileFalse] 证明。 + - 假设 [st =[ WHILE b DO c END ]=> st'] 使用规则 [E_WhileFalse] 证明。 那么根据假设得出 [beval st b = false]。但它与 [b] 等价于 [BTrue] 矛盾。 - - 假设 [(WHILE b DO c END) / st \\ st'] 使用规则 [E_WhileTrue]证明。 - 那么我们就给出了一个和 [(WHILE b DO c END) / st \\ st'] 矛盾的假设, - 它刚好就是我们要证明的那个! + - 假设 [st =[ WHILE b DO c END ]=> st'] 使用规则 [E_WhileTrue]证明。 + 我们必有: + + 1. [beval st b = true], + 2. 存在某个 [st0] 使得 [st =[ c ]=> st0] 且 + [st0 =[ WHILE b DO c END ]=> st'], + 3. 以及我们给出了导致矛盾的归纳假设 [st0 =[ WHILE b DO c END ]=> st'], - - 由于只有以上几条规则可用于证明 [(WHILE b DO c END) / st \\ st'], - 因此归纳时的其它情况可直接得出矛盾。 [] *) + 我们根据 2 和 3 会得到矛盾。 [] *) Lemma WHILE_true_nonterm : forall b c st st', bequiv b BTrue -> - ~( (WHILE b DO c END) / st \\ st' ). + ~( st =[ WHILE b DO c END ]=> st' ). Proof. (* 课上已完成 *) intros b c st st' Hb. intros H. - remember (WHILE b DO c END) as cw eqn:Heqcw. + remember (WHILE b DO c END)%imp as cw eqn:Heqcw. induction H; (* 大多数证明规则无法应用,我们可通过反演(inversion)来去除它们: *) inversion Heqcw; subst; clear Heqcw. @@ -272,17 +277,19 @@ Proof. - (* E_WhileTrue *) (* 直接使用 IH *) apply IHceval2. reflexivity. Qed. -(** **** 练习:2 星, optional (WHILE_true_nonterm_informal) *) -(** 试解释 [WHILE_true_nonterm] 的含义。 +(** **** 练习:2 星, standard, optional (WHILE_true_nonterm_informal) + + 试解释 [WHILE_true_nonterm] 的含义。 (* 请在此处解答 *) -*) -(** [] *) -(** **** 练习:2 星, recommended (WHILE_true) *) -(** 请证明以下定理。_'提示'_:你可能需要使用 [WHILE_true_nonterm] 。 *) + [] *) + +(** **** 练习:2 星, standard, recommended (WHILE_true) -Theorem WHILE_true: forall b c, + 请证明以下定理。_'提示'_:你可能需要使用 [WHILE_true_nonterm] 。 *) + +Theorem WHILE_true : forall b c, bequiv b true -> cequiv (WHILE b DO c END) @@ -294,10 +301,10 @@ Proof. (** 关于 [WHILE] 指令的更有趣的事实是,任何数量的循环体的副本在不改变意义 的情况下均可被“展开”。循环展开在实际的编译器中是种常见的变换。 *) -Theorem loop_unrolling: forall b c, +Theorem loop_unrolling : forall b c, cequiv (WHILE b DO c END) - (IFB b THEN (c ;; WHILE b DO c END) ELSE SKIP FI). + (TEST b THEN (c ;; WHILE b DO c END) ELSE SKIP FI). Proof. (* 课上已完成 *) intros b c st st'. @@ -318,43 +325,42 @@ Proof. + (* 不执行循环 *) inversion H5; subst. apply E_WhileFalse. assumption. Qed. -(** **** 练习:2 星, optional (seq_assoc) *) +(** **** 练习:2 星, standard, optional (seq_assoc) *) Theorem seq_assoc : forall c1 c2 c3, cequiv ((c1;;c2);;c3) (c1;;(c2;;c3)). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 证明涉及赋值的程序属性经常会用到函数的外延公理。 *) +(** 证明涉及赋值的程序的属性经常会用到这一事实,即程序状态会根据其外延性 + (如 [x !-> m x ; m] 和 [m] 是相等的映射)来对待。 *) -Theorem identity_assignment : forall (X:string), +Theorem identity_assignment : forall x, cequiv - (X ::= X) + (x ::= x) SKIP. Proof. - intros. split; intro H. - - (* -> *) - inversion H; subst. simpl. - replace (st & { X --> st X }) with st. - + constructor. - + apply functional_extensionality. intro. - rewrite t_update_same; reflexivity. - - (* <- *) - replace st' with (st' & { X --> aeval st' X }). - + inversion H. subst. apply E_Ass. reflexivity. - + apply functional_extensionality. intro. - rewrite t_update_same. reflexivity. + intros. + split; intro H; inversion H; subst. + - (* -> *) + rewrite t_update_same. + apply E_Skip. + - (* <- *) + assert (Hx : st' =[ x ::= x ]=> (x !-> st' x ; st')). + { apply E_Ass. reflexivity. } + rewrite t_update_same in Hx. + apply Hx. Qed. -(** **** 练习:2 星, recommended (assign_aequiv) *) -Theorem assign_aequiv : forall (X:string) e, - aequiv X e -> - cequiv SKIP (X ::= e). +(** **** 练习:2 星, standard, recommended (assign_aequiv) *) +Theorem assign_aequiv : forall (x : string) e, + aequiv x e -> + cequiv SKIP (x ::= e). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (equiv_classes) *) +(** **** 练习:2 星, standard (equiv_classes) *) (** 给定下列程序,请按照它们在 [Imp] 中是否等价将这些程序分组。 你的答案应该是一个列表的列表,其中每个子列表都表示一组等价的程序。 @@ -366,51 +372,51 @@ Proof. 请在 [equiv_classes] 的定义下方写出你的答案。 *) Definition prog_a : com := - WHILE ! (X <= 0) DO + (WHILE ~(X <= 0) DO X ::= X + 1 - END. + END)%imp. Definition prog_b : com := - IFB X = 0 THEN + (TEST X = 0 THEN X ::= X + 1;; Y ::= 1 ELSE Y ::= 0 FI;; X ::= X - Y;; - Y ::= 0. + Y ::= 0)%imp. Definition prog_c : com := - SKIP. + SKIP%imp. Definition prog_d : com := - WHILE ! (X = 0) DO + (WHILE ~(X = 0) DO X ::= (X * Y) + 1 - END. + END)%imp. Definition prog_e : com := - Y ::= 0. + (Y ::= 0)%imp. Definition prog_f : com := - Y ::= X + 1;; - WHILE ! (X = Y) DO + (Y ::= X + 1;; + WHILE ~(X = Y) DO Y ::= X + 1 - END. + END)%imp. Definition prog_g : com := - WHILE true DO + (WHILE true DO SKIP - END. + END)%imp. Definition prog_h : com := - WHILE ! (X = X) DO + (WHILE ~(X = X) DO X ::= X + 1 - END. + END)%imp. Definition prog_i : com := - WHILE ! (X = Y) DO + (WHILE ~(X = Y) DO X ::= Y + 1 - END. + END)%imp. Definition equiv_classes : list (list com) (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -469,7 +475,7 @@ 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'. + assert (st =[ c1 ]=> st' <-> st =[ c2 ]=> st') as H'. { (* Proof of assertion *) apply H. } apply iff_sym. assumption. Qed. @@ -487,7 +493,7 @@ 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. + apply iff_trans with (st =[ c2 ]=> st'). apply H12. apply H23. Qed. (* ================================================================= *) (** ** 行为等价是一种一致性 *) @@ -498,11 +504,11 @@ Proof. aequiv a1 a1' ----------------------------- - cequiv (i ::= a1) (i ::= a1') + cequiv (x ::= a1) (x ::= a1') cequiv c1 c1' cequiv c2 c2' - ------------------------ + -------------------------- cequiv (c1;;c2) (c1';;c2') ...以及这些指令的更多其它形式。 *) @@ -516,11 +522,11 @@ Proof. _'无需'_进行与不变的部分相关的证明。也就是说,程序的改变所产生的证明的工作量 与改变的大小而非整个程序的大小成比例。 *) -Theorem CAss_congruence : forall i a1 a1', +Theorem CAss_congruence : forall x a1 a1', aequiv a1 a1' -> - cequiv (CAss i a1) (CAss i a1'). + cequiv (CAss x a1) (CAss x a1'). Proof. - intros i a1 a2 Heqv st st'. + intros x a1 a2 Heqv st st'. split; intros Hceval. - (* -> *) inversion Hceval. subst. apply E_Ass. @@ -535,26 +541,26 @@ Proof. 等价于 [c1'],那么 [WHILE b1 DO c1 END] 等价于 [WHILE b1' DO c1' END]。 _'证明'_: 假设 [b1] 等价于 [b1'] 且 [c1] 等价于 [c1']。我们必须证明, - 对于每个 [st] 和 [st'],[WHILE b1 DO c1 END / st \\ st'] 当且仅当 - [WHILE b1' DO c1' END / st \\ st']。我们把两个方向分开考虑。 + 对于每个 [st] 和 [st'],[st =[ WHILE b1 DO c1 END ]=> st'] 当且仅当 + [st =[ WHILE b1' DO c1' END ]=> st']。我们把两个方向分开考虑。 - - ([->]) 我们通过对 [WHILE b1 DO c1 END / st \\ st'] 使用归纳法证明 - [WHILE b1 DO c1 END / st \\ st'] 蕴含 [WHILE b1' DO c1' END / st \\ st']。 + - ([->]) 我们通过对 [st =[ WHILE b1 DO c1 END ]=> st'] 使用归纳法证明 + [st =[ WHILE b1 DO c1 END ]=> st'] 蕴含 [st =[ WHILE b1' DO c1' END ]=> st']。 只有推导的最后所使用的规则为 [E_WhileFalse] 或 [E_WhileTrue] 时才需要进行特别讨论。 - [E_WhileFalse]:此时我们拥有假设的必备条件 [beval st b1 = false] 和 [st = st']。但是,由于 [b1] 和 [b1'] 等价,我们有 [beval st b1' = false],然后应用 [E-WhileFalse] 得出我们需要的 - [WHILE b1' DO c1' END / st \\ st']。 + [st =[ WHILE b1' DO c1' END ]=> st']。 - [E_WhileTrue]:此时我们拥有假设的必备条件 [beval st b1 = true],以及 - 对于某些状态 [st'0] 的 [c1 / st \\ st'0] 和 [WHILE b1 DO c1 END / st'0 - \\ st'],还有归纳假设 [WHILE b1' DO c1' END / st'0 \\ st']。 + 对于某些状态 [st'0] 的 [st =[ c1 ]=> st'0] 和 [st'0 =[ WHILE b1 DO c1 + END ]=> st'],还有归纳假设 [st'0 =[ WHILE b1' DO c1' END ]=> st']。 - 由于 [c1] 和 [c1'] 等价,我们有 [c1' / st \\ st'0]; + 由于 [c1] 和 [c1'] 等价,我们有 [st =[ c1' ]=> st'0]; 由于 [b1] 和 [b1'] 等价,我们有 [beval st b1' = true]。现在应用 - [E-WhileTrue],得出我们所需的 [WHILE b1' DO c1' END / st \\ st']。 + [E-WhileTrue],得出我们所需的 [st =[ WHILE b1' DO c1' END ]=> st']。 - ([<-]) 反之亦然。 [] *) @@ -567,7 +573,7 @@ Proof. intros b1 b1' c1 c1' Hb1e Hc1e st st'. split; intros Hce. - (* -> *) - remember (WHILE b1 DO c1 END) as cwhile + remember (WHILE b1 DO c1 END)%imp as cwhile eqn:Heqcwhile. induction Hce; inversion Heqcwhile; subst. + (* E_WhileFalse *) @@ -580,7 +586,7 @@ Proof. * (* 执行之后的循环 *) apply IHHce2. reflexivity. - (* <- *) - remember (WHILE b1' DO c1' END) as c'while + remember (WHILE b1' DO c1' END)%imp as c'while eqn:Heqc'while. induction Hce; inversion Heqc'while; subst. + (* E_WhileFalse *) @@ -593,7 +599,7 @@ Proof. * (* 执行之后的循环 *) apply IHHce2. reflexivity. Qed. -(** **** 练习:3 星, optional (CSeq_congruence) *) +(** **** 练习:3 星, standard, optional (CSeq_congruence) *) Theorem CSeq_congruence : forall c1 c1' c2 c2', cequiv c1 c1' -> cequiv c2 c2' -> cequiv (c1;;c2) (c1';;c2'). @@ -601,11 +607,11 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (CIf_congruence) *) +(** **** 练习:3 星, standard (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). + cequiv (TEST b THEN c1 ELSE c2 FI) + (TEST b' THEN c1' ELSE c2' FI). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -616,7 +622,7 @@ Example congruence_example: cequiv (* 程序 1: *) (X ::= 0;; - IFB X = 0 + TEST X = 0 THEN Y ::= 0 ELSE @@ -624,7 +630,7 @@ Example congruence_example: FI) (* 程序 1: *) (X ::= 0;; - IFB X = 0 + TEST X = 0 THEN Y ::= X - X (* <--- 这里不同 *) ELSE @@ -632,20 +638,22 @@ Example congruence_example: 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. + - apply refl_cequiv. + - apply CIf_congruence. + + apply refl_bequiv. + + apply CAss_congruence. unfold aequiv. simpl. + * symmetry. apply minus_diag. + + apply refl_cequiv. Qed. -(** **** 练习:3 星, advanced, optional (not_congr) *) -(** 我们已经证明了 [cequiv] 关系对指令同时满足等价关系和一致性。 +(** **** 练习:3 星, advanced, optional (not_congr) + + 我们已经证明了 [cequiv] 关系对指令同时满足等价关系和一致性。 你能想出一个对于指令满足等价关系但_'不满足'_一致性的关系吗? *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * 程序变换 *) @@ -678,33 +686,33 @@ Definition ctrans_sound (ctrans : com -> com) : Prop := Fixpoint fold_constants_aexp (a : aexp) : aexp := match a with | ANum n => ANum n - | AId i => AId i + | AId x => AId x | APlus a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp 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) + 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) + match (fold_constants_aexp a1, + fold_constants_aexp a2) with | (ANum n1, ANum n2) => ANum (n1 * n2) | (a1', a2') => AMult a1' a2' end end. -(* 解析下面的示例时要用 *) -Local Open Scope aexp_scope. -Local Open Scope bexp_scope. - Example fold_aexp_ex1 : - fold_constants_aexp ((1 + 2) * X) = (3 * X). + fold_constants_aexp ((1 + 2) * X) + = (3 * X)%imp. Proof. reflexivity. Qed. (** 注意此版本的常量折叠不包括优化平凡的加法等 -- 为简单起见, @@ -712,7 +720,7 @@ Proof. reflexivity. Qed. 只是定义和证明会更长。 *) Example fold_aexp_ex2 : - fold_constants_aexp (X - ((0 * 6) + Y)) = (X - (0 + Y)). + fold_constants_aexp (X - ((0 * 6) + Y))%imp = (X - (0 + Y))%imp. Proof. reflexivity. Qed. (** 我们不仅可以将 [fold_constants_aexp] 优化成 [bexp](如在 [BEq] 和 [BLe] @@ -723,14 +731,16 @@ Fixpoint fold_constants_bexp (b : bexp) : bexp := | BTrue => BTrue | BFalse => BFalse | BEq a1 a2 => - match (fold_constants_aexp a1, fold_constants_aexp a2) with + match (fold_constants_aexp a1, + fold_constants_aexp a2) with | (ANum n1, ANum n2) => if 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 + match (fold_constants_aexp a1, + fold_constants_aexp a2) with | (ANum n1, ANum n2) => if n1 <=? n2 then BTrue else BFalse | (a1', a2') => @@ -743,7 +753,8 @@ Fixpoint fold_constants_bexp (b : bexp) : bexp := | b1' => BNot b1' end | BAnd b1 b2 => - match (fold_constants_bexp b1, fold_constants_bexp b2) with + match (fold_constants_bexp b1, + fold_constants_bexp b2) with | (BTrue, BTrue) => BTrue | (BTrue, BFalse) => BFalse | (BFalse, BTrue) => BFalse @@ -753,29 +764,31 @@ Fixpoint fold_constants_bexp (b : bexp) : bexp := end. Example fold_bexp_ex1 : - fold_constants_bexp (true && ! (false && true)) = true. + fold_constants_bexp (true && ~(false && true))%imp + = true. Proof. reflexivity. Qed. Example fold_bexp_ex2 : - fold_constants_bexp ((X = Y) && (0 = (2 - (1 + 1)))) = - ((X = Y) && true). + fold_constants_bexp ((X = Y) && (0 = (2 - (1 + 1))))%imp + = ((X = Y) && true)%imp. Proof. reflexivity. Qed. (** 为了折叠指令中的常量,我们需要对所有内嵌的表达式应用适当的折叠函数。 *) +Open Scope imp. Fixpoint fold_constants_com (c : com) : com := match c with | SKIP => SKIP - | i ::= a => - CAss i (fold_constants_aexp a) + | x ::= a => + x ::= (fold_constants_aexp a) | c1 ;; c2 => (fold_constants_com c1) ;; (fold_constants_com c2) - | IFB b THEN c1 ELSE c2 FI => + | TEST b THEN c1 ELSE c2 FI => match fold_constants_bexp b with - | BTrue => fold_constants_com c1 + | BTrue => fold_constants_com c1 | BFalse => fold_constants_com c2 - | b' => IFB b' THEN fold_constants_com c1 + | b' => TEST b' THEN fold_constants_com c1 ELSE fold_constants_com c2 FI end | WHILE b DO c END => @@ -785,38 +798,29 @@ Fixpoint fold_constants_com (c : com) : com := | b' => WHILE b' DO (fold_constants_com c) END end end. +Close Scope imp. Example fold_com_ex1 : fold_constants_com (* 原程序: *) (X ::= 4 + 5;; Y ::= X - 3;; - IFB (X - Y) = (2 + 4) THEN - SKIP - ELSE - Y ::= 0 - FI;; - IFB 0 <= (4 - (2 + 1)) - THEN - Y ::= 0 - ELSE - SKIP - FI;; + TEST (X - Y) = (2 + 4) THEN SKIP + ELSE Y ::= 0 FI;; + TEST 0 <= (4 - (2 + 1)) THEN Y ::= 0 + ELSE SKIP FI;; WHILE Y = 0 DO X ::= X + 1 - END) + END)%imp = (* 常量折叠后: *) (X ::= 9;; Y ::= X - 3;; - IFB (X - Y) = 6 THEN - SKIP - ELSE - Y ::= 0 - FI;; + TEST (X - Y) = 6 THEN SKIP + ELSE Y ::= 0 FI;; Y ::= 0;; WHILE Y = 0 DO X ::= X + 1 - END). + END)%imp. Proof. reflexivity. Qed. (* ================================================================= *) @@ -842,15 +846,16 @@ Proof. destruct (fold_constants_aexp a2); rewrite IHa1; rewrite IHa2; reflexivity). Qed. -(** **** 练习:3 星, optional (fold_bexp_Eq_informal) *) -(** 下面是布尔表达式常量折叠中 [BEq] 情况的可靠性的证明。 +(** **** 练习:3 星, standard, optional (fold_bexp_Eq_informal) + + 下面是布尔表达式常量折叠中 [BEq] 情况的可靠性的证明。 请认真读完它再和之后的形式化证明作比较,然后补充完 [BLe] 情况的形式化证明 (尽量不看之前 [BEq] 情况的证明)。 _'定理'_:布尔值的常量折叠函数 [fold_constants_bexp] 是可靠的。 _'证明'_:我们必须证明对于所有的布尔表达式 [b],[b] 都等价于 - [fold_constants_bexp]。我们对 [b] 使用归纳法。这里只给出了 [b] + [fold_constants_bexp b]。我们对 [b] 使用归纳法。这里只给出了 [b] 形如 [BEq a1 a2] 的情况。 在本情况中,我们必须证明 @@ -926,8 +931,7 @@ Proof. aeval st a1 = aeval st (fold_constants_aexp a1) aeval st a2 = aeval st (fold_constants_aexp a2), - 本例证毕。 [] -*) + 本例证毕。 [] *) Theorem fold_constants_bexp_sound: btrans_sound fold_constants_bexp. @@ -968,8 +972,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (fold_constants_com_sound) *) -(** 完成以下证明的 [WHILE] 情况。 *) +(** **** 练习:3 星, standard (fold_constants_com_sound) + + 完成以下证明的 [WHILE] 情况。 *) Theorem fold_constants_com_sound : ctrans_sound fold_constants_com. @@ -980,7 +985,7 @@ Proof. - (* ::= *) apply CAss_congruence. apply fold_constants_aexp_sound. - (* ;; *) apply CSeq_congruence; assumption. - - (* IFB *) + - (* TEST *) assert (bequiv b (fold_constants_bexp b)). { apply fold_constants_bexp_sound. } destruct (fold_constants_bexp b) eqn:Heqb; @@ -989,10 +994,10 @@ Proof. [fold_constants_bexp_sound] 来得出证明。) *) + (* b 总为真 *) apply trans_cequiv with c1; try assumption. - apply IFB_true; assumption. + apply TEST_true; assumption. + (* b 总为假 *) apply trans_cequiv with c2; try assumption. - apply IFB_false; assumption. + apply TEST_false; assumption. - (* WHILE *) (* 请在此处解答 *) Admitted. (** [] *) @@ -1000,8 +1005,9 @@ Proof. (* ----------------------------------------------------------------- *) (** *** 再论 (0 + n) 优化的可靠性 *) -(** **** 练习:4 星, advanced, optional (optimize_0plus) *) -(** 回顾_'逻辑基础'_ [Imp] 一章中 [optimize_0plus] 的定义: +(** **** 练习:4 星, advanced, optional (optimize_0plus) + + 回顾_'逻辑基础'_ [Imp] 一章中 [optimize_0plus] 的定义: Fixpoint optimize_0plus (e:aexp) : aexp := match e with @@ -1035,8 +1041,9 @@ Proof. - 证明此优化程序有可靠性。(这部分应该会_'很简单'_ 。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * 证明程序不等价 *) @@ -1056,57 +1063,56 @@ Proof. (** 我们马上就会发现这是不行的。不过且慢,现在, 看你自己能否找出一个反例来。 *) -(** 以下形式化的定义描述了如何在算术表达式中, - 将某个变量的所有引用都替换成另一个表达式: *) +(** 以下形式化的定义描述了如何在算术表达式 [a] 中, + 将某个变量 [x] 的所有引用都替换成另一个表达式 [u] : *) -Fixpoint subst_aexp (i : string) (u : aexp) (a : aexp) : aexp := +Fixpoint subst_aexp (x : string) (u : aexp) (a : aexp) : aexp := match a with | ANum n => ANum n - | AId i' => - if eqb_string i i' then u else AId i' + | AId x' => + if eqb_string x x' then u else AId x' | APlus a1 a2 => - APlus (subst_aexp i u a1) (subst_aexp i u a2) + APlus (subst_aexp x u a1) (subst_aexp x u a2) | AMinus a1 a2 => - AMinus (subst_aexp i u a1) (subst_aexp i u a2) + AMinus (subst_aexp x u a1) (subst_aexp x u a2) | AMult a1 a2 => - AMult (subst_aexp i u a1) (subst_aexp i u a2) + AMult (subst_aexp x u a1) (subst_aexp x u a2) end. Example subst_aexp_ex : - subst_aexp X (42 + 53) (Y + X) - = (Y + (42 + 53)). + subst_aexp X (42 + 53) (Y + X)%imp + = (Y + (42 + 53))%imp. Proof. reflexivity. Qed. (** 而这里是一个我们感兴趣的性质:它断言类似上述形式的 [c1] 和 [c2] 总是等价的。 *) -Definition subst_equiv_property := forall i1 i2 a1 a2, - cequiv (i1 ::= a1;; i2 ::= a2) - (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). +Definition subst_equiv_property := forall x1 x2 a1 a2, + cequiv (x1 ::= a1;; x2 ::= a2) + (x1 ::= a1;; x2 ::= subst_aexp x1 a1 a2). (** 遗憾的是, 这个性质_'并不'_总是成立 -- 即,它并不是对所有的 - [i1]、[i2]、[a1] 和 [a2] 都成立。 + [x1]、[x2]、[a1] 和 [a2] 都成立。 - cequiv (i1 ::= a1;; i2 ::= a2) - (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). + cequiv (x1 ::= a1;; x2 ::= a2) + (x1 ::= a1;; x2 ::= subst_aexp x1 a1 a2). - 我们使用反证法来证明这一点。假设对于所有的 [i1]、[i2]、[a1] + 我们使用反证法来证明这一点。假设对于所有的 [x1]、[x2]、[a1] 和 [a2],我们有 - cequiv (i1 ::= a1;; i2 ::= a2) - (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). + cequiv (x1 ::= a1;; x2 ::= a2) + (x1 ::= a1;; x2 ::= subst_aexp x1 a1 a2). 考虑以下程序: - X ::= X + 1;; Y ::= X + X ::= X + 1;; Y ::= X 注意 - (X ::= X + 1;; Y ::= X) - / { --> 0 } \\ st1, + empty_st =[ X ::= X + 1;; Y ::= X ]=> st1, - 其中 [st1 = { X --> 1; Y --> 1 }]。 + 其中 [st1 = (Y !-> 1 ; X !-> 1)]. 根据假设,我们知道 @@ -1117,17 +1123,14 @@ Definition subst_equiv_property := forall i1 i2 a1 a2, 同时,根据 [cequiv] 的定义,我们有 - (X ::= X + 1;; Y ::= X + 1 - / { --> 0 } \\ st1. + empty_st =[ X ::= X + 1;; Y ::= X + 1 ]=> st1. 但是我们也能推导出 - (X ::= X + 1;; Y ::= X + 1) - / { --> 0 } \\ st2, - - 其中 [st2 = { X --> 1; Y --> 2 }]。但由于 [ceval] 是确定性的,而 - [st1 <> st2] ,这就造成了矛盾! [] *) + empty_st =[ X ::= X + 1;; Y ::= X + 1 ]=> st2, + 其中 [st2 = (Y !-> 2 ; X !-> 1)]。但由于 [ceval] 是确定性的,而 + [st1 <> st2] ,这就造成了矛盾! [] *) Theorem subst_inequiv : ~ subst_equiv_property. @@ -1138,65 +1141,68 @@ Proof. (* 这里有个反例:假设 [subst_equiv_property] 成立能够让我们证明以下两个程序等价... *) remember (X ::= X + 1;; - Y ::= X) + Y ::= X)%imp as c1. remember (X ::= X + 1;; - Y ::= X + 1) + Y ::= X + 1)%imp as c2. assert (cequiv c1 c2) by (subst; apply Contra). - (* ...让我们证明 [c2] 能够在两个不同的状态下停机: - st1 = {X --> 1; Y --> 1} - st2 = {X --> 1; Y --> 2}. *) - remember {X --> 1 ; Y --> 1} as st1. - remember {X --> 1 ; Y --> 2} as st2. - assert (H1: c1 / { --> 0 } \\ st1); - assert (H2: c2 / { --> 0 } \\ st2); + (* ...我们来证明 [c2] 能够在两个不同的状态下停机: + st1 = (Y !-> 1 ; X !-> 1) + st2 = (Y !-> 2 ; X !-> 1). *) + remember (Y !-> 1 ; X !-> 1) as st1. + remember (Y !-> 2 ; X !-> 1) as st2. + assert (H1 : empty_st =[ c1 ]=> st1); + assert (H2 : empty_st =[ c2 ]=> st2); try (subst; - apply E_Seq with (st' := {X --> 1}); + apply E_Seq with (st' := (X !-> 1)); apply E_Ass; reflexivity). apply H in H1. (* 最后,因为程序求值的确定性而产生矛盾。 *) - assert (Hcontra: st1 = st2) - by (apply (ceval_deterministic c2 { --> 0 }); assumption). - assert (Hcontra': st1 Y = st2 Y) + assert (Hcontra : st1 = st2) + by (apply (ceval_deterministic c2 empty_st); assumption). + assert (Hcontra' : st1 Y = st2 Y) by (rewrite Hcontra; reflexivity). subst. inversion Hcontra'. Qed. -(** **** 练习:4 星, optional (better_subst_equiv) *) -(** 之前我们思考的等价关系也不全是妄言 -- 只要再增加一个条件, +(** **** 练习:4 星, standard, optional (better_subst_equiv) + + 之前我们思考的等价关系也不全是妄言 -- 只要再增加一个条件, 即变量 [X] 不在第一个赋值语句的右边出现,它就是正确的了。 *) -Inductive var_not_used_in_aexp (X:string) : 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 (st & { i --> ni }) a = aeval st a. +Inductive var_not_used_in_aexp (x : string) : 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 x st a ni, + var_not_used_in_aexp x a -> + aeval (x !-> ni ; st) a = aeval st a. Proof. (* 请在此处解答 *) Admitted. (** 使用 [var_not_used_in_aexp],形式化并证明正确版本的 [subst_equiv_property]。 *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) -(** **** 练习:3 星 (inequiv_exercise) *) -(** 证明无限循环不等价于 [SKIP] *) +(** **** 练习:3 星, standard (inequiv_exercise) + + 证明无限循环不等价于 [SKIP] *) Theorem inequiv_exercise: ~ cequiv (WHILE true DO SKIP END) SKIP. @@ -1247,65 +1253,69 @@ Inductive com : Type := | CSeq : com -> com -> com | CIf : bexp -> com -> com -> com | CWhile : bexp -> com -> com - | CHavoc : string -> com. (* <---- 新增的 *) + | CHavoc : string -> com. (* <--- 新增 *) Notation "'SKIP'" := - CSkip. + CSkip : imp_scope. Notation "X '::=' a" := - (CAss X a) (at level 60). + (CAss X a) (at level 60) : imp_scope. Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). + (CSeq c1 c2) (at level 80, right associativity) : imp_scope. 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). + (CWhile b c) (at level 80, right associativity) : imp_scope. +Notation "'TEST' e1 'THEN' e2 'ELSE' e3 'FI'" := + (CIf e1 e2 e3) (at level 80, right associativity) : imp_scope. +Notation "'HAVOC' l" := + (CHavoc l) (at level 60) : imp_scope. + +(** **** 练习:2 星, standard (himp_ceval) -(** **** 练习:2 星 (himp_ceval) *) -(** 现在,我们必须扩展操作语义。前面我们已经提过了 [ceval] 关系的模版, + 现在,我们必须扩展操作语义。前面我们已经提过了 [ceval] 关系的模版, 指定了大步语义。为了形式化 [HAVOC] 指令的行为,我们还需要在 [ceval] 的定义中添加哪些规则? *) -Reserved Notation "c1 '/' st '\\' st'" - (at level 40, st at level 39). +Reserved Notation "st '=[' c ']=>' st'" (at level 40). +Open Scope imp_scope. Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st : state, SKIP / st \\ st - | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : string), + | E_Skip : forall st, + st =[ SKIP ]=> st + | E_Ass : forall st a1 n x, aeval st a1 = n -> - (X ::= a1) / st \\ 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_WhileFalse : forall (b1 : bexp) (st : state) (c1 : com), - beval st b1 = false -> - (WHILE b1 DO c1 END) / st \\ st - | E_WhileTrue : 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'' + st =[ x ::= a1 ]=> (x !-> n ; st) + | E_Seq : forall c1 c2 st st' st'', + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> st'' + | E_IfTrue : forall st st' b c1 c2, + beval st b = true -> + st =[ c1 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_IfFalse : forall st st' b c1 c2, + beval st b = false -> + st =[ c2 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ WHILE b DO c END ]=> st + | E_WhileTrue : forall st st' st'' b c, + beval st b = true -> + st =[ c ]=> st' -> + st' =[ WHILE b DO c END ]=> st'' -> + st =[ WHILE b DO c END ]=> st'' (* 请在此处解答 *) - where "c1 '/' st '\\' st'" := (ceval c1 st st'). + where "st =[ c ]=> st'" := (ceval c st st'). +Close Scope imp_scope. (** 作为合理性检查,以下断言对于你的定义来说应该是可证的: *) -Example havoc_example1 : (HAVOC X) / { --> 0 } \\ { X --> 0 }. +Example havoc_example1 : empty_st =[ (HAVOC X)%imp ]=> (X !-> 0). Proof. (* 请在此处解答 *) Admitted. Example havoc_example2 : - (SKIP;; HAVOC Z) / { --> 0 } \\ { Z --> 42 }. + empty_st =[ (SKIP;; HAVOC Z)%imp ]=> (Z !-> 42). Proof. (* 请在此处解答 *) Admitted. @@ -1316,35 +1326,36 @@ Definition manual_grade_for_Check_rule_for_HAVOC : option (nat*string) := None. (** 最后,我们重新定义和之前等价的指令: *) Definition cequiv (c1 c2 : com) : Prop := forall st st' : state, - c1 / st \\ st' <-> c2 / st \\ st'. + st =[ c1 ]=> st' <-> st =[ c2 ]=> st'. (** 我们应用此定义来证明一些非确定性程序是否等价。 *) -(** **** 练习:3 星 (havoc_swap) *) -(** 以下两个程序是否等价? *) +(** **** 练习:3 星, standard (havoc_swap) + + 以下两个程序是否等价? *) Definition pXY := - HAVOC X;; HAVOC Y. + (HAVOC X;; HAVOC Y)%imp. Definition pYX := - HAVOC Y;; HAVOC X. + (HAVOC Y;; HAVOC X)%imp. (** 请证明你的想法。 *) - Theorem pXY_cequiv_pYX : cequiv pXY pYX \/ ~cequiv pXY pYX. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, optional (havoc_copy) *) -(** 以下两个程序是否等价? *) +(** **** 练习:4 星, standard, optional (havoc_copy) + + 以下两个程序是否等价? *) Definition ptwice := - HAVOC X;; HAVOC Y. + (HAVOC X;; HAVOC Y)%imp. Definition pcopy := - HAVOC X;; Y ::= X. + (HAVOC X;; Y ::= X)%imp. (** 请证明你的想法。(提示:你可能会用到 [assert] 的略。) *) @@ -1360,74 +1371,76 @@ Proof. (* 请在此处解答 *) Admitted. 以下练习的最后一部分展示了这种现象。 *) -(** **** 练习:4 星, advanced (p1_p2_term) *) -(** 考虑一下指令: *) +(** **** 练习:4 星, advanced (p1_p2_term) + + 考虑一下指令: *) Definition p1 : com := - WHILE ! (X = 0) DO + (WHILE ~ (X = 0) DO HAVOC Y;; X ::= X + 1 - END. + END)%imp. Definition p2 : com := - WHILE ! (X = 0) DO + (WHILE ~ (X = 0) DO SKIP - END. + END)%imp. (** 直觉上来说,[p1] 和 [p2] 的停机行为相同:要么无限循环,要么以相同的状态开始, 就在相同的状态下停机。我们可以用以下引理分别刻画 [p1] 和 [p2] 的停机行为: *) Lemma p1_may_diverge : forall st st', st X <> 0 -> - ~ p1 / st \\ st'. + ~ st =[ p1 ]=> st'. Proof. (* 请在此处解答 *) Admitted. Lemma p2_may_diverge : forall st st', st X <> 0 -> - ~ p2 / st \\ st'. + ~ st =[ p2 ]=> st'. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced (p1_p2_equiv) *) -(** 使用这两个引理来证明 [p1] 和 [p2] 确实等价。 *) +(** **** 练习:4 星, advanced (p1_p2_equiv) + + 使用这两个引理来证明 [p1] 和 [p2] 确实等价。 *) Theorem p1_p2_equiv : cequiv p1 p2. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced (p3_p4_inequiv) *) -(** 证明以下程序_'不等价'_(提示:当 [p3] 停机时 [Z] 的值是什么?当 +(** **** 练习:4 星, advanced (p3_p4_inequiv) + + 证明以下程序_'不等价'_(提示:当 [p3] 停机时 [Z] 的值是什么?当 [p4] 停机时呢?) *) Definition p3 : com := - Z ::= 1;; - WHILE ! (X = 0) DO + (Z ::= 1;; + WHILE ~(X = 0) DO HAVOC X;; HAVOC Z - END. + END)%imp. Definition p4 : com := - X ::= 0;; - Z ::= 1. - + (X ::= 0;; + Z ::= 1)%imp. Theorem p3_p4_inequiv : ~ cequiv p3 p4. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, advanced, optional (p5_p6_equiv) *) -(** 证明以下指令等价。(提示:正如我们之前提到的,我们为 Himp 定义的 - [cequiv] 只考虑了可能的停机配置的集合:对于两个程序而言, - 当且仅当给定了相同的起始状态 [st],且可能的停机状态的集合相同时,二者才等价。 +(** **** 练习:5 星, advanced, optional (p5_p6_equiv) + + 证明以下指令等价。(提示:正如我们之前提到的,我们为 Himp 定义的 + [cequiv] 只考虑了可能的停机配置的集合:对于两个拥有相同起始状态 [st] + 的程序而言,当且仅当二者可能的停机状态的集合相同时,二者才等价。 若 [p5] 停机,那么最终状态应当是什么?反过来说,[p5] 总是会停机吗?) *) Definition p5 : com := - WHILE ! (X = 1) DO + (WHILE ~(X = 1) DO HAVOC X - END. + END)%imp. Definition p6 : com := - X ::= 1. - + (X ::= 1)%imp. Theorem p5_p6_equiv : cequiv p5 p6. Proof. (* 请在此处解答 *) Admitted. @@ -1438,8 +1451,9 @@ End Himp. (* ################################################################# *) (** * 附加练习 *) -(** **** 练习:4 星, optional (for_while_equiv) *) -(** 此练习是 [Imp] 一章中可选练习 [add_for_loop] 的扩展, +(** **** 练习:4 星, standard, optional (for_while_equiv) + + 此练习是 [Imp] 一章中可选练习 [add_for_loop] 的扩展, 就是那个让你扩展出类似 C 风格的 [for] 循环指令的练习。请证明指令: for (c1 ; b ; c2) { @@ -1454,11 +1468,13 @@ End Himp. c2 END *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) -(** **** 练习:3 星, optional (swap_noninterfering_assignments) *) -(** (提示:这里你需要 [functional_extensionality]。) *) +(** **** 练习:3 星, standard, optional (swap_noninterfering_assignments) + + (提示:这里你需要 [functional_extensionality]。) *) Theorem swap_noninterfering_assignments: forall l1 l2 a1 a2, l1 <> l2 -> @@ -1471,23 +1487,31 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced, optional (capprox) *) -(** 在这个练习中我们定义了一个非对称的程序等价变形, 叫做 +(** **** 练习:4 星, advanced, optional (capprox) + + 在这个练习中我们定义了一个非对称的程序等价变形, 叫做 _'程序近似(program approximation)'_。 当每个能让 [c1] 停机的初始状态也能让 [c2] 在相同的状态下停机时,我们就说程序 [c1] _'近似与'_ 程序 [c2] 。下面是程序近似的形式化定义: *) Definition capprox (c1 c2 : com) : Prop := forall (st st' : state), - c1 / st \\ st' -> c2 / st \\ st'. + st =[ c1 ]=> st' -> st =[ c2 ]=> st'. + +(** 例如,程序 + + c1 = WHILE ~(X = 1) DO + X ::= X - 1 + END -(** 例如,程序 [c1 = WHILE !(X = 1) DO X ::= X - 1 END] 近似于 [c2 = X ::= 1],但是 [c2] 不近似于 [c1],因为 [c1] 不会在 [X = 0] 时停机,而 [c2] 会。如果两个程序互相近似,那么它们等价。 *) (** 请找出两个程序 [c3] 和 [c4],它们互不近似。 *) -Definition c3 : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. -Definition c4 : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. +Definition c3 : com + (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. +Definition c4 : com + (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Theorem c3_c4_different : ~ capprox c3 c4 /\ ~ capprox c4 c3. Proof. (* 请在此处解答 *) Admitted. @@ -1510,4 +1534,4 @@ Theorem zprop_preserving : forall c c', Proof. (* 请在此处解答 *) Admitted. (** [] *) - +(* Sat Jan 26 15:15:43 UTC 2019 *) diff --git a/plf-current/EquivTest.v b/plf-current/EquivTest.v index 7f450897..12dd38b0 100644 --- a/plf-current/EquivTest.v +++ b/plf-current/EquivTest.v @@ -44,17 +44,17 @@ Print Assumptions skip_right. Goal True. idtac " ". -idtac "------------------- IFB_false --------------------". +idtac "------------------- TEST_false --------------------". idtac " ". -idtac "#> IFB_false". +idtac "#> TEST_false". idtac "Possible points: 2". -check_type @IFB_false ( +check_type @TEST_false ( (forall (b : Imp.bexp) (c1 c2 : Imp.com), bequiv b Imp.BFalse -> cequiv (Imp.CIf b c1 c2) c2)). idtac "Assumptions:". Abort. -Print Assumptions IFB_false. +Print Assumptions TEST_false. Goal True. idtac " ". @@ -93,8 +93,8 @@ idtac " ". idtac "#> assign_aequiv". idtac "Possible points: 2". check_type @assign_aequiv ( -(forall (X : String.string) (e : Imp.aexp), - aequiv (Imp.AId X) e -> cequiv Imp.CSkip (Imp.CAss X e))). +(forall (x : String.string) (e : Imp.aexp), + aequiv (Imp.AId x) e -> cequiv Imp.CSkip (Imp.CAss x e))). idtac "Assumptions:". Abort. Print Assumptions assign_aequiv. @@ -234,8 +234,8 @@ idtac "". idtac "********** Standard **********". idtac "---------- skip_right ---------". Print Assumptions skip_right. -idtac "---------- IFB_false ---------". -Print Assumptions IFB_false. +idtac "---------- TEST_false ---------". +Print Assumptions TEST_false. idtac "---------- swap_if_branches ---------". Print Assumptions swap_if_branches. idtac "---------- WHILE_true ---------". @@ -265,3 +265,5 @@ Print Assumptions Himp.p1_p2_equiv. idtac "---------- Himp.p3_p4_inequiv ---------". Print Assumptions Himp.p3_p4_inequiv. Abort. + +(* Sat Jan 26 15:15:53 UTC 2019 *) diff --git a/plf-current/Hoare.html b/plf-current/Hoare.html index c65d376b..8fe619e3 100644 --- a/plf-current/Hoare.html +++ b/plf-current/Hoare.html @@ -32,22 +32,16 @@

              Hoare霍尔逻辑(第一部分)

              -
              - -
              - -
              Remove "Nat." -
              -
              + Set Warnings "-notation-overridden,-parsing".
              -Require Import Coq.Bool.Bool.
              -Require Import Coq.Arith.Arith.
              -Require Import Coq.Arith.EqNat.
              -Require Import Coq.Arith.PeanoNat. Import Nat.
              -Require Import Coq.omega.Omega.
              -From PLF Require Import Imp.
              From PLF Require Import Maps.
              +From Coq Require Import Bool.Bool.
              +From Coq Require Import Arith.Arith.
              +From Coq Require Import Arith.EqNat.
              +From Coq Require Import Arith.PeanoNat. Import Nat.
              +From Coq Require Import omega.Omega.
              +From PLF Require Import Imp.
              @@ -146,7 +140,8 @@

              Hoare霍尔逻辑(第一部分)< ——其中“复合”的意思是,这些证明的结构直接反映了相应程序的结构。
              - 在这一章里: + 本章概览... + 主题:
              @@ -212,7 +207,7 @@

              Hoare霍尔逻辑(第一部分)<

              -

              练习:1 星, optional (assertions)

              +

              练习:1 星, standard, optional (assertions)

              用中文重新表述下列断言(或者用你最喜欢的语言)。
              @@ -224,7 +219,7 @@

              Hoare霍尔逻辑(第一部分)<   fun stst X = 3 ∨ st Xst Y.
              Definition as4 : Assertion :=
                fun stst Z * st Zst X
              -            ¬ (((S (st Z)) * (S (st Z))) ≤ st X).
              +            ¬(((S (st Z)) * (S (st Z))) ≤ st X).
              Definition as5 : Assertion := fun stTrue.
              Definition as6 : Assertion := fun stFalse.
              (* 请在此处解答 *)
              @@ -248,7 +243,7 @@

              Hoare霍尔逻辑(第一部分)<
                    fun st ⇒ (st Z) * (st Z) ≤ m ∧
              -                ¬ ((S (st Z)) * (S (st Z)) ≤ m) +                ¬((S (st Z)) * (S (st Z)) ≤ m)
              @@ -272,13 +267,13 @@

              Hoare霍尔逻辑(第一部分)<
              给出两断言 PQ,我们说 P 蕴含 Q, - 写作 P ->> Q,如果当 Pst 下成立,Q 也成立。 + 写作 P ->> Q,如果当 Pst 下成立,Q 也成立。

              Definition assert_implies (P Q : Assertion) : Prop :=
              -   st, P stQ st.

              -Notation "P ->> Q" := (assert_implies P Q)
              +  st, P stQ st.

              +Notation "P ->> Q" := (assert_implies P Q)
                                    (at level 80) : hoare_spec_scope.
              Open Scope hoare_spec_scope.
              @@ -293,8 +288,8 @@

              Hoare霍尔逻辑(第一部分)<
              -Notation "P <<->> Q" :=
              -  (P ->> QQ ->> P) (at level 80) : hoare_spec_scope.
              +Notation "P <<->> Q" :=
              +  (P ->> QQ ->> P) (at level 80) : hoare_spec_scope.
              @@ -328,9 +323,9 @@

              Hoare霍尔逻辑(第一部分)<
              Definition hoare_triple
              -           (P:Assertion) (c:com) (Q:Assertion) : Prop :=
              -   st st',
              -     c / st \\ st'
              +           (P : Assertion) (c : com) (Q : Assertion) : Prop :=
              +  st st',
              +     st =[ c ]⇒ st'
                   P st
                   Q st'.
              @@ -357,7 +352,7 @@

              Hoare霍尔逻辑(第一部分)<

              -

              练习:1 星, optional (triples)

              +

              练习:1 星, standard, optional (triples)

              用中文重新表述下列霍尔三元组。
              @@ -377,17 +372,21 @@

              Hoare霍尔逻辑(第一部分)<
                 6) {{X = m}}
                    c
              -      {{(Z * Z) ≤ m ∧ ¬ (((S Z) * (S Z)) ≤ m)}} +      {{(Z * Z) ≤ m ∧ ¬(((S Z) * (S Z)) ≤ m)}}

              -
              + +
              +(* 请在此处解答 *)
              +
              - + +
              -

              练习:1 星, optional (valid_triples)

              +

              练习:1 星, standard, optional (valid_triples)

              下列的霍尔三元组是否有效,亦即,表述的 PcQ 之间的 关系是否为真? @@ -398,7 +397,7 @@

              Hoare霍尔逻辑(第一部分)<
                 2) {{X = 2}X ::= X + 1 {{X = 3}}

              -   3) {{True}X ::= 5; Y ::= 0 {{X = 5}}
              +   3) {{True}X ::= 5;; Y ::= 0 {{X = 5}}

                 4) {{X = 2 ∧ X = 3}X ::= 5 {{X = 0}}

              @@ -413,12 +412,19 @@

              Hoare霍尔逻辑(第一部分)<       {{X = 1}}

                 9) {{X = 1}}
              -        WHILE !(X = 0) DO X ::= X + 1 END
              +        WHILE ~(X = 0) DO X ::= X + 1 END
                    {{X = 100}}

              - + + +
              +(* 请在此处解答 *)
              +
              + + +
              为了热身,这里有两个关于霍尔三元组的简单定理。 @@ -426,8 +432,8 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem hoare_post_true : (P Q : Assertion) c,
              -  ( st, Q st) →
              +Theorem hoare_post_true : (P Q : Assertion) c,
              +  (st, Q st) →
                {{P}} c {{Q}}.
              @@ -438,8 +444,8 @@

              Hoare霍尔逻辑(第一部分)<


              -Theorem hoare_pre_false : (P Q : Assertion) c,
              -  ( st, ~(P st)) →
              +Theorem hoare_pre_false : (P Q : Assertion) c,
              +  (st, ¬(P st)) →
                {{P}} c {{Q}}.
              @@ -506,7 +512,7 @@

              Hoare霍尔逻辑(第一部分)<
              -       {a = 1 }}  X ::= a {X = 1 }} +       {a = 1 }}  X ::= a  {X = 1 }}
              @@ -520,11 +526,11 @@

              Hoare霍尔逻辑(第一部分)<
              -      {Q [X |-> a}X ::= a {Q }} +      {Q [X > a}X ::= a {Q }}
              - 其中 "Q [X |-> a]" 读作 “在 Q 中把 X 换成 a”。 + 其中 "Q [X > a]" 读作 “在 Q 中把 X 换成 a”。
              例如,下列这些是赋值规则正确的应用: @@ -532,18 +538,18 @@

              Hoare霍尔逻辑(第一部分)<
              -      {{ (X ≤ 5) [X |-> X + 1]
              +      {{ (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]
              +         i.e., 3 = 3 }}
                    X ::= 3
                    {X = 3 }}

              -      {{ (0 ≤ X ∧ X ≤ 5) [X |-> 3]
              -         i.e., (0 ≤ 3 ∧ 3 ≤ 5)}}
              +      {{ (0 ≤ X ∧ X ≤ 5) [X > 3]
              +         i.e., (0 ≤ 3 ∧ 3 ≤ 5) }}
                    X ::= 3
                    {{ 0 ≤ X ∧ X ≤ 5 }}
              @@ -566,25 +572,26 @@

              Hoare霍尔逻辑(第一部分)< Definition assn_sub X a P : Assertion :=
                fun (st : state) ⇒
              -    P (st & { X --> aeval st a }).

              -Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10).
              +    P (X !-> aeval st a ; st).

              +Notation "P [ X > a ]" := (assn_sub X a P)
              +  (at level 10, X at next level).

              -也就是说,P [X |-> a] 是一个新的断言——我们把它叫做 P' —— +也就是说,P [X > a] 是一个新的断言——我们把它叫做 P' —— 它就是 P,不过当 P 在当前状态中查找变量 X 的时候,P' 使用表 达式 a 的值。
              为了演示工作原理,我们来计算一下这几个例子中发生了些什么。首先,假设 - P'(X 5) [X |-> 3] ——或者,更形式化地, P' 是 Coq 表达式 + P'(X 5) [X > 3] ——或者,更形式化地, P' 是 Coq 表达式
                  fun st ⇒
                    (fun st' ⇒ st' X ≤ 5)
              -      (st & { X --> aeval st 3 }) +      (X !-> aeval st 3 ; st),
              @@ -595,7 +602,7 @@

              Hoare霍尔逻辑(第一部分)<
                  fun st ⇒
                    (fun st' ⇒ st' X ≤ 5)
              -      (st & { X --> 3 }) +      (X !-> 3 ; st)
              @@ -605,7 +612,7 @@

              Hoare霍尔逻辑(第一部分)<
                  fun st ⇒
              -      ((st & { X --> 3 }) X) ≤ 5 +      ((X !-> 3 ; stX) ≤ 5
              @@ -622,7 +629,7 @@

              Hoare霍尔逻辑(第一部分)< 也就是说,P' 是一个断言指出 3 小于等于 5(像我们想的一样)。
              - 一个更有趣的例子是,假设 P'(X 5) [X |-> X+1]。形式化地,P' + 一个更有趣的例子是,假设 P'(X 5) [X > X + 1]。形式化地,P' 是 Coq 表达式
              @@ -630,7 +637,7 @@

              Hoare霍尔逻辑(第一部分)<
                  fun st ⇒
                    (fun st' ⇒ st' X ≤ 5)
              -      (st & { X --> aeval st (X+1) }), +      (X !-> aeval st (X + 1) ; st),
              @@ -640,7 +647,7 @@

              Hoare霍尔逻辑(第一部分)<
                  fun st ⇒
              -      (st & { X --> aeval st (X+1) }) X ≤ 5 +      (X !-> aeval st (X + 1) ; stX ≤ 5
              @@ -650,11 +657,11 @@

              Hoare霍尔逻辑(第一部分)<
                  fun st ⇒
              -      (aeval st (X+1)) ≤ 5. +      (aeval st (X + 1)) ≤ 5.
              - 也就是说,P' 指出 X+1 最多是 5。 + 也就是说,P' 指出 X + 1 最多是 5
              @@ -669,7 +676,7 @@

              Hoare霍尔逻辑(第一部分)<

              - +

              {{Q [X |-> a]}} X ::= a {{Q}}{{Q [X > a]}} X ::= a {{Q}}
              @@ -679,8 +686,8 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem hoare_asgn : Q X a,
              -  {{Q [X |-> a]}} (X ::= a) {{Q}}.
              +Theorem hoare_asgn : Q X a,
              +  {{Q [X > a]}} X ::= a {{Q}}.
              Proof.
              @@ -697,8 +704,8 @@

              Hoare霍尔逻辑(第一部分)<
              Example assn_sub_example :
              -  {{(fun stst X < 5) [X |-> X+1]}}
              -  (X ::= X+1)
              +  {{(fun stst X < 5) [X > X + 1]}}
              +  X ::= X + 1
                {{fun stst X < 5}}.
              Proof.
                (* 课上已完成 *)
              @@ -711,24 +718,24 @@

              Hoare霍尔逻辑(第一部分)<
              -      {{X < 4}} (X ::= X+1) {{X < 5}} +      {{X < 4}X ::= X + 1 {{X < 5}}
              我们会在下一节中了解怎么做。
              -

              练习:2 星 (hoare_asgn_examples)

              +

              练习:2 星, standard (hoare_asgn_examples)

              将下列非正式的霍尔三元组……
              -    1) {{ (X ≤ 10) [X |-> 2 * X}}
              +    1) {{ (X ≤ 10) [X > 2 * X}}
                     X ::= 2 * X
                     {X ≤ 10 }}

              -    2) {{ (0 ≤ X ∧ X ≤ 5) [X |-> 3] }}
              +    2) {{ (0 ≤ X ∧ X ≤ 5) [X > 3] }}
                     X ::= 3
                     {{ 0 ≤ X ∧ X ≤ 5 }}
              @@ -748,7 +755,7 @@

              Hoare霍尔逻辑(第一部分)<
              -

              练习:2 星, recommended (hoare_asgn_wrong)

              +

              练习:2 星, standard, recommended (hoare_asgn_wrong)

              几乎所有人在看赋值规则第一眼就会觉得它是反向的。如果你还感觉很 迷惑,思考一些“正向”的规则可能有帮助。这里是一个看起来挺自然的 霍尔三元组: @@ -777,12 +784,9 @@

              Hoare霍尔逻辑(第一部分)<

              -
              - -Local Close Scope aexp_scope.
              -
              +
              +
              -

              练习:3 星, advanced (hoare_asgn_fwd)

              然而,通过引入一个参数 m(一个 Coq 整数)来记录 X 原 来的值,我们可以定义一个赋值的证明规则,它可以,直觉上讲,“正向地 @@ -809,7 +813,7 @@

              Hoare霍尔逻辑(第一部分)< - (其中 st' = st & { X --> m }) + (其中 st' = (X !-> m ; st)) 可以注意到,在赋值发生之前我们用 X 原来的值重新构造了状态 @@ -819,11 +823,11 @@

              Hoare霍尔逻辑(第一部分)<
              Theorem hoare_asgn_fwd :
              -   m a P,
              +  m a P,
                {{fun stP stst X = m}}
                  X ::= a
              -  {{fun stP (st & { X --> m })
              -            ∧ st X = aeval (st & { X --> m }) a }}.
              +  {{fun stP (X !-> m ; st)
              +           ∧ st X = aeval (X !-> m ; st) a }}.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -853,11 +857,11 @@

              Hoare霍尔逻辑(第一部分)< - {{fun st ⇒  m, P (st & { X --> m }) ∧ + {{fun st ⇒ m, P (X !-> m ; st) ∧ - st X = aeval (st & { X --> m }) a }} + st X = aeval (X !-> m ; st) a }} @@ -865,11 +869,11 @@

              Hoare霍尔逻辑(第一部分)<
              Theorem hoare_asgn_fwd_exists :
              -   a P,
              +  a P,
                {{fun stP st}}
                  X ::= a
              -  {{fun st m, P (st & { X --> m }) ∧
              -                st X = aeval (st & { X --> m }) a }}.
              +  {{fun stm, P (X !-> m ; st) ∧
              +                st X = aeval (X !-> m ; st) a }}.
              Proof.
                intros a P.
                (* 请在此处解答 *) Admitted.
              @@ -894,7 +898,7 @@

              Hoare霍尔逻辑(第一部分)<
              -      {{(X = 3) [X |-> 3]}X ::= 3 {{X = 3}} +      {{(X = 3) [X > 3]}X ::= 3 {{X = 3}}
              @@ -908,7 +912,7 @@

              Hoare霍尔逻辑(第一部分)<

              却不行。这个三元组是有效的,不过它并不是 hoare_asgn 的实例,因 - 为 True and (X = 3) [X |-> 3] 在语法上并不是相同的断言。然而, + 为 True and (X = 3) [X > 3] 在语法上并不是相同的断言。然而, 它们在逻辑上等价,所以前面那个三元组成立,后者也一定成立。 我们把这种想法用下列规则写出来:
              @@ -917,7 +921,7 @@

              Hoare霍尔逻辑(第一部分)<

              - + @@ -940,7 +944,7 @@

              Hoare霍尔逻辑(第一部分)<

              - + @@ -957,7 +961,7 @@

              Hoare霍尔逻辑(第一部分)<

              - + @@ -975,9 +979,9 @@

              Hoare霍尔逻辑(第一部分)<
              -Theorem hoare_consequence_pre : (P P' Q : Assertion) c,
              +Theorem hoare_consequence_pre : (P P' Q : Assertion) c,
                {{P'}} c {{Q}} →
              -  P ->> P'
              +  P ->> P'
                {{P}} c {{Q}}.
              @@ -988,9 +992,9 @@

              Hoare霍尔逻辑(第一部分)<


              -Theorem hoare_consequence_post : (P Q Q' : Assertion) c,
              +Theorem hoare_consequence_post : (P Q Q' : Assertion) c,
                {{P}} c {{Q'}} →
              -  Q' ->> Q
              +  Q' ->> Q
                {{P}} c {{Q}}.
              @@ -1009,10 +1013,10 @@

              Hoare霍尔逻辑(第一部分)<
              -                {True }->>
              -                {{ 1 = 1 }}
              +      {True }->>
              +      {{ 1 = 1 }}
                  X ::= 1
              -                {X = 1 }} +      {X = 1 }}
              @@ -1021,11 +1025,11 @@

              Hoare霍尔逻辑(第一部分)<
              Example hoare_asgn_example1 :
              -  {{fun stTrue}} (X ::= 1) {{fun stst X = 1}}.
              +  {{fun stTrue}} X ::= 1 {{fun stst X = 1}}.
              Proof.
                (* 课上已完成 *)
                apply hoare_consequence_pre
              -    with (P' := (fun stst X = 1) [X |-> 1]).
              +    with (P' := (fun stst X = 1) [X > 1]).
                apply hoare_asgn.
                intros st H. unfold assn_sub, t_update. simpl. reflexivity.
              Qed.
              @@ -1037,10 +1041,10 @@

              Hoare霍尔逻辑(第一部分)<
              -                {X < 4 }->>
              -                {{ (X < 5)[X |-> X+1] }}
              +      {X < 4 }->>
              +      {{ (X < 5)[X > X + 1] }}
                  X ::= X + 1
              -                {X < 5 }} +      {X < 5 }}
              @@ -1050,12 +1054,12 @@

              Hoare霍尔逻辑(第一部分)< Example assn_sub_example2 :
                {{(fun stst X < 4)}}
              -  (X ::= X+1)
              +  X ::= X + 1
                {{fun stst X < 5}}.
              Proof.
                (* 课上已完成 *)
                apply hoare_consequence_pre
              -    with (P' := (fun stst X < 5) [X |-> X+1]).
              +    with (P' := (fun stst X < 5) [X > X + 1]).
                apply hoare_asgn.
                intros st H. unfold assn_sub, t_update. simpl. omega.
              Qed.
              @@ -1070,11 +1074,11 @@

              Hoare霍尔逻辑(第一部分)<

              - + - + @@ -1089,10 +1093,10 @@

              Hoare霍尔逻辑(第一部分)<
              -Theorem hoare_consequence : (P P' Q Q' : Assertion) c,
              +Theorem hoare_consequence : (P P' Q Q' : Assertion) c,
                {{P'}} c {{Q'}} →
              -  P ->> P'
              -  Q' ->> Q
              +  P ->> P'
              +  Q' ->> Q
                {{P}} c {{Q}}.
              @@ -1132,7 +1136,7 @@

              Hoare霍尔逻辑(第一部分)< Example hoare_asgn_example1' :
                {{fun stTrue}}
              -  (X ::= 1)
              +  X ::= 1
                {{fun stst X = 1}}.
              Proof.
                eapply hoare_consequence_pre.
              @@ -1155,9 +1159,9 @@

              Hoare霍尔逻辑(第一部分)<

              -Lemma silly1 : (P : natnatProp) (Q : natProp),
              -  ( x y : nat, P x y) →
              -  ( x y : nat, P x yQ x) →
              +Lemma silly1 : (P : natnatProp) (Q : natProp),
              +  (x y : nat, P x y) →
              +  (x y : nat, P x yQ x) →
                Q 42.
              Proof.
                intros P Q HP HQ. eapply HQ. apply HP.
              @@ -1180,9 +1184,9 @@

              Hoare霍尔逻辑(第一部分)<
              Lemma silly2 :
              -   (P : natnatProp) (Q : natProp),
              -  ( y, P 42 y) →
              -  ( x y : nat, P x yQ x) →
              +  (P : natnatProp) (Q : natProp),
              +  (y, P 42 y) →
              +  (x y : nat, P x yQ x) →
                Q 42.
              Proof.
                intros P Q HP HQ. eapply HQ. destruct HP as [y HP'].
              @@ -1194,19 +1198,18 @@

              Hoare霍尔逻辑(第一部分)<
              -     ErrorImpossible to unify "?175" with "y". +      ErrorImpossible to unify "?175" with "y".
              有一个简单的解决办法:把 destruct HP 提到 eapply HQ 之前

              - Abort.

              Lemma silly2_fixed :
              -   (P : natnatProp) (Q : natProp),
              -  ( y, P 42 y) →
              -  ( x y : nat, P x yQ x) →
              +  (P : natnatProp) (Q : natProp),
              +  (y, P 42 y) →
              +  (x y : nat, P x yQ x) →
                Q 42.
              Proof.
                intros P Q HP HQ. destruct HP as [y HP'].
              @@ -1226,9 +1229,9 @@

              Hoare霍尔逻辑(第一部分)<

              -Lemma silly2_eassumption : (P : natnatProp) (Q : natProp),
              -  ( y, P 42 y) →
              -  ( x y : nat, P x yQ x) →
              +Lemma silly2_eassumption : (P : natnatProp) (Q : natProp),
              +  (y, P 42 y) →
              +  (x y : nat, P x yQ x) →
                Q 42.
              Proof.
                intros P Q HP HQ. destruct HP as [y HP']. eapply HQ. eassumption.
              @@ -1236,7 +1239,7 @@

              Hoare霍尔逻辑(第一部分)<

              -

              练习:2 星 (hoare_asgn_examples_2)

              +

              练习:2 星, standard (hoare_asgn_examples_2)

              将下述的非形式化霍尔三元组
              @@ -1282,7 +1285,7 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem hoare_skip : P,
              +Theorem hoare_skip : P,
                   {{P}} SKIP {{P}}.
              @@ -1322,7 +1325,7 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem hoare_seq : P Q R c1 c2,
              +Theorem hoare_seq : P Q R c1 c2,
                   {{Q}} c2 {{R}} →
                   {{P}} c1 {{Q}} →
                   {{P}} c1;;c2 {{R}}.
              @@ -1351,7 +1354,7 @@

              Hoare霍尔逻辑(第一部分)<
                    {a = n }}
                  X ::= a;;
              -      {X = n }}    <----
              +      {X = n }}    <--- decoration for Q
                  SKIP
                    {X = n }}
              @@ -1364,9 +1367,9 @@

              Hoare霍尔逻辑(第一部分)<

              -Example hoare_asgn_example3 : a n,
              +Example hoare_asgn_example3 : a n,
                {{fun staeval st a = n}}
              -  (X ::= a;; SKIP)
              +  X ::= a;; SKIP
                {{fun stst X = n}}.
              Proof.
                intros a n. eapply hoare_seq.
              @@ -1383,28 +1386,29 @@

              Hoare霍尔逻辑(第一部分)< hoare_consequence_pre 以及 eapply 策略一起使用,如上所示。
              -

              练习:2 星, recommended (hoare_asgn_example4)

              +

              练习:2 星, standard, recommended (hoare_asgn_example4)

              将这个“标注程序”翻译成正式证明:
              -                   {True }->>
              +                   {True }->>
                                 {{ 1 = 1 }}
                  X ::= 1;;
              -                   {X = 1 }->>
              +                   {X = 1 }->>
                                 {X = 1 ∧ 2 = 2 }}
                  Y ::= 2
                                 {X = 1 ∧ Y = 2 }}
              - (带 “->>” 的标记代表了使用 hoare_consequence_pre。) + (带 “->>” 的标记代表了使用 hoare_consequence_pre。)

              Example hoare_asgn_example4 :
              -  {{fun stTrue}} (X ::= 1;; Y ::= 2)
              +  {{fun stTrue}}
              +  X ::= 1;; Y ::= 2
                {{fun stst X = 1 ∧ st Y = 2}}.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -1414,7 +1418,7 @@

              Hoare霍尔逻辑(第一部分)<
              -

              练习:3 星 (swap_exercise)

              +

              练习:3 星, standard (swap_exercise)

              写一个 Imp 程序 c,用来交换变量 XY 并且说明 它符合如下规范: @@ -1425,7 +1429,9 @@

              Hoare霍尔逻辑(第一部分)<

              - 你的证明不应该使用 unfold hoare_triple。 + 你的证明不应该使用 unfold hoare_triple。 + (提示:记住赋值规则在“从后往前”,即从后置条件到前置条件应用时工作得最好。 + 因此你的证明可以从程序的后面开始逐步往前进行。)

              @@ -1443,15 +1449,15 @@

              Hoare霍尔逻辑(第一部分)<
              -

              练习:3 星 (hoarestate1)

              +

              练习:3 星, standard (hoarestate1)

              解释为何下列命题无法被证明:
              -       (a : aexp) (n : nat),
              +      (a : aexp) (n : nat),
                       {{fun st ⇒ aeval st a = n}}
              -           (X ::= 3;; Y ::= a)
              +           X ::= 3;; Y ::= a
                       {{fun st ⇒ st Y = n}}.
              @@ -1492,7 +1498,7 @@

              Hoare霍尔逻辑(第一部分)<

              - +
              <<->> P'<<->> P' (hoare_consequence_pre_equiv)  
              ->> P'->> P' (hoare_consequence_pre)  
              Q' ->> QQ' ->> Q (hoare_consequence_post)  
              ->> P'->> P'
              Q' ->> QQ' ->> Q (hoare_consequence)  

              {{P}} IFB b THEN c1 ELSE c2 {{Q}}{{P}} TEST b THEN c1 ELSE c2 {{Q}}
              @@ -1504,9 +1510,9 @@

              Hoare霍尔逻辑(第一部分)<
                   {True }}
              -     IFB X = 0
              -     THEN Y ::= 2
              -     ELSE Y ::= X + 1
              +     TEST X = 0
              +       THEN Y ::= 2
              +       ELSE Y ::= X + 1
                   FI
                   {X ≤ Y }}
              @@ -1523,11 +1529,11 @@

              Hoare霍尔逻辑(第一部分)<
              - + - + @@ -1535,7 +1541,7 @@

              Hoare霍尔逻辑(第一部分)<

              - +
              {{P ∧  b}} c1 {{Q}}{{P ∧   b}} c1 {{Q}}
              {{P ∧ ~b}} c2 {{Q}}{{P ∧ ¬b}} c2 {{Q}} (hoare_if)  

              {{P}} IFB b THEN c1 ELSE c2 FI {{Q}}{{P}} TEST b THEN c1 ELSE c2 FI {{Q}}
              @@ -1558,7 +1564,7 @@

              Hoare霍尔逻辑(第一部分)<

              -Lemma bexp_eval_true : b st,
              +Lemma bexp_eval_true : b st,
                beval st b = true → (bassn b) st.
              @@ -1568,8 +1574,8 @@

              Hoare霍尔逻辑(第一部分)<


              -Lemma bexp_eval_false : b st,
              -  beval st b = false → ¬ ((bassn b) st).
              +Lemma bexp_eval_false : b st,
              +  beval st b = false → ¬((bassn b) st).
              Proof.
              @@ -1584,10 +1590,10 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem hoare_if : P Q b c1 c2,
              +Theorem hoare_if : P Q b c1 c2,
                {{fun stP stbassn b st}} c1 {{Q}} →
              -  {{fun stP st ∧ ~(bassn b st)}} c2 {{Q}} →
              -  {{P}} (IFB b THEN c1 ELSE c2 FI) {{Q}}.
              +  {{fun stP st ∧ ¬(bassn b st)}} c2 {{Q}} →
              +  {{P}} TEST b THEN c1 ELSE c2 FI {{Q}}.
              Proof.
              @@ -1617,7 +1623,7 @@

              Hoare霍尔逻辑(第一部分)< Example if_example :
                  {{fun stTrue}}
              -  IFB X = 0
              +  TEST X = 0
                  THEN Y ::= 2
                  ELSE Y ::= X + 1
                FI
              @@ -1642,14 +1648,14 @@

              Hoare霍尔逻辑(第一部分)<

              -

              练习:2 星 (if_minus_plus)

              +

              练习:2 星, standard (if_minus_plus)

              hoare_if 证明下面的三元组。不要使用 unfold hoare_triple
              Theorem if_minus_plus :
                {{fun stTrue}}
              -  IFB XY
              +  TEST XY
                  THEN Z ::= Y - X
                  ELSE Y ::= X + Z
                FI
              @@ -1665,7 +1671,7 @@

              Hoare霍尔逻辑(第一部分)<
              -

              练习:4 星 (if1_hoare)

              +

              练习:4 星, standard (if1_hoare)

              在这个练习中我们考虑对 Imp 加入形如 IF1 b THEN c FI 的“单边条件”。 这里 b 是个布尔表达式而 c 是一个命令。如果 b 化简为 truec 就被执行,而如果 b 化简为 falseIF1 b THEN c FI 就啥也不做。 @@ -1690,17 +1696,17 @@

              Hoare霍尔逻辑(第一部分)<   | CWhile : bexpcomcom
                | CIf1 : bexpcomcom.

              Notation "'SKIP'" :=
              -  CSkip.
              +  CSkip : imp_scope.
              Notation "c1 ;; c2" :=
              -  (CSeq c1 c2) (at level 80, right associativity).
              +  (CSeq c1 c2) (at level 80, right associativity) : imp_scope.
              Notation "X '::=' a" :=
              -  (CAss X a) (at level 60).
              +  (CAss X a) (at level 60) : imp_scope.
              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).
              +  (CWhile b c) (at level 80, right associativity) : imp_scope.
              +Notation "'TEST' e1 'THEN' e2 'ELSE' e3 'FI'" :=
              +  (CIf e1 e2 e3) (at level 80, right associativity) : imp_scope.
              Notation "'IF1' b 'THEN' c 'FI'" :=
              -  (CIf1 b c) (at level 80, right associativity).
              +  (CIf1 b c) (at level 80, right associativity) : imp_scope.

              @@ -1709,29 +1715,38 @@

              Hoare霍尔逻辑(第一部分)<

              -Reserved Notation "c1 '/' st '\\' st'" (at level 40, st at level 39).

              +Reserved Notation "st '=[' c ']⇒' st'" (at level 40).

              +Open Scope imp_scope.
              Inductive ceval : comstatestateProp :=
              -  | E_Skip : st : state, SKIP / st \\ st
              -  | E_Ass : (st : state) (a1 : aexp) (n : nat) (X : string),
              -            aeval st a1 = n → (X ::= a1) / st \\ 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_WhileFalse : (b1 : bexp) (st : state) (c1 : com),
              -                 beval st b1 = false → (WHILE b1 DO c1 END) / st \\ st
              -  | E_WhileTrue : (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_Skip : st,
              +      st =[ SKIP ]⇒ st
              +  | E_Ass : st a1 n x,
              +      aeval st a1 = n
              +      st =[ x ::= a1 ]⇒ (x !-> n ; st)
              +  | E_Seq : c1 c2 st st' st'',
              +      st =[ c1 ]⇒ st'
              +      st' =[ c2 ]⇒ st''
              +      st =[ c1 ;; c2 ]⇒ st''
              +  | E_IfTrue : st st' b c1 c2,
              +      beval st b = true
              +      st =[ c1 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_IfFalse : st st' b c1 c2,
              +      beval st b = false
              +      st =[ c2 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_WhileFalse : b st c,
              +      beval st b = false
              +      st =[ WHILE b DO c END ]⇒ st
              +  | E_WhileTrue : st st' st'' b c,
              +      beval st b = true
              +      st =[ c ]⇒ st'
              +      st' =[ WHILE b DO c END ]⇒ st''
              +      st =[ WHILE b DO c END ]⇒ st''
              (* 请在此处解答 *)

              -  where "c1 '/' st '\\' st'" := (ceval c1 st st').
              +  where "st '=[' c ']⇒' st'" := (ceval c st st').
              +Close Scope imp_scope.
              @@ -1739,9 +1754,10 @@

              Hoare霍尔逻辑(第一部分)<

              -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop :=
              -   st st',
              -       c / st \\ st'
              +Definition hoare_triple
              +           (P : Assertion) (c : com) (Q : Assertion) : Prop :=
              +  st st',
              +       st =[ c ]⇒ st'
                     P st
                     Q st'.

              Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q)
              @@ -1766,7 +1782,7 @@

              Hoare霍尔逻辑(第一部分)<
                {X + Y = Z }}
              -  IF1 !(Y = 0) THEN
              +  IF1 ~(Y = 0) THEN
                  X ::= X + Y
                FI
                {X = Z }} @@ -1783,9 +1799,9 @@

              Hoare霍尔逻辑(第一部分)< Lemma hoare_if1_good :
                {{ fun stst X + st Y = st Z }}
              -  IF1 !(Y = 0) THEN
              +  (IF1 ~(Y = 0) THEN
                  X ::= X + Y
              -  FI
              +  FI)%imp
                {{ fun stst X = st Z }}.
              Proof. (* 请在此处解答 *) Admitted.

              End If1.

              @@ -1877,7 +1893,7 @@

              Hoare霍尔逻辑(第一部分)<
              - {{P}} WHILE b DO c END {{P ∧ ~b}} + {{P}} WHILE b DO c END {{P ∧ ¬b}} 这几乎就是我们想要的规则,不过它还有一点可以改进的地方:在循环体 @@ -1886,9 +1902,7 @@

              Hoare霍尔逻辑(第一部分)<
              这给我们带来了一点额外的信息用来推论 c (用来说明它结束时 - 满足不变式)。 这让我们可以给出这个规则的最终版本: -
              - + 满足不变式)。 而这会将我们导向此规则的最终版本:
              @@ -1899,7 +1913,7 @@

              Hoare霍尔逻辑(第一部分)<

              - +
              {{P ∧ b}} c {{P}}
              {{P}} WHILE b DO c END {{P ∧ ~b}}{{P}} WHILE b DO c END {{P ∧ ¬b}}
              断言 P 叫做循环不变式(invariant of the loop)。 @@ -1907,16 +1921,16 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem hoare_while : P b c,
              +Theorem hoare_while : P b c,
                {{fun stP stbassn b st}} c {{P}} →
              -  {{P}} WHILE b DO c END {{fun stP st ∧ ¬ (bassn b st)}}.
              +  {{P}} WHILE b DO c END {{fun stP st ∧ ¬(bassn b st)}}.
              Proof.
                intros P b c Hhoare st st' He HP.
                (* 像之前见到过的,我们需要对 He 做归纳来推理。
                   因为,在“继续循环”的情形中,假设会是关于整个循环而不只是关于 c 的。*)

              -  remember (WHILE b DO c END) as wcom eqn:Heqwcom.
              +  remember (WHILE b DO c END)%imp as wcom eqn:Heqwcom.
                induction He;
                  try (inversion Heqwcom); subst; clear Heqwcom.
                - (* E_WhileFalse *)
              @@ -1943,7 +1957,7 @@

              Hoare霍尔逻辑(第一部分)<
              -    WHILE X = 2 DO X := 1 END +      WHILE X = 2 DO X := 1 END
              @@ -1978,7 +1992,7 @@

              Hoare霍尔逻辑(第一部分)<

              -Theorem always_loop_hoare : P Q,
              +Theorem always_loop_hoare : P Q,
                {{P}} WHILE true DO SKIP END {{Q}}.
              @@ -2015,8 +2029,8 @@

              Hoare霍尔逻辑(第一部分)<

              练习:4 星, advanced (hoare_repeat)

              - 在这个练习中,我们会往 Imp 里面加一种新的命令:REPEAT c UNTIL a END。 - 请你写出 repeat 的求值规则,并且写一个关于它的霍尔逻辑证明规则。 + 在这个练习中,我们会往 Imp 里面加一种新的命令:REPEAT c UNTIL b END。 + 请你写出 REPEAT 的求值规则,并且写一个关于它的霍尔逻辑证明规则。 (回想在 Auto 中给出的规则,试着自己把这个写出来,别偷看。)

              @@ -2046,7 +2060,7 @@

              Hoare霍尔逻辑(第一部分)<   (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'" :=
              +Notation "'TEST' 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).
              @@ -2059,34 +2073,36 @@

              Hoare霍尔逻辑(第一部分)<

              +Reserved Notation "st '=[' c ']⇒' st'" (at level 40).

              Inductive ceval : statecomstateProp :=
              -  | E_Skip : st,
              -      ceval st SKIP st
              -  | E_Ass : st a1 n X,
              +  | E_Skip : st,
              +      st =[ SKIP ]⇒ st
              +  | E_Ass : st a1 n x,
                    aeval st a1 = n
              -      ceval st (X ::= a1) (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_WhileFalse : b1 st c1,
              -      beval st b1 = false
              -      ceval st (WHILE b1 DO c1 END) st
              -  | E_WhileTrue : 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''
              +      st =[ x ::= a1 ]⇒ (x !-> n ; st)
              +  | E_Seq : c1 c2 st st' st'',
              +      st =[ c1 ]⇒ st'
              +      st' =[ c2 ]⇒ st''
              +      st =[ c1 ;; c2 ]⇒ st''
              +  | E_IfTrue : st st' b c1 c2,
              +      beval st b = true
              +      st =[ c1 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_IfFalse : st st' b c1 c2,
              +      beval st b = false
              +      st =[ c2 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_WhileFalse : b st c,
              +      beval st b = false
              +      st =[ WHILE b DO c END ]⇒ st
              +  | E_WhileTrue : st st' st'' b c,
              +      beval st b = true
              +      st =[ c ]⇒ st'
              +      st' =[ WHILE b DO c END ]⇒ st''
              +      st =[ WHILE b DO c END ]⇒ st''
              (* 请在此处解答 *)
              -.
              +
              +where "st '=[' c ']⇒' st'" := (ceval st c st').
              @@ -2094,11 +2110,9 @@

              Hoare霍尔逻辑(第一部分)<

              -Notation "c1 '/' st '\\' st'" := (ceval st c1 st')
              -                                 (at level 40, st at level 39).

              -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion)
              +Definition hoare_triple (P : Assertion) (c : com) (Q : Assertion)
                                      : Prop :=
              -   st st', (c / st \\ st') → P stQ st'.

              +  st st', st =[ c ]⇒ st'P stQ st'.

              Notation "{{ P }} c {{ Q }}" :=
                (hoare_triple P c Q) (at level 90, c at next level).
              @@ -2115,7 +2129,7 @@

              Hoare霍尔逻辑(第一部分)<     Y ::= Y + 1
                UNTIL X = 1 END.

              Theorem ex1_repeat_works :
              -  ex1_repeat / { --> 0 } \\ { X --> 1 ; Y --> 1 }.
              +  empty_st =[ ex1_repeat ]⇒ (Y !-> 1 ; X !-> 1).
              Proof.
                (* 请在此处解答 *) Admitted.

              @@ -2174,7 +2188,7 @@

              Hoare霍尔逻辑(第一部分)<
              - {{Q [X |-> a]}} X::={{Q}} + {{Q [X > a]}} X::={{Q}}
              @@ -2209,11 +2223,11 @@

              Hoare霍尔逻辑(第一部分)<

              - + - + @@ -2221,7 +2235,7 @@

              Hoare霍尔逻辑(第一部分)<

              - +
              {{P ∧  b}} c1 {{Q}}{{P ∧   b}} c1 {{Q}}
              {{P ∧ ~b}} c2 {{Q}}{{P ∧ ¬b}} c2 {{Q}} (hoare_if)  

              {{P}} IFB b THEN c1 ELSE c2 FI {{Q}}{{P}} TEST b THEN c1 ELSE c2 FI {{Q}}
              @@ -2234,7 +2248,7 @@

              Hoare霍尔逻辑(第一部分)<

              - +

              {{P}} WHILE b DO c END {{P ∧ ~b}}{{P}} WHILE b DO c END {{P ∧ ¬b}}
              @@ -2243,11 +2257,11 @@

              Hoare霍尔逻辑(第一部分)<

              - + - + @@ -2266,7 +2280,7 @@

              Hoare霍尔逻辑(第一部分)<
              -

              练习:3 星 (hoare_havoc)

              +

              练习:3 星, standard (hoare_havoc)

              在这个练习中我们将会为一种 HAVOC 命令实现证明规则,这个命令类似于 Imp 中的 any 表达式。 @@ -2293,33 +2307,40 @@

              Hoare霍尔逻辑(第一部分)<   (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'" :=
              +Notation "'TEST' 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).

              +Reserved Notation "st '=[' c ']⇒' st'" (at level 40).

              Inductive ceval : comstatestateProp :=
              -  | E_Skip : st : state, SKIP / st \\ st
              -  | E_Ass : (st : state) (a1 : aexp) (n : nat) (X : string),
              -            aeval st a1 = n → (X ::= a1) / st \\ 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_WhileFalse : (b1 : bexp) (st : state) (c1 : com),
              -                 beval st b1 = false → (WHILE b1 DO c1 END) / st \\ st
              -  | E_WhileTrue : (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 : string) (n : nat),
              -              (HAVOC X) / st \\ st & { X --> n }
              +  | E_Skip : st,
              +      st =[ SKIP ]⇒ st
              +  | E_Ass : st a1 n x,
              +      aeval st a1 = n
              +      st =[ x ::= a1 ]⇒ (x !-> n ; st)
              +  | E_Seq : c1 c2 st st' st'',
              +      st =[ c1 ]⇒ st'
              +      st' =[ c2 ]⇒ st''
              +      st =[ c1 ;; c2 ]⇒ st''
              +  | E_IfTrue : st st' b c1 c2,
              +      beval st b = true
              +      st =[ c1 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_IfFalse : st st' b c1 c2,
              +      beval st b = false
              +      st =[ c2 ]⇒ st'
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ st'
              +  | E_WhileFalse : b st c,
              +      beval st b = false
              +      st =[ WHILE b DO c END ]⇒ st
              +  | E_WhileTrue : st st' st'' b c,
              +      beval st b = true
              +      st =[ c ]⇒ st'
              +      st' =[ WHILE b DO c END ]⇒ st''
              +      st =[ WHILE b DO c END ]⇒ st''
              +  | E_Havoc : st X n,
              +      st =[ HAVOC X ]⇒ (X !-> n ; st)

              -  where "c1 '/' st '\\' st'" := (ceval c1 st st').
              +where "st '=[' c ']⇒' st'" := (ceval c st st').
              @@ -2328,7 +2349,7 @@

              Hoare霍尔逻辑(第一部分)<
              Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop :=
              -   st st', c / st \\ st'P stQ st'.

              +  st st', st =[ c ]⇒ st'P stQ st'.

              Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q)
                                                (at level 90, c at next level)
                                                : hoare_spec_scope.
              @@ -2342,7 +2363,7 @@

              Hoare霍尔逻辑(第一部分)< Definition havoc_pre (X : string) (Q : Assertion) : Assertion
                (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Theorem hoare_havoc : (Q : Assertion) (X : string),
              +Theorem hoare_havoc : (Q : Assertion) (X : string),
                {{ havoc_pre X Q }} HAVOC X {{ Q }}.
              Proof.
                (* 请在此处解答 *) Admitted.

              @@ -2350,6 +2371,305 @@

              Hoare霍尔逻辑(第一部分)<

              +
              +
              + +

              练习:4 星, standard, optional (assert_vs_assume)

              + +
              +
              + +
              +Module HoareAssertAssume.
              +
              + +
              + 在这个练习中我们会对 Imp 加入语句 ASSERTASSUME。这两个命令 + 都是用来指出某个布尔表达式应该在任何一次程序运行到这里的时候都为真。 + 但是它们有下列区别: + +
              + +
                +
              • 如果 ASSERT 失败了,程序就会进入错误状态并且退出。 + +
                + + +
              • +
              • 如果 ASSUME 失败了,程序就不能运行。换句话说这段程序会卡住,没有 + 最终状态。 + +
              • +
              + 新的一系列命令是: +
              +
              + +Inductive com : Type :=
              +  | CSkip : com
              +  | CAss : stringaexpcom
              +  | CSeq : comcomcom
              +  | CIf : bexpcomcomcom
              +  | CWhile : bexpcomcom
              +  | CAssert : bexpcom
              +  | CAssume : bexpcom.

              +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 "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" :=
              +  (CIf c1 c2 c3) (at level 80, right associativity).
              +Notation "'ASSERT' b" :=
              +  (CAssert b) (at level 60).
              +Notation "'ASSUME' b" :=
              +  (CAssume b) (at level 60).
              +
              + +
              +要定义 ASSERTASSUME 的行为,我们必须要加入一个表示错误 + 状态的记号,它指出某个 ASSERT 失败了。我们修改一下 ceval + 规则,让它是开始状态和“结束状态或者是 error”的关系。result + 类型是程序结束时的值,要么是 state 要么是 error。 +
              +
              + +Inductive result : Type :=
              +  | RNormal : stateresult
              +  | RError : result.
              +
              + +
              +现在我们可以给出新语言的 ceval 了。 +
              +
              + +Inductive ceval : comstateresultProp :=
              +  (* 稍加修改的旧有规则 *)
              +  | E_Skip : st,
              +      st =[ SKIP ]⇒ RNormal st
              +  | E_Ass : st a1 n x,
              +      aeval st a1 = n
              +      st =[ x ::= a1 ]⇒ RNormal (x !-> n ; st)
              +  | E_SeqNormal : c1 c2 st st' r,
              +      st =[ c1 ]⇒ RNormal st'
              +      st' =[ c2 ]⇒ r
              +      st =[ c1 ;; c2 ]⇒ r
              +  | E_SeqError : c1 c2 st,
              +      st =[ c1 ]⇒ RError
              +      st =[ c1 ;; c2 ]⇒ RError
              +  | E_IfTrue : st r b c1 c2,
              +      beval st b = true
              +      st =[ c1 ]⇒ r
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ r
              +  | E_IfFalse : st r b c1 c2,
              +      beval st b = false
              +      st =[ c2 ]⇒ r
              +      st =[ TEST b THEN c1 ELSE c2 FI ]⇒ r
              +  | E_WhileFalse : b st c,
              +      beval st b = false
              +      st =[ WHILE b DO c END ]⇒ RNormal st
              +  | E_WhileTrueNormal : st st' r b c,
              +      beval st b = true
              +      st =[ c ]⇒ RNormal st'
              +      st' =[ WHILE b DO c END ]⇒ r
              +      st =[ WHILE b DO c END ]⇒ r
              +  | E_WhileTrueError : st b c,
              +      beval st b = true
              +      st =[ c ]⇒ RError
              +      st =[ WHILE b DO c END ]⇒ RError
              +  (* Assert 和 Assume 的规则 *)
              +  | E_AssertTrue : st b,
              +      beval st b = true
              +      st =[ ASSERT b ]⇒ RNormal st
              +  | E_AssertFalse : st b,
              +      beval st b = false
              +      st =[ ASSERT b ]⇒ RError
              +  | E_Assume : st b,
              +      beval st b = true
              +      st =[ ASSUME b ]⇒ RNormal st
              +
              +where "st '=[' c ']⇒' r" := (ceval c st r).
              +
              + +
              +我们重新定义霍尔三元组:现在,{{P}} c {{Q}} 的意思是, + 当 c 在一个满足 P 的状态中启动并且停机在一个状态 r,那么 r + 不是错误并且满足 Q。 +
              +
              + +Definition hoare_triple
              +           (P : Assertion) (c : com) (Q : Assertion) : Prop :=
              +  st r,
              +     st =[ c ]⇒ rP st
              +     (st', r = RNormal st'Q st').

              +Notation "{{ P }} c {{ Q }}" :=
              +  (hoare_triple P c Q) (at level 90, c at next level)
              +  : hoare_spec_scope.
              +
              + +
              +为了测试你对这个修改的理解是否正确,请给出一组前置条件和后置条件, + 它们可以被 ASSUME 语句导出却不能被 ASSERT 导出。然后证明任何关于 + ASSERT 的三元组换成 ASSUME 也是正确的。 +
              +
              + +Theorem assert_assume_differ : P b Q,
              +       ({{P}} ASSUME b {{Q}})
              +  ∧ ¬({{P}} ASSERT b {{Q}}).
              +Proof.
              +(* 请在此处解答 *) Admitted.

              +Theorem assert_implies_assume : P b Q,
              +     ({{P}} ASSERT b {{Q}})
              +  → ({{P}} ASSUME b {{Q}}).
              +Proof.
              +(* 请在此处解答 *) Admitted.
              +
              + +
              +你的任务是为 ASSERTASSUME 创建霍尔规则,并且用它们证明 + 一个小程序是正确的。把你的规则起名为 hoare_asserthoare_assume。 + +
              + + 为了你方便点,我们把新语义上的那些旧有的霍尔规则帮你证明好了。 +
              +
              + +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.
              +  (X !-> aeval st a ; st). split; try reflexivity.
              +  assumption. Qed.

              +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 r Hc HP.
              +  unfold hoare_triple in Hhoare.
              +  assert (st', r = RNormal st'Q' st').
              +  { apply (Hhoare st); assumption. }
              +  destruct H as [st' [Hr HQ']].
              +  st'. split; try assumption.
              +  apply Himp. assumption.
              +Qed.

              +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 r H12 Pre.
              +  inversion H12; subst.
              +  - eapply H1.
              +    + apply H6.
              +    + apply H2 in H3. apply H3 in Pre.
              +        destruct Pre as [st'0 [Heq HQ]].
              +        inversion Heq; subst. assumption.
              +  - (* 找到矛盾的假设 *)
              +     apply H2 in H5. apply H5 in Pre.
              +     destruct Pre as [st' [C _]].
              +     inversion C.
              +Qed.
              +
              + +
              + 把你的霍尔规则,hoare_asserthoare_assume 写在下面。 +
              +
              + +(* 请在此处解答 *)
              +
              + +
              +下列是其它证明规则(用来检查是否合理) +
              +
              +Theorem hoare_skip : P,
              +     {{P}} SKIP {{P}}.
              +Proof.
              +  intros P st st' H HP. inversion H. subst.
              +  eexists. split. reflexivity. assumption.
              +Qed.

              +Theorem hoare_if : P Q b c1 c2,
              +  {{fun stP stbassn b st}} c1 {{Q}} →
              +  {{fun stP st ∧ ¬(bassn b st)}} c2 {{Q}} →
              +  {{P}} TEST b THEN c1 ELSE c2 FI {{Q}}.
              +Proof.
              +  intros P Q b c1 c2 HTrue HFalse st st' HE HP.
              +  inversion HE; subst.
              +  - (* b 是 true *)
              +    apply (HTrue st st').
              +      assumption.
              +      split. assumption.
              +      apply bexp_eval_true. assumption.
              +  - (* b 是 false *)
              +    apply (HFalse st st').
              +      assumption.
              +      split. assumption.
              +      apply bexp_eval_false. assumption. Qed.

              +Theorem hoare_while : P b c,
              +  {{fun stP stbassn b st}} c {{P}} →
              +  {{P}} WHILE b DO c END {{fun stP st ∧ ¬(bassn b st)}}.
              +Proof.
              +  intros P b c Hhoare st st' He HP.
              +  remember (WHILE b DO c END) as wcom eqn:Heqwcom.
              +  induction He;
              +    try (inversion Heqwcom); subst; clear Heqwcom.
              +  - (* E_WhileFalse *)
              +    eexists. split. reflexivity. split.
              +    assumption. apply bexp_eval_false. assumption.
              +  - (* E_WhileTrueNormal *)
              +    clear IHHe1.
              +    apply IHHe2. reflexivity.
              +    clear IHHe2 He2 r.
              +    unfold hoare_triple in Hhoare.
              +    apply Hhoare in He1.
              +    + destruct He1 as [st1 [Heq Hst1]].
              +        inversion Heq; subst.
              +        assumption.
              +    + split; assumption.
              +  - (* E_WhileTrueError *)
              +     exfalso. clear IHHe.
              +     unfold hoare_triple in Hhoare.
              +     apply Hhoare in He.
              +     + destruct He as [st' [C _]]. inversion C.
              +     + split; assumption.
              +Qed.

              +Example assert_assume_example:
              +  {{fun stTrue}}
              +  ASSUME (X = 1);;
              +  X ::= X + 1;;
              +  ASSERT (X = 2)
              +  {{fun stTrue}}.
              +Proof.
              +(* 请在此处解答 *) Admitted.

              +End HoareAssertAssume.
              +
              + + +
              + +(* Sat Jan 26 15:15:43 UTC 2019 *)
              +

              diff --git a/plf-current/Hoare.v b/plf-current/Hoare.v index e142b314..4beda4f3 100644 --- a/plf-current/Hoare.v +++ b/plf-current/Hoare.v @@ -1,15 +1,13 @@ (** * Hoare: 霍尔逻辑(第一部分) *) -(** Remove "Nat." - *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Bool.Bool. -Require Import Coq.Arith.Arith. -Require Import Coq.Arith.EqNat. -Require Import Coq.Arith.PeanoNat. Import Nat. -Require Import Coq.omega.Omega. -From PLF Require Import Imp. From PLF Require Import Maps. +From Coq Require Import Bool.Bool. +From Coq Require Import Arith.Arith. +From Coq Require Import Arith.EqNat. +From Coq Require Import Arith.PeanoNat. Import Nat. +From Coq Require Import omega.Omega. +From PLF Require Import Imp. (** 在_'逻辑基础'_(_'软件基础'_ 的第一章) 中, 我们用课程前面的部分中学习的数学工具研究了一个小型编程语言 Imp 。 @@ -62,7 +60,8 @@ From PLF Require Import Maps. ;和一种用来证明程序正确地实现了规范的_'复合证明技巧(compositional proof technique)'_ ——其中“复合”的意思是,这些证明的结构直接反映了相应程序的结构。*) -(** 在这一章里: +(** 本章概览... + 主题: - 推理 Imp 程序_'功能正确性(functional correctness)'_ 的系统方法 目标: @@ -86,8 +85,9 @@ From PLF Require Import Maps. Definition Assertion := state -> Prop. -(** **** 练习:1 星, optional (assertions) *) -(** 用中文重新表述下列断言(或者用你最喜欢的语言)。 *) +(** **** 练习:1 星, standard, optional (assertions) + + 用中文重新表述下列断言(或者用你最喜欢的语言)。 *) Module ExAssertions. Definition as1 : Assertion := fun st => st X = 3. @@ -108,8 +108,7 @@ End ExAssertions. (2) 状态 [st] 是唯一我们希望用来再断言中查找变量的状态(我们将不会 讨论在同一时间的两种不同状态。 当我们非正式地讨论某些例子的时候,我们会简化一下:我们把开头的 - [fun st =>] 去掉,并且用 [X] 来代替 [st X] 所以,我们将把*) -(** + [fun st =>] 去掉,并且用 [X] 来代替 [st X] 所以,我们将把 fun st => (st Z) * (st Z) <= m /\ ~ ((S (st Z)) * (S (st Z)) <= m) @@ -161,9 +160,9 @@ Notation "P <<->> Q" := (** 形式化地: *) Definition hoare_triple - (P:Assertion) (c:com) (Q:Assertion) : Prop := + (P : Assertion) (c : com) (Q : Assertion) : Prop := forall st st', - c / st \\ st' -> + st =[ c ]=> st' -> P st -> Q st'. @@ -171,16 +170,17 @@ Definition hoare_triple 利的: {{P}} c {{Q}}. -*) -(** (传统的记号是 [{P} c {Q}],不过单花括号已经被用在 Coq 中其 + + (传统的记号是 [{P} c {Q}],不过单花括号已经被用在 Coq 中其 它东西上了。*) Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) (at level 90, c at next level) : hoare_spec_scope. -(** **** 练习:1 星, optional (triples) *) -(** 用中文重新表述下列霍尔三元组。 +(** **** 练习:1 星, standard, optional (triples) + + 用中文重新表述下列霍尔三元组。 1) {{True}} c {{X = 5}} @@ -198,18 +198,20 @@ Notation "{{ P }} c {{ Q }}" := c {{(Z * Z) <= m /\ ~ (((S Z) * (S Z)) <= m)}} *) +(* 请在此处解答 -(** [] *) + [] *) -(** **** 练习:1 星, optional (valid_triples) *) -(** 下列的霍尔三元组是否_'有效'_,亦即,表述的 [P]、[c]、[Q] 之间的 +(** **** 练习:1 星, standard, optional (valid_triples) + + 下列的霍尔三元组是否_'有效'_,亦即,表述的 [P]、[c]、[Q] 之间的 关系是否为真? 1) {{True}} X ::= 5 {{X = 5}} 2) {{X = 2}} X ::= X + 1 {{X = 3}} - 3) {{True}} X ::= 5; Y ::= 0 {{X = 5}} + 3) {{True}} X ::= 5;; Y ::= 0 {{X = 5}} 4) {{X = 2 /\ X = 3}} X ::= 5 {{X = 0}} @@ -224,10 +226,12 @@ Notation "{{ P }} c {{ Q }}" := {{X = 1}} 9) {{X = 1}} - WHILE !(X = 0) DO X ::= X + 1 END + WHILE ~(X = 0) DO X ::= X + 1 END {{X = 100}} *) -(** [] *) +(* 请在此处解答 + + [] *) (** 为了热身,这里有两个关于霍尔三元组的简单定理。 (确保你弄懂它们的意思。)*) @@ -241,7 +245,7 @@ Proof. apply H. Qed. Theorem hoare_pre_false : forall (P Q : Assertion) c, - (forall st, ~(P st)) -> + (forall st, ~ (P st)) -> {{P}} c {{Q}}. Proof. intros P Q c H. unfold hoare_triple. @@ -282,7 +286,7 @@ Proof. (** 更一般地, 如果 [a] 是_'任意'_算术表达式,那么 - {{ a = 1 }} X ::= a {{ X = 1 }} + {{ a = 1 }} X ::= a {{ X = 1 }} 是一个有效的霍尔三元组。 *) @@ -302,12 +306,12 @@ Proof. {{ X <= 5 }} {{ (X = 3) [X |-> 3] - i.e., 3 = 3}} + i.e., 3 = 3 }} X ::= 3 {{ X = 3 }} {{ (0 <= X /\ X <= 5) [X |-> 3] - i.e., (0 <= 3 /\ 3 <= 5)}} + i.e., (0 <= 3 /\ 3 <= 5) }} X ::= 3 {{ 0 <= X /\ X <= 5 }} *) @@ -323,9 +327,10 @@ Proof. Definition assn_sub X a P : Assertion := fun (st : state) => - P (st & { X --> aeval st a }). + P (X !-> aeval st a ; st). -Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10). +Notation "P [ X |-> a ]" := (assn_sub X a P) + (at level 10, X at next level). (** 也就是说,[P [X |-> a]] 是一个新的断言——我们把它叫做 [P'] —— 它就是 [P],不过当 [P] 在当前状态中查找变量 [X] 的时候,[P'] 使用表 @@ -336,18 +341,18 @@ Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10). fun st => (fun st' => st' X <= 5) - (st & { X --> aeval st 3 }) + (X !-> aeval st 3 ; st), 它简化为 fun st => (fun st' => st' X <= 5) - (st & { X --> 3 }) + (X !-> 3 ; st) 并且可以进一步简化为 fun st => - ((st & { X --> 3 }) X) <= 5 + ((X !-> 3 ; st) X) <= 5 最终是 @@ -356,24 +361,24 @@ Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10). 也就是说,[P'] 是一个断言指出 [3] 小于等于 [5](像我们想的一样)。*) -(** 一个更有趣的例子是,假设 [P'] 是 [(X <= 5) [X |-> X+1]]。形式化地,[P'] +(** 一个更有趣的例子是,假设 [P'] 是 [(X <= 5) [X |-> X + 1]]。形式化地,[P'] 是 Coq 表达式 fun st => (fun st' => st' X <= 5) - (st & { X --> aeval st (X+1) }), + (X !-> aeval st (X + 1) ; st), 它简化为 fun st => - (st & { X --> aeval st (X+1) }) X <= 5 + (X !-> aeval st (X + 1) ; st) X <= 5 并且进一步简化为 fun st => - (aeval st (X+1)) <= 5. + (aeval st (X + 1)) <= 5. - 也就是说,[P'] 指出 [X+1] 最多是 [5]。 + 也就是说,[P'] 指出 [X + 1] 最多是 [5]。 *) (** 现在,利用替换的概念,我们可以给出下述赋值证明规则的严谨证明: @@ -385,7 +390,7 @@ Notation "P [ X |-> a ]" := (assn_sub X a P) (at level 10). (** 我们可以形式化地证明这个规则是正确的。*) Theorem hoare_asgn : forall Q X a, - {{Q [X |-> a]}} (X ::= a) {{Q}}. + {{Q [X |-> a]}} X ::= a {{Q}}. Proof. unfold hoare_triple. intros Q X a st st' HE HQ. @@ -395,8 +400,8 @@ Proof. (** 下述是一个利用这个规则的形式化证明。*) Example assn_sub_example : - {{(fun st => st X < 5) [X |-> X+1]}} - (X ::= X+1) + {{(fun st => st X < 5) [X |-> X + 1]}} + X ::= X + 1 {{fun st => st X < 5}}. Proof. (* 课上已完成 *) @@ -404,12 +409,13 @@ Proof. (** 当然,更加有帮助的是证明这个更简单的三元组: - {{X < 4}} (X ::= X+1) {{X < 5}} + {{X < 4}} X ::= X + 1 {{X < 5}} 我们会在下一节中了解怎么做。*) -(** **** 练习:2 星 (hoare_asgn_examples) *) -(** 将下列非正式的霍尔三元组…… +(** **** 练习:2 星, standard (hoare_asgn_examples) + + 将下列非正式的霍尔三元组…… 1) {{ (X <= 10) [X |-> 2 * X] }} X ::= 2 * X @@ -428,8 +434,9 @@ Proof. Definition manual_grade_for_hoare_asgn_examples : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, recommended (hoare_asgn_wrong) *) -(** 几乎所有人在看赋值规则第一眼就会觉得它是反向的。如果你还感觉很 +(** **** 练习:2 星, standard, recommended (hoare_asgn_wrong) + + 几乎所有人在看赋值规则第一眼就会觉得它是反向的。如果你还感觉很 迷惑,思考一些“正向”的规则可能有帮助。这里是一个看起来挺自然的 霍尔三元组: @@ -446,10 +453,9 @@ Definition manual_grade_for_hoare_asgn_examples : option (nat*string) := None. Definition manual_grade_for_hoare_asgn_wrong : option (nat*string) := None. (** [] *) -Local Close Scope aexp_scope. +(** **** 练习:3 星, advanced (hoare_asgn_fwd) -(** **** 练习:3 星, advanced (hoare_asgn_fwd) *) -(** 然而,通过引入一个_'参数'_ [m](一个 Coq 整数)来记录 [X] 原 + 然而,通过引入一个_'参数'_ [m](一个 Coq 整数)来记录 [X] 原 来的值,我们可以定义一个赋值的证明规则,它可以,直觉上讲,“正向地 工作”。 @@ -457,7 +463,7 @@ Local Close Scope aexp_scope. {{fun st => P st /\ st X = m}} X ::= a {{fun st => P st' /\ st X = aeval st' a }} - (其中 st' = st & { X --> m }) + (其中 st' = (X !-> m ; st)) 可以注意到,在赋值发生之前我们用 [X] 原来的值重新构造了状态 [st']。证明这个规则是正确的。(注意,这个规则比 [hoare_asgn] 复杂些。) @@ -467,29 +473,30 @@ Theorem hoare_asgn_fwd : forall m a P, {{fun st => P st /\ st X = m}} X ::= a - {{fun st => P (st & { X --> m }) - /\ st X = aeval (st & { X --> m }) a }}. + {{fun st => P (X !-> m ; st) + /\ st X = aeval (X !-> m ; st) a }}. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, advanced, optional (hoare_asgn_fwd_exists) *) -(** 另外一种定义正向赋值规则的方式是,对变量在赋值之前的值做存在量化。 +(** **** 练习:2 星, advanced, optional (hoare_asgn_fwd_exists) + + 另外一种定义正向赋值规则的方式是,对变量在赋值之前的值做存在量化。 证明这是正确的。 ------------------------------------ (hoare_asgn_fwd_exists) {{fun st => P st}} X ::= a - {{fun st => exists m, P (st & { X --> m }) /\ - st X = aeval (st & { X --> m }) a }} + {{fun st => exists m, P (X !-> m ; st) /\ + st X = aeval (X !-> m ; st) a }} *) Theorem hoare_asgn_fwd_exists : forall a P, {{fun st => P st}} X ::= a - {{fun st => exists m, P (st & { X --> m }) /\ - st X = aeval (st & { X --> m }) a }}. + {{fun st => exists m, P (X !-> m ; st) /\ + st X = aeval (X !-> m ; st) a }}. Proof. intros a P. (* 请在此处解答 *) Admitted. @@ -561,15 +568,15 @@ Proof. (** 例如,我们可以这样应用第一条规则: - {{ True }} ->> - {{ 1 = 1 }} + {{ True }} ->> + {{ 1 = 1 }} X ::= 1 - {{ X = 1 }} + {{ X = 1 }} 或者,形式化地:*) Example hoare_asgn_example1 : - {{fun st => True}} (X ::= 1) {{fun st => st X = 1}}. + {{fun st => True}} X ::= 1 {{fun st => st X = 1}}. Proof. (* 课上已完成 *) apply hoare_consequence_pre @@ -580,21 +587,21 @@ Qed. (** 我们也可以用它来证明之前提到的例子。 - {{ X < 4 }} ->> - {{ (X < 5)[X |-> X+1] }} + {{ X < 4 }} ->> + {{ (X < 5)[X |-> X + 1] }} X ::= X + 1 - {{ X < 5 }} + {{ X < 5 }} 或者,形式化地:*) Example assn_sub_example2 : {{(fun st => st X < 4)}} - (X ::= X+1) + X ::= X + 1 {{fun st => st X < 5}}. Proof. (* 课上已完成 *) apply hoare_consequence_pre - with (P' := (fun st => st X < 5) [X |-> X+1]). + with (P' := (fun st => st X < 5) [X |-> X + 1]). apply hoare_asgn. intros st H. unfold assn_sub, t_update. simpl. omega. Qed. @@ -639,7 +646,7 @@ Proof. Example hoare_asgn_example1' : {{fun st => True}} - (X ::= 1) + X ::= 1 {{fun st => st X = 1}}. Proof. eapply hoare_consequence_pre. @@ -683,10 +690,9 @@ Proof. (** 在这里使用 [apply HP'] 将会失败并产生如下错误: - Error: Impossible to unify "?175" with "y". + Error: Impossible to unify "?175" with "y". 有一个简单的解决办法:把 [destruct HP] 提到 [eapply HQ] _'之前'_。 *) - Abort. Lemma silly2_fixed : @@ -714,8 +720,9 @@ Proof. intros P Q HP HQ. destruct HP as [y HP']. eapply HQ. eassumption. Qed. -(** **** 练习:2 星 (hoare_asgn_examples_2) *) -(** 将下述的非形式化霍尔三元组 +(** **** 练习:2 星, standard (hoare_asgn_examples_2) + + 将下述的非形式化霍尔三元组 {{ X + 1 <= 5 }} X ::= X + 1 {{ X <= 5 }} {{ 0 <= 3 /\ 3 <= 5 }} X ::= 3 {{ 0 <= X /\ X <= 5 }} @@ -729,7 +736,6 @@ Qed. Definition manual_grade_for_hoare_asgn_examples_2 : option (nat*string) := None. (** [] *) - (* ================================================================= *) (** ** 跳过 *) @@ -755,7 +761,7 @@ Proof. {{ P }} c1 {{ Q }} {{ Q }} c2 {{ R }} - --------------------- (hoare_seq) + ---------------------- (hoare_seq) {{ P }} c1;;c2 {{ R }} *) @@ -779,7 +785,7 @@ Proof. {{ a = n }} X ::= a;; - {{ X = n }} <---- + {{ X = n }} <--- decoration for Q SKIP {{ X = n }} *) @@ -788,7 +794,7 @@ Proof. Example hoare_asgn_example3 : forall a n, {{fun st => aeval st a = n}} - (X ::= a;; SKIP) + X ::= a;; SKIP {{fun st => st X = n}}. Proof. intros a n. eapply hoare_seq. @@ -802,8 +808,9 @@ Qed. (** 我们一般会将 [hoare_seq] 和 [hoare_consequence_pre] 以及 [eapply] 策略一起使用,如上所示。*) -(** **** 练习:2 星, recommended (hoare_asgn_example4) *) -(** 将这个“标注程序”翻译成正式证明: +(** **** 练习:2 星, standard, recommended (hoare_asgn_example4) + + 将这个“标注程序”翻译成正式证明: {{ True }} ->> {{ 1 = 1 }} @@ -816,19 +823,23 @@ Qed. (带 “[->>]” 的标记代表了使用 [hoare_consequence_pre]。) *) Example hoare_asgn_example4 : - {{fun st => True}} (X ::= 1;; Y ::= 2) + {{fun st => True}} + X ::= 1;; Y ::= 2 {{fun st => st X = 1 /\ st Y = 2}}. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (swap_exercise) *) -(** 写一个 Imp 程序 [c],用来交换变量 [X] 和 [Y] 并且说明 +(** **** 练习:3 星, standard (swap_exercise) + + 写一个 Imp 程序 [c],用来交换变量 [X] 和 [Y] 并且说明 它符合如下规范: {{X <= Y}} c {{Y <= X}} - 你的证明不应该使用 [unfold hoare_triple]。 *) + 你的证明不应该使用 [unfold hoare_triple]。 + (提示:记住赋值规则在“从后往前”,即从后置条件到前置条件应用时工作得最好。 + 因此你的证明可以从程序的后面开始逐步往前进行。) *) Definition swap_program : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -841,12 +852,13 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (hoarestate1) *) -(** 解释为何下列命题无法被证明: +(** **** 练习:3 星, standard (hoarestate1) + + 解释为何下列命题无法被证明: forall (a : aexp) (n : nat), {{fun st => aeval st a = n}} - (X ::= 3;; Y ::= a) + X ::= 3;; Y ::= a {{fun st => st Y = n}}. *) @@ -866,16 +878,16 @@ Definition manual_grade_for_hoarestate1 : option (nat*string) := None. {{P}} c1 {{Q}} {{P}} c2 {{Q}} - -------------------------------- - {{P}} IFB b THEN c1 ELSE c2 {{Q}} + --------------------------------- + {{P}} TEST b THEN c1 ELSE c2 {{Q}} *) (** 然而,这个规则太弱了。例如,用这个规则我们并不能推理出 {{ True }} - IFB X = 0 - THEN Y ::= 2 - ELSE Y ::= X + 1 + TEST X = 0 + THEN Y ::= 2 + ELSE Y ::= X + 1 FI {{ X <= Y }} @@ -884,13 +896,12 @@ Definition manual_grade_for_hoarestate1 : option (nat*string) := None. (** 不过我们还是可以表述得更精确。在“THEN”分支中,[b] 化简为 [true],而在“ELSE”分支中我们知道它化简为 [false]。 我们可以让这个信息作为 [c1] 和 [c2] 的假设出现可以让我们分别研究 - [c1] 和 [c2] 的行为(亦即它们为什么能导出后置条件 [Q])。*) -(** + [c1] 和 [c2] 的行为(亦即它们为什么能导出后置条件 [Q])。 - {{P /\ b}} c1 {{Q}} - {{P /\ ~b}} c2 {{Q}} + {{P /\ b}} c1 {{Q}} + {{P /\ ~ b}} c2 {{Q}} ------------------------------------ (hoare_if) - {{P}} IFB b THEN c1 ELSE c2 FI {{Q}} + {{P}} TEST b THEN c1 ELSE c2 FI {{Q}} *) (** 要形式化地解释这个规则,我们还需要做一点微小的工作。 @@ -921,8 +932,8 @@ Proof. 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}}. + {{fun st => P st /\ ~ (bassn b st)}} c2 {{Q}} -> + {{P}} TEST b THEN c1 ELSE c2 FI {{Q}}. Proof. intros P Q b c1 c2 HTrue HFalse st st' HE HP. inversion HE; subst. @@ -944,7 +955,7 @@ Proof. Example if_example : {{fun st => True}} - IFB X = 0 + TEST X = 0 THEN Y ::= 2 ELSE Y ::= X + 1 FI @@ -964,12 +975,13 @@ Proof. simpl; intros st _. omega. Qed. -(** **** 练习:2 星 (if_minus_plus) *) -(** 用 [hoare_if] 证明下面的三元组。不要使用 [unfold hoare_triple]。*) +(** **** 练习:2 星, standard (if_minus_plus) + + 用 [hoare_if] 证明下面的三元组。不要使用 [unfold hoare_triple]。*) Theorem if_minus_plus : {{fun st => True}} - IFB X <= Y + TEST X <= Y THEN Z ::= Y - X ELSE Y ::= X + Z FI @@ -981,8 +993,9 @@ Proof. (* ----------------------------------------------------------------- *) (** *** 练习:单侧条件 *) -(** **** 练习:4 星 (if1_hoare) *) -(** 在这个练习中我们考虑对 Imp 加入形如 [IF1 b THEN c FI] 的“单边条件”。 +(** **** 练习:4 星, standard (if1_hoare) + + 在这个练习中我们考虑对 Imp 加入形如 [IF1 b THEN c FI] 的“单边条件”。 这里 [b] 是个布尔表达式而 [c] 是一个命令。如果 [b] 化简为 [true], [c] 就被执行,而如果 [b] 化简为 [false], [IF1 b THEN c FI] 就啥也不做。 @@ -1003,51 +1016,61 @@ Inductive com : Type := | CIf1 : bexp -> com -> com. Notation "'SKIP'" := - CSkip. + CSkip : imp_scope. Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). + (CSeq c1 c2) (at level 80, right associativity) : imp_scope. Notation "X '::=' a" := - (CAss X a) (at level 60). + (CAss X a) (at level 60) : imp_scope. 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). + (CWhile b c) (at level 80, right associativity) : imp_scope. +Notation "'TEST' e1 'THEN' e2 'ELSE' e3 'FI'" := + (CIf e1 e2 e3) (at level 80, right associativity) : imp_scope. Notation "'IF1' b 'THEN' c 'FI'" := - (CIf1 b c) (at level 80, right associativity). + (CIf1 b c) (at level 80, right associativity) : imp_scope. (** 接下来我们需要拓展求值规则以包含 [IF1] 的情形。我们把任务交给你…… 应该网 [ceval] 中加入哪条(那些)命令来化简单边分支命令?*) -Reserved Notation "c1 '/' st '\\' st'" (at level 40, st at level 39). +Reserved Notation "st '=[' c ']=>' st'" (at level 40). +Open Scope imp_scope. Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st : state, SKIP / st \\ st - | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : string), - aeval st a1 = n -> (X ::= a1) / st \\ 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_WhileFalse : forall (b1 : bexp) (st : state) (c1 : com), - beval st b1 = false -> (WHILE b1 DO c1 END) / st \\ st - | E_WhileTrue : 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_Skip : forall st, + st =[ SKIP ]=> st + | E_Ass : forall st a1 n x, + aeval st a1 = n -> + st =[ x ::= a1 ]=> (x !-> n ; st) + | E_Seq : forall c1 c2 st st' st'', + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> st'' + | E_IfTrue : forall st st' b c1 c2, + beval st b = true -> + st =[ c1 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_IfFalse : forall st st' b c1 c2, + beval st b = false -> + st =[ c2 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ WHILE b DO c END ]=> st + | E_WhileTrue : forall st st' st'' b c, + beval st b = true -> + st =[ c ]=> st' -> + st' =[ WHILE b DO c END ]=> st'' -> + st =[ WHILE b DO c END ]=> st'' (* 请在此处解答 *) - where "c1 '/' st '\\' st'" := (ceval c1 st st'). + where "st '=[' c ']=>' st'" := (ceval c st st'). +Close Scope imp_scope. (** 现在我们把霍尔三元组的定义和记号重新写在这里。*) -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop := +Definition hoare_triple + (P : Assertion) (c : com) (Q : Assertion) : Prop := forall st st', - c / st \\ st' -> + st =[ c ]=> st' -> P st -> Q st'. @@ -1064,7 +1087,7 @@ Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) 能够证明下列的霍尔三元组是有效的: {{ X + Y = Z }} - IF1 !(Y = 0) THEN + IF1 ~(Y = 0) THEN X ::= X + Y FI {{ X = Z }} @@ -1075,9 +1098,9 @@ Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) Lemma hoare_if1_good : {{ fun st => st X + st Y = st Z }} - IF1 !(Y = 0) THEN + (IF1 ~(Y = 0) THEN X ::= X + Y - FI + FI)%imp {{ fun st => st X = st Z }}. Proof. (* 请在此处解答 *) Admitted. @@ -1114,35 +1137,33 @@ Definition manual_grade_for_if1_hoare : option (nat*string) := None. (** 不过就像我们在上面对条件语句分析时那样,我们还会有一点附加 的信息:除了 [P] 成立以外,[b] 会在执行完毕以后化简为 [false]。 - 所以,我们可以再添补一下后置条件: *) -(** + 所以,我们可以再添补一下后置条件: - {{P}} WHILE b DO c END {{P /\ ~b}} + {{P}} WHILE b DO c END {{P /\ ~ b}} *) (** 那么循环体被执行的情形呢?为了确保 [P] 在循环最终退出 的时候成立,我们当然需要保证命令 [c] 执行后 [P] 成立。 进一步说,因为 [P] 在 [c] 第一次执行前成立,每次 [c] 执行完成 都会重新满足作为后置条件的 [P],我们可以假设 [P] 在 [c] 执行前 - 就成立。总结为以下规则:*) -(** + 就成立。总结为以下规则: {{P}} c {{P}} ----------------------------------- - {{P}} WHILE b DO c END {{P /\ ~b}} -*) -(** 这几乎就是我们想要的规则,不过它还有一点可以改进的地方:在循环体 + {{P}} WHILE b DO c END {{P /\ ~ b}} + + 这几乎就是我们想要的规则,不过它还有一点可以改进的地方:在循环体 开始是的时候,我们不止知道 [P] 成立,还有条件 [b] 会在当前状态 中化简为 [true]。*) (** 这给我们带来了一点额外的信息用来推论 [c] (用来说明它结束时 - 满足不变式)。*) -(** 这让我们可以给出这个规则的最终版本:*) -(** + 满足不变式)。 + + 而这会将我们导向此规则的最终版本: {{P /\ b}} c {{P}} - ----------------------------------- (hoare_while) - {{P}} WHILE b DO c END {{P /\ ~b}} + ---------------------------------- (hoare_while) + {{P}} WHILE b DO c END {{P /\ ~ b}} 断言 [P] 叫做_'循环不变式(invariant of the loop)'_。 *) @@ -1154,7 +1175,7 @@ Proof. intros P b c Hhoare st st' He HP. (* 像之前见到过的,我们需要对 [He] 做归纳来推理。 因为,在“继续循环”的情形中,假设会是关于整个循环而不只是关于 [c] 的。*) - remember (WHILE b DO c END) as wcom eqn:Heqwcom. + remember (WHILE b DO c END)%imp as wcom eqn:Heqwcom. induction He; try (inversion Heqwcom); subst; clear Heqwcom. - (* E_WhileFalse *) @@ -1165,7 +1186,6 @@ Proof. split. assumption. apply bexp_eval_true. assumption. Qed. - (** 令人费解的事情是,我们把断言 [P] 叫做“循环不变式” 并不代表它只是由 (上述问题中的)循环体所保证(也就是 [{{P}} c {{P}}],其中 [c] 是循环体), 而实际上 [P] _'加上循环条件为真'_才是 [c] 能够推出后置条件所 @@ -1174,7 +1194,7 @@ Qed. 这是略微弱化的(但十分重要)前提。例如,如果 [P] 是断言 [X = 0],那么 [P] _'是'_下述循环的不变式: - WHILE X = 2 DO X := 1 END + WHILE X = 2 DO X := 1 END 即使它很明显_'不是'_只由循环体所导出。*) @@ -1224,9 +1244,10 @@ Proof. (* ----------------------------------------------------------------- *) (** *** 练习:[REPEAT] *) -(** **** 练习:4 星, advanced (hoare_repeat) *) -(** 在这个练习中,我们会往 Imp 里面加一种新的命令:[REPEAT] c [UNTIL] a [END]。 - 请你写出 [repeat] 的求值规则,并且写一个关于它的霍尔逻辑证明规则。 +(** **** 练习:4 星, advanced (hoare_repeat) + + 在这个练习中,我们会往 Imp 里面加一种新的命令:[REPEAT] c [UNTIL] b [END]。 + 请你写出 [REPEAT] 的求值规则,并且写一个关于它的霍尔逻辑证明规则。 (回想在 [Auto] 中给出的规则,试着自己把这个写出来,别偷看。)*) Module RepeatExercise. @@ -1251,7 +1272,7 @@ 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'" := +Notation "'TEST' 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). @@ -1260,43 +1281,43 @@ Notation "'REPEAT' e1 'UNTIL' b2 'END'" := 模板,不过注意 [REPEAT] 的循环体至少要执行一次,并且循环会在条件 为真的时候结束。*) +Reserved Notation "st '=[' c ']=>' st'" (at level 40). + Inductive ceval : state -> com -> state -> Prop := | E_Skip : forall st, - ceval st SKIP st - | E_Ass : forall st a1 n X, + st =[ SKIP ]=> st + | E_Ass : forall st a1 n x, aeval st a1 = n -> - ceval st (X ::= a1) (st & { X --> n }) + st =[ x ::= a1 ]=> (x !-> n ; st) | 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_WhileFalse : forall b1 st c1, - beval st b1 = false -> - ceval st (WHILE b1 DO c1 END) st - | E_WhileTrue : 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'' + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> st'' + | E_IfTrue : forall st st' b c1 c2, + beval st b = true -> + st =[ c1 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_IfFalse : forall st st' b c1 c2, + beval st b = false -> + st =[ c2 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ WHILE b DO c END ]=> st + | E_WhileTrue : forall st st' st'' b c, + beval st b = true -> + st =[ c ]=> st' -> + st' =[ WHILE b DO c END ]=> st'' -> + st =[ WHILE b DO c END ]=> st'' (* 请在此处解答 *) -. -(** 下面是一些之前出现的定义,我们把它重新写一遍它就会用新的 [ceval]。 *) +where "st '=[' c ']=>' st'" := (ceval st c st'). -Notation "c1 '/' st '\\' st'" := (ceval st c1 st') - (at level 40, st at level 39). +(** 下面是一些之前出现的定义,我们把它重新写一遍它就会用新的 [ceval]。 *) -Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) +Definition hoare_triple (P : Assertion) (c : com) (Q : Assertion) : Prop := - forall st st', (c / st \\ st') -> P st -> Q st'. + forall st st', st =[ c ]=> st' -> P st -> Q st'. Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) (at level 90, c at next level). @@ -1311,7 +1332,7 @@ Definition ex1_repeat := UNTIL X = 1 END. Theorem ex1_repeat_works : - ex1_repeat / { --> 0 } \\ { X --> 1 ; Y --> 1 }. + empty_st =[ ex1_repeat ]=> (Y !-> 1 ; X !-> 1). Proof. (* 请在此处解答 *) Admitted. @@ -1344,7 +1365,7 @@ Definition manual_grade_for_hoare_repeat : option (nat*string) := None. (** 到此为止,我们引入了用来推理 Imp 程序的工具,霍尔逻辑。霍尔逻辑 的证明规则有: - ------------------------------ (hoare_asgn) + --------------------------- (hoare_asgn) {{Q [X |-> a]}} X::=a {{Q}} -------------------- (hoare_skip) @@ -1352,17 +1373,17 @@ Definition manual_grade_for_hoare_repeat : option (nat*string) := None. {{ P }} c1 {{ Q }} {{ Q }} c2 {{ R }} - --------------------- (hoare_seq) + ---------------------- (hoare_seq) {{ P }} c1;;c2 {{ R }} - {{P /\ b}} c1 {{Q}} - {{P /\ ~b}} c2 {{Q}} + {{P /\ b}} c1 {{Q}} + {{P /\ ~ b}} c2 {{Q}} ------------------------------------ (hoare_if) - {{P}} IFB b THEN c1 ELSE c2 FI {{Q}} + {{P}} TEST b THEN c1 ELSE c2 FI {{Q}} {{P /\ b}} c {{P}} ----------------------------------- (hoare_while) - {{P}} WHILE b DO c END {{P /\ ~b}} + {{P}} WHILE b DO c END {{P /\ ~ b}} {{P'}} c {{Q'}} P ->> P' @@ -1375,9 +1396,9 @@ Definition manual_grade_for_hoare_repeat : option (nat*string) := None. (* ################################################################# *) (** * 附加练习 *) +(** **** 练习:3 星, standard (hoare_havoc) -(** **** 练习:3 星 (hoare_havoc) *) -(** 在这个练习中我们将会为一种 [HAVOC] 命令实现证明规则,这个命令类似于 + 在这个练习中我们将会为一种 [HAVOC] 命令实现证明规则,这个命令类似于 [Imp] 中的 [any] 表达式。 首先我们把这些命令放在一个分离的模块里,并且把命令的语法和粗略语义 @@ -1401,40 +1422,47 @@ 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'" := +Notation "'TEST' 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). +Reserved Notation "st '=[' c ']=>' st'" (at level 40). Inductive ceval : com -> state -> state -> Prop := - | E_Skip : forall st : state, SKIP / st \\ st - | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : string), - aeval st a1 = n -> (X ::= a1) / st \\ 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_WhileFalse : forall (b1 : bexp) (st : state) (c1 : com), - beval st b1 = false -> (WHILE b1 DO c1 END) / st \\ st - | E_WhileTrue : 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 : string) (n : nat), - (HAVOC X) / st \\ st & { X --> n } - - where "c1 '/' st '\\' st'" := (ceval c1 st st'). + | E_Skip : forall st, + st =[ SKIP ]=> st + | E_Ass : forall st a1 n x, + aeval st a1 = n -> + st =[ x ::= a1 ]=> (x !-> n ; st) + | E_Seq : forall c1 c2 st st' st'', + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> st'' + | E_IfTrue : forall st st' b c1 c2, + beval st b = true -> + st =[ c1 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_IfFalse : forall st st' b c1 c2, + beval st b = false -> + st =[ c2 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ WHILE b DO c END ]=> st + | E_WhileTrue : forall st st' st'' b c, + beval st b = true -> + st =[ c ]=> st' -> + st' =[ WHILE b DO c END ]=> st'' -> + st =[ WHILE b DO c END ]=> st'' + | E_Havoc : forall st X n, + st =[ HAVOC X ]=> (X !-> n ; st) + +where "st '=[' c ']=>' st'" := (ceval c st st'). (** 对霍尔三元组的定义和之前完全一致。 *) Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop := - forall st st', c / st \\ st' -> P st -> Q st'. + forall st st', st =[ c ]=> st' -> P st -> Q st'. Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q) (at level 90, c at next level) @@ -1454,5 +1482,258 @@ Proof. End Himp. (** [] *) +(** **** 练习:4 星, standard, optional (assert_vs_assume) *) + +Module HoareAssertAssume. + +(** 在这个练习中我们会对 Imp 加入语句 [ASSERT] 和 [ASSUME]。这两个命令 + 都是用来指出某个布尔表达式应该在任何一次程序运行到这里的时候都为真。 + 但是它们有下列区别: + + - 如果 [ASSERT] 失败了,程序就会进入错误状态并且退出。 + + - 如果 [ASSUME] 失败了,程序就不能运行。换句话说这段程序会卡住,没有 + 最终状态。 + + 新的一系列命令是:*) + +Inductive com : Type := + | CSkip : com + | CAss : string -> aexp -> com + | CSeq : com -> com -> com + | CIf : bexp -> com -> com -> com + | CWhile : bexp -> com -> com + | CAssert : bexp -> com + | CAssume : bexp -> com. + +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 "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" := + (CIf c1 c2 c3) (at level 80, right associativity). +Notation "'ASSERT' b" := + (CAssert b) (at level 60). +Notation "'ASSUME' b" := + (CAssume b) (at level 60). + +(** 要定义 [ASSERT] 和 [ASSUME] 的行为,我们必须要加入一个表示错误 + 状态的记号,它指出某个 [ASSERT] 失败了。我们修改一下 [ceval] + 规则,让它是开始状态和“结束状态或者是 [error]”的关系。[result] + 类型是程序结束时的值,要么是 [state] 要么是 [error]。*) + +Inductive result : Type := + | RNormal : state -> result + | RError : result. + +(** 现在我们可以给出新语言的 [ceval] 了。*) + +Inductive ceval : com -> state -> result -> Prop := + (* 稍加修改的旧有规则 *) + | E_Skip : forall st, + st =[ SKIP ]=> RNormal st + | E_Ass : forall st a1 n x, + aeval st a1 = n -> + st =[ x ::= a1 ]=> RNormal (x !-> n ; st) + | E_SeqNormal : forall c1 c2 st st' r, + st =[ c1 ]=> RNormal st' -> + st' =[ c2 ]=> r -> + st =[ c1 ;; c2 ]=> r + | E_SeqError : forall c1 c2 st, + st =[ c1 ]=> RError -> + st =[ c1 ;; c2 ]=> RError + | E_IfTrue : forall st r b c1 c2, + beval st b = true -> + st =[ c1 ]=> r -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> r + | E_IfFalse : forall st r b c1 c2, + beval st b = false -> + st =[ c2 ]=> r -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> r + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ WHILE b DO c END ]=> RNormal st + | E_WhileTrueNormal : forall st st' r b c, + beval st b = true -> + st =[ c ]=> RNormal st' -> + st' =[ WHILE b DO c END ]=> r -> + st =[ WHILE b DO c END ]=> r + | E_WhileTrueError : forall st b c, + beval st b = true -> + st =[ c ]=> RError -> + st =[ WHILE b DO c END ]=> RError + (* Assert 和 Assume 的规则 *) + | E_AssertTrue : forall st b, + beval st b = true -> + st =[ ASSERT b ]=> RNormal st + | E_AssertFalse : forall st b, + beval st b = false -> + st =[ ASSERT b ]=> RError + | E_Assume : forall st b, + beval st b = true -> + st =[ ASSUME b ]=> RNormal st + +where "st '=[' c ']=>' r" := (ceval c st r). + +(** 我们重新定义霍尔三元组:现在,[{{P}} c {{Q}}] 的意思是, + 当 [c] 在一个满足 [P] 的状态中启动并且停机在一个状态 [r],那么 [r] + 不是错误并且满足 [Q]。*) + +Definition hoare_triple + (P : Assertion) (c : com) (Q : Assertion) : Prop := + forall st r, + st =[ c ]=> r -> P st -> + (exists st', r = RNormal st' /\ Q st'). + +Notation "{{ P }} c {{ Q }}" := + (hoare_triple P c Q) (at level 90, c at next level) + : hoare_spec_scope. +(** 为了测试你对这个修改的理解是否正确,请给出一组前置条件和后置条件, + 它们可以被 [ASSUME] 语句导出却不能被 [ASSERT] 导出。然后证明任何关于 + [ASSERT] 的三元组换成 [ASSUME] 也是正确的。*) + +Theorem assert_assume_differ : exists P b Q, + ({{P}} ASSUME b {{Q}}) + /\ ~ ({{P}} ASSERT b {{Q}}). +Proof. +(* 请在此处解答 *) Admitted. + +Theorem assert_implies_assume : forall P b Q, + ({{P}} ASSERT b {{Q}}) + -> ({{P}} ASSUME b {{Q}}). +Proof. +(* 请在此处解答 *) Admitted. + +(** 你的任务是为 [ASSERT] 和 [ASSUME] 创建霍尔规则,并且用它们证明 + 一个小程序是正确的。把你的规则起名为 [hoare_assert] 和 [hoare_assume]。 + + 为了你方便点,我们把新语义上的那些旧有的霍尔规则帮你证明好了。*) + +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. + exists (X !-> aeval st a ; st). split; try reflexivity. + assumption. Qed. + +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 r Hc HP. + unfold hoare_triple in Hhoare. + assert (exists st', r = RNormal st' /\ Q' st'). + { apply (Hhoare st); assumption. } + destruct H as [st' [Hr HQ']]. + exists st'. split; try assumption. + apply Himp. assumption. +Qed. + +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 r H12 Pre. + inversion H12; subst. + - eapply H1. + + apply H6. + + apply H2 in H3. apply H3 in Pre. + destruct Pre as [st'0 [Heq HQ]]. + inversion Heq; subst. assumption. + - (* 找到矛盾的假设 *) + apply H2 in H5. apply H5 in Pre. + destruct Pre as [st' [C _]]. + inversion C. +Qed. + +(** 把你的霍尔规则,[hoare_assert] 和 [hoare_assume] 写在下面。*) + +(* 请在此处解答 *) + +(** 下列是其它证明规则(用来检查是否合理)*) +Theorem hoare_skip : forall P, + {{P}} SKIP {{P}}. +Proof. + intros P st st' H HP. inversion H. subst. + eexists. split. reflexivity. assumption. +Qed. + +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}} TEST b THEN c1 ELSE c2 FI {{Q}}. +Proof. + intros P Q b c1 c2 HTrue HFalse st st' HE HP. + inversion HE; subst. + - (* b 是 true *) + apply (HTrue st st'). + assumption. + split. assumption. + apply bexp_eval_true. assumption. + - (* b 是 false *) + apply (HFalse st st'). + assumption. + split. assumption. + apply bexp_eval_false. assumption. Qed. + +Theorem 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. + remember (WHILE b DO c END) as wcom eqn:Heqwcom. + induction He; + try (inversion Heqwcom); subst; clear Heqwcom. + - (* E_WhileFalse *) + eexists. split. reflexivity. split. + assumption. apply bexp_eval_false. assumption. + - (* E_WhileTrueNormal *) + clear IHHe1. + apply IHHe2. reflexivity. + clear IHHe2 He2 r. + unfold hoare_triple in Hhoare. + apply Hhoare in He1. + + destruct He1 as [st1 [Heq Hst1]]. + inversion Heq; subst. + assumption. + + split; assumption. + - (* E_WhileTrueError *) + exfalso. clear IHHe. + unfold hoare_triple in Hhoare. + apply Hhoare in He. + + destruct He as [st' [C _]]. inversion C. + + split; assumption. +Qed. + +Example assert_assume_example: + {{fun st => True}} + ASSUME (X = 1);; + X ::= X + 1;; + ASSERT (X = 2) + {{fun st => True}}. +Proof. +(* 请在此处解答 *) Admitted. + +End HoareAssertAssume. +(** [] *) +(* Sat Jan 26 15:15:43 UTC 2019 *) diff --git a/plf-current/Hoare2.html b/plf-current/Hoare2.html index 15910827..f4aec669 100644 --- a/plf-current/Hoare2.html +++ b/plf-current/Hoare2.html @@ -35,18 +35,19 @@

              Hoare2Hoare Logic, Part II Set Warnings "-notation-overridden,-parsing".
              -Require Import Coq.Bool.Bool.
              -Require Import Coq.Arith.Arith.
              -Require Import Coq.Arith.EqNat.
              -Require Import Coq.Arith.PeanoNat. Import Nat.
              -Require Import Coq.omega.Omega.
              +From Coq Require Import Strings.String.
              From PLF Require Import Maps.
              -From PLF Require Import Imp.
              +From Coq Require Import Bool.Bool.
              +From Coq Require Import Arith.Arith.
              +From Coq Require Import Arith.EqNat.
              +From Coq Require Import Arith.PeanoNat. Import Nat.
              +From Coq Require Import omega.Omega.
              From PLF Require Import Hoare.
              +From PLF Require Import Imp.
              -

              Decorated Programs

              +

              Decorated Programs

              @@ -67,15 +68,13 @@

              Hoare2Hoare Logic, Part II

              For example, consider the program: -
              -
                  X ::= m;;
                  Z ::= p;
              -    WHILE !(X = 0) DO
              +    WHILE ~(X = 0) DO
                    Z ::= Z - 1;;
                    X ::= X - 1
                  END @@ -85,9 +84,7 @@

              Hoare2Hoare Logic, Part IIm and p, which stand for fixed-but-arbitrary numbers. Formally, they are simply Coq variables of type nat.) - Here is one possible specification for this program: -
              - + Here is one possible specification for this program:
              @@ -95,7 +92,7 @@

              Hoare2Hoare Logic, Part II{{ True }}
                  X ::= m;;
                  Z ::= p;
              -    WHILE !(X = 0) DO
              +    WHILE ~(X = 0) DO
                    Z ::= Z - 1;;
                    X ::= X - 1
                  END
              @@ -105,29 +102,28 @@

              Hoare2Hoare Logic, Part II Here is a decorated version of the program, embodying a proof of this specification: -
              -
              -      {True }->>
              +      {True }->>
                    {m = m }}
                  X ::= m;;
              -      {X = m }->>
              +      {X = m }->>
                    {X = m ∧ p = p }}
                  Z ::= p;
              -      {X = m ∧ Z = p }->>
              +      {X = m ∧ Z = p }->>
                    {Z - X = p - m }}
              -    WHILE !(X = 0) DO
              -        {Z - X = p - m ∧ X ≠ 0 }->>
              +    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 }} +      {Z - X = p - m ∧ ¬(X ≠ 0) }->> 
              +      {Z = p - m }}
              @@ -196,7 +192,7 @@

              Hoare2Hoare Logic, Part II

              -       {P [X |-> a}}
              +       {P [X > a}}
                     X ::= a
                     {P }}
              @@ -223,7 +219,7 @@

              Hoare2Hoare Logic, Part II        {P }}
              -       IFB b THEN
              +       TEST b THEN
                       {P ∧ b }}
                       c1
                       {Q }}
              @@ -274,13 +270,13 @@

              Hoare2Hoare Logic, Part II

                -
              • A pair of assertions separated by ->> is locally consistent if +
              • A pair of assertions separated by ->> is locally consistent if the first implies the second:
                -       {P }->>
                +       {P }->>
                       {P' }}
                @@ -311,7 +307,7 @@

                Hoare2Hoare Logic, Part II
                -

                Example: Swapping Using Addition and Subtraction

                +

                Example: Swapping Using Addition and Subtraction

                @@ -328,16 +324,15 @@

                Hoare2Hoare Logic, Part II

                - We can prove using decorations that this program is correct — - i.e., it always swaps the values of variables X and Y. - + We can prove (informally) using decorations that this program is + correct — i.e., it always swaps the values of variables X and Y.
                -    (1)     {X = m ∧ Y = n }->>
                +    (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 }}
                @@ -395,7 +390,7 @@

                Hoare2Hoare Logic, Part II
                -

                Example: Simple Conditionals

                +

                Example: Simple Conditionals

                @@ -405,13 +400,13 @@

                Hoare2Hoare Logic, Part II       (1)     {{True}}
                -            IFB X ≤ Y THEN
                -      (2)       {{True ∧ X ≤ Y}->>
                +            TEST 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}->>
                +      (5)       {{True ∧ ~(X ≤ Y}->>
                      (6)       {{(X - Y) + X = Y ∨ (X - Y) + Y = X}}
                              Z ::= X - Y
                      (7)       {{Z + X = Y ∨ Z + Y = X}}
                @@ -454,20 +449,20 @@

                Hoare2Hoare Logic, Part II

                -

                练习:2 星 (if_minus_plus_reloaded)

                +

                练习:2 星, standard (if_minus_plus_reloaded)

                Fill in valid decorations for the following program:
                       {True }}
                -      IFB X ≤ Y THEN
                -          {{                         }->>
                +      TEST X ≤ Y THEN
                +          {{                         }->>
                          {{                         }}
                        Z ::= Y - X
                          {{                         }}
                      ELSE
                -          {{                         }->>
                +          {{                         }->>
                          {{                         }}
                        Y ::= X + Z
                          {{                         }}
                @@ -487,7 +482,7 @@

                Hoare2Hoare Logic, Part II
                -

                Example: Reduce to Zero

                +

                Example: Reduce to Zero

                @@ -498,13 +493,13 @@

                Hoare2Hoare Logic, Part II         (1)      {True }}
                -               WHILE !(X = 0) DO
                -        (2)        {True ∧ X ≠ 0 }->>
                +               WHILE ~(X = 0) DO
                +        (2)        {True ∧ X ≠ 0 }->>
                        (3)        {True }}
                                 X ::= X - 1
                        (4)        {True }}
                               END
                -        (5)      {True ∧ X = 0 }->>
                +        (5)      {True ∧ X = 0 }->>
                        (6)      {X = 0 }}
                @@ -544,9 +539,9 @@

                Hoare2Hoare Logic, Part II Definition reduce_to_zero' : com :=
                -  WHILE !(X = 0) DO
                +  (WHILE ~(X = 0) DO
                    X ::= X - 1
                -  END.

                +  END)%imp.

                Theorem reduce_to_zero_correct' :
                  {{fun stTrue}}
                  reduce_to_zero'
                @@ -562,8 +557,8 @@

                Hoare2Hoare Logic, Part II(* 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.
                +    (* Proving trivial implication (2) ->> (3) *)
                +    intros st [HT Hbp]. unfold assn_sub. constructor.
                  - (* Invariant and negated guard imply postcondition *)
                    intros st [Inv GuardFalse].
                    unfold bassn in GuardFalse. simpl in GuardFalse.
                @@ -575,7 +570,7 @@

                Hoare2Hoare Logic, Part II
                -

                Example: Division

                +

                Example: Division

                @@ -602,7 +597,7 @@

                Hoare2Hoare Logic, Part II

                In order to give a specification to this program we need to - remember that dividing m by n produces a reminder X and a + remember that dividing m by n produces a remainder X and a quotient Y such that n * Y + X = m X < n.
                @@ -615,14 +610,14 @@

                Hoare2Hoare Logic, Part II

                -      (1)    {True }->>
                +      (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 }->>
                +      (5)      {n * Y + X = m ∧ n ≤ X }->>
                      (6)      {n * (Y + 1) + (X - n) = m }}
                             X ::= X - n;;
                      (7)      {n * (Y + 1) + X = m }}
                @@ -648,7 +643,7 @@

                Hoare2Hoare Logic, Part II
                -

                Finding Loop Invariants

                +

                Finding Loop Invariants

                @@ -669,7 +664,7 @@

                Hoare2Hoare Logic, Part II

                -

                Example: Slow Subtraction

                +

                Example: Slow Subtraction

                @@ -681,7 +676,7 @@

                Hoare2Hoare Logic, Part II              {X = m ∧ Y = n }}
                -           WHILE !(X = 0) DO
                +           WHILE ~(X = 0) DO
                             Y ::= Y - 1;;
                             X ::= X - 1
                           END
                @@ -692,8 +687,8 @@

                Hoare2Hoare Logic, Part II

                - 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 + To verify this program, we need to find an invariant Inv for the + loop. As a first step we can leave Inv as an unknown and build a _skeleton_ for the proof by applying the rules for local consistency (working from the end of the program to the beginning, as usual, and without any thinking at all yet). @@ -705,22 +700,22 @@

                Hoare2Hoare Logic, Part II

                -        (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] }}
                +        (1)      {X = m ∧ Y = n }}  ->>             (a)
                +        (2)      {Inv }}
                +               WHILE ~(X = 0) DO
                +        (3)        {Inv ∧ X ≠ 0 }}  ->>              (c)
                +        (4)        {Inv [X > X-1] [Y > Y-1] }}
                                 Y ::= Y - 1;;
                -        (5)        {I [X |-> X-1] }}
                +        (5)        {Inv [X > X-1] }}
                                 X ::= X - 1
                -        (6)        {I }}
                +        (6)        {Inv }}
                               END
                -        (7)      {I ∧ ¬ (X ≠ 0) }}  ->>            (b)
                +        (7)      {Inv ∧ ¬(X ≠ 0) }}  ->>            (b)
                        (8)      {Y = n - m }}
                - By examining this skeleton, we can see that any valid I will + By examining this skeleton, we can see that any valid Inv will have to respect three conditions:
                @@ -734,8 +729,8 @@

                Hoare2Hoare Logic, Part II -
              • (c) it must be _preserved_ by one iteration of the loop, i.e., (3) - must imply (4). +
              • (c) it must be _preserved_ by each iteration of the loop (given + that the loop guard evaluates to true), i.e., (3) must imply (4).
              @@ -755,23 +750,23 @@

              Hoare2Hoare Logic, Part IITrue as an invariant did the - job. So let's try instantiating I with True in the skeleton + job. So let's try instantiating Inv with True in the skeleton above and see what we get...
              -        (1)      {X = m ∧ Y = n }->>       (a - OK)
              +        (1)      {X = m ∧ Y = n }->>       (a - OK)
                      (2)      {True }}
              -               WHILE !(X = 0) DO
              -        (3)        {True ∧ X ≠ 0 }}  ->>    (c - OK)
              +               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!)
              +        (7)      {True ∧ X = 0 }}  ->>       (b - WRONG!)
                      (8)      {Y = n - m }}
              @@ -787,23 +782,23 @@

              Hoare2Hoare Logic, Part III with Y = n - m, and + return to our skeleton, instantiate Inv with Y = n - m, and check conditions (a) to (c) again.
              -    (1)      {X = m ∧ Y = n }}  ->>          (a - WRONG!)
              +    (1)      {X = m ∧ Y = n }}  ->>          (a - WRONG!)
                  (2)      {Y = n - m }}
              -           WHILE !(X = 0) DO
              -    (3)        {Y = n - m ∧ X ≠ 0 }}  ->>   (c - WRONG!)
              +           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)
              +    (7)      {Y = n - m ∧ X = 0 }}  ->>      (b - OK)
                  (8)      {Y = n - m }}
              @@ -836,23 +831,23 @@

              Hoare2Hoare Logic, Part IIX = 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, and the - difference is always n - m. So let's try instantiating I in + difference is always n - m. So let's try instantiating Inv in the skeleton above with Y - X = n - m.
              -    (1)      {X = m ∧ Y = n }}  ->>               (a - OK)
              +    (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)
              +           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)
              +    (7)      {Y - X = n - m ∧ X = 0 }}  ->>       (b - OK)
                  (8)      {Y = n - m }}
              @@ -864,11 +859,11 @@

              Hoare2Hoare Logic, Part II
              -

              Exercise: Slow Assignment

              +

              Exercise: Slow Assignment

              -

              练习:2 星 (slow_assignment)

              +

              练习:2 星, standard (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 @@ -879,7 +874,7 @@

              Hoare2Hoare Logic, Part II         {X = m }}
                    Y ::= 0;;
              -      WHILE !(X = 0) DO
              +      WHILE ~(X = 0) DO
                      X ::= X - 1;;
                      Y ::= Y + 1
                    END
              @@ -900,18 +895,18 @@

              Hoare2Hoare Logic, Part II
              -

              Exercise: Slow Addition

              +

              Exercise: Slow Addition

              -

              练习:3 星, optional (add_slowly_decoration)

              +

              练习:3 星, standard, 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
              +      WHILE ~(X = 0) DO
                       Z ::= Z + 1;;
                       X ::= X - 1
                    END @@ -931,7 +926,7 @@

              Hoare2Hoare Logic, Part II
              -

              Example: Parity

              +

              Example: Parity

              @@ -976,15 +971,15 @@

              Hoare2Hoare Logic, Part II

              -        {X = m }->>                               (a - OK)
              +        {X = m }->>                               (a - OK)
                      {parity X = parity m }}
                    WHILE 2 ≤ X DO
              -          {parity X = parity m ∧ 2 ≤ X }}  ->>    (c - OK)
              +          {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)
              +        {parity X = parity m ∧ X < 2 }}  ->>       (b - OK)
                      {X = parity m }}
              @@ -996,13 +991,13 @@

              Hoare2Hoare Logic, Part IIparity X = parity (X-2).
              -

              练习:3 星, optional (parity_formal)

              +

              练习:3 星, standard, 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,
              +Lemma parity_ge_2 : x,
                2 ≤ x
                parity (x - 2) = parity x.
              @@ -1015,8 +1010,8 @@

              Hoare2Hoare Logic, Part II
              -Lemma parity_lt_2 : x,
              -  ¬ 2 ≤ x
              +Lemma parity_lt_2 : x,
              +  ¬2 ≤ x
                parity (x) = x.
              @@ -1027,7 +1022,7 @@

              Hoare2Hoare Logic, Part II
              -Theorem parity_correct : m,
              +Theorem parity_correct : m,
                  {{ fun stst X = m }}
                WHILE 2 ≤ X DO
                  X ::= X - 2
              @@ -1040,7 +1035,7 @@

              Hoare2Hoare Logic, Part II
              -

              Example: Finding Square Roots

              +

              Example: Finding Square Roots

              @@ -1068,17 +1063,17 @@

              Hoare2Hoare Logic, Part II

              -    (1)  {X=m }}  ->>           (a - second conjunct of (2) WRONG!)
              +    (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*Zm ∧ (Z+1)*(Z+1)≤X }}  ->>             (c - WRONG!)
              +    (4)    {Z*Zm ∧ (Z+1)*(Z+1)≤X }}  ->>             (c - WRONG!)
                  (5)    {{ (Z+1)*(Z+1)≤m ∧ m<(Z+2)*(Z+2) }}
                       Z ::= Z+1
                  (6)    {Z*Zm ∧ m<(Z+1)*(Z+1) }}
                     END
              -    (7)  {Z*Zm ∧ m<(Z+1)*(Z+1) ∧ ~((Z+1)*(Z+1)≤X}}  ->> (b - OK)
              +    (7)  {Z*Zm ∧ m<(Z+1)*(Z+1) ∧ ~((Z+1)*(Z+1)≤X}}  ->> (b - OK)
                  (8)  {Z*Zm ∧ m<(Z+1)*(Z+1) }}
              @@ -1087,15 +1082,16 @@

              Hoare2Hoare Logic, Part IIX while (5) mentions m. But note that X is never - assigned in this program, so we should always have X=m, but we - didn't propagate this information from (1) into the loop invariant. + assigned in this program, so we should always have X=m; we + didn't propagate this information from (1) into the loop + invariant, but we could!
              - Also, looking at the second conjunct of (8), it seems quite - hopeless as an invariant (why?); fortunately, we don't need it, - since we can obtain it from the negation of the guard — the third - conjunct in (7) — again under the assumption that X=m. + Also, we don't need the second conjunct of (8), since we can + obtain it from the negation of the guard — the third conjunct + in (7) — again under the assumption that X=m. This allows + us to simplify a bit.
              @@ -1104,17 +1100,17 @@

              Hoare2Hoare Logic, Part II

              -      {X=m }}  ->>                                      (a - OK)
              +      {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*Zm ∧ (Z+1)*(Z+1)≤X }}  ->>        (c - OK)
              +        {X=m ∧ Z*Zm ∧ (Z+1)*(Z+1)≤X }}  ->>        (c - OK)
                      {X=m ∧ (Z+1)*(Z+1)≤m }}
              -      Z ::= Z+1
              +      Z ::= Z + 1
                      {X=m ∧ Z*Zm }}
                  END
              -      {X=m ∧ Z*Zm ∧ X<(Z+1)*(Z+1) }}  ->>           (b - OK)
              +      {X=m ∧ Z*Zm ∧ X<(Z+1)*(Z+1) }}  ->>           (b - OK)
                    {Z*Zm ∧ m<(Z+1)*(Z+1) }}
              @@ -1124,14 +1120,14 @@

              Hoare2Hoare Logic, Part II

              - Very often, even if a variable is used in a loop in a read-only + 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

              +

              Example: Squaring

              @@ -1143,7 +1139,7 @@

              Hoare2Hoare Logic, Part II{{ X = m }}
                Y ::= 0;;
                Z ::= 0;;
              -  WHILE !(Y = X)  DO
              +  WHILE ~(Y = X)  DO
                  Z ::= Z + X;;
                  Y ::= Y + 1
                END
              @@ -1164,21 +1160,21 @@

              Hoare2Hoare Logic, Part II

              -      {X = m }->>                            (a - WRONG)
              +      {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 = XDO
              -        {Z = Y*m ∧ X = m ∧ Y ≠ X }->>     (c - WRONG)
              +    WHILE ~(Y = XDO
              +        {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 ∧ X = m ∧ ~(Y ≠ X}->>         (b - OK)
                    {Z = m*m }}
              @@ -1197,21 +1193,21 @@

              Hoare2Hoare Logic, Part II

              -      {X = m }->>                               (a - OK)
              +      {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 = XDO
              -        {Z = Y*m ∧ X = m ∧ Y ≠ X }->>        (c - OK)
              +    WHILE ~(Y = XDO
              +        {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 = Y*m ∧ X = m ∧ ~(Y ≠ X}->>           (b - OK)
                    {Z = m*m }}
              @@ -1226,17 +1222,17 @@

              Hoare2Hoare Logic, Part IIZ = m*m and the Z = Y*m conjunct of the invariant. It is often the case that one has - to replace parameters with variables — or - with expressions involving both variables and parameters, like - m - Y — when going from postconditions to invariants. + to replace parameters with variables — or with expressions + involving both variables and parameters, like m - Y — when + going from postconditions to invariants.

              -

              Exercise: Factorial

              +

              Exercise: Factorial

              -

              练习:3 星 (factorial)

              +

              练习:3 星, standard (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 @@ -1247,7 +1243,7 @@

              Hoare2Hoare Logic, Part II     {X = m }}
                Y ::= 1 ;;
              -  WHILE !(X = 0)
              +  WHILE ~(X = 0)
                DO
                   Y ::= Y * X ;;
                   X ::= X - 1
              @@ -1256,24 +1252,26 @@

              Hoare2Hoare Logic, Part II

              - Fill in the blanks in following decorated program: + Fill in the blanks in following decorated program. For full credit, + make sure all the arithmetic operations used in the assertions are + well-defined on natural numbers.
              -    {X = m }->>
              +    {X = m }->>
                  {{                                      }}
                Y ::= 1;;
                  {{                                      }}
              -  WHILE !(X = 0)
              -  DO   {{                                      }->>
              +  WHILE ~(X = 0)
              +  DO   {{                                      }->>
                     {{                                      }}
                   Y ::= Y * X;;
                     {{                                      }}
                   X ::= X - 1
                     {{                                      }}
                END
              -    {{                                      }->>
              +    {{                                      }->>
                  {Y = m}}
              @@ -1287,13 +1285,23 @@

              Hoare2Hoare Logic, Part II +
              + +(* LY: I saw one submission for factorial_dec use a program like that instead
              +   of the one already given by the informal exercise. I accepted it because the
              +   exercise does not require to reuse the given program, and we did not
              +   strictly define what it means to "implement" factorial in Imp.
              +   This other one "implements" factorial in the same way two_loops_dec
              +   "implements" the sum (a + b + c).
              +*)

              +
              -

              Exercise: Min

              +

              Exercise: Min

              -

              练习:3 星 (Min_Hoare)

              +

              练习:3 星, standard (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 @@ -1301,9 +1309,9 @@

              Hoare2Hoare Logic, Part II

              -  Lemma lemma1 :  x y,
              +  Lemma lemma1 : x y,
                  (x=0 ∨ y=0) → min x y = 0.
              -  Lemma lemma2 :  x y,
              +  Lemma lemma2 : x y,
                  min (x-1) (y-1) = (min x y) - 1.
              @@ -1313,7 +1321,7 @@

              Hoare2Hoare Logic, Part II

              -  {True }->>
              +  {True }->>
                {{                    }}
                X ::= a;;
                {{                       }}
              @@ -1321,8 +1329,8 @@

              Hoare2Hoare Logic, Part II{{                       }}
                Z ::= 0;;
                {{                       }}
              -  WHILE !(X = 0) && !(Y = 0) DO
              -  {{                                     }->>
              +  WHILE ~(X = 0) && ~(Y = 0) DO
              +  {{                                     }->>
                {{                                }}
                X := X - 1;;
                {{                            }}
              @@ -1331,7 +1339,7 @@

              Hoare2Hoare Logic, Part IIZ := Z + 1
                {{                       }}
                END
              -  {{                            }->>
              +  {{                            }->>
                {Z = min a b }}
              @@ -1348,23 +1356,23 @@

              Hoare2Hoare Logic, Part II
              -

              练习:3 星 (two_loops)

              +

              练习:3 星, standard (two_loops)

              Here is a very inefficient way of adding 3 numbers:
              -  X ::= 0;;
              -  Y ::= 0;;
              -  Z ::= c;;
              -  WHILE !(X = aDO
              -    X ::= X + 1;;
              -    Z ::= Z + 1
              -  END;;
              -  WHILE !(Y = bDO
              -    Y ::= Y + 1;;
              -    Z ::= Z + 1
              -  END +     X ::= 0;;
              +     Y ::= 0;;
              +     Z ::= c;;
              +     WHILE ~(X = aDO
              +       X ::= X + 1;;
              +       Z ::= Z + 1
              +     END;;
              +     WHILE ~(Y = bDO
              +       Y ::= Y + 1;;
              +       Z ::= Z + 1
              +     END
              @@ -1374,34 +1382,34 @@

              Hoare2Hoare Logic, Part II

              -    {True }->>
              -    {{                                        }}
              -  X ::= 0;;
              -    {{                                        }}
              -  Y ::= 0;;
              -    {{                                        }}
              -  Z ::= c;;
              -    {{                                        }}
              -  WHILE !(X = aDO
              -      {{                                        }->>
              +      {True }->>
                    {{                                        }}
              -    X ::= X + 1;;
              -      {{                                        }}
              -    Z ::= Z + 1
              +    X ::= 0;;
                    {{                                        }}
              -  END;;
              -    {{                                        }->>
              -    {{                                        }}
              -  WHILE !(Y = bDO
              -      {{                                        }->>
              +    Y ::= 0;;
                    {{                                        }}
              -    Y ::= Y + 1;;
              +    Z ::= c;;
                    {{                                        }}
              -    Z ::= Z + 1
              +    WHILE ~(X = aDO
              +        {{                                        }->>
              +        {{                                        }}
              +      X ::= X + 1;;
              +        {{                                        }}
              +      Z ::= Z + 1
              +        {{                                        }}
              +    END;;
              +      {{                                        }->>
                    {{                                        }}
              -  END
              -    {{                                        }->>
              -    {Z = a + b + c }} +    WHILE ~(Y = bDO
              +        {{                                        }->>
              +        {{                                        }}
              +      Y ::= Y + 1;;
              +        {{                                        }}
              +      Z ::= Z + 1
              +        {{                                        }}
              +    END
              +      {{                                        }->>
              +      {Z = a + b + c }}
              @@ -1416,11 +1424,11 @@

              Hoare2Hoare Logic, Part II
              -

              Exercise: Power Series

              +

              Exercise: Power Series

              -

              练习:4 星, optional (dpow2_down)

              +

              练习:4 星, standard, optional (dpow2_down)

              Here is a program that computes the series: 1 + 2 + 2^2 + ... + 2^m = 2^(m+1) - 1 @@ -1430,7 +1438,7 @@

              Hoare2Hoare Logic, Part II::= 0;;
                  Y ::= 1;;
                  Z ::= 1;;
              -    WHILE !(X = mDO
              +    WHILE ~(X = mDO
                    Z ::= 2 * Z;;
                    Y ::= Y + Z;;
                    X ::= X + 1
              @@ -1448,7 +1456,7 @@

              Hoare2Hoare Logic, Part II
              -

              Weakest Preconditions (Optional)

              +

              Weakest Preconditions (Optional)

              @@ -1506,7 +1514,7 @@

              Hoare2Hoare Logic, Part IIDefinition is_wp P c Q :=
                {{P}} c {{Q}} ∧
              -   P', {{P'}} c {{Q}} → (P' ->> P).
              +  P', {{P'}} c {{Q}} → (P' ->> P).

              @@ -1516,7 +1524,7 @@

              Hoare2Hoare Logic, Part IIQ will hold after executing c.
              -

              练习:1 星, optional (wp)

              +

              练习:1 星, standard, optional (wp)

              What are the weakest preconditions of the following commands for the following postconditions? @@ -1530,7 +1538,7 @@

              Hoare2Hoare Logic, Part II{{ ? }}  X ::= Y  {X = Y }}

                4) {{ ? }}
              -     IFB X == 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI
              +     TEST X = 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI
                   {Y = 5 }}

                5) {{ ? }}
              @@ -1553,7 +1561,7 @@

              Hoare2Hoare Logic, Part II
              -

              练习:3 星, advanced, optional (is_wp_formal)

              +

              练习:3 星, 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. @@ -1571,14 +1579,14 @@

              Hoare2Hoare Logic, Part II
              -

              练习:2 星, advanced, optional (hoare_asgn_weakest)

              +

              练习:2 星, advanced, optional (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.
              +Theorem hoare_asgn_weakest : Q X a,
              +  is_wp (Q [X > a]) (X ::= a) Q.
              Proof.
              (* 请在此处解答 *) Admitted.
              @@ -1587,16 +1595,16 @@

              Hoare2Hoare Logic, Part II
              -

              练习:2 星, advanced, optional (hoare_havoc_weakest)

              +

              练习:2 星, 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 : (P Q : Assertion) (X : string),
              +Lemma hoare_havoc_weakest : (P Q : Assertion) (X : string),
                {{ P }} HAVOC X {{ Q }} →
              -  P ->> havoc_pre X Q.
              +  P ->> havoc_pre X Q.
              Proof.
              (* 请在此处解答 *) Admitted.
              @@ -1604,7 +1612,7 @@

              Hoare2Hoare Logic, Part II
              -

              Formal Decorated Programs (Optional)

              +

              Formal Decorated Programs (Advanced)

              @@ -1618,7 +1626,7 @@

              Hoare2Hoare Logic, Part II

              -

              Syntax

              +

              Syntax

              @@ -1629,11 +1637,11 @@

              Hoare2Hoare Logic, Part IIdecorated, is used to add the precondition - for the entire program. + redundant decorations—the postcondition of the first likely being + the same as the precondition of the second. Instead, decorations + are added corresponding to postconditions only. A separate type, + decorated, is used to add just one precondition for the entire + program.

              @@ -1648,6 +1656,7 @@

              Hoare2Hoare Logic, Part IIDCPost : dcomAssertiondcom.

              Inductive decorated : Type :=
                | Decorated : Assertiondcomdecorated.

              +Delimit Scope default with default.

              Notation "'SKIP' {{ P }}"
                    := (DCSkip P)
                    (at level 10) : dcom_scope.
              @@ -1657,13 +1666,13 @@

              Hoare2Hoare Logic, Part IINotation "'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 }}"
              +Notation "'TEST' 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"
              +Notation "'->>' {{ P }} d"
                    := (DCPre P d)
                    (at level 90, right associativity) : dcom_scope.
              -Notation "d '->>' {{ P }}"
              +Notation "d '->>' {{ P }}"
                    := (DCPost d P)
                    (at level 80, right associativity) : dcom_scope.
              Notation " d ;; d' "
              @@ -1673,7 +1682,13 @@

              Hoare2Hoare Logic, Part IIDecorated P d)
                    (at level 90) : dcom_scope.

              Delimit Scope dcom_scope with dcom.
              -Open Scope dcom_scope.
              +Open Scope dcom_scope.

              +Example dec0 :=
              +  SKIP {{ fun stTrue }}.
              +Example dec1 :=
              +  WHILE true DO {{ fun stTrue }} SKIP {{ fun stTrue }} END
              +  {{ fun stTrue }}.
              +Set Printing All.

              @@ -1686,21 +1701,21 @@

              Hoare2Hoare Logic, Part II->>. The "without" version is intended to be + 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 : decorated :=
              -  {{ fun stTrue }}
              -  WHILE !(X = 0)
              +  {{ fun stTrue }}
              +  WHILE ~(X = 0)
                DO
                  {{ fun stTruest X ≠ 0}}
                  X ::= X - 1
                  {{ fun _True }}
                END
              -  {{ fun stTruest X = 0}} ->>
              +  {{ fun stTruest X = 0}} ->>
                {{ fun stst X = 0 }}.
              @@ -1710,12 +1725,12 @@

              Hoare2Hoare Logic, Part II
              -Fixpoint extract (d:dcom) : com :=
              +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
              +  | DCIf b _ d1 _ d2 _TEST b THEN extract d1 ELSE extract d2 FI
                | DCWhile b _ d _WHILE b DO extract d END
                | DCPre _ dextract d
                | DCPost d _extract d
              @@ -1771,7 +1786,7 @@

              Hoare2Hoare Logic, Part II
              -Fixpoint post (d:dcom) : Assertion :=
              +Fixpoint post (d : dcom) : Assertion :=
                match d with
                | DCSkip PP
                | DCSeq d1 d2post d2
              @@ -1818,7 +1833,7 @@

              Hoare2Hoare Logic, Part II

              -

              Extracting Verification Conditions

              +

              Extracting Verification Conditions

              @@ -1837,33 +1852,32 @@

              Hoare2Hoare Logic, Part II
              -Fixpoint verification_conditions (P : Assertion) (d:dcom)
              -                               : Prop :=
              +Fixpoint verification_conditions (P : Assertion) (d : dcom) : Prop :=
                match d with
                | DCSkip Q
              -      (P ->> Q)
              +      (P ->> Q)
                | DCSeq d1 d2
                    verification_conditions P d1
                    ∧ verification_conditions (post d1) d2
                | DCAsgn X a Q
              -      (P ->> Q [X |-> a])
              +      (P ->> Q [X > a])
                | DCIf b P1 d1 P2 d2 Q
              -      ((fun stP stbassn b st) ->> P1)
              -      ∧ ((fun stP st ∧ ¬ (bassn b st)) ->> P2)
              -      ∧ (post d1 ->> Q) ∧ (post d2 ->> Q)
              +      ((fun stP stbassn b st) ->> P1)
              +      ∧ ((fun stP st ∧ ¬(bassn b st)) ->> P2)
              +      ∧ (post d1 ->> Q) ∧ (post d2 ->> Q)
                    ∧ 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)
              -      ∧ ((fun stpost d stbassn b st) ->> Pbody)
              -      ∧ ((fun stpost d st ∧ ~(bassn b st)) ->> Ppost)
              +      (P ->> post d)
              +      ∧ ((fun stpost d stbassn b st) ->> Pbody)
              +      ∧ ((fun stpost d st ∧ ~(bassn b st)) ->> Ppost)
                    ∧ verification_conditions Pbody d
                | DCPre P' d
              -      (P ->> P') ∧ verification_conditions P' d
              +      (P ->> P') ∧ verification_conditions P' d
                | DCPost d Q
              -      verification_conditions P d ∧ (post d ->> Q)
              +      verification_conditions P d ∧ (post d ->> Q)
                end.
              @@ -1874,7 +1888,7 @@

              Hoare2Hoare Logic, Part II
              -Theorem verification_correct : d P,
              +Theorem verification_correct : d P,
                verification_conditions P d{{P}} (extract d) {{post d}}.
              @@ -1885,7 +1899,7 @@

              Hoare2Hoare Logic, Part IIapply hoare_skip.
                    assumption.
                - (* Seq *)
              -    inversion H as [H1 H2]. clear H.
              +    destruct H as [H1 H2].
                  eapply hoare_seq.
                    apply IHd2. apply H2.
                    apply IHd1. apply H1.
              @@ -1894,8 +1908,7 @@

              Hoare2Hoare Logic, Part IIapply hoare_asgn.
                    assumption.
                - (* If *)
              -    inversion H as [HPre1 [HPre2 [Hd1 [Hd2 [HThen HElse]]]]].
              -    clear H.
              +    destruct H as [HPre1 [HPre2 [Hd1 [Hd2 [HThen HElse]]]]].
                  apply IHd1 in HThen. clear IHd1.
                  apply IHd2 in HElse. clear IHd2.
                  apply hoare_if.
              @@ -1904,23 +1917,23 @@

              Hoare2Hoare Logic, Part IIeapply hoare_consequence_post with (Q':=post d2); eauto.
                       eapply hoare_consequence_pre; eauto.
                - (* While *)
              -    inversion H as [Hpre [Hbody1 [Hpost1 Hd]]]. clear H.
              +    destruct H as [Hpre [Hbody1 [Hpost1 Hd]]].
                  eapply hoare_consequence_pre; eauto.
                  eapply hoare_consequence_post; eauto.
                  apply hoare_while.
                  eapply hoare_consequence_pre; eauto.
                - (* Pre *)
              -    inversion H as [HP Hd]; clear H.
              +    destruct H as [HP Hd].
                  eapply hoare_consequence_pre. apply IHd. apply Hd. assumption.
                - (* Post *)
              -    inversion H as [Hd HQ]; clear H.
              +    destruct H as [Hd HQ].
                  eapply hoare_consequence_post. apply IHd. apply Hd. assumption.
              Qed.

              -

              Automation

              +

              Automation

              @@ -1932,7 +1945,7 @@

              Hoare2Hoare Logic, Part IImatch dec with
                | Decorated P dverification_conditions P d
                end.

              -Lemma verification_correct_dec : dec,
              +Lemma verification_correct_dec : dec,
                verification_conditions_dec decdec_correct dec.
              Proof.
                intros [P d]. apply verification_correct.
              @@ -1953,15 +1966,16 @@

              Hoare2Hoare Logic, Part II

              -    ==>
              -    (((fun _ : state ⇒ True->> (fun _ : state ⇒ True)) ∧
              -     ((fun st : state ⇒ True ∧ bassn (! (X = 0)) st->>
              +   ===>
              +    (((fun _ : state ⇒ True->> (fun _ : state ⇒ True)) ∧
              +     ((fun st : state ⇒ True ∧ bassn (~(X = 0)) st->>
                    (fun st : state ⇒ True ∧ st X ≠ 0)) ∧
              -     ((fun st : state ⇒ True ∧ ¬ bassn (! (X = 0)) st->>
              +     ((fun st : state ⇒ True ∧ ¬bassn (~(X = 0)) st->>
                    (fun st : state ⇒ True ∧ st X = 0)) ∧
              -      (fun st : state ⇒ True ∧ st X ≠ 0) ->>
              -      (fun _ : state ⇒ True) [X |-> X - 1]) ∧
              -      (fun st : state ⇒ True ∧ st X = 0) ->> (fun st : state ⇒ st X = 0)    +      (fun st : state ⇒ True ∧ st X ≠ 0) ->>
              +      (fun _ : state ⇒ True) [X > X - 1]) ∧
              +      (fun st : state ⇒ True ∧ st X = 0) ->> 
              +      (fun st : state ⇒ st X = 0)   
              @@ -1987,7 +2001,7 @@

              Hoare2Hoare Logic, Part IIrepeat rewrite t_update_eq;
                repeat (rewrite t_update_neq; [| (intro X; inversion X)]);
                simpl in *;
              -  repeat match goal with [H : __ |- _] ⇒ destruct H end;
              +  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 *;
              @@ -1999,10 +2013,10 @@

              Hoare2Hoare Logic, Part IItry subst;
                repeat
                  match goal with
              -      [st : state |- _] ⇒
              +      [st : state_] ⇒
                      match goal with
              -          [H : st _ = _ |- _] ⇒ rewriteH in *; clear H
              -        | [H : _ = st _ |- _] ⇒ rewrite <- H in *; clear H
              +          [H : st _ = __] ⇒ rewriteH in *; clear H
              +        | [H : _ = st __] ⇒ rewrite <- H in *; clear H
                      end
                  end;
                try eauto; try omega.
              @@ -2011,8 +2025,8 @@

              Hoare2Hoare Logic, Part II 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!). + simple examples, verify sometimes even immediately solves the + goal (provided that the annotations are correct!).

              @@ -2027,26 +2041,26 @@

              Hoare2Hoare Logic, Part II
              -Example subtract_slowly_dec (m:nat) (p:nat) : decorated :=
              -    {{ fun stst X = mst Z = p }} ->>
              +Example subtract_slowly_dec (m : nat) (p : nat) : decorated :=
              +    {{ fun stst X = mst Z = p }} ->>
                  {{ fun stst Z - st X = p - m }}
              -  WHILE ! (X = 0)
              -  DO {{ fun stst Z - st X = p - mst X ≠ 0 }} ->>
              +  WHILE ~(X = 0)
              +  DO {{ fun stst Z - st X = p - mst X ≠ 0 }} ->>
                     {{ fun st ⇒ (st Z - 1) - (st X - 1) = p - m }}
                   Z ::= Z - 1
                     {{ fun stst Z - (st X - 1) = p - m }} ;;
                   X ::= X - 1
                     {{ fun stst Z - st X = p - m }}
                END
              -    {{ fun stst Z - st X = p - mst X = 0 }} ->>
              +    {{ fun stst Z - st X = p - mst X = 0 }} ->>
                  {{ fun stst Z = p - m }}.

              -Theorem subtract_slowly_dec_correct : m p,
              +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.
              -

              Examples

              +

              Examples

              @@ -2055,7 +2069,7 @@

              Hoare2Hoare Logic, Part II

              -

              Swapping Using Addition and Subtraction

              +

              Swapping Using Addition and Subtraction

              @@ -2066,7 +2080,7 @@

              Hoare2Hoare Logic, Part IIY ::= X - Y;;
                X ::= X - Y.

              Definition swap_dec m n : decorated :=
              -   {{ fun stst X = mst Y = n}} ->>
              +   {{ fun stst X = mst Y = n}} ->>
                 {{ fun st ⇒ (st X + st Y) - ((st X + st Y) - st Y) = n
                              ∧ (st X + st Y) - st Y = m }}
                X ::= X + Y
              @@ -2075,32 +2089,32 @@

              Hoare2Hoare Logic, Part II{{ fun stst X - st Y = nst Y = m }};;
                X ::= X - Y
                 {{ fun stst X = nst Y = m}}.

              -Theorem swap_correct : m n,
              +Theorem swap_correct : m n,
                dec_correct (swap_dec m n).
              Proof. intros; verify. Qed.

              -

              Simple Conditionals

              +

              Simple Conditionals


              Definition if_minus_plus_com :=
              -  IFB XY
              +  (TEST XY
                  THEN Z ::= Y - X
                  ELSE Y ::= X + Z
              -  FI.

              +  FI)%imp.

              Definition if_minus_plus_dec :=
                {{fun stTrue}}
              -  IFB XY THEN
              -      {{ fun stTruest Xst Y }} ->>
              +  TEST XY THEN
              +      {{ fun stTruest Xst Y }} ->>
                    {{ fun stst Y = st X + (st Y - st X) }}
                  Z ::= Y - X
                    {{ fun stst Y = st X + st Z }}
                ELSE
              -      {{ fun stTrue ∧ ~(st Xst Y) }} ->>
              +      {{ fun stTrue ∧ ~(st Xst Y) }} ->>
                    {{ fun stst X + st Z = st X + st Z }}
                  Y ::= X + Z
                    {{ fun stst Y = st X + st Z }}
              @@ -2111,14 +2125,14 @@

              Hoare2Hoare Logic, Part IIProof. verify. Qed.

              Definition if_minus_dec :=
                {{fun stTrue}}
              -  IFB XY THEN
              -      {{fun stTruest Xst Y }} ->>
              +  TEST XY THEN
              +      {{fun stTruest Xst Y }} ->>
                    {{fun st ⇒ (st Y - st X) + st X = st Y
                             ∨ (st Y - st X) + st Y = st X}}
                  Z ::= Y - X
                    {{fun stst Z + st X = st Yst Z + st Y = st X}}
                ELSE
              -      {{fun stTrue ∧ ~(st Xst Y) }} ->>
              +      {{fun stTrue ∧ ~(st Xst Y) }} ->>
                    {{fun st ⇒ (st X - st Y) + st X = st Y
                             ∨ (st X - st Y) + st Y = st X}}
                  Z ::= X - Y
              @@ -2131,30 +2145,30 @@

              Hoare2Hoare Logic, Part II
              -

              Division

              +

              Division


              Definition div_mod_dec (a b : nat) : decorated :=
              -  {{ fun stTrue }} ->>
              +  {{ fun stTrue }} ->>
                {{ fun stb * 0 + a = a }}
                X ::= a
                {{ fun stb * 0 + st X = a }};;
                Y ::= 0
                {{ fun stb * st Y + st X = a }};;
                WHILE bX DO
              -    {{ fun stb * st Y + st X = abst X }} ->>
              +    {{ fun stb * st Y + st X = abst X }} ->>
                  {{ fun stb * (st Y + 1) + (st X - b) = a }}
                  X ::= X - b
                  {{ fun stb * (st Y + 1) + st X = a }};;
                  Y ::= Y + 1
                  {{ fun stb * st Y + st X = a }}
                END
              -  {{ fun stb * st Y + st X = a ∧ ~(bst X) }} ->>
              +  {{ fun stb * st Y + st X = a ∧ ~(bst X) }} ->>
                {{ fun stb * st Y + st X = a ∧ (st X < b) }}.

              -Theorem div_mod_dec_correct : a b,
              +Theorem div_mod_dec_correct : a b,
                dec_correct (div_mod_dec a b).
              Proof. intros a b. verify.
                rewrite mult_plus_distr_l. omega.
              @@ -2162,7 +2176,7 @@

              Hoare2Hoare Logic, Part II
              -

              Parity

              +

              Parity

              @@ -2183,33 +2197,33 @@

              Hoare2Hoare Logic, Part IIInductive ev : natProp :=
                | ev_0 : ev O
              -  | ev_SS : n:nat, ev nev (S (S n)).

              +  | ev_SS : n : nat, ev nev (S (S n)).

              Definition find_parity_dec m : decorated :=
              -   {{ fun stst X = m}} ->>
              +   {{ fun stst X = m}} ->>
                 {{ fun stst Xmev (m - st X) }}
                WHILE 2 ≤ X DO
              -     {{ fun st ⇒ (st Xmev (m - st X)) ∧ 2 ≤ st X }} ->>
              +     {{ fun st ⇒ (st Xmev (m - st X)) ∧ 2 ≤ st X }} ->>
                   {{ fun stst X - 2 ≤ m ∧ (ev (m - (st X - 2))) }}
                   X ::= X - 2
                   {{ fun stst Xmev (m - st X) }}
                END
              -   {{ fun st ⇒ (st Xmev (m - st X)) ∧ st X < 2 }} ->>
              +   {{ fun st ⇒ (st Xmev (m - st X)) ∧ st X < 2 }} ->>
                 {{ fun stst X=0 ↔ ev m }}.

              -Lemma l1 : m n p,
              +Lemma l1 : m n p,
                pn
                nm
                m - (n - p) = m - n + p.
              Proof. intros. omega. Qed.

              -Lemma l2 : m,
              +Lemma l2 : m,
                ev m
                ev (m + 2).
              Proof. intros. rewrite plus_comm. simpl. constructor. assumption. Qed.

              -Lemma l3' : m,
              +Lemma l3' : m,
                ev m
                ¬ev (S m).
              Proof. induction m; intros H1 H2. inversion H2. apply IHm.
                     inversion H2; subst; assumption. assumption. Qed.

              -Lemma l3 : m,
              +Lemma l3 : m,
                1 ≤ m
                ev m
                ev (m - 1) →
              @@ -2217,7 +2231,7 @@

              Hoare2Hoare Logic, Part IIProof. intros. apply l2 in H1.
                     assert (G : m - 1 + 2 = S m). clear H0 H1. omega.
                     rewrite G in H1. apply l3' in H0. apply H0. assumption. Qed.

              -Theorem find_parity_correct : m,
              +Theorem find_parity_correct : m,
                dec_correct (find_parity_dec m).
              Proof.
                intro m. verify;
              @@ -2231,7 +2245,7 @@

              Hoare2Hoare Logic, Part IIrewrite l1; try assumption.
                    apply l2; assumption.
                  - (* invariant strong enough to imply conclusion
              -         (-> direction) *)

              +         (-> direction) *)
                    rewrite <- minus_n_O in H2. assumption.
                  - (* invariant strong enough to imply conclusion
                       (<- direction) *)

              @@ -2253,17 +2267,17 @@

              Hoare2Hoare Logic, Part II Definition find_parity_dec' m : decorated :=
              -  {{ fun stst X = m}} ->>
              +  {{ fun stst X = m}} ->>
                {{ fun stev (st X) ↔ ev m }}
               WHILE 2 ≤ X DO
              -    {{ fun st ⇒ (ev (st X) ↔ ev m) ∧ 2 ≤ st X }} ->>
              +    {{ fun st ⇒ (ev (st X) ↔ ev m) ∧ 2 ≤ st X }} ->>
                  {{ fun st ⇒ (ev (st X - 2) ↔ ev m) }}
                  X ::= X - 2
                  {{ fun st ⇒ (ev (st X) ↔ ev m) }}
               END
              {{ fun st ⇒ (ev (st X) ↔ ev m) ∧ ~(2 ≤ st X) }} ->>
              {{ fun st ⇒ (ev (st X) ↔ ev m) ∧ ~(2 ≤ st X) }} ->>
               {{ fun stst X=0 ↔ ev m }}.

              -Lemma l4 : m,
              +Lemma l4 : m,
                2 ≤ m
                (ev (m - 2) ↔ ev m).
              Proof.
              @@ -2273,7 +2287,7 @@

              Hoare2Hoare Logic, Part IIconstructor. assumption.
                  inversion H0. assumption.
              Qed.

              -Theorem find_parity_correct' : m,
              +Theorem find_parity_correct' : m,
                dec_correct (find_parity_dec' m).
              Proof.
                intros m. verify;
              @@ -2286,7 +2300,7 @@

              Hoare2Hoare Logic, Part II(* invariant preserved (part 2) *)
                  rewrite l4; eauto.
                - (* invariant strong enough to imply conclusion
              -       (-> direction) *)

              +       (-> direction) *)
                  apply H0. constructor.
                - (* invariant strong enough to imply conclusion
                     (<- direction) *)

              @@ -2307,17 +2321,17 @@

              Hoare2Hoare Logic, Part II Definition parity_dec m : decorated :=
              -  {{ fun stst X = m}} ->>
              +  {{ fun stst X = m}} ->>
                {{ fun stparity (st X) = parity m }}
               WHILE 2 ≤ X DO
              -    {{ fun stparity (st X) = parity m ∧ 2 ≤ st X }} ->>
              +    {{ fun stparity (st X) = parity m ∧ 2 ≤ st X }} ->>
                  {{ fun stparity (st X - 2) = parity m }}
                  X ::= X - 2
                  {{ fun stparity (st X) = parity m }}
               END
              {{ fun stparity (st X) = parity m ∧ ~(2 ≤ st X) }} ->>
              {{ fun stparity (st X) = parity m ∧ ~(2 ≤ st X) }} ->>
               {{ fun stst X = parity m }}.

              -Theorem parity_dec_correct : m,
              +Theorem parity_dec_correct : m,
                dec_correct (parity_dec m).
              Proof.
                intros. verify;
              @@ -2333,34 +2347,34 @@

              Hoare2Hoare Logic, Part II
              -

              Square Roots

              +

              Square Roots


              Definition sqrt_dec m : decorated :=
              -    {{ fun stst X = m }} ->>
              +    {{ fun stst X = m }} ->>
                  {{ fun stst X = m ∧ 0*0 ≤ m }}
                Z ::= 0
                  {{ fun stst X = mst Z*st Zm }};;
                WHILE (Z+1)*(Z+1) ≤ X DO
                    {{ fun st ⇒ (st X = mst Z*st Zm)
              -                   ∧ (st Z + 1)*(st Z + 1) ≤ st X }} ->>
              +                   ∧ (st Z + 1)*(st Z + 1) ≤ st X }} ->>
                    {{ fun stst X = m ∧ (st Z+1)*(st Z+1)≤m }}
                  Z ::= Z + 1
                    {{ fun stst X = mst Z*st Zm }}
                END
                  {{ fun st ⇒ (st X = mst Z*st Zm)
              -                   ∧ ~((st Z + 1)*(st Z + 1) ≤ st X) }} ->>
              +                   ∧ ~((st Z + 1)*(st Z + 1) ≤ st X) }} ->>
                  {{ fun stst Z*st Zmm<(st Z+1)*(st Z+1) }}.

              -Theorem sqrt_correct : m,
              +Theorem sqrt_correct : m,
                dec_correct (sqrt_dec m).
              Proof. intro m. verify. Qed.
              -

              Squaring

              +

              Squaring

              @@ -2375,19 +2389,19 @@

              Hoare2Hoare Logic, Part IIY ::= X
                {{ fun stst X = mst Y = m }};;
                Z ::= 0
              -  {{ fun stst X = mst Y = mst Z = 0}} ->>
              +  {{ fun stst X = mst Y = mst Z = 0}} ->>
                {{ fun stst Z + st X * st Y = m * m }};;
              -  WHILE !(Y = 0) DO
              -    {{ fun stst Z + st X * st Y = m * mst Y ≠ 0 }} ->>
              +  WHILE ~(Y = 0) DO
              +    {{ fun stst Z + st X * st Y = m * mst Y ≠ 0 }} ->>
                  {{ fun st ⇒ (st Z + st X) + st X * (st Y - 1) = m * m }}
                  Z ::= Z + X
                  {{ fun stst Z + st X * (st Y - 1) = m * m }};;
                  Y ::= Y - 1
                  {{ fun stst Z + st X * st Y = m * m }}
                END
              -  {{ fun stst Z + st X * st Y = m * mst Y = 0 }} ->>
              +  {{ fun stst Z + st X * st Y = m * mst Y = 0 }} ->>
                {{ fun stst Z = m * m }}.

              -Theorem square_dec_correct : m,
              +Theorem square_dec_correct : m,
                dec_correct (square_dec m).
              Proof.
                intro n. verify.
              @@ -2395,7 +2409,7 @@

              Hoare2Hoare Logic, Part IIdestruct (st Y) as [| y']. apply False_ind. apply H0.
                  reflexivity.
                  simpl. rewrite <- minus_n_O.
              -    assert (G : n m, n * S m = n + n * m). {
              +    assert (G : n m, n * S m = n + n * m). {
                    clear. intros. induction n. reflexivity. simpl.
                    rewrite IHn. omega. }
                  rewrite <- H. rewrite G. rewrite plus_assoc. reflexivity.
              @@ -2407,10 +2421,10 @@

              Hoare2Hoare Logic, Part IIY ::= X
                {{ fun stst X = nst Y = n }};;
                Z ::= 0
              -  {{ fun stst X = nst Y = nst Z = 0 }} ->>
              +  {{ fun stst X = nst Y = nst Z = 0 }} ->>
                {{ fun stst Z = st X * (st X - st Y)
                             ∧ st X = nst Yst X }};;
              -  WHILE !(Y = 0) DO
              +  WHILE ~(Y = 0) DO
                  {{ fun st ⇒ (st Z = st X * (st X - st Y)
                              ∧ st X = nst Yst X)
                               ∧ st Y ≠ 0 }}
              @@ -2423,9 +2437,9 @@

              Hoare2Hoare Logic, Part IIEND
                {{ fun st ⇒ (st Z = st X * (st X - st Y)
                            ∧ st X = nst Yst X)
              -               ∧ st Y = 0 }} ->>
              +               ∧ st Y = 0 }} ->>
                {{ fun stst Z = n * n }}.

              -Theorem square_dec'_correct : n,
              +Theorem square_dec'_correct : n,
                dec_correct (square_dec' n).
              Proof.
                intro n. verify.
              @@ -2434,7 +2448,7 @@

              Hoare2Hoare Logic, Part II(* invariant preserved *) subst.
                  rewrite mult_minus_distr_l.
                  repeat rewrite mult_minus_distr_l. rewrite mult_1_r.
              -    assert (G : n m p,
              +    assert (G : n m p,
                                mnpmn - (m - p) = n - m + p).
                    intros. omega.
                  rewrite G. reflexivity. apply mult_le_compat_l. assumption.
              @@ -2446,25 +2460,25 @@

              Hoare2Hoare Logic, Part IIrewrite <- minus_n_O. reflexivity.
              Qed.

              Definition square_simpler_dec (m : nat) : decorated :=
              -  {{ fun stst X = m }} ->>
              +  {{ fun stst X = m }} ->>
                {{ fun st ⇒ 0 = 0*mst X = m }}
                Y ::= 0
                {{ fun st ⇒ 0 = (st Y)*mst X = m }};;
                Z ::= 0
              -  {{ fun stst Z = (st Y)*mst X = m }}->>
              +  {{ fun stst Z = (st Y)*mst X = m }}->>
                {{ fun stst Z = (st Y)*mst X = m }};;
              -  WHILE !(Y = X) DO
              +  WHILE ~(Y = X) DO
                  {{ fun st ⇒ (st Z = (st Y)*mst X = m)
              -        ∧ st Yst X }} ->>
              +        ∧ st Yst X }} ->>
                  {{ fun stst Z + st X = ((st Y) + 1)*mst X = m }}
                  Z ::= Z + X
                  {{ fun stst Z = ((st Y) + 1)*mst X = m }};;
                  Y ::= Y + 1
                  {{ fun stst Z = (st Y)*mst X = m }}
                END
              -  {{ fun st ⇒ (st Z = (st Y)*mst X = m) ∧ st Y = st X }} ->>
              +  {{ fun st ⇒ (st Z = (st Y)*mst X = m) ∧ st Y = st X }} ->>
                {{ fun stst Z = m*m }}.

              -Theorem square_simpler_dec_correct : m,
              +Theorem square_simpler_dec_correct : m,
                dec_correct (square_simpler_dec m).
              Proof.
                intro m. verify.
              @@ -2474,14 +2488,14 @@

              Hoare2Hoare Logic, Part II
              -

              Two loops

              +

              Two loops


              Definition two_loops_dec (a b c : nat) : decorated :=
              -  {{ fun stTrue }} ->>
              +  {{ fun stTrue }} ->>
                {{ fun stc = 0 + c ∧ 0 = 0 }}
                X ::= 0
                {{ fun stc = st X + c ∧ 0 = 0 }};;
              @@ -2489,33 +2503,33 @@

              Hoare2Hoare Logic, Part II{{ fun stc = st X + cst Y = 0 }};;
                Z ::= c
                {{ fun stst Z = st X + cst Y = 0 }};;
              -  WHILE !(X = a) DO
              -    {{ fun st ⇒ (st Z = st X + cst Y = 0) ∧ st Xa }} ->>
              +  WHILE ~(X = a) DO
              +    {{ fun st ⇒ (st Z = st X + cst Y = 0) ∧ st Xa }} ->>
                  {{ fun stst Z + 1 = st X + 1 + cst Y = 0 }}
                  X ::= X + 1
                  {{ fun stst Z + 1 = st X + cst Y = 0 }};;
                  Z ::= Z + 1
                  {{ fun stst Z = st X + cst Y = 0 }}
                END
              -  {{ fun st ⇒ (st Z = st X + cst Y = 0) ∧ st X = a }} ->>
              +  {{ fun st ⇒ (st Z = st X + cst Y = 0) ∧ st X = a }} ->>
                {{ fun stst Z = a + st Y + c }};;
              -  WHILE !(Y = b) DO
              -    {{ fun stst Z = a + st Y + cst Yb }} ->>
              +  WHILE ~(Y = b) DO
              +    {{ fun stst Z = a + st Y + cst Yb }} ->>
                  {{ fun stst Z + 1 = a + st Y + 1 + c }}
                  Y ::= Y + 1
                  {{ fun stst Z + 1 = a + st Y + c }};;
                  Z ::= Z + 1
                  {{ fun stst Z = a + st Y + c }}
                END
              -  {{ fun st ⇒ (st Z = a + st Y + c) ∧ st Y = b }} ->>
              +  {{ fun st ⇒ (st Z = a + st Y + c) ∧ st Y = b }} ->>
                {{ fun stst Z = a + b + c }}.

              -Theorem two_loops_correct : a b c,
              +Theorem two_loops_correct : a b c,
                dec_correct (two_loops_dec a b c).
              Proof. intros a b c. verify. Qed.

              -

              Power Series

              +

              Power Series

              @@ -2526,8 +2540,8 @@

              Hoare2Hoare Logic, Part II   | S n' ⇒ 2 * (pow2 n')
                end.

              -Definition dpow2_down (n: nat) :=
              -  {{ fun stTrue }} ->>
              +Definition dpow2_down (n : nat) :=
              +  {{ fun stTrue }} ->>
                {{ fun st ⇒ 1 = (pow2 (0 + 1))-1 ∧ 1 = pow2 0 }}
                X ::= 0
                {{ fun st ⇒ 1 = (pow2 (0 + 1))-1 ∧ 1 = pow2 (st X) }};;
              @@ -2535,9 +2549,9 @@

              Hoare2Hoare Logic, Part II{{ fun stst Y = (pow2 (st X + 1))-1 ∧ 1 = pow2 (st X) }};;
                Z ::= 1
                {{ fun stst Y = (pow2 (st X + 1))-1 ∧ st Z = pow2 (st X) }};;
              -  WHILE !(X = n) DO
              +  WHILE ~(X = n) DO
                  {{ fun st ⇒ (st Y = (pow2 (st X + 1))-1 ∧ st Z = pow2 (st X))
              -                 ∧ st Xn }} ->>
              +                 ∧ st Xn }} ->>
                  {{ fun stst Y + 2 * st Z = (pow2 (st X + 2))-1
                               ∧ 2 * st Z = pow2 (st X + 1) }}
                  Z ::= 2 * Z
              @@ -2551,14 +2565,14 @@

              Hoare2Hoare Logic, Part IIst Z = pow2 (st X) }}
                END
                {{ fun st ⇒ (st Y = (pow2 (st X + 1))-1 ∧ st Z = pow2 (st X))
              -               ∧ st X = n }} ->>
              +               ∧ st X = n }} ->>
                {{ fun stst Y = pow2 (n+1) - 1 }}.

              -Lemma pow2_plus_1 : n,
              +Lemma pow2_plus_1 : n,
                pow2 (n+1) = pow2 n + pow2 n.
              Proof. induction n; simpl. reflexivity. omega. Qed.

              -Lemma pow2_le_1 : n, pow2 n ≥ 1.
              +Lemma pow2_le_1 : n, pow2 n ≥ 1.
              Proof. induction n. simpl. constructor. simpl. omega. Qed.

              -Theorem dpow2_down_correct : n,
              +Theorem dpow2_down_correct : n,
                dec_correct (dpow2_down n).
              Proof.
                intro m. verify.
              @@ -2582,11 +2596,11 @@

              Hoare2Hoare Logic, Part II
              -

              Further Exercises

              +

              Further Exercises

              -

              练习:3 星, advanced (slow_assignment_dec)

              +

              练习:3 星, 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, @@ -2595,9 +2609,9 @@

              Hoare2Hoare Logic, Part II
              -Example slow_assignment_dec (m:nat) : decorated
              +Example slow_assignment_dec (m : nat) : decorated
                (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Theorem slow_assignment_dec_correct : m,
              +Theorem slow_assignment_dec_correct : m,
                dec_correct (slow_assignment_dec m).
              Proof. (* 请在此处解答 *) Admitted.

              (* 请勿修改下面这一行: *)
              @@ -2608,12 +2622,12 @@

              Hoare2Hoare Logic, Part II
              -

              练习:4 星, advanced (factorial_dec)

              +

              练习:4 星, advanced (factorial_dec)

              Remember the factorial function we worked with before:
              -Fixpoint real_fact (n:nat) : nat :=
              +Fixpoint real_fact (n : nat) : nat :=
                match n with
                | O ⇒ 1
                | S n'n * (real_fact n')
              @@ -2636,7 +2650,7 @@

              Hoare2Hoare Logic, Part II
              -

              练习:4 星, advanced, optional (fib_eqn)

              +

              练习:4 星, advanced, optional (fib_eqn)

              The Fibonacci function is usually written like this:
              @@ -2663,7 +2677,7 @@

              Hoare2Hoare Logic, Part II             | S n''fib n' + fib n''
                          end
              -  end.

              +  end.

              @@ -2671,7 +2685,7 @@

              Hoare2Hoare Logic, Part II
              -Lemma fib_eqn : n,
              +Lemma fib_eqn : n,
                n > 0 →
                fib n + fib (Init.Nat.pred n) = fib (n + 1).
              Proof.
              @@ -2682,7 +2696,7 @@

              Hoare2Hoare Logic, Part II
              -

              练习:4 星, advanced, optional (fib)

              +

              练习:4 星, advanced, optional (fib)

              The following Imp program leaves the value of fib n in the variable Y when it terminates: @@ -2692,8 +2706,8 @@

              Hoare2Hoare Logic, Part II::= 1;;
                  Y ::= 1;;
                  Z ::= 1;;
              -    WHILE !(X = n+1) DO
              -      T ::= Z;
              +    WHILE ~(X = n + 1) DO
              +      T ::= Z;;
                    Z ::= Z + Y;;
                    Y ::= T;;
                    X ::= X + 1
              @@ -2707,7 +2721,7 @@

              Hoare2Hoare Logic, Part II

              -      {{True}dfib {Y = fib n }} +      {True }dfib {Y = fib n }}
              @@ -2716,9 +2730,9 @@

              Hoare2Hoare Logic, Part II Definition T : string := "T".

              -Definition dfib (n:nat) : decorated
              +Definition dfib (n : nat) : decorated
              (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Theorem dfib_correct : n,
              +Theorem dfib_correct : n,
                dec_correct (dfib n).
              (* 请在此处解答 *) Admitted.

              @@ -2727,7 +2741,7 @@

              Hoare2Hoare Logic, Part II
              -

              练习:5 星, advanced, optional (improve_dcom)

              +

              练习:5 星, advanced, optional (improve_dcom)

              The formal decorated programs defined in this section are intended to look as similar as possible to the informal ones defined earlier in the chapter. If we drop this requirement, we can eliminate @@ -2746,7 +2760,7 @@

              Hoare2Hoare Logic, Part II
              -

              练习:4 星, advanced, optional (implement_dcom)

              +

              练习:4 星, advanced, optional (implement_dcom)

              Adapt the parser for Imp presented in chapter ImpParser of _Logical Foundations_ to parse decorated commands (either ours or, even better, the ones you defined in the previous exercise). @@ -2757,6 +2771,10 @@

              Hoare2Hoare Logic, Part II +
              + +(* Sat Jan 26 15:15:43 UTC 2019 *)
              +

              diff --git a/plf-current/Hoare2.v b/plf-current/Hoare2.v index 798859d8..b1cb0fae 100644 --- a/plf-current/Hoare2.v +++ b/plf-current/Hoare2.v @@ -1,14 +1,15 @@ (** * Hoare2: Hoare Logic, Part II *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Bool.Bool. -Require Import Coq.Arith.Arith. -Require Import Coq.Arith.EqNat. -Require Import Coq.Arith.PeanoNat. Import Nat. -Require Import Coq.omega.Omega. +From Coq Require Import Strings.String. From PLF Require Import Maps. -From PLF Require Import Imp. +From Coq Require Import Bool.Bool. +From Coq Require Import Arith.Arith. +From Coq Require Import Arith.EqNat. +From Coq Require Import Arith.PeanoNat. Import Nat. +From Coq Require Import omega.Omega. From PLF Require Import Hoare. +From PLF Require Import Imp. (* ################################################################# *) (** * Decorated Programs *) @@ -24,12 +25,11 @@ From PLF Require Import Hoare. Such a _decorated program_ carries within it an argument for its own correctness. *) -(** For example, consider the program: *) -(** +(** For example, consider the program: X ::= m;; Z ::= p; - WHILE !(X = 0) DO + WHILE ~(X = 0) DO Z ::= Z - 1;; X ::= X - 1 END @@ -37,22 +37,20 @@ From PLF Require Import Hoare. (Note the _parameters_ [m] and [p], which stand for fixed-but-arbitrary numbers. Formally, they are simply Coq variables of type [nat].) -*) -(** Here is one possible specification for this program: *) -(** + + Here is one possible specification for this program: {{ True }} X ::= m;; Z ::= p; - WHILE !(X = 0) DO + WHILE ~(X = 0) DO Z ::= Z - 1;; X ::= X - 1 END {{ Z = p - m }} -*) -(** Here is a decorated version of the program, embodying a - proof of this specification: *) -(** + + Here is a decorated version of the program, embodying a + proof of this specification: {{ True }} ->> {{ m = m }} @@ -62,7 +60,7 @@ From PLF Require Import Hoare. Z ::= p; {{ X = m /\ Z = p }} ->> {{ Z - X = p - m }} - WHILE !(X = 0) DO + WHILE ~(X = 0) DO {{ Z - X = p - m /\ X <> 0 }} ->> {{ (Z - 1) - (X - 1) = p - m }} Z ::= Z - 1;; @@ -70,7 +68,8 @@ From PLF Require Import Hoare. X ::= X - 1 {{ Z - X = p - m }} END - {{ Z - X = p - m /\ ~ (X <> 0) }} ->> {{ Z = p - m }} + {{ Z - X = p - m /\ ~ (X <> 0) }} ->> + {{ Z = p - m }} *) (** Concretely, a decorated program consists of the program text @@ -111,7 +110,7 @@ From PLF Require Import Hoare. respect to [P /\ ~b] and [Q]): {{ P }} - IFB b THEN + TEST b THEN {{ P /\ b }} c1 {{ Q }} @@ -172,10 +171,8 @@ From PLF Require Import Hoare. 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]. -*) -(** + We can prove (informally) 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 }} @@ -219,7 +216,7 @@ From PLF Require Import Hoare. (** Here is a simple decorated program using conditionals: (1) {{True}} - IFB X <= Y THEN + TEST X <= Y THEN (2) {{True /\ X <= Y}} ->> (3) {{(Y - X) + X = Y \/ (Y - X) + Y = X}} Z ::= Y - X @@ -252,11 +249,12 @@ These decorations were constructed as follows: arbitrary natural numbers [n] and [m] (for example, [3 - 5 + 5 = 5]). *) -(** **** 练习:2 星 (if_minus_plus_reloaded) *) -(** Fill in valid decorations for the following program: +(** **** 练习:2 星, standard (if_minus_plus_reloaded) + + Fill in valid decorations for the following program: {{ True }} - IFB X <= Y THEN + TEST X <= Y THEN {{ }} ->> {{ }} Z ::= Y - X @@ -274,7 +272,6 @@ These decorations were constructed as follows: Definition manual_grade_for_decorations_in_if_minus_plus_reloaded : option (nat*string) := None. (** [] *) - (* ================================================================= *) (** ** Example: Reduce to Zero *) @@ -282,7 +279,7 @@ Definition manual_grade_for_decorations_in_if_minus_plus_reloaded : option (nat* invariant (i.e., the invariant [True] will do the job). (1) {{ True }} - WHILE !(X = 0) DO + WHILE ~(X = 0) DO (2) {{ True /\ X <> 0 }} ->> (3) {{ True }} X ::= X - 1 @@ -310,9 +307,9 @@ The decorations can be constructed as follows: programs. *) Definition reduce_to_zero' : com := - WHILE !(X = 0) DO + (WHILE ~(X = 0) DO X ::= X - 1 - END. + END)%imp. Theorem reduce_to_zero_correct' : {{fun st => True}} @@ -328,7 +325,7 @@ Proof. (* 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. + intros st [HT Hbp]. unfold assn_sub. constructor. - (* Invariant and negated guard imply postcondition *) intros st [Inv GuardFalse]. unfold bassn in GuardFalse. simpl in GuardFalse. @@ -356,9 +353,8 @@ Proof. 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 + remember that dividing [m] by [n] produces a remainder [X] and a quotient [Y] such that [n * Y + X = m /\ X < n]. It turns out that we get lucky with this program and don't have to @@ -418,15 +414,15 @@ Proof. correctness with respect to the pre- and postconditions shown: {{ X = m /\ Y = n }} - WHILE !(X = 0) DO + 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 +(** To verify this program, we need to find an invariant [Inv] for the + loop. As a first step we can leave [Inv] as an unknown and build a _skeleton_ for the proof by applying the rules for local consistency (working from the end of the program to the beginning, as usual, and without any thinking at all yet). @@ -434,26 +430,26 @@ Proof. This 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] }} + (2) {{ Inv }} + WHILE ~(X = 0) DO + (3) {{ Inv /\ X <> 0 }} ->> (c) + (4) {{ Inv [X |-> X-1] [Y |-> Y-1] }} Y ::= Y - 1;; - (5) {{ I [X |-> X-1] }} + (5) {{ Inv [X |-> X-1] }} X ::= X - 1 - (6) {{ I }} + (6) {{ Inv }} END - (7) {{ I /\ ~ (X <> 0) }} ->> (b) + (7) {{ Inv /\ ~ (X <> 0) }} ->> (b) (8) {{ Y = n - m }} - By examining this skeleton, we can see that any valid [I] will + By examining this skeleton, we can see that any valid [Inv] 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 program'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). *) + - (c) it must be _preserved_ by each iteration of the loop (given + that the loop guard evaluates to true), i.e., (3) must imply (4). *) (** These conditions are actually independent of the particular program and specification we are considering. Indeed, every loop @@ -467,12 +463,12 @@ Proof. 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 instantiating [I] with [True] in the skeleton + job. So let's try instantiating [Inv] with [True] in the skeleton above and see what we get... (1) {{ X = m /\ Y = n }} ->> (a - OK) (2) {{ True }} - WHILE !(X = 0) DO + WHILE ~(X = 0) DO (3) {{ True /\ X <> 0 }} ->> (c - OK) (4) {{ True }} Y ::= Y - 1;; @@ -492,12 +488,12 @@ Proof. If we want (b) to hold, we need to strengthen the invariant so that it implies the postcondition (8). One 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 + return to our skeleton, instantiate [Inv] 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 + WHILE ~(X = 0) DO (3) {{ Y = n - m /\ X <> 0 }} ->> (c - WRONG!) (4) {{ Y - 1 = n - m }} Y ::= Y - 1;; @@ -532,12 +528,12 @@ Proof. 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], and the - difference is always [n - m]. So let's try instantiating [I] in + difference is always [n - m]. So let's try instantiating [Inv] 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 + WHILE ~(X = 0) DO (3) {{ Y - X = n - m /\ X <> 0 }} ->> (c - OK) (4) {{ (Y - 1) - (X - 1) = n - m }} Y ::= Y - 1;; @@ -556,15 +552,16 @@ Proof. (* ================================================================= *) (** ** Exercise: Slow Assignment *) -(** **** 练习:2 星 (slow_assignment) *) -(** A roundabout way of assigning a number currently stored in [X] to +(** **** 练习:2 星, standard (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 + WHILE ~(X = 0) DO X ::= X - 1;; Y ::= Y + 1 END @@ -582,11 +579,12 @@ Definition manual_grade_for_decorations_in_slow_assignment : option (nat*string) (* ================================================================= *) (** ** Exercise: Slow Addition *) -(** **** 练习:3 星, optional (add_slowly_decoration) *) -(** The following program adds the variable X into the variable Z +(** **** 练习:3 星, standard, 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 + WHILE ~(X = 0) DO Z ::= Z + 1;; X ::= X - 1 END @@ -596,8 +594,9 @@ Definition manual_grade_for_decorations_in_slow_assignment : option (nat*string) specification of [add_slowly]; then (informally) decorate the program accordingly. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** Example: Parity *) @@ -648,8 +647,9 @@ Fixpoint parity x := [parity]). For verifying (c), we observe that, when [2 <= X], we have [parity X = parity (X-2)]. *) -(** **** 练习:3 星, optional (parity_formal) *) -(** Translate this proof to Coq. Refer to the [reduce_to_zero] example +(** **** 练习:3 星, standard, 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, @@ -682,7 +682,6 @@ Proof. (* ================================================================= *) (** ** Example: Finding Square Roots *) - (** The following program computes the (integer) square root of [X] by naive iteration: @@ -714,13 +713,14 @@ Proof. 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 always have [X=m], but we - didn't propagate this information from (1) into the loop invariant. + assigned in this program, so we should always have [X=m]; we + didn't propagate this information from (1) into the loop + invariant, but we could! - Also, looking at the second conjunct of (8), it seems quite - hopeless as an invariant (why?); fortunately, we don't need it, - since we can obtain it from the negation of the guard -- the third - conjunct in (7) -- again under the assumption that [X=m]. + Also, we don't need the second conjunct of (8), since we can + obtain it from the negation of the guard -- the third conjunct + in (7) -- again under the assumption that [X=m]. This allows + us to simplify a bit. So we now try [X=m /\ Z*Z <= m] as the loop invariant: @@ -731,7 +731,7 @@ Proof. 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 + Z ::= Z + 1 {{ X=m /\ Z*Z<=m }} END {{ X=m /\ Z*Z<=m /\ X<(Z+1)*(Z+1) }} ->> (b - OK) @@ -740,7 +740,7 @@ Proof. This works, since conditions (a), (b), and (c) are now all trivially satisfied. - Very often, even if a variable is used in a loop in a read-only + 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. *) @@ -748,13 +748,12 @@ Proof. (* ================================================================= *) (** ** Example: Squaring *) - (** Here is a program that squares [X] by repeated addition: {{ X = m }} Y ::= 0;; Z ::= 0;; - WHILE !(Y = X) DO + WHILE ~(Y = X) DO Z ::= Z + X;; Y ::= Y + 1 END @@ -774,7 +773,7 @@ Proof. {{ 0 = m*m /\ X = m }} Z ::= 0;; {{ Z = m*m /\ X = m }} - WHILE !(Y = X) DO + WHILE ~(Y = X) DO {{ Z = Y*m /\ X = m /\ Y <> X }} ->> (c - WRONG) {{ Z+X = m*m /\ X = m }} Z ::= Z + X;; @@ -785,7 +784,6 @@ Proof. {{ 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] progresses @@ -800,7 +798,7 @@ Proof. {{ 0 = Y*m /\ X = m }} Z ::= 0;; {{ Z = Y*m /\ X = m }} - WHILE !(Y = X) DO + WHILE ~(Y = X) DO {{ Z = Y*m /\ X = m /\ Y <> X }} ->> (c - OK) {{ Z+X = (Y+1)*m /\ X = m }} Z ::= Z + X; @@ -811,41 +809,43 @@ Proof. {{ 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 parameters with variables -- or - with expressions involving both variables and parameters, like - [m - Y] -- when going from postconditions to invariants. *) + to replace parameters with variables -- or with expressions + involving both variables and parameters, like [m - Y] -- when + going from postconditions to invariants. *) (* ================================================================= *) (** ** Exercise: Factorial *) -(** **** 练习:3 星 (factorial) *) -(** Recall that [n!] denotes the factorial of [n] (i.e., [n! = +(** **** 练习:3 星, standard (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) + WHILE ~(X = 0) DO Y ::= Y * X ;; X ::= X - 1 END {{ Y = m! }} - Fill in the blanks in following decorated program: + Fill in the blanks in following decorated program. For full credit, + make sure all the arithmetic operations used in the assertions are + well-defined on natural numbers. {{ X = m }} ->> {{ }} Y ::= 1;; {{ }} - WHILE !(X = 0) + WHILE ~(X = 0) DO {{ }} ->> {{ }} Y ::= Y * X;; @@ -857,16 +857,24 @@ Proof. {{ Y = m! }} *) - (* 请勿修改下面这一行: *) Definition manual_grade_for_decorations_in_factorial : option (nat*string) := None. (** [] *) +(* LY: I saw one submission for [factorial_dec] use a program like that instead + of the one already given by the informal exercise. I accepted it because the + exercise does not require to reuse the given program, and we did not + strictly define what it means to "implement" factorial in Imp. + This other one "implements" factorial in the same way two_loops_dec + "implements" the sum (a + b + c). +*) + (* ================================================================= *) (** ** Exercise: Min *) -(** **** 练习:3 星 (Min_Hoare) *) -(** Fill in valid decorations for the following program. +(** **** 练习:3 星, standard (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 @@ -885,7 +893,7 @@ Definition manual_grade_for_decorations_in_factorial : option (nat*string) := No {{ }} Z ::= 0;; {{ }} - WHILE !(X = 0) && !(Y = 0) DO + WHILE ~(X = 0) && ~(Y = 0) DO {{ }} ->> {{ }} X := X - 1;; @@ -899,57 +907,57 @@ Definition manual_grade_for_decorations_in_factorial : option (nat*string) := No {{ Z = min a b }} *) - (* 请勿修改下面这一行: *) Definition manual_grade_for_decorations_in_Min_Hoare : option (nat*string) := None. (** [] *) -(** **** 练习:3 星 (two_loops) *) -(** Here is a very inefficient way of adding 3 numbers: +(** **** 练习:3 星, standard (two_loops) - 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 + 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;; + {{ True }} ->> {{ }} - Z ::= Z + 1 + X ::= 0;; {{ }} - END;; - {{ }} ->> - {{ }} - WHILE !(Y = b) DO - {{ }} ->> + Y ::= 0;; {{ }} - Y ::= Y + 1;; + Z ::= c;; {{ }} - Z ::= Z + 1 + WHILE ~(X = a) DO + {{ }} ->> + {{ }} + X ::= X + 1;; + {{ }} + Z ::= Z + 1 + {{ }} + END;; + {{ }} ->> {{ }} - END - {{ }} ->> - {{ Z = a + b + c }} + WHILE ~(Y = b) DO + {{ }} ->> + {{ }} + Y ::= Y + 1;; + {{ }} + Z ::= Z + 1 + {{ }} + END + {{ }} ->> + {{ Z = a + b + c }} *) (* 请勿修改下面这一行: *) @@ -959,14 +967,15 @@ Definition manual_grade_for_decorations_in_two_loops : option (nat*string) := No (* ================================================================= *) (** ** Exercise: Power Series *) -(** **** 练习:4 星, optional (dpow2_down) *) -(** Here is a program that computes the series: +(** **** 练习:4 星, standard, 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 + WHILE ~(X = m) DO Z ::= 2 * Z;; Y ::= Y + Z;; X ::= X + 1 @@ -974,8 +983,9 @@ Definition manual_grade_for_decorations_in_two_loops : option (nat*string) := No Write a decorated program for this. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * Weakest Preconditions (Optional) *) @@ -1021,8 +1031,9 @@ Definition is_wp P c Q := _weakest_ (easiest to satisfy) assertion that guarantees that [Q] will hold after executing [c]. *) -(** **** 练习:1 星, optional (wp) *) -(** What are the weakest preconditions of the following commands +(** **** 练习:1 星, standard, optional (wp) + + What are the weakest preconditions of the following commands for the following postconditions? 1) {{ ? }} SKIP {{ X = 5 }} @@ -1032,7 +1043,7 @@ Definition is_wp P c Q := 3) {{ ? }} X ::= Y {{ X = Y }} 4) {{ ? }} - IFB X == 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI + TEST X = 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI {{ Y = 5 }} 5) {{ ? }} @@ -1043,11 +1054,13 @@ Definition is_wp P c Q := WHILE true DO X ::= 0 END {{ X = 0 }} *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) + +(** **** 练习:3 星, advanced, optional (is_wp_formal) -(** **** 练习:3 星, advanced, optional (is_wp_formal) *) -(** Prove formally, using the definition of [hoare_triple], that [Y <= 4] + 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]. *) @@ -1058,8 +1071,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, advanced, optional (hoare_asgn_weakest) *) -(** Show that the precondition in the rule [hoare_asgn] is in fact the +(** **** 练习:2 星, advanced, optional (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, @@ -1068,8 +1082,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, advanced, optional (hoare_havoc_weakest) *) -(** Show that your [havoc_pre] rule from the [himp_hoare] exercise +(** **** 练习:2 星, 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. @@ -1082,9 +1097,8 @@ Proof. End Himp2. (** [] *) - (* ################################################################# *) -(** * Formal Decorated Programs (Optional) *) +(** * Formal Decorated Programs (Advanced) *) (** Our informal conventions for decorated programs amount to a way of displaying Hoare triples, in which commands are annotated @@ -1104,11 +1118,11 @@ End Himp2. (** We don't want both preconditions and postconditions on each command, because a sequence of two commands would contain - redundant decorations, the postcondition of the first likely - being the same as the precondition of the second. Instead, - decorations are added corresponding to each postcondition. - A separate type, [decorated], is used to add the precondition - for the entire program. **) + redundant decorations--the postcondition of the first likely being + the same as the precondition of the second. Instead, decorations + are added corresponding to postconditions only. A separate type, + [decorated], is used to add just one precondition for the entire + program. **) Inductive dcom : Type := | DCSkip : Assertion -> dcom @@ -1123,6 +1137,8 @@ Inductive dcom : Type := Inductive decorated : Type := | Decorated : Assertion -> dcom -> decorated. +Delimit Scope default with default. + Notation "'SKIP' {{ P }}" := (DCSkip P) (at level 10) : dcom_scope. @@ -1132,7 +1148,7 @@ Notation "l '::=' a {{ P }}" 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 }}" +Notation "'TEST' 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" @@ -1150,6 +1166,14 @@ Notation "{{ P }} d" Delimit Scope dcom_scope with dcom. Open Scope dcom_scope. + +Example dec0 := + SKIP {{ fun st => True }}. +Example dec1 := + WHILE true DO {{ fun st => True }} SKIP {{ fun st => True }} END + {{ fun st => True }}. +Set Printing All. + (** 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 [Open] this scope for the @@ -1162,8 +1186,8 @@ Open Scope dcom_scope. of the program. *) Example dec_while : decorated := - {{ fun st => True }} - WHILE !(X = 0) + {{ fun st => True }} + WHILE ~(X = 0) DO {{ fun st => True /\ st X <> 0}} X ::= X - 1 @@ -1175,12 +1199,12 @@ Example dec_while : decorated := (** It is easy to go from a [dcom] to a [com] by erasing all annotations. *) -Fixpoint extract (d:dcom) : com := +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 + | DCIf b _ d1 _ d2 _ => TEST 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 @@ -1191,7 +1215,6 @@ Definition extract_dec (dec : decorated) : com := | Decorated P 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 @@ -1216,7 +1239,7 @@ Definition extract_dec (dec : decorated) : com := triple [{{P}} (extract d) {{post d}}], where [post] is defined as follows: *) -Fixpoint post (d:dcom) : Assertion := +Fixpoint post (d : dcom) : Assertion := match d with | DCSkip P => P | DCSeq d1 d2 => post d2 @@ -1268,8 +1291,7 @@ Definition dec_correct (dec : decorated) := add some uses of the rule of consequence, but the correspondence should be clear.) *) -Fixpoint verification_conditions (P : Assertion) (d:dcom) - : Prop := +Fixpoint verification_conditions (P : Assertion) (d : dcom) : Prop := match d with | DCSkip Q => (P ->> Q) @@ -1310,7 +1332,7 @@ Proof. apply hoare_skip. assumption. - (* Seq *) - inversion H as [H1 H2]. clear H. + destruct H as [H1 H2]. eapply hoare_seq. apply IHd2. apply H2. apply IHd1. apply H1. @@ -1319,8 +1341,7 @@ Proof. apply hoare_asgn. assumption. - (* If *) - inversion H as [HPre1 [HPre2 [Hd1 [Hd2 [HThen HElse]]]]]. - clear H. + destruct H as [HPre1 [HPre2 [Hd1 [Hd2 [HThen HElse]]]]]. apply IHd1 in HThen. clear IHd1. apply IHd2 in HElse. clear IHd2. apply hoare_if. @@ -1329,16 +1350,16 @@ Proof. + eapply hoare_consequence_post with (Q':=post d2); eauto. eapply hoare_consequence_pre; eauto. - (* While *) - inversion H as [Hpre [Hbody1 [Hpost1 Hd]]]. clear H. + destruct H as [Hpre [Hbody1 [Hpost1 Hd]]]. eapply hoare_consequence_pre; eauto. eapply hoare_consequence_post; eauto. apply hoare_while. eapply hoare_consequence_pre; eauto. - (* Pre *) - inversion H as [HP Hd]; clear H. + destruct H as [HP Hd]. eapply hoare_consequence_pre. apply IHd. apply Hd. assumption. - (* Post *) - inversion H as [Hd HQ]; clear H. + destruct H as [Hd HQ]. eapply hoare_consequence_post. apply IHd. apply Hd. assumption. Qed. @@ -1364,15 +1385,16 @@ Qed. Eval simpl in (verification_conditions_dec dec_while). (** - ==> + ===> (((fun _ : state => True) ->> (fun _ : state => True)) /\ - ((fun st : state => True /\ bassn (! (X = 0)) st) ->> + ((fun st : state => True /\ bassn (~(X = 0)) st) ->> (fun st : state => True /\ st X <> 0)) /\ - ((fun st : state => True /\ ~ bassn (! (X = 0)) st) ->> + ((fun st : state => True /\ ~ bassn (~(X = 0)) st) ->> (fun st : state => True /\ st X = 0)) /\ (fun st : state => True /\ st X <> 0) ->> (fun _ : state => True) [X |-> X - 1]) /\ - (fun st : state => True /\ st X = 0) ->> (fun st : state => st X = 0) + (fun st : state => True /\ st X = 0) ->> + (fun st : state => st X = 0) *) (** In principle, we could work with such propositions using just the @@ -1414,8 +1436,8 @@ Tactic Notation "verify" := (** 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!). *) + simple examples, [verify] sometimes even immediately solves the + goal (provided that the annotations are correct!). *) Theorem dec_while_correct : dec_correct dec_while. @@ -1424,10 +1446,10 @@ Proof. verify. Qed. (** Another example (formalizing a decorated program we've seen before): *) -Example subtract_slowly_dec (m:nat) (p:nat) : decorated := +Example subtract_slowly_dec (m : nat) (p : nat) : decorated := {{ fun st => st X = m /\ st Z = p }} ->> {{ fun st => st Z - st X = p - m }} - WHILE ! (X = 0) + WHILE ~(X = 0) DO {{ fun st => st Z - st X = p - m /\ st X <> 0 }} ->> {{ fun st => (st Z - 1) - (st X - 1) = p - m }} Z ::= Z - 1 @@ -1476,14 +1498,14 @@ Proof. intros; verify. Qed. (** *** Simple Conditionals *) Definition if_minus_plus_com := - IFB X <= Y + (TEST X <= Y THEN Z ::= Y - X ELSE Y ::= X + Z - FI. + FI)%imp. Definition if_minus_plus_dec := {{fun st => True}} - IFB X <= Y THEN + TEST X <= Y THEN {{ fun st => True /\ st X <= st Y }} ->> {{ fun st => st Y = st X + (st Y - st X) }} Z ::= Y - X @@ -1502,7 +1524,7 @@ Proof. verify. Qed. Definition if_minus_dec := {{fun st => True}} - IFB X <= Y THEN + TEST X <= Y THEN {{fun st => True /\ st X <= st Y }} ->> {{fun st => (st Y - st X) + st X = st Y \/ (st Y - st X) + st Y = st X}} @@ -1521,7 +1543,6 @@ Theorem if_minus_correct : dec_correct if_minus_dec. Proof. verify. Qed. - (* ----------------------------------------------------------------- *) (** *** Division *) @@ -1563,7 +1584,7 @@ Definition find_parity : com := Inductive ev : nat -> Prop := | ev_0 : ev O - | ev_SS : forall n:nat, ev n -> ev (S (S n)). + | ev_SS : forall n : nat, ev n -> ev (S (S n)). Definition find_parity_dec m : decorated := {{ fun st => st X = m}} ->> @@ -1749,7 +1770,7 @@ Definition square_dec (m : nat) : decorated := Z ::= 0 {{ fun st => st X = m /\ st Y = m /\ st Z = 0}} ->> {{ fun st => st Z + st X * st Y = m * m }};; - WHILE !(Y = 0) DO + WHILE ~(Y = 0) DO {{ fun st => st Z + st X * st Y = m * m /\ st Y <> 0 }} ->> {{ fun st => (st Z + st X) + st X * (st Y - 1) = m * m }} Z ::= Z + X @@ -1784,7 +1805,7 @@ Definition square_dec' (n : nat) : decorated := {{ fun st => st X = n /\ st Y = n /\ st Z = 0 }} ->> {{ fun st => st Z = st X * (st X - st Y) /\ st X = n /\ st Y <= st X }};; - WHILE !(Y = 0) DO + WHILE ~(Y = 0) DO {{ fun st => (st Z = st X * (st X - st Y) /\ st X = n /\ st Y <= st X) /\ st Y <> 0 }} @@ -1829,7 +1850,7 @@ Definition square_simpler_dec (m : nat) : decorated := Z ::= 0 {{ fun st => st Z = (st Y)*m /\ st X = m }}->> {{ fun st => st Z = (st Y)*m /\ st X = m }};; - WHILE !(Y = X) DO + WHILE ~(Y = X) DO {{ fun st => (st Z = (st Y)*m /\ st X = m) /\ st Y <> st X }} ->> {{ fun st => st Z + st X = ((st Y) + 1)*m /\ st X = m }} @@ -1861,7 +1882,7 @@ Definition two_loops_dec (a b c : nat) : decorated := {{ fun st => c = st X + c /\ st Y = 0 }};; Z ::= c {{ fun st => st Z = st X + c /\ st Y = 0 }};; - WHILE !(X = a) DO + WHILE ~(X = a) DO {{ fun st => (st Z = st X + c /\ st Y = 0) /\ st X <> a }} ->> {{ fun st => st Z + 1 = st X + 1 + c /\ st Y = 0 }} X ::= X + 1 @@ -1871,7 +1892,7 @@ Definition two_loops_dec (a b c : nat) : decorated := END {{ fun st => (st Z = st X + c /\ st Y = 0) /\ st X = a }} ->> {{ fun st => st Z = a + st Y + c }};; - WHILE !(Y = b) DO + WHILE ~(Y = b) DO {{ fun st => st Z = a + st Y + c /\ st Y <> b }} ->> {{ fun st => st Z + 1 = a + st Y + 1 + c }} Y ::= Y + 1 @@ -1895,7 +1916,7 @@ Fixpoint pow2 n := | S n' => 2 * (pow2 n') end. -Definition dpow2_down (n: nat) := +Definition dpow2_down (n : nat) := {{ fun st => True }} ->> {{ fun st => 1 = (pow2 (0 + 1))-1 /\ 1 = pow2 0 }} X ::= 0 @@ -1904,7 +1925,7 @@ Definition dpow2_down (n: nat) := {{ fun st => st Y = (pow2 (st X + 1))-1 /\ 1 = pow2 (st X) }};; Z ::= 1 {{ fun st => st Y = (pow2 (st X + 1))-1 /\ st Z = pow2 (st X) }};; - WHILE !(X = n) DO + WHILE ~(X = n) DO {{ fun st => (st Y = (pow2 (st X + 1))-1 /\ st Z = pow2 (st X)) /\ st X <> n }} ->> {{ fun st => st Y + 2 * st Z = (pow2 (st X + 2))-1 @@ -1955,14 +1976,15 @@ Qed. (* ================================================================= *) (** ** Further Exercises *) -(** **** 练习:3 星, advanced (slow_assignment_dec) *) -(** In the [slow_assignment] exercise above, we saw a roundabout way +(** **** 练习:3 星, 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) : decorated +Example slow_assignment_dec (m : nat) : decorated (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Theorem slow_assignment_dec_correct : forall m, @@ -1973,10 +1995,11 @@ Proof. (* 请在此处解答 *) Admitted. Definition manual_grade_for_check_defn_of_slow_assignment_dec : option (nat*string) := None. (** [] *) -(** **** 练习:4 星, advanced (factorial_dec) *) -(** Remember the factorial function we worked with before: *) +(** **** 练习:4 星, advanced (factorial_dec) -Fixpoint real_fact (n:nat) : nat := + 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') @@ -1992,8 +2015,9 @@ Fixpoint real_fact (n:nat) : nat := Definition manual_grade_for_factorial_dec : option (nat*string) := None. (** [] *) -(** **** 练习:4 星, advanced, optional (fib_eqn) *) -(** The Fibonacci function is usually written like this: +(** **** 练习:4 星, advanced, optional (fib_eqn) + + The Fibonacci function is usually written like this: Fixpoint fib n := match n with @@ -2014,8 +2038,6 @@ Fixpoint fib n := end end. - - (** Prove that [fib] satisfies the following equation: *) Lemma fib_eqn : forall n, @@ -2025,15 +2047,16 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced, optional (fib) *) -(** The following Imp program leaves the value of [fib n] in the +(** **** 练习:4 星, advanced, optional (fib) + + The following Imp program leaves the value of [fib n] in the variable [Y] when it terminates: X ::= 1;; Y ::= 1;; Z ::= 1;; - WHILE !(X = n+1) DO - T ::= Z; + WHILE ~(X = n + 1) DO + T ::= Z;; Z ::= Z + Y;; Y ::= T;; X ::= X + 1 @@ -2042,12 +2065,12 @@ Proof. Fill in the following definition of [dfib] and prove that it satisfies this specification: - {{True}} dfib {{ Y = fib n }} + {{ True }} dfib {{ Y = fib n }} *) Definition T : string := "T". -Definition dfib (n:nat) : decorated +Definition dfib (n : nat) : decorated (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Theorem dfib_correct : forall n, @@ -2055,8 +2078,9 @@ Theorem dfib_correct : forall n, (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, advanced, optional (improve_dcom) *) -(** The formal decorated programs defined in this section are intended +(** **** 练习:5 星, advanced, optional (improve_dcom) + + The formal decorated programs defined in this section are intended to look as similar as possible to the informal ones defined earlier in the chapter. If we drop this requirement, we can eliminate almost all annotations, just requiring final postconditions and @@ -2065,16 +2089,18 @@ Theorem dfib_correct : forall n, rest of the formal development leading up to the [verification_correct] theorem. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 -(** **** 练习:4 星, advanced, optional (implement_dcom) *) -(** Adapt the parser for Imp presented in chapter [ImpParser] + [] *) + +(** **** 练习:4 星, advanced, optional (implement_dcom) + + Adapt the parser for Imp presented in chapter [ImpParser] of _Logical Foundations_ to parse decorated commands (either ours or, even better, the ones you defined in the previous exercise). *) -(* 请在此处解答 *) -(** [] *) - +(* 请在此处解答 + [] *) +(* Sat Jan 26 15:15:43 UTC 2019 *) diff --git a/plf-current/Hoare2Test.v b/plf-current/Hoare2Test.v index 1db33516..0944821a 100644 --- a/plf-current/Hoare2Test.v +++ b/plf-current/Hoare2Test.v @@ -128,3 +128,5 @@ Print Assumptions slow_assignment_dec_correct. idtac "---------- factorial_dec ---------". idtac "MANUAL". Abort. + +(* Sat Jan 26 15:15:59 UTC 2019 *) diff --git a/plf-current/HoareAsLogic.html b/plf-current/HoareAsLogic.html index ca5943f8..43e04a8c 100644 --- a/plf-current/HoareAsLogic.html +++ b/plf-current/HoareAsLogic.html @@ -58,30 +58,30 @@

              HoareAsLogic证明论霍尔逻辑
              -

              定义

              +

              定义


              Inductive hoare_proof : AssertioncomAssertionType :=
              -  | H_Skip : P,
              +  | H_Skip : P,
                    hoare_proof P (SKIP) P
              -  | H_Asgn : Q V a,
              +  | H_Asgn : Q V a,
                    hoare_proof (assn_sub V a Q) (V ::= a) Q
              -  | H_Seq : P c Q d R,
              +  | H_Seq : P c Q d R,
                    hoare_proof P c Qhoare_proof Q d Rhoare_proof P (c;;d) R
              -  | H_If : P Q b c1 c2,
              +  | H_If : P Q b c1 c2,
                  hoare_proof (fun stP stbassn b st) c1 Q
                  hoare_proof (fun stP st ∧ ~(bassn b st)) c2 Q
              -    hoare_proof P (IFB b THEN c1 ELSE c2 FI) Q
              -  | H_While : P b c,
              +    hoare_proof P (TEST b THEN c1 ELSE c2 FI) Q
              +  | H_While : P b c,
                  hoare_proof (fun stP stbassn b st) c P
              -    hoare_proof P (WHILE b DO c END) (fun stP st ∧ ¬ (bassn b st))
              -  | H_Consequence : (P Q P' Q' : Assertion) c,
              +    hoare_proof P (WHILE b DO c END) (fun stP st ∧ ¬(bassn b st))
              +  | H_Consequence : (P Q P' Q' : Assertion) c,
                  hoare_proof P' c Q'
              -    ( st, P stP' st) →
              -    ( st, Q' stQ st) →
              +    (st, P stP' st) →
              +    (st, Q' stQ st) →
                  hoare_proof P c Q.
              @@ -91,9 +91,9 @@

              HoareAsLogic证明论霍尔逻辑
              -Lemma H_Consequence_pre : (P Q P': Assertion) c,
              +Lemma H_Consequence_pre : (P Q P': Assertion) c,
                  hoare_proof P' c Q
              -    ( st, P stP' st) →
              +    (st, P stP' st) →
                  hoare_proof P c Q.
              @@ -103,9 +103,9 @@

              HoareAsLogic证明论霍尔逻辑
              -Lemma H_Consequence_post : (P Q Q' : Assertion) c,
              +Lemma H_Consequence_post : (P Q Q' : Assertion) c,
                  hoare_proof P c Q'
              -    ( st, Q' stQ st) →
              +    (st, Q' stQ st) →
                  hoare_proof P c Q.
              @@ -121,7 +121,7 @@

              HoareAsLogic证明论霍尔逻辑

              -      {{(X=3) [X |-> X + 2] [X |-> X + 1]}}
              +      {{(X=3) [X > X + 2] [X > X + 1]}}
                    X::=X+1 ;; X::=X+2
                    {{X=3}}.
              @@ -133,7 +133,7 @@

              HoareAsLogic证明论霍尔逻辑Example sample_proof :
                hoare_proof
              -    ((fun st:statest X = 3) [X |-> X + 2] [X |-> X + 1])
              +    ((fun st:statest X = 3) [X > X + 2] [X > X + 1])
                  (X ::= X + 1;; X ::= X + 2)
                  (fun st:statest X = 3).
              Proof.
              @@ -144,13 +144,13 @@

              HoareAsLogic证明论霍尔逻辑 ====>
                H_Seq
              -  (((fun st : state => st X = 3) X |-> X + 2X |-> X + 1)
              +  (((fun st : state => st X = 3) X > X + 2X > X + 1)
                (X ::= X + 1)
              -  ((fun st : state => st X = 3) X |-> X + 2)
              +  ((fun st : state => st X = 3) X > X + 2)
                (X ::= X + 2)
                (fun st : state => st X = 3)
                (H_Asgn
              -     ((fun st : state => st X = 3) X |-> X + 2)
              +     ((fun st : state => st X = 3) X > X + 2)
                   X (X + 1))
                (H_Asgn
                   (fun st : state => st X = 3)
              @@ -159,16 +159,16 @@

              HoareAsLogic证明论霍尔逻辑
              -

              性质

              +

              性质

              -

              练习:2 星 (hoare_proof_sound)

              +

              练习:2 星, standard (hoare_proof_sound)

              证明这些证明对象是正确的断言。
              -Theorem hoare_proof_sound : P c Q,
              +Theorem hoare_proof_sound : P c Q,
                hoare_proof P c Q{{P}} c {{Q}}.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -191,7 +191,7 @@

              HoareAsLogic证明论霍尔逻辑 Theorem H_Post_True_deriv:
              -   c P, hoare_proof P c (fun _True).
              +  c P, hoare_proof P c (fun _True).
              Proof.
                intro c.
                induction c; intro P.
              @@ -211,7 +211,7 @@

              HoareAsLogic证明论霍尔逻辑apply (IHc1 (fun _True)).
                  apply IHc2.
                  intros. apply I.
              -  - (* IFB *)
              +  - (* TEST *)
                  apply H_Consequence_pre with (fun _True).
                  apply H_If.
                  apply IHc1.
              @@ -231,7 +231,7 @@

              HoareAsLogic证明论霍尔逻辑
              -Lemma False_and_P_imp: P Q,
              +Lemma False_and_P_imp: P Q,
                FalsePQ.
              Proof.
                intros P Q [CONTRA HP].
              @@ -241,14 +241,14 @@

              HoareAsLogic证明论霍尔逻辑eapply H_Consequence_pre;
                  [eapply CONSTR | intros ? CONTRA; destruct CONTRA].

              Theorem H_Pre_False_deriv:
              -   c Q, hoare_proof (fun _False) c Q.
              +  c Q, hoare_proof (fun _False) c Q.
              Proof.
                intros c.
                induction c; intro Q.
                - (* SKIP *) pre_false_helper H_Skip.
                - (* ::= *) pre_false_helper H_Asgn.
                - (* ;; *) pre_false_helper H_Seq. apply IHc1. apply IHc2.
              -  - (* IFB *)
              +  - (* TEST *)
                  apply H_If; eapply H_Consequence_pre.
                  apply IHc1. intro. eapply False_and_P_imp.
                  apply IHc2. intro. eapply False_and_P_imp.
              @@ -286,17 +286,17 @@

              HoareAsLogic证明论霍尔逻辑 Definition wp (c:com) (Q:Assertion) : Assertion :=
              -  fun s s', c / s \\ s'Q s'.
              +  fun ss', s =[ c ]⇒ s'Q s'.

              -

              练习:1 星 (wp_is_precondition)

              +

              练习:1 星, standard (wp_is_precondition)


              -Lemma wp_is_precondition: c Q,
              +Lemma wp_is_precondition: c Q,
                {{wp c Q}} c {{Q}}.
              (* 请在此处解答 *) Admitted.
              @@ -305,14 +305,14 @@

              HoareAsLogic证明论霍尔逻辑
              -

              练习:1 星 (wp_is_weakest)

              +

              练习:1 星, standard (wp_is_weakest)


              -Lemma wp_is_weakest: c Q P',
              -   {{P'}} c {{Q}} → st, P' stwp c Q st.
              +Lemma wp_is_weakest: c Q P',
              +   {{P'}} c {{Q}} → st, P' stwp c Q st.
              (* 请在此处解答 *) Admitted.
              @@ -321,7 +321,7 @@

              HoareAsLogic证明论霍尔逻辑
              -Lemma bassn_eval_false : b st, ¬ bassn b stbeval st b = false.
              +Lemma bassn_eval_false : b st, ¬bassn b stbeval st b = false.
              Proof.
                intros b st H. unfold bassn in H. destruct (beval st b).
                  exfalso. apply H. reflexivity.
              @@ -333,12 +333,12 @@

              HoareAsLogic证明论霍尔逻辑
              -

              练习:5 星 (hoare_proof_complete)

              +

              练习:5 星, standard (hoare_proof_complete)

              完成如下定理的证明。

              -Theorem hoare_proof_complete: P c Q,
              +Theorem hoare_proof_complete: P c Q,
                {{P}} c {{Q}} → hoare_proof P c Q.
              Proof.
                intros P c. generalize dependent P.
              @@ -377,7 +377,7 @@

              HoareAsLogic证明论霍尔逻辑

              - 类似地,三元组 {{True}} SKIP {{P}} 是合法的当且仅当 s, P s 是合法的,其中 P + 类似地,三元组 {{True}} SKIP {{P}} 是合法的当且仅当 s, P s 是合法的,其中 P 是Coq逻辑的任意一个断言。但是我们已知对于这个逻辑并没有任何的决定性过程。
              @@ -387,6 +387,10 @@

              HoareAsLogic证明论霍尔逻辑Hoare2 一章中的关于形式化修饰程序的章节会向我们展 示如何做的更好。

              +
              + +(* Sat Jan 26 15:15:43 UTC 2019 *)
              +

              diff --git a/plf-current/HoareAsLogic.v b/plf-current/HoareAsLogic.v index 829a9d48..2f652ca4 100644 --- a/plf-current/HoareAsLogic.v +++ b/plf-current/HoareAsLogic.v @@ -27,7 +27,7 @@ Inductive hoare_proof : Assertion -> com -> Assertion -> Type := | H_If : forall P Q b c1 c2, hoare_proof (fun st => P st /\ bassn b st) c1 Q -> hoare_proof (fun st => P st /\ ~(bassn b st)) c2 Q -> - hoare_proof P (IFB b THEN c1 ELSE c2 FI) Q + hoare_proof P (TEST b THEN c1 ELSE c2 FI) Q | H_While : forall P b c, hoare_proof (fun st => P st /\ bassn b st) c P -> hoare_proof P (WHILE b DO c END) (fun st => P st /\ ~ (bassn b st)) @@ -94,8 +94,9 @@ Print sample_proof. (* ################################################################# *) (** * 性质 *) -(** **** 练习:2 星 (hoare_proof_sound) *) -(** 证明这些证明对象是正确的断言。 *) +(** **** 练习:2 星, standard (hoare_proof_sound) + + 证明这些证明对象是正确的断言。 *) Theorem hoare_proof_sound : forall P c Q, hoare_proof P c Q -> {{P}} c {{Q}}. @@ -132,7 +133,7 @@ Proof. apply (IHc1 (fun _ => True)). apply IHc2. intros. apply I. - - (* IFB *) + - (* TEST *) apply H_Consequence_pre with (fun _ => True). apply H_If. apply IHc1. @@ -167,7 +168,7 @@ Proof. - (* SKIP *) pre_false_helper H_Skip. - (* ::= *) pre_false_helper H_Asgn. - (* ;; *) pre_false_helper H_Seq. apply IHc1. apply IHc2. - - (* IFB *) + - (* TEST *) apply H_If; eapply H_Consequence_pre. apply IHc1. intro. eapply False_and_P_imp. apply IHc2. intro. eapply False_and_P_imp. @@ -195,16 +196,16 @@ Qed. [P' -> P]。我们可以更加直接地将其定义为: *) Definition wp (c:com) (Q:Assertion) : Assertion := - fun s => forall s', c / s \\ s' -> Q s'. + fun s => forall s', s =[ c ]=> s' -> Q s'. -(** **** 练习:1 星 (wp_is_precondition) *) +(** **** 练习:1 星, standard (wp_is_precondition) *) Lemma wp_is_precondition: forall c Q, {{wp c Q}} c {{Q}}. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (wp_is_weakest) *) +(** **** 练习:1 星, standard (wp_is_weakest) *) Lemma wp_is_weakest: forall c Q P', {{P'}} c {{Q}} -> forall st, P' st -> wp c Q st. @@ -220,8 +221,9 @@ Proof. Qed. (** [] *) -(** **** 练习:5 星 (hoare_proof_complete) *) -(** 完成如下定理的证明。 *) +(** **** 练习:5 星, standard (hoare_proof_complete) + + 完成如下定理的证明。 *) Theorem hoare_proof_complete: forall P c Q, {{P}} c {{Q}} -> hoare_proof P c Q. @@ -262,3 +264,4 @@ Proof. 满意:这太冗长了。在 [Hoare2] 一章中的关于形式化修饰程序的章节会向我们展 示如何做的更好。 *) +(* Sat Jan 26 15:15:43 UTC 2019 *) diff --git a/plf-current/HoareAsLogicTest.v b/plf-current/HoareAsLogicTest.v index 92ca4f53..9832716f 100644 --- a/plf-current/HoareAsLogicTest.v +++ b/plf-current/HoareAsLogicTest.v @@ -106,3 +106,5 @@ Print Assumptions hoare_proof_complete. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:00 UTC 2019 *) diff --git a/plf-current/HoareTest.v b/plf-current/HoareTest.v index 2e480a7e..48ec8dba 100644 --- a/plf-current/HoareTest.v +++ b/plf-current/HoareTest.v @@ -192,3 +192,5 @@ Print Assumptions hoare_asgn_fwd. idtac "---------- hoare_repeat ---------". idtac "MANUAL". Abort. + +(* Sat Jan 26 15:15:55 UTC 2019 *) diff --git a/plf-current/Imp.v b/plf-current/Imp.v index 7b397ef0..ddfd0d54 100644 --- a/plf-current/Imp.v +++ b/plf-current/Imp.v @@ -1,13 +1,13 @@ (** * Imp: 简单的指令式程序 *) -(** 在本章中,我们会更加认真地看待如何用 Coq 来研究自身以外的有趣的东西。 +(** 在本章中,我们会更加认真地看待如何用 Coq 来研究其它东西。 我们的案例研究是一个名为 Imp 的_'简单的指令式编程语言'_, 它包含了传统主流语言(如 C 和 Java)的一小部分核心片段。下面是一个用 Imp 编写的常见数学函数: Z ::= X;; Y ::= 1;; - WHILE ! (Z = 0) DO + WHILE ~(Z = 0) DO Y ::= Y * Z;; Z ::= Z - 1 END @@ -19,12 +19,13 @@ _'霍尔逻辑(Hoare Logic)'_,它是一种广泛用于推理指令式程序的逻辑。 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Bool.Bool. -Require Import Coq.Init.Nat. -Require Import Coq.Arith.Arith. -Require Import Coq.Arith.EqNat. -Require Import Coq.omega.Omega. -Require Import Coq.Lists.List. +From Coq Require Import Bool.Bool. +From Coq Require Import Init.Nat. +From Coq Require Import Arith.Arith. +From Coq Require Import Arith.EqNat. +From Coq Require Import omega.Omega. +From Coq Require Import Lists.List. +From Coq Require Import Strings.String. Import ListNotations. From PLF Require Import Maps. @@ -58,11 +59,11 @@ Inductive bexp : Type := | BAnd (b1 b2 : bexp). (** 在本章中,我们省略了大部分从程序员实际编写的具体语法到其抽象语法树的翻译 - -- 例如,它会将字符串 ["1+2*3"] 翻译成如下 AST: + -- 例如,它会将字符串 ["1 + 2 * 3"] 翻译成如下 AST: APlus (ANum 1) (AMult (ANum 2) (ANum 3)). - 可选的章节 [ImpParser] 中开发了一个简单的词法分析器和解析器的实现, + 可选的章节 [ImpParser] 中开发了一个简单的词法分析器和解析器, 它可以进行这种翻译。你_'无需'_通过理解该章来理解本章, 但如果你没有上过涵盖这些技术的课程(例如编译器课程),可能想要略读一下该章节。 *) @@ -77,26 +78,26 @@ Inductive bexp : Type := | false | a = a | a <= a - | not b - | b and b + | ~ b + | b && b *) (** 与前面的 Coq 版本相对比... - BNF 是非形式化的 -- 例如,它给出了表达式表面上的语法的建议 - (例如加法运算写作 [+] 且它是一个中缀符),而没有指定词法分析和解析的其它方面 + (例如加法运算符写作中缀的 [+]),而没有指定词法分析和解析的其它方面 (如 [+]、[-] 和 [*] 的相对优先级,用括号来明确子表达式的分组等)。 在实现编译器时,需要一些附加的信息(以及人类的智慧) 才能将此描述转换成形式化的定义。 Coq 版本则始终忽略了所有这些信息,只专注于抽象语法。 - - 另一方面 BNF 版本则更加清晰易读。它的非形式化使其更加灵活, + - 反之,BNF 版本则更加清晰易读。它的非形式化使其更加灵活, 在讨论和在黑板上书写时,它有很大的优势, 此时传达一般的概念要比精确定下所有细节更加重要。 确实,存在很多种类似 BNF 的记法,人们可以随意使用它们, - 而无需关心具体使用了哪种 BNF 的形式,因为没有必要: + 而无需关心具体使用了哪种 BNF,因为没有必要: 大致的理解是非常重要的。 适应这两种记法都很有必要:非形式化的用语人类之间的交流, @@ -110,9 +111,9 @@ Inductive bexp : Type := 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) + | 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: @@ -136,20 +137,15 @@ Fixpoint beval (b : bexp) : bool := (** 我们尚未定义太多东西,不过从这些定义出发,已经能前进不少了。 假设我们定义了一个接收算术表达式并对它稍微进行化简的函数,即将所有的 - [0+e](如 [(APlus (ANum 0) e])化简为 [e]。 *) + [0 + e](如 [(APlus (ANum 0) e])化简为 [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) + | 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. (** 要保证我们的优化是正确的,可以在某些示例中测试它并观察其输出出否正确。 *) @@ -209,16 +205,16 @@ Proof. (** *** [try] 泛策略 *) (** 如果 [T] 是一个策略,那么 [try T] 是一个和 [T] 一样的策略,只是如果 - [T] 失败的话,[try T] 就会_'成功地'_什么也不做(而非失败)。 *) + [T] 失败的话,[try T] 就会_'成功地'_什么也不做(而非失败)。*) Theorem silly1 : forall ae, aeval ae = aeval ae. -Proof. try reflexivity. (* 它和 [reflexivity] 做的一样 *) Qed. +Proof. try reflexivity. (* 它和 [reflexivity] 做的一样。 *) Qed. Theorem silly2 : forall (P : Prop), P -> P. Proof. intros P HP. - try reflexivity. (* 和 [reflexivity] 失败时一样 *) - apply HP. (* 我们仍然可以换种方式来结束此证明 *) + try reflexivity. (* 和 [reflexivity] 失败时一样。 *) + apply HP. (* 我们仍然可以换种方式来结束此证明。 *) Qed. (** 我们并没有真正的理由在像这样的手动证明中使用 [try],不过在连同 @@ -235,7 +231,7 @@ Qed. Lemma foo : forall n, 0 <=? n = true. Proof. intros. - destruct n eqn:E. + destruct n. (* 会产生两个执行过程相同的子目标... *) - (* n=0 *) simpl. reflexivity. - (* n=Sn' *) simpl. reflexivity. @@ -370,11 +366,12 @@ Qed. 那么重复 [T] 会永远循环(例如 [repeat simpl] 会一直循环,因为 [simpl] 总是会成功)。虽然 Coq 的主语言 Gallina 中的求值保证会终止, 然而策略却不会!然而这并不会影响 Coq 的逻辑一致性,因为 [repeat] - 和其它策略的工作就是指导 Coq 去构造证明;如果构造过程发散(即不终止), + 和其它策略的工作就是指导 Coq 去构造证明;如果构造过程发散(即不停机), 那就意味着我们构造证明失败,而非构造出了错误的证明。 *) -(** **** 练习:3 星 (optimize_0plus_b_sound) *) -(** 由于 [optimize_0plus] 变换不会改变 [aexp] 的值, +(** **** 练习:3 星, standard (optimize_0plus_b_sound) + + 由于 [optimize_0plus] 变换不会改变 [aexp] 的值, 因此我们可以将它应用到所有出现在 [bexp] 中的 [aexp] 上而不改变 [bexp] 的值。请编写一个对 [bexp] 执行此变换的函数,并证明它的可靠性。 利用我们刚学过的泛策略来构造一个尽可能优雅的证明。 *) @@ -388,13 +385,15 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, optional (optimizer) *) -(** _'设计练习'_:[optimize_0plus] 函数只是众多算术和布尔表达式优化的方法之一。 +(** **** 练习:4 星, standard, optional (optimize) + + _'设计练习'_:[optimize_0plus] 函数只是众多算术和布尔表达式优化的方法之一。 请编写一个更加聪明的优化器并证明它的正确性。(最容易的方法就是从小处着手: 一开始只添加单个简单的优化并证明它的正确性,然后逐渐增加其它更有趣的优化。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** 定义新的策略记法 *) @@ -449,7 +448,7 @@ Proof. intros. omega. Qed. -(** (注意本文件顶部 [Require Import Coq.omega.Omega.]。)*) +(** (注意本文件顶部 [From Coq Require Import omega.Omega.]。)*) (* ================================================================= *) (** ** 更多方便的策略 *) @@ -458,10 +457,10 @@ Qed. - [clear H]:从上下文中删除前提 [H]。 - - [subst x]:在上下文中查找假设 [x = e] 或 [e = x], + - [subst x]:对于变量 [x],在上下文中查找假设 [x = e] 或 [e = x], 将整个上下文和当前目标中的所有 [x] 替换为 [e] 并清除该假设。 - - [subst]:替换掉_'所有'_形如 [x = e] 或 [e = x] 的假设。 + - [subst]:替换掉_'所有'_形如 [x = e] 或 [e = x] 的假设(其中 [x] 为变量)。 - [rename... into...]:更改证明上下文中前提的名字。例如, 如果上下文中包含名为 [x] 的变量,那么 [rename x into y] @@ -477,7 +476,7 @@ Qed. 定义中查找可用于解决当前目标的构造子 [c]。如果找到了,那么其行为与 [apply c] 相同。 - 我们之后会看到它们的例子。 *) + 我们之后会看到所有它们的例子。 *) (* ################################################################# *) (** * 求值作为关系 *) @@ -505,6 +504,35 @@ Inductive aevalR : aexp -> nat -> Prop := aevalR e2 n2 -> aevalR (AMult e1 e2) (n1 * n2). +Module TooHardToRead. + +(* A small notational aside. We would previously have written the + definition of [aevalR] like this, with explicit names for the + hypotheses in each case: *) + +Inductive aevalR : aexp -> nat -> Prop := + | E_ANum n : + aevalR (ANum n) n + | E_APlus (e1 e2: aexp) (n1 n2: nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (APlus e1 e2) (n1 + n2) + | E_AMinus (e1 e2: aexp) (n1 n2: nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (AMinus e1 e2) (n1 - n2) + | E_AMult (e1 e2: aexp) (n1 n2: nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (AMult e1 e2) (n1 * n2). + +(** Instead, we've chosen to leave the hypotheses anonymous, just + giving their types. This style gives us less control over the + names that Coq chooses during proofs involving [aevalR], but it + makes the definition itself quite a bit lighter. *) + +End TooHardToRead. + (** 如果 [aevalR] 有中缀记法的话会很方便。我们用 [e \\ n] 表示算术表达式 [e] 求值为 [n]。 *) @@ -521,16 +549,16 @@ End aevalR_first_try. 具体做法是,我们先“保留”该记法,然后在给出定义的同时声明它的意义。*) -Reserved Notation "e '\\' n" (at level 50, left associativity). +Reserved Notation "e '\\' n" (at level 90, left associativity). Inductive aevalR : aexp -> nat -> Prop := - | E_ANum n : + | E_ANum (n : nat) : (ANum n) \\ n - | E_APlus e1 e2 n1 n2 : + | E_APlus (e1 e2 : aexp) (n1 n2 : nat) : (e1 \\ n1) -> (e2 \\ n2) -> (APlus e1 e2) \\ (n1 + n2) - | E_AMinus 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 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. @@ -554,7 +582,7 @@ Inductive aevalR : aexp -> nat -> Prop := e1 \\ n1 e2 \\ n2 - -------------------- (E_APlus) + -------------------- (E_APlus) APlus e1 e2 \\ n1+n2 *) @@ -588,6 +616,27 @@ Inductive aevalR : aexp -> nat -> Prop := AMult e1 e2 \\ n1*n2 *) +(** **** 练习:1 星, standard, optional (beval_rules) + + 下面是 Coq 中 [beval] 函数的定义: + + Fixpoint beval (e : bexp) : bool := + match e with + | BTrue => true + | BFalse => false + | BEq a1 a2 => (aeval a1) =? (aeval a2) + | BLe a1 a2 => (aeval a1) <=? (aeval a2) + | BNot b1 => negb (beval b1) + | BAnd b1 b2 => andb (beval b1) (beval b2) + end. + + 请用推理规则记法将布尔求值的定义写成关系的形式。 *) +(* 请在此处解答 *) + +(* 请勿修改下面这一行: *) +Definition manual_grade_for_beval_rules : option (nat*string) := None. +(** [] *) + (* ================================================================= *) (** ** 定义的等价关系 *) @@ -643,8 +692,9 @@ Proof. try apply IHa1; try apply IHa2; reflexivity. Qed. -(** **** 练习:3 星 (bevalR) *) -(** 用和 [aevalR] 同样的方式写出关系 [bevalR],并证明它等价于 [beval]。 *) +(** **** 练习:3 星, standard (bevalR) + + 用和 [aevalR] 同样的方式写出关系 [bevalR],并证明它等价于 [beval]。 *) Inductive bevalR: bexp -> bool -> Prop := (* 请在此处解答 *) @@ -668,31 +718,31 @@ End AExp. Module aevalR_division. -(** 例如,假设我们想要用除法运算来扩展算术运算: *) +(** 例如,假设我们想要用除法来扩展算术运算: *) Inductive aexp : Type := | ANum (n : nat) | APlus (a1 a2 : aexp) | AMinus (a1 a2 : aexp) | AMult (a1 a2 : aexp) - | ADiv (a1 a2 : aexp). (* <--- 新增 *) + | ADiv (a1 a2 : aexp). (* <--- 新增 *) (** 扩展 [aeval] 的定义来处理此讯算并不是很直观(我们要返回什么作为 [ADiv (ANum 5) (ANum 0)] 的结果?)。然而扩展 [aevalR] 却很直观。*) Reserved Notation "e '\\' n" - (at level 50, left associativity). + (at level 90, left associativity). Inductive aevalR : aexp -> nat -> Prop := - | E_ANum : forall (n:nat), + | E_ANum (n : nat) : (ANum n) \\ n - | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_APlus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (APlus a1 a2) \\ (n1 + n2) - | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_AMinus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (AMinus a1 a2) \\ (n1 - n2) - | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), + | E_AMult (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), + | E_ADiv (a1 a2 : aexp) (n1 n2 n3 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (n2 > 0) -> (mult n2 n3 = n1) -> (ADiv a1 a2) \\ n3 @@ -702,15 +752,15 @@ End aevalR_division. Module aevalR_extended. -(** 假设,我们转而想要用非确定性的数值生成器 [any] 来扩展算术运算, +(** 假设我们想要用非确定性的数值生成器 [any] 来扩展算术运算, 该生成器会在求值时产生任何数。(注意,这不同于在所有可能的数值中作出 - _'概率上的'_选择 -- 我们没有为结果指定任何具体的分布,只是说了 + _'概率上的'_选择 -- 我们没有为结果指定任何具体的概率分布,只是说了 _'可能的结果'_。) *) -Reserved Notation "e '\\' n" (at level 50, left associativity). +Reserved Notation "e '\\' n" (at level 90, left associativity). Inductive aexp : Type := - | AAny (* <--- NEW *) + | AAny (* <--- NEW *) | ANum (n : nat) | APlus (a1 a2 : aexp) | AMinus (a1 a2 : aexp) @@ -720,15 +770,15 @@ Inductive aexp : Type := 而扩展 [aevalR] 则无此问题... *) Inductive aevalR : aexp -> nat -> Prop := - | E_Any : forall (n:nat), - AAny \\ n (* <--- new *) - | E_ANum : forall (n:nat), + | E_Any (n : nat) : + AAny \\ n (* <--- NEW *) + | E_ANum (n : nat) : (ANum n) \\ n - | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_APlus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (APlus a1 a2) \\ (n1 + n2) - | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), + | E_AMinus (a1 a2 : aexp) (n1 n2 : nat) : (a1 \\ n1) -> (a2 \\ n2) -> (AMinus a1 a2) \\ (n1 - n2) - | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), + | 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. @@ -736,7 +786,7 @@ where "a '\\' n" := (aevalR a n) : type_scope. End aevalR_extended. (** 这时你可能会问:默认情况下应该使用哪种风格? - 上面的例子表明关系式定义从根本上要比函数式的更加强大。 + 我们刚看到的例子表明关系式的定义反而比函数式的更加有用。 对于这种定义的东西不太容易用函数表达,或者确实_'不是'_函数的情况来说, 明显别无选择。但如果两种风格均可行呢? @@ -749,7 +799,7 @@ End aevalR_extended. 我们需要这些性质时必须显式地证明它们。 - 有了函数,我们还可以利用 Coq 的计算机制在证明过程中简化表达式。 - 此外,函数还可以直“提取为”OCaml 或 Haskell 的可执行代码。 *) + 此外,函数还可以直接从 Gallina“提取”出 OCaml 或 Haskell 的可执行代码。 *) (** 最终,选择视具体情况而定,或者只是品味问题。确实,在大型的 Coq 开发中,经常可以看到一个定义同时给出了函数式和关系式_'两种'_风格, @@ -784,7 +834,7 @@ Definition state := total_map nat. Inductive aexp : Type := | ANum (n : nat) - | AId (x : string) (* <----- 新增 *) + | AId (x : string) (* <--- 新增 *) | APlus (a1 a2 : aexp) | AMinus (a1 a2 : aexp) | AMult (a1 a2 : aexp). @@ -811,35 +861,53 @@ Inductive bexp : Type := | BAnd (b1 b2 : bexp). (* ================================================================= *) -(** ** 记法 *) -(** 要让 Imp 程序更易读写,我们引入了一些记法和隐式转换(Coercion)。 +(** ** 记法 + + 要让 Imp 程序更易读写,我们引入了一些记法和隐式转换(Coercion)。 - 在本章中你无需理解以下声明具体做了些什么。简言而之,Coq 中的 [Coercion] + 你无需理解以下声明具体做了些什么。简言而之,Coq 中的 [Coercion] 声明规定了一个函数(或构造子)可以被类型系统隐式地用于将一个输入类型的值 转换成输出类型的值。例如,[AId] 的转换声明在需要一个 [aexp] 时直接使用普通的字符串,该字符串会被隐式地用 [AId] 来包装。 *) (** 下列记法在具体的_'记法作用域'_中声明,以避免与其它符号相同的解释相冲突。 - 同样,你也暂时无需理解其中的细节。 *) + 同样,你暂时也无需理解其中的细节,但要意识到到我们为 [+]、[-]、[*]、[=]、[<=] + 等运算符定义了_'新的'_解释十分重要。 *) Coercion AId : string >-> aexp. Coercion ANum : nat >-> aexp. -Definition bool_to_bexp (b: bool) : bexp := + +Definition bool_to_bexp (b : bool) : bexp := if b then BTrue else BFalse. Coercion bool_to_bexp : bool >-> bexp. -Bind Scope aexp_scope with aexp. -Infix "+" := APlus : aexp_scope. -Infix "-" := AMinus : aexp_scope. -Infix "*" := AMult : aexp_scope. -Bind Scope bexp_scope with bexp. -Infix "<=" := BLe : bexp_scope. -Infix "=" := BEq : bexp_scope. -Infix "&&" := BAnd : bexp_scope. -Notation "'!' b" := (BNot b) (at level 60) : bexp_scope. +Bind Scope imp_scope with aexp. +Bind Scope imp_scope with bexp. +Delimit Scope imp_scope with imp. + +Notation "x + y" := (APlus x y) (at level 50, left associativity) : imp_scope. +Notation "x - y" := (AMinus x y) (at level 50, left associativity) : imp_scope. +Notation "x * y" := (AMult x y) (at level 40, left associativity) : imp_scope. +Notation "x <= y" := (BLe x y) (at level 70, no associativity) : imp_scope. +Notation "x = y" := (BEq x y) (at level 70, no associativity) : imp_scope. +Notation "x && y" := (BAnd x y) (at level 40, left associativity) : imp_scope. +Notation "'~' b" := (BNot b) (at level 75, right associativity) : imp_scope. (** 现在我们可以用 [3 + (X * 2)] 来代替 [APlus 3 (AMult X 2)] 了,同样可以用 - [true && !(X <= 4)] 来代替 [BAnd true (BNot (BLe X 4))] *) + [true && !(X <= 4)] 来代替 [BAnd true (BNot (BLe X 4))]。 *) + +Definition example_aexp := (3 + (X * 2))%imp : aexp. +Definition example_bexp := (true && ~(X <= 4))%imp : bexp. + +(** 强制转换有一点不便之处,即它会略微提高人类推导表达式类型的难度。 + 如果你感到有点困惑,请用 [Set Printing Coercions] 来查看具体发生了什么。 *) + +Set Printing Coercions. + +Print example_bexp. +(* ===> example_bexp = bool_to_bexp true && ~ (AId X <= ANum 4) *) + +Unset Printing Coercions. (* ================================================================= *) (** ** 求值 *) @@ -850,7 +918,7 @@ Notation "'!' b" := (BNot b) (at level 60) : bexp_scope. Fixpoint aeval (st : state) (a : aexp) : nat := match a with | ANum n => n - | AId x => st x (* <----- 新增 *) + | AId x => st x (* <--- 新增 *) | 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) @@ -866,28 +934,21 @@ Fixpoint beval (st : state) (b : bexp) : bool := | BAnd b1 b2 => andb (beval st b1) (beval st b2) end. -(** 我们为具体状态的全映射声明具体的记法,即使用 [{ --> 0 }] 作为空状态。 *) - -Notation "{ a --> x }" := - (t_update { --> 0 } a x) (at level 0). -Notation "{ a --> x ; b --> y }" := - (t_update ({ a --> x }) b y) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z }" := - (t_update ({ a --> x ; b --> y }) c z) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z ; d --> t }" := - (t_update ({ a --> x ; b --> y ; c --> z }) d t) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" := - (t_update ({ a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 0). -Notation "{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" := - (t_update ({ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 0). +(** 我们为具体状态的全映射声明具体的记法,即使用 [(_ !-> 0)] 作为空状态。 *) + +Definition empty_st := (_ !-> 0). + +(** 现在我们可以为“单例状态(singleton state)”添加新的记法了, + 即只有一个绑定到值的变量。 *) +Notation "a '!->' x" := (t_update empty_st a x) (at level 100). Example aexp1 : - aeval { X --> 5 } (3 + (X * 2)) + aeval (X !-> 5) (3 + (X * 2))%imp = 13. Proof. reflexivity. Qed. Example bexp1 : - beval { X --> 5 } (true && !(X <= 4)) + beval (X !-> 5) (true && ~(X <= 4))%imp = true. Proof. reflexivity. Qed. @@ -900,19 +961,18 @@ Proof. reflexivity. Qed. (* ================================================================= *) (** ** 语法 *) -(** 指令 [c] 可以用以下 BNF 文法非形式化地描述。(为了能够使用 Coq - 的记法机制来定义 Imp 语法,我们选择了这种略尴尬的具体语法。具体来说, - 我们使用了 [IFB] 来避免与表中库中的 [if] 记法相冲突。) +(** 指令 [c] 可以用以下 BNF 文法非形式化地描述。 - c ::= SKIP | x ::= a | c ;; c | IFB b THEN c ELSE c FI + c ::= SKIP | x ::= a | c ;; c | TEST b THEN c ELSE c FI | WHILE b DO c END -*) -(** + + (为了能够使用 Coq 的记法机制来定义 Imp 语法,我们选择了这种略尴尬的具体语法。 + 具体来说,我们使用了 [TEST] 来避免与表中库中的 [if] 记法相冲突。) 例如,下面是用 Imp 编写的阶乘: Z ::= X;; Y ::= 1;; - WHILE ! (Z = 0) DO + WHILE ~(Z = 0) DO Y ::= Y * Z;; Z ::= Z - 1 END @@ -930,30 +990,102 @@ Inductive com : Type := (** 至于表达式,我们可以用一些 [Notation] 声明来让 Imp 程序的读写更加方便。 *) -Bind Scope com_scope with com. +Bind Scope imp_scope with com. Notation "'SKIP'" := - CSkip : com_scope. + CSkip : imp_scope. Notation "x '::=' a" := - (CAss x a) (at level 60) : com_scope. + (CAss x a) (at level 60) : imp_scope. Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity) : com_scope. + (CSeq c1 c2) (at level 80, right associativity) : imp_scope. Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity) : com_scope. -Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := - (CIf c1 c2 c3) (at level 80, right associativity) : com_scope. - -(** 以下声明可以让这些记法在模式匹配中使用。 *) -Open Scope com_scope. + (CWhile b c) (at level 80, right associativity) : imp_scope. +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" := + (CIf c1 c2 c3) (at level 80, right associativity) : imp_scope. (** 例如,下面是个阶乘函数,写成 Coq 的形式化定义: *) Definition fact_in_coq : com := - Z ::= X;; + (Z ::= X;; Y ::= 1;; - WHILE ! (Z = 0) DO + WHILE ~(Z = 0) DO Y ::= Y * Z;; Z ::= Z - 1 - END. + END)%imp. + +(* ================================================================= *) +(** ** 脱糖记法 *) + +(** Coq 为管理日益复杂的工作对象提供了丰富的特性,例如隐式转换和记法。 + 然而,过度使用它们会产生繁杂的语法。为了教学,我们通常会用以下命令来 + “关闭”这些特性以获得对事物更加本质的描述: + + - [Unset Printing Notations](用 [Set Printing Notations] 撤销) + - [Set Printing Coercions](用 [Unset Printing Coercions] 撤销) + - [Set Printing All](用 [Unset Printing All] 撤销) + + 这些命令也可在证明过程中详述当前目标和上下文。 *) + +Unset Printing Notations. +Print fact_in_coq. +(* ===> + fact_in_coq = + CSeq (CAss Z X) + (CSeq (CAss Y (S O)) + (CWhile (BNot (BEq Z O)) + (CSeq (CAss Y (AMult Y Z)) + (CAss Z (AMinus Z (S O)))))) + : com *) +Set Printing Notations. + +Set Printing Coercions. +Print fact_in_coq. +(* ===> + fact_in_coq = + (Z ::= AId X;; + Y ::= ANum 1;; + WHILE ~ (AId Z = ANum 0) DO + Y ::= AId Y * AId Z;; + Z ::= AId Z - ANum 1 + END)%imp + : com *) +Unset Printing Coercions. + +(* ================================================================= *) +(** ** [Locate] 命令 *) + +(* ----------------------------------------------------------------- *) +(** *** 查询记法 *) + +(** 当遇到未知记法时,可使用 [Locate] 后跟一个包含其符号的_'字符串'_ + 来查看其可能的解释。 *) +Locate "&&". +(* ===> + Notation "x && y" := andb x y : bool_scope (default interpretation) *) + +Locate ";;". +(* ===> + Notation "c1 ;; c2" := CSeq c1 c2 : imp_scope (default interpretation) *) + +Locate "WHILE". +(* ===> + Notation "'WHILE' b 'DO' c 'END'" := CWhile b c : imp_scope + (default interpretation) *) + +(* ----------------------------------------------------------------- *) +(** *** 查询标识符 *) + +(** 当以标示符使用 [Locate] 时,它会打印作用域中同名的所有值的完成路径。 + 它很适合解决由变量覆盖所引起的问题。 *) +Locate aexp. +(* ===> + Inductive Top.aexp + Inductive Top.AExp.aexp + (shorter name to refer to it in current context is AExp.aexp) + Inductive Top.aevalR_division.aexp + (shorter name to refer to it in current context is aevalR_division.aexp) + Inductive Top.aevalR_extended.aexp + (shorter name to refer to it in current context is aevalR_extended.aexp) +*) (* ================================================================= *) (** ** 更多示例 *) @@ -971,12 +1103,12 @@ Definition subtract_slowly_body : com := X ::= X - 1. (* ----------------------------------------------------------------- *) -(** *** Loops *) +(** *** 循环 *) Definition subtract_slowly : com := - WHILE ! (X = 0) DO + (WHILE ~(X = 0) DO subtract_slowly_body - END. + END)%imp. Definition subtract_3_from_5_slowly : com := X ::= 3 ;; @@ -984,7 +1116,7 @@ Definition subtract_3_from_5_slowly : com := subtract_slowly. (* ----------------------------------------------------------------- *) -(** *** An infinite loop: *) +(** *** 无限循环: *) Definition loop : com := WHILE true DO @@ -1002,23 +1134,26 @@ Definition loop : com := (** 下面是一次为指令定义求值函数的尝试,我们忽略了 [WHILE] 的情况。 *) +(** 为了在模式匹配中使用记法,我们需要以下声明。 *) +Open Scope imp_scope. Fixpoint ceval_fun_no_while (st : state) (c : com) : state := match c with | SKIP => st | x ::= a1 => - st & { x --> (aeval st a1) } + (x !-> (aeval st a1) ; st) | c1 ;; c2 => let st' := ceval_fun_no_while st c1 in ceval_fun_no_while st' c2 - | IFB b THEN c1 ELSE c2 FI => + | TEST 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 (* 假装能用 *) end. +Close Scope imp_scope. (** 在 OCaml 或 Haskell 这类传统的函数式编程语言中,我们可以像下面这样添加 [WHILE] 的情况: @@ -1028,7 +1163,7 @@ Fixpoint ceval_fun_no_while (st : state) (c : com) ... | WHILE b DO c END => if (beval st b) - then ceval_fun st (c;; WHILE b DO c END) + then ceval_fun st (c ;; WHILE b DO c END) else st end. @@ -1059,7 +1194,7 @@ Fixpoint ceval_fun_no_while (st : state) (c : com) [any] 这样非确定性的特性,我们需要让求值的定义也是非确定性的 -- 即,它不仅会有不完全性,甚至还可以不是个函数! *) -(** 我们将使用记法 [c / st \\ st'] 来表示 [ceval] 这种关系:[c / st \\ st'] +(** 我们将使用记法 [st =[ c ]=> st'] 来表示 [ceval] 这种关系:[st =[ c ]=> st'] 表示在开始状态 [st] 下启动程序并在结束状态 [st'] 下产生结果。它可以读作: “[c] 将状态 [st] 变成 [st']”。 *) @@ -1068,111 +1203,116 @@ Fixpoint ceval_fun_no_while (st : state) (c : com) (** 下面是求值的非形式化定义,为了可读性表示成推理规则: - ---------------- (E_Skip) - SKIP / st \\ st + ----------------- (E_Skip) + st =[ SKIP ]=> st aeval st a1 = n - -------------------------------- (E_Ass) - x := a1 / st \\ st & { x --> n } + -------------------------------- (E_Ass) + st =[ x := a1 ]=> (x !-> n ; st) - c1 / st \\ st' - c2 / st' \\ st'' - ------------------- (E_Seq) - c1;;c2 / st \\ st'' + st =[ c1 ]=> st' + st' =[ c2 ]=> st'' + --------------------- (E_Seq) + st =[ c1;;c2 ]=> st'' beval st b1 = true - c1 / st \\ st' - ------------------------------------- (E_IfTrue) - IF b1 THEN c1 ELSE c2 FI / st \\ st' + st =[ c1 ]=> st' + --------------------------------------- (E_IfTrue) + st =[ TEST b1 THEN c1 ELSE c2 FI ]=> st' beval st b1 = false - c2 / st \\ st' - ------------------------------------- (E_IfFalse) - IF b1 THEN c1 ELSE c2 FI / st \\ st' + st =[ c2 ]=> st' + --------------------------------------- (E_IfFalse) + st =[ TEST b1 THEN c1 ELSE c2 FI ]=> st' beval st b = false - ------------------------------ (E_WhileFalse) - WHILE b DO c END / st \\ st + ----------------------------- (E_WhileFalse) + st =[ WHILE b DO c END ]=> st beval st b = true - c / st \\ st' - WHILE b DO c END / st' \\ st'' - --------------------------------- (E_WhileTrue) - WHILE b DO c END / st \\ st'' + st =[ c ]=> st' + st' =[ WHILE b DO c END ]=> st'' + -------------------------------- (E_WhileTrue) + st =[ WHILE b DO c END ]=> st'' *) (** 下面是它的形式化定义。请确保你理解了它是如何与以上推理规则相对应的。 *) -Reserved Notation "c1 '/' st '\\' st'" - (at level 40, st at level 39). +Reserved Notation "st '=[' c ']=>' st'" + (at level 40). Inductive ceval : com -> state -> state -> Prop := | E_Skip : forall st, - SKIP / st \\ st + st =[ SKIP ]=> st | E_Ass : forall st a1 n x, aeval st a1 = n -> - (x ::= a1) / st \\ st & { x --> n } + st =[ x ::= a1 ]=> (x !-> n ; st) | E_Seq : forall c1 c2 st st' st'', - c1 / st \\ st' -> - c2 / st' \\ st'' -> - (c1 ;; c2) / st \\ st'' + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ;; c2 ]=> 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' + st =[ c1 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> 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' + st =[ c2 ]=> st' -> + st =[ TEST b THEN c1 ELSE c2 FI ]=> st' | E_WhileFalse : forall b st c, beval st b = false -> - (WHILE b DO c END) / st \\ st + st =[ WHILE b DO c END ]=> st | E_WhileTrue : 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'' + st =[ c ]=> st' -> + st' =[ WHILE b DO c END ]=> st'' -> + st =[ WHILE b DO c END ]=> st'' - where "c1 '/' st '\\' st'" := (ceval c1 st st'). + where "st =[ c ]=> st'" := (ceval c st st'). (** 将求值定义成关系而非函数的代价是,我们需要自己为某个程序求值成某种结束状态_'构造证明'_, 而不能只是交给 Coq 的计算机制去做了。 *) Example ceval_example1: - (X ::= 2;; - IFB X <= 1 + empty_st =[ + X ::= 2;; + TEST X <= 1 THEN Y ::= 3 ELSE Z ::= 4 - FI) - / { --> 0 } \\ { X --> 2 ; Z --> 4 }. + FI + ]=> (Z !-> 4 ; X !-> 2). Proof. (* 我们必须提供中间状态 *) - apply E_Seq with { X --> 2 }. + apply E_Seq with (X !-> 2). - (* 赋值指令 *) apply E_Ass. reflexivity. - (* if 指令 *) apply E_IfFalse. - reflexivity. - apply E_Ass. reflexivity. Qed. + reflexivity. + apply E_Ass. reflexivity. +Qed. -(** **** 练习:2 星 (ceval_example2) *) +(** **** 练习:2 星, standard (ceval_example2) *) Example ceval_example2: - (X ::= 0;; Y ::= 1;; Z ::= 2) / { --> 0 } \\ - { X --> 0 ; Y --> 1 ; Z --> 2 }. + empty_st =[ + X ::= 0;; Y ::= 1;; Z ::= 2 + ]=> (Z !-> 2 ; Y !-> 1 ; X !-> 0). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (pup_to_n) *) -(** 写一个 Imp 程序对从 [1] 到 [X] 进行求值(包括:将 [1 + 2 + ... + X]) 赋予变量 [Y]。 +(** **** 练习:3 星, standard, optional (pup_to_n) + + 写一个 Imp 程序对从 [1] 到 [X] 进行求值(包括:将 [1 + 2 + ... + X]) 赋予变量 [Y]。 证明此程序对于 [X] = [2] 会按预期执行(这可能比你预想的还要棘手)。 *) Definition pup_to_n : com (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Theorem pup_to_2_ceval : - pup_to_n / { X --> 2 } - \\ { X --> 2 ; Y --> 0 ; Y --> 2 ; X --> 1 ; Y --> 3 ; X --> 0 }. + (X !-> 2) =[ + pup_to_n + ]=> (X !-> 0 ; Y !-> 3 ; X !-> 1 ; Y !-> 2 ; Y !-> 0 ; X !-> 2). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -1189,8 +1329,8 @@ Proof. 实际上这不可能发生,因为 [ceval] _'确实'_是一个偏函数: *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. intros c st st1 st2 E1 E2. @@ -1232,8 +1372,8 @@ Proof. Theorem plus2_spec : forall st n st', st X = n -> - plus2 / st \\ st' -> - st' X = (n + 2). + st =[ plus2 ]=> st' -> + st' X = n + 2. Proof. intros st n st' HX Heval. @@ -1244,8 +1384,9 @@ Proof. inversion Heval. subst. clear Heval. simpl. apply t_update_eq. Qed. -(** **** 练习:3 星, recommended (XtimesYinZ_spec) *) -(** 叙述并证明 [XtimesYinZ] 的规范(Specification)。 *) +(** **** 练习:3 星, standard, recommended (XtimesYinZ_spec) + + 叙述并证明 [XtimesYinZ] 的规范(Specification)。 *) (* 请在此处解答 *) @@ -1253,12 +1394,12 @@ Proof. Definition manual_grade_for_XtimesYinZ_spec : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, recommended (loop_never_stops) *) +(** **** 练习:3 星, standard, recommended (loop_never_stops) *) Theorem loop_never_stops : forall st st', - ~(loop / st \\ st'). + ~(st =[ loop ]=> st'). Proof. intros st st' contra. unfold loop in contra. - remember (WHILE true DO SKIP END) as loopdef + remember (WHILE true DO SKIP END)%imp as loopdef eqn:Heqloopdef. (** 归纳讨论假设“[loopdef] 会终止”之构造,其中多数情形的矛盾显而易见, @@ -1267,9 +1408,11 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (no_whiles_eqv) *) -(** 考虑以下函数: *) +(** **** 练习:3 星, standard (no_whiles_eqv) + + 考虑以下函数: *) +Open Scope imp_scope. Fixpoint no_whiles (c : com) : bool := match c with | SKIP => @@ -1278,11 +1421,12 @@ Fixpoint no_whiles (c : com) : bool := true | c1 ;; c2 => andb (no_whiles c1) (no_whiles c2) - | IFB _ THEN ct ELSE cf FI => + | TEST _ THEN ct ELSE cf FI => andb (no_whiles ct) (no_whiles cf) | WHILE _ DO _ END => false end. +Close Scope imp_scope. (** 此断言只对没有 [WHILE] 循环的程序产生 [true]。请用 [Inductive] 写出一个性质 [no_whilesR] 使得 [no_whilesR c] 仅当 [c] 是个没有 @@ -1298,10 +1442,12 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (no_whiles_terminating) *) -(** 不涉及 [WHILE] 循环的 Imp 程序一定会终止。请陈述并证明定理 - [no_whiles_terminating] 来说明这一点。 *) -(** 按照你的偏好使用 [no_whiles] 或 [no_whilesR]。 *) +(** **** 练习:4 星, standard (no_whiles_terminating) + + 不涉及 [WHILE] 循环的 Imp 程序一定会终止。请陈述并证明定理 + [no_whiles_terminating] 来说明这一点。 + + 按照你的偏好使用 [no_whiles] 或 [no_whilesR]。 *) (* 请在此处解答 *) @@ -1312,8 +1458,9 @@ Definition manual_grade_for_no_whiles_terminating : option (nat*string) := None. (* ################################################################# *) (** * 附加练习 *) -(** **** 练习:3 星 (stack_compiler) *) -(** 旧式惠普计算器的编程语言类似于 Forth 和 Postscript,而其抽象机器类似于 +(** **** 练习:3 星, standard (stack_compiler) + + 旧式惠普计算器的编程语言类似于 Forth 和 Postscript,而其抽象机器类似于 Java 虚拟机,即所有对算术表达式的求值都使用_'栈'_来进行。例如,表达式 (2*3)+(3*(4-2)) @@ -1364,13 +1511,13 @@ Fixpoint s_execute (st : state) (stack : list nat) (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. Example s_execute1 : - s_execute { --> 0 } [] + s_execute empty_st [] [SPush 5; SPush 3; SPush 1; SMinus] = [2; 5]. (* 请在此处解答 *) Admitted. Example s_execute2 : - s_execute { X --> 3 } [3;4] + s_execute (X !-> 3) [3;4] [SPush 4; SLoad X; SMult; SPlus] = [15; 4]. (* 请在此处解答 *) Admitted. @@ -1384,13 +1531,14 @@ Fixpoint s_compile (e : aexp) : list sinstr (** 在定义完 [s_compile] 之后,请证明以下示例来测试它是否起作用。 *) Example s_compile1 : - s_compile (X - (2 * Y)) + s_compile (X - (2 * Y))%imp = [SLoad X; SPush 2; SLoad Y; SMult; SMinus]. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, advanced (stack_compiler_correct) *) -(** 现在我们将证明在之前练习中实现的编译器的正确性。记住当栈中的元素少于两个时, +(** **** 练习:4 星, advanced (stack_compiler_correct) + + 现在我们将证明在之前练习中实现的编译器的正确性。记住当栈中的元素少于两个时, 规范并未指定 [SPlus]、[SMinus] 或 [SMult] 指令的行为。 (为了让正确性证明更加容易,你可能需要返回去修改你的实现!) @@ -1403,8 +1551,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (short_circuit) *) -(** 大部分现代编程语言对布尔 [and] 运算提供了“短路求值”的方法:要对 +(** **** 练习:3 星, standard, optional (short_circuit) + + 大部分现代编程语言对布尔 [and] 运算提供了“短路求值”的方法:要对 [BAnd b1 b2] 进行求值,首先对 [b1] 求值。如果结果为 [false],那么整个 [BAnd] 表达式的求值就是 [false],而无需对 [b2] 求值。否则,[b2] 的求值结果就决定了 [BAnd] 表达式的值。 @@ -1414,17 +1563,19 @@ Proof. 在更大的语言中该表达式可能会发散,此时短路求值的 [BAnd] _'并不'_ 等价于原始版本,因为它能让更多程序终止。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) Module BreakImp. -(** **** 练习:4 星, advanced (break_imp) *) -(** 像 C 和 Java 这样的指令式语言通常会包含 [break] 或类似地语句来中断循环的执行。 +(** **** 练习:4 星, advanced (break_imp) + + 像 C 和 Java 这样的指令式语言通常会包含 [break] 或类似地语句来中断循环的执行。 在本练习中,我们考虑如何为 Imp 加上 [break]。首先,我们需要丰富语言的指令。 *) Inductive com : Type := | CSkip - | CBreak (* <-- 新增 *) + | CBreak (* <--- 新增 *) | CAss (x : string) (a : aexp) | CSeq (c1 c2 : com) | CIf (b : bexp) (c1 c2 : com) @@ -1440,7 +1591,7 @@ 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'" := +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" := (CIf c1 c2 c3) (at level 80, right associativity). (** 接着,我们需要定义 [BREAK] 的行为。非形式化地说,只要 [BREAK] @@ -1453,8 +1604,8 @@ Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := X ::= 0;; Y ::= 1;; - WHILE 0 <> Y DO - WHILE TRUE DO + WHILE ~(0 = Y) DO + WHILE true DO BREAK END;; X ::= 1;; @@ -1470,15 +1621,15 @@ Inductive result : Type := | SContinue | SBreak. -Reserved Notation "c1 '/' st '\\' s '/' st'" - (at level 40, st, s at level 39). +Reserved Notation "st '=[' c ']=>' st' '/' s" + (at level 40, st' at next level). -(** 直觉上说,[c / st \\ s / st'] 表示如果 [c] 在 [st] 状况下开始, +(** 直觉上说,[st =[ c ]=> st' / s] 表示如果 [c] 在 [st] 状况下开始, 它会在 [st'] 状态下终止,围绕它的最内层循环(或整个程序) 要么收到立即退出的信号([s = SBreak]),要么继续正常执行([s = SContinue])。 - “[c / st \\ s / st']”关系的定义非常类似于之前我们为一般求值关系 - ([c / st \\ st'])给出的定义 -- 我们只需要恰当地处理终止信号。 + “[st =[ c ]=> st' / s]”关系的定义非常类似于之前我们为一般求值关系 + ([st =[ c ]=> st'])给出的定义 -- 我们只需要恰当地处理终止信号。 - 若指令为 [SKIP],则状态不变,任何围绕它的循环继续正常执行。 @@ -1486,7 +1637,7 @@ Reserved Notation "c1 '/' st '\\' s '/' st'" - 若指令为赋值,则根据状态更新该变量绑定的值,并发出继续正常执行的信号。 - - 若指令为 [IFB b THEN c1 ELSE c2 FI] 的形式,则按照 Imp 的原始语义更新状态, + - 若指令为 [TEST b THEN c1 ELSE c2 FI] 的形式,则按照 Imp 的原始语义更新状态, 除此之外我们还要从被选择执行的分支中传播信号。 - 若指令为一系列 [c1 ;; c2],我们首先执行 [c1]。如果它产生了 @@ -1504,46 +1655,46 @@ Reserved Notation "c1 '/' st '\\' s '/' st'" Inductive ceval : com -> state -> result -> state -> Prop := | E_Skip : forall st, - CSkip / st \\ SContinue / st + st =[ CSkip ]=> st / SContinue (* 请在此处解答 *) - where "c1 '/' st '\\' s '/' st'" := (ceval c1 st s st'). + where "st '=[' c ']=>' st' '/' s" := (ceval c st s st'). (** 现在证明你定义的 [ceval] 的如下性质: *) Theorem break_ignore : forall c st st' s, - (BREAK;; c) / st \\ s / st' -> + st =[ BREAK;; c ]=> st' / s -> st = st'. Proof. (* 请在此处解答 *) Admitted. Theorem while_continue : forall b c st st' s, - (WHILE b DO c END) / st \\ s / st' -> + st =[ WHILE b DO c END ]=> st' / s -> s = SContinue. Proof. (* 请在此处解答 *) 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'. + st =[ c ]=> st' / SBreak -> + st =[ WHILE b DO c END ]=> st' / SContinue. Proof. (* 请在此处解答 *) Admitted. (** [] *) (** **** 练习:3 星, advanced, optional (while_break_true) *) Theorem while_break_true : forall b c st st', - (WHILE b DO c END) / st \\ SContinue / st' -> + st =[ WHILE b DO c END ]=> st' / SContinue -> beval st' b = true -> - exists st'', c / st'' \\ SBreak / st'. + exists st'', st'' =[ c ]=> st' / SBreak. Proof. (* 请在此处解答 *) Admitted. (** [] *) (** **** 练习:4 星, advanced, optional (ceval_deterministic) *) Theorem ceval_deterministic: forall (c:com) st st1 st2 s1 s2, - c / st \\ s1 / st1 -> - c / st \\ s2 / st2 -> + st =[ c ]=> st1 / s1 -> + st =[ c ]=> st2 / s2 -> st1 = st2 /\ s1 = s2. Proof. (* 请在此处解答 *) Admitted. @@ -1551,8 +1702,9 @@ Proof. (** [] *) End BreakImp. -(** **** 练习:4 星, optional (add_for_loop) *) -(** 为该语言添加 C 风格的 [for] 循环指令,更新 [ceval] 的定义来定义 +(** **** 练习:4 星, standard, optional (add_for_loop) + + 为该语言添加 C 风格的 [for] 循环指令,更新 [ceval] 的定义来定义 [for] 循环,按需添加 [for] 循环的情况使得本文件中的所有证明都被 Coq 所接受。 @@ -1561,7 +1713,9 @@ End BreakImp. (c) 一个在循环的每次迭代最后执行的语句,以及 (d) 一个创建循环体的语句 (你不必关心为 [for] 构造一个具体的记法,不过如果你喜欢,可以随意去做。) *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) +(* Sat Jan 26 15:15:42 UTC 2019 *) diff --git a/plf-current/ImpTest.v b/plf-current/ImpTest.v index 02affaef..f9e7fba6 100644 --- a/plf-current/ImpTest.v +++ b/plf-current/ImpTest.v @@ -64,8 +64,8 @@ idtac " ". idtac "#> ceval_example2". idtac "Possible points: 2". check_type @ceval_example2 ( -((X ::= 0;; Y ::= 1;; Z ::= 2) / @Maps.t_empty nat 0 \\ - {X --> 0; Y --> 1; Z --> 2})). +(empty_st =[ X ::= 0;; Y ::= 1;; Z ::= 2 + ]=> @Maps.t_update nat (@Maps.t_update nat (X !-> 0) Y 1) Z 2)). idtac "Assumptions:". Abort. Print Assumptions ceval_example2. @@ -85,7 +85,7 @@ idtac " ". idtac "#> loop_never_stops". idtac "Possible points: 3". -check_type @loop_never_stops ((forall st st' : state, ~ loop / st \\ st')). +check_type @loop_never_stops ((forall st st' : state, ~ st =[ loop ]=> st')). idtac "Assumptions:". Abort. Print Assumptions loop_never_stops. @@ -118,7 +118,7 @@ idtac " ". idtac "#> s_execute1". idtac "Possible points: 0.5". check_type @s_execute1 ( -(s_execute (@Maps.t_empty nat 0) (@nil nat) +(s_execute empty_st (@nil nat) (SPush 5 :: (SPush 3 :: SPush 1 :: SMinus :: @nil sinstr)%list) = (2 :: 5 :: @nil nat)%list)). idtac "Assumptions:". @@ -130,7 +130,7 @@ idtac " ". idtac "#> s_execute2". idtac "Possible points: 0.5". check_type @s_execute2 ( -(s_execute {X --> 3} (3 :: (4 :: @nil nat)%list) +(s_execute (X !-> 3) (3 :: (4 :: @nil nat)%list) (SPush 4 :: (SLoad X :: SMult :: SPlus :: @nil sinstr)%list) = (15 :: 4 :: @nil nat)%list)). idtac "Assumptions:". @@ -245,3 +245,5 @@ Print Assumptions BreakImp.while_continue. idtac "---------- BreakImp.while_stops_on_break ---------". Print Assumptions BreakImp.while_stops_on_break. Abort. + +(* Sat Jan 26 15:15:50 UTC 2019 *) diff --git a/plf-current/LICENSE b/plf-current/LICENSE index 15ebac8e..568f5c1d 100644 --- a/plf-current/LICENSE +++ b/plf-current/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2018 +Copyright (c) 2019 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/plf-current/LibTactics.html b/plf-current/LibTactics.html index 8f32fe35..01b3b4d0 100644 --- a/plf-current/LibTactics.html +++ b/plf-current/LibTactics.html @@ -157,7 +157,7 @@

              LibTacticsA Collection of Handy Gene
              Inductive Boxer : Type :=
              -  | boxer : (A:Type), ABoxer.
              +  | boxer : (A:Type), ABoxer.
              @@ -229,7 +229,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac gen_until_mark :=
              -  match goal with H: ?T |- _
              +  match goal with H: ?T_
                match T with
                | ltac_Markclear H
                | _generalize H; clear H; gen_until_mark
              @@ -244,7 +244,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac gen_until_mark_with_processing cont :=
              -  match goal with H: ?T |- _
              +  match goal with H: ?T_
                match T with
                | ltac_Markclear H
                | _cont H; generalize H; clear H;
              @@ -262,7 +262,7 @@

              LibTacticsA Collection of Handy Gene Ltac intro_until_mark :=
                match goal with
              -  | |- (ltac_Mark_) ⇒ intros _
              +  | ⊢ (ltac_Mark_) ⇒ intros _
                | _intro; intro_until_mark
                end.

              @@ -416,7 +416,7 @@

              LibTacticsA Collection of Handy Gene Definition ltac_database (D:Boxer) (T:Boxer) (A:Boxer) := Ltac_database_token.

              Notation "'Register' D T" := (ltac_database (boxer D) (boxer T) _)
                (at level 69, D at level 0, T at level 0).

              -Lemma ltac_database_provide : (A:Boxer) (D:Boxer) (T:Boxer),
              +Lemma ltac_database_provide : (A:Boxer) (D:Boxer) (T:Boxer),
                ltac_database D T A.
              Proof using. split. Qed.

              Ltac Provide T := apply (@ltac_database_provide (boxer T)).

              @@ -429,7 +429,7 @@

              LibTacticsA Collection of Handy Gene                generalize L end; clear H ].

              (* Note for a possible alternative implementation of the ltac_database_token:
                 Inductive Ltac_database : Type :=
              -     | ltac_database : forall A, A -> Ltac_database.
              +     | ltac_database : forall A, A -> Ltac_database.
                 Implicit Arguments ltac_database A.
              *)

              @@ -457,7 +457,7 @@

              LibTacticsA Collection of Handy Gene Ltac rm_term E :=
                let T := type of E in
              -  match goal with H: T |- _try clear H end.
              +  match goal with H: T_try clear H end.

              @@ -608,7 +608,7 @@

              LibTacticsA Collection of Handy Gene

              -Lemma dup_lemma : P, PPP.
              +Lemma dup_lemma : P, PPP.
              Proof using. auto. Qed.

              Ltac dup_tactic N :=
                match number_to_nat N with
              @@ -661,7 +661,7 @@

              LibTacticsA Collection of Handy Gene Ltac check_noevar_hyp H :=
                let T := type of H in check_noevar T.

              Ltac check_noevar_goal :=
              -  match goal with |- ?Gcheck_noevar G end.
              +  match goal with ⊢ ?Gcheck_noevar G end.

              @@ -693,7 +693,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac get_last_hyp tt :=
              -  match goal with H: _ |- _constr:(H) end.
              +  match goal with H: __constr:(H) end.
              @@ -719,7 +719,7 @@

              LibTacticsA Collection of Handy Gene Definition ltac_to_generalize (A:Type) (x:A) := x.

              Ltac gen_to_generalize :=
                repeat match goal with
              -    H: ltac_to_generalize _ |- _generalize H; clear H end.

              +    H: ltac_to_generalize __generalize H; clear H end.

              Ltac mark_to_generalize H :=
                let T := type of H in
                change T with (ltac_to_generalize T) in H.
              @@ -789,7 +789,7 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "ltac_action_at" constr(K) "of" constr(E) "do" tactic(Tac) :=
                let p := fresh "TEMP" in ltac_pattern E at K;
              -  match goal with |- ?P _set (p:=P) end;
              +  match goal with ⊢ ?P _set (p:=P) end;
                Tac; unfold p; clear p.

              Tactic Notation "ltac_action_at" constr(K) "of" constr(E) "in" hyp(H) "do" tactic(Tac) :=
                let p := fresh "TEMP" in ltac_pattern E at K in H;
              @@ -838,17 +838,17 @@

              LibTacticsA Collection of Handy Gene
              Ltac jauto_set_hyps :=
              -  repeat match goal with H: ?T |- _
              +  repeat match goal with H: ?T_
                  match T with
                  | __destruct H
              -    | a, _destruct H
              +    | a, _destruct H
                  | _generalize H; clear H
                  end
                end.

              Ltac jauto_set_goal :=
                repeat match goal with
              -  | |- a, _esplit
              -  | |- __split
              +  | ⊢ a, _esplit
              +  | ⊢ __split
                end.

              Ltac jauto_set :=
                intros; jauto_set_hyps;
              @@ -1000,7 +1000,7 @@

              LibTacticsA Collection of Handy Gene asserts H: T is another syntax for assert (H : T), which also works with introduction patterns. For instance, one can write: - asserts \[x P\] (n, n = 3), or + asserts \[x P\] ( n, n = 3), or asserts \[H|H\] (n = 0 n = 1).

              @@ -1101,7 +1101,7 @@

              LibTacticsA Collection of Handy Gene The instantiation tactics are used to instantiate a lemma E (whose type is a product) on some arguments. The type of E is made of implications and universal quantifications, e.g. - x, P x y z, Q x y z R z. + x, P x y z, Q x y z R z.
              @@ -1156,7 +1156,7 @@

              LibTacticsA Collection of Handy Gene   let rec go t :=
                  match type of t with
                  | ?P → ?Qapp_assert t P go
              -    | _:?A, _app_evar t A go
              +    | _:?A, _app_evar t A go
                  | _final t
                  end in
                go t.

              @@ -1188,14 +1188,14 @@

              LibTacticsA Collection of Handy Gene            | ltac_wild
                           match T with
                           | ?P → ?Qfirst [ app_assert t P cont' | fail 3 ]
              -             | _:?A, _first [ app_evar t A cont' | fail 3 ]
              +             | _:?A, _first [ app_evar t A cont' | fail 3 ]
                           end
                         | _
                           match T with (* should test T for unifiability *)
                           | U → ?Qfirst [ app_assert t U cont' | fail 3 ]
              -             | _:U, _first [ app_evar t U cont' | fail 3 ]
              +             | _:U, _first [ app_evar t U cont' | fail 3 ]
                           | ?P → ?Qfirst [ app_assert t P cont | fail 3 ]
              -             | _:?A, _first [ app_evar t A cont | fail 3 ]
              +             | _:?A, _first [ app_evar t A cont | fail 3 ]
                           end
                         end
                       | fail 2 ]
              @@ -1204,7 +1204,7 @@

              LibTacticsA Collection of Handy Gene           | ?P → ?Qfirst [ app_arg t P v cont'
                                            | app_assert t P cont
                                            | fail 3 ]
              -           | _:Type, _
              +           | _:Type, _
                            match type of v with
                            | Typefirst [ cont' (t v)
                                            | app_evar t Type cont
              @@ -1212,7 +1212,7 @@

              LibTacticsA Collection of Handy Gene               | _first [ app_evar t Type cont
                                         | fail 3 ]
                            end
              -          | _:?A, _
              +          | _:?A, _
                           let V := type of v in
                           match type of V with
                           | Propfirst [ app_evar t A cont
              @@ -1239,7 +1239,7 @@

              LibTacticsA Collection of Handy Gene   let rec go t :=
                  match type of t with
                  | ?P → ?Qapp_assert t P go
              -    | _:?A, _
              +    | _:?A, _
                      first [ app_evar t A go
                            | app_typeclass t go
                            | fail 3 ]
              @@ -1263,19 +1263,19 @@

              LibTacticsA Collection of Handy Gene            | ltac_wild
                           match T with
                           | ?P → ?Qfirst [ app_assert t P cont' | fail 3 ]
              -             | _:?A, _first [ app_typeclass t cont'
              +             | _:?A, _first [ app_typeclass t cont'
                                                     | app_evar t A cont'
                                                     | fail 3 ]
                           end
                         | _
                           match T with (* should test T for unifiability *)
                           | U → ?Qfirst [ app_assert t U cont' | fail 3 ]
              -             | _:U, _first
              +             | _:U, _first
                               [ app_typeclass t cont'
                               | app_evar t U cont'
                               | fail 3 ]
                           | ?P → ?Qfirst [ app_assert t P cont | fail 3 ]
              -             | _:?A, _first
              +             | _:?A, _first
                               [ app_typeclass t cont
                               | app_evar t A cont
                               | fail 3 ]
              @@ -1287,7 +1287,7 @@

              LibTacticsA Collection of Handy Gene           | ?P → ?Qfirst [ app_arg t P v cont'
                                            | app_assert t P cont
                                            | fail 3 ]
              -           | _:Type, _
              +           | _:Type, _
                            match type of v with
                            | Typefirst [ cont' (t v)
                                            | app_evar t Type cont
              @@ -1295,7 +1295,7 @@

              LibTacticsA Collection of Handy Gene               | _first [ app_evar t Type cont
                                         | fail 3 ]
                            end
              -          | _:?A, _
              +          | _:?A, _
                           let V := type of v in
                           match type of V with
                           | Propfirst [ app_typeclass t cont
              @@ -1329,20 +1329,20 @@

              LibTacticsA Collection of Handy Gene | ltac_wild match T with | ?P ?Q first [ app_assert t P cont' | fail 3 ] - | _:?A, _ first [ app_evar t A cont' | fail 3 ] + | _:?A, _ first [ app_evar t A cont' | fail 3 ] end | _ match T with  should test T for unifiability *)
              | U ?Q first [ app_assert t U cont' | fail 3 ] - | _:U, _ first [ app_evar t U cont' | fail 3 ] + | _:U, _ first [ app_evar t U cont' | fail 3 ] | ?P ?Q first [ app_assert t P cont | fail 3 ] - | _:?A, _ first [ app_evar t A cont | fail 3 ] + | _:?A, _ first [ app_evar t A cont | fail 3 ] end end | fail 2
                    | _ =>
                        match T with
              -          | ?P -> ?Q => first  app_arg t P v cont' +          | ?P -> ?Q => first  app_arg t P v cont' | app_assert t P cont | fail 3
                        | forall _:?A, _ => first  cont' (t v) @@ -1662,7 +1662,7 @@

              LibTacticsA Collection of Handy Gene Ltac specializes_var_base H :=
                match type of H with
                | ?P → ?Qfail 1
              -  | _:_, _specializes H __
              +  | _:_, _specializes H __
                end.

              Ltac specializes_vars_base H :=
                repeat (specializes_var_base H).

              @@ -1771,7 +1771,7 @@

              LibTacticsA Collection of Handy Gene subgoal ?a = y. The introduction of the evar ?a makes it possible to apply lemmas that would not apply to the original goal, for example a lemma of the form - n m, P n n m, because x and y might be equal + n m, P n n m, because x and y might be equal but not convertible.
              @@ -1785,36 +1785,36 @@

              LibTacticsA Collection of Handy Gene Section equatesLemma.
              Variables (A0 A1 : Type).
              -Variables (A2 : (x1 : A1), Type).
              -Variables (A3 : (x1 : A1) (x2 : A2 x1), Type).
              -Variables (A4 : (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type).
              -Variables (A5 : (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3), Type).
              -Variables (A6 : (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3) (x5 : A5 x4), Type).

              -Lemma equates_0 : (P Q:Prop),
              +Variables (A2 : (x1 : A1), Type).
              +Variables (A3 : (x1 : A1) (x2 : A2 x1), Type).
              +Variables (A4 : (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type).
              +Variables (A5 : (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3), Type).
              +Variables (A6 : (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3) (x5 : A5 x4), Type).

              +Lemma equates_0 : (P Q:Prop),
                PP = QQ.
              Proof. intros. subst. auto. Qed.

              Lemma equates_1 :
              -   (P:A0Prop) x1 y1,
              +  (P:A0Prop) x1 y1,
                P y1x1 = y1P x1.
              Proof. intros. subst. auto. Qed.

              Lemma equates_2 :
              -   y1 (P:A0(x1:A1),Prop) x1 x2,
              +  y1 (P:A0(x1:A1),Prop) x1 x2,
                P y1 x2x1 = y1P x1 x2.
              Proof. intros. subst. auto. Qed.

              Lemma equates_3 :
              -   y1 (P:A0(x1:A1)(x2:A2 x1),Prop) x1 x2 x3,
              +  y1 (P:A0(x1:A1)(x2:A2 x1),Prop) x1 x2 x3,
                P y1 x2 x3x1 = y1P x1 x2 x3.
              Proof. intros. subst. auto. Qed.

              Lemma equates_4 :
              -   y1 (P:A0(x1:A1)(x2:A2 x1)(x3:A3 x2),Prop) x1 x2 x3 x4,
              +  y1 (P:A0(x1:A1)(x2:A2 x1)(x3:A3 x2),Prop) x1 x2 x3 x4,
                P y1 x2 x3 x4x1 = y1P x1 x2 x3 x4.
              Proof. intros. subst. auto. Qed.

              Lemma equates_5 :
              -   y1 (P:A0(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3),Prop) x1 x2 x3 x4 x5,
              +  y1 (P:A0(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3),Prop) x1 x2 x3 x4 x5,
                P y1 x2 x3 x4 x5x1 = y1P x1 x2 x3 x4 x5.
              Proof. intros. subst. auto. Qed.

              Lemma equates_6 :
              -   y1 (P:A0(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3)(x5:A5 x4),Prop)
              +  y1 (P:A0(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3)(x5:A5 x4),Prop)
                x1 x2 x3 x4 x5 x6,
                P y1 x2 x3 x4 x5 x6x1 = y1P x1 x2 x3 x4 x5 x6.
              Proof. intros. subst. auto. Qed.

              @@ -1967,7 +1967,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac false_invert_iter :=
              -  match goal with H:_ |- _
              +  match goal with H:_ ⊢ _
                  solve [ inversion H; false
                        | clear H; false_invert_iter
                        | fail 2 ] end.

              @@ -1996,7 +1996,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac false_neq_self_hyp :=
              -  match goal with H: ?x ≠ ?x |- _
              +  match goal with H: ?x ≠ ?x_
                  false_goal; apply H; reflexivity end.
              @@ -2019,15 +2019,15 @@

              LibTacticsA Collection of Handy Gene
                -
              • If introv is called on a goal of the form x, H, +
              • If introv is called on a goal of the form x, H, it should introduce all the variables quantified with a - at the head of the goal, but it does not introduce + at the head of the goal, but it does not introduce hypotheses that preceed an arrow constructor, like in P Q.
              • If introv is called on a goal that is not of the form - x, H nor P Q, the tactic unfolds definitions - until the goal takes the form x, H or P Q. + x, H nor P Q, the tactic unfolds definitions + until the goal takes the form x, H or P Q. If unfolding definitions does not produces a goal of this form, then the tactic introv does nothing at all.
              • @@ -2040,38 +2040,38 @@

                LibTacticsA Collection of Handy Gene    It does not try to unfold any definition. *)

                Ltac introv_rec :=
                  match goal with
                -  | |- ?P → ?Qidtac
                -  | |- _, _intro; introv_rec
                -  | |- _idtac
                +  | ⊢ ?P → ?Qidtac
                +  | ⊢ _, _intro; introv_rec
                +  | ⊢ _idtac
                  end.

                -(* introv_noarg forces the goal to be a or an ,
                +(* introv_noarg forces the goal to be a  or an ,
                   and then calls introv_rec to introduces variables
                   (possibly none, in which case introv is the same as hnf).
                   If the goal is not a product, then it does not do anything. *)


                Ltac introv_noarg :=
                  match goal with
                -  | |- ?P → ?Qidtac
                -  | |- _, _introv_rec
                -  | |- ?Ghnf;
                +  | ⊢ ?P → ?Qidtac
                +  | ⊢ _, _introv_rec
                +  | ⊢ ?Ghnf;
                     match goal with
                -     | |- ?P → ?Qidtac
                -     | |- _, _introv_rec
                +     | ⊢ ?P → ?Qidtac
                +     | ⊢ _, _introv_rec
                     end
                -  | |- _idtac
                +  | ⊢ _idtac
                  end.

                  (* simpler yet perhaps less efficient imlementation *)
                  Ltac introv_noarg_not_optimized :=
                -    intro; match goal with H:_|-_ ⇒ revert H end; introv_rec.

                +    intro; match goal with H:_⊢_ ⇒ revert H end; introv_rec.

                (* introv_arg H introduces one non-dependent hypothesis
                   under the name H, after introducing the variables
                -   quantified with a that preceeds this hypothesis.
                +   quantified with a  that preceeds this hypothesis.
                   This tactic fails if there does not exist a hypothesis
                   to be introduced. *)

                  (* todo: __ in introv means "intros" *)

                Ltac introv_arg H :=
                  hnf; match goal with
                -  | |- ?P → ?Qintros H
                -  | |- _, _intro; introv_arg H
                +  | ⊢ ?P → ?Qintros H
                +  | ⊢ _, _intro; introv_arg H
                  end.

                (* introv I1 .. IN iterates introv Ik *)

                Tactic Notation "introv" :=
                @@ -2117,7 +2117,7 @@

                LibTacticsA Collection of Handy Gene intros_all repeats intro as long as possible. Contrary to intros, it unfolds any definition on the way. Remark that it also unfolds the definition of negation, so applying intros_all to a goal of the form - x, P x ¬Q will introduce x and P x and Q, and will + x, P x ¬Q will introduce x and P x and Q, and will leave False in the goal.

              @@ -2132,7 +2132,7 @@

              LibTacticsA Collection of Handy Gene
              Tactic Notation "intro_hnf" :=
              -  intro; match goal with H: _ |- _hnf in H end.
              +  intro; match goal with H: __hnf in H end.
              @@ -2192,11 +2192,11 @@

              LibTacticsA Collection of Handy Gene   fail.

              Ltac intro_nondeps_aux is_already_hnf :=
                match goal with
              -  | |- (?P → ?Q) ⇒ idtac
              -  | |- ?G_intro_nondeps_aux_special_intro G;
              +  | ⊢ (?P → ?Q) ⇒ idtac
              +  | ⊢ ?G_intro_nondeps_aux_special_intro G;
                                intro; intro_nondeps_aux true
              -  | |- ( _,_) ⇒ intros ?; intro_nondeps_aux true
              -  | |- _
              +  | ⊢ (_,_) ⇒ intros ?; intro_nondeps_aux true
              +  | ⊢ _
                   match is_already_hnf with
                   | trueidtac
                   | falsehnf; intro_nondeps_aux true
              @@ -2341,7 +2341,7 @@

              LibTacticsA Collection of Handy Gene sets_eq X HX: E does the same but replaces E by X everywhere in the goal. sets_eq X HX: E in H replaces in H. - set_eq X HX: E in |- performs no substitution at all. + set_eq X HX: E in performs no substitution at all.

              @@ -2381,18 +2381,18 @@

              LibTacticsA Collection of Handy Gene   let HX := fresh "EQ" X in set_eq <- X HX: E in H.
              Tactic Notation "set_eq" "<-" ":" constr(E) "in" hyp(H) :=
                let X := fresh "X" in set_eq <- X: E in H.

              -Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) "in" "|-" :=
              -  set (X := E) in |-; def_to_eq X HX E.
              -Tactic Notation "set_eq" ident(X) ":" constr(E) "in" "|-" :=
              -  let HX := fresh "EQ" X in set_eq X HX: E in |-.
              -Tactic Notation "set_eq" ":" constr(E) "in" "|-" :=
              -  let X := fresh "X" in set_eq X: E in |-.

              -Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) "in" "|-" :=
              -  set (X := E) in |-; def_to_eq_sym X HX E.
              -Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) "in" "|-" :=
              -  let HX := fresh "EQ" X in set_eq <- X HX: E in |-.
              -Tactic Notation "set_eq" "<-" ":" constr(E) "in" "|-" :=
              -  let X := fresh "X" in set_eq <- X: E in |-.
              +Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) "in" "⊢" :=
              +  set (X := E) in ⊢; def_to_eq X HX E.
              +Tactic Notation "set_eq" ident(X) ":" constr(E) "in" "⊢" :=
              +  let HX := fresh "EQ" X in set_eq X HX: E in ⊢.
              +Tactic Notation "set_eq" ":" constr(E) "in" "⊢" :=
              +  let X := fresh "X" in set_eq X: E in ⊢.

              +Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) "in" "⊢" :=
              +  set (X := E) in ⊢; def_to_eq_sym X HX E.
              +Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) "in" "⊢" :=
              +  let HX := fresh "EQ" X in set_eq <- X HX: E in ⊢.
              +Tactic Notation "set_eq" "<-" ":" constr(E) "in" "⊢" :=
              +  let X := fresh "X" in set_eq <- X: E in ⊢.

              @@ -2437,8 +2437,8 @@

              LibTacticsA Collection of Handy Gene Ltac sets_let_base tac :=
                match goal with
              -  | |- context[let _ := ?E in _] ⇒ tac E; cbv zeta
              -  | H: context[let _ := ?E in _] |- _tac E; cbv zeta in H
              +  | ⊢ context[let _ := ?E in _] ⇒ tac E; cbv zeta
              +  | H: context[let _ := ?E in _] ⊢ _tac E; cbv zeta in H
                end.

              Ltac sets_let_in_base H tac :=
                match type of H with context[let _ := ?E in _] ⇒
              @@ -2693,12 +2693,12 @@

              LibTacticsA Collection of Handy Gene   let go E :=
                  let P := get_head E in cont P in
                match E with
              -  | _,_ ⇒ intros; apply_to_head_of E cont
              +  | _,_ ⇒ intros; apply_to_head_of E cont
                | ?A = ?Bfirst [ go A | go B ]
                | ?Ago A
                end.

              Ltac unfolds_base :=
              -  match goal with |- ?G
              +  match goal with ⊢ ?G
                 apply_to_head_of G ltac:(fun Punfold P) end.

              Tactic Notation "unfolds" :=
                unfolds_base.
              @@ -2878,7 +2878,7 @@

              LibTacticsA Collection of Handy Gene
              Tactic Notation "substs" :=
              -  repeat (match goal with H: ?x = ?y |- _
              +  repeat (match goal with H: ?x = ?y_
                          first [ subst x | subst y ] end).
              @@ -2890,7 +2890,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac substs_below limit :=
              -  match goal with H: ?T |- _
              +  match goal with H: ?T_
                match T with
                | limitidtac
                | ?x = ?y
              @@ -2970,7 +2970,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac subst_local :=
              -  repeat match goal with H:=_ |- _subst H end.
              +  repeat match goal with H:=_ ⊢ _subst H end.
              @@ -3029,11 +3029,11 @@

              LibTacticsA Collection of Handy Gene Ltac fequal_base :=
                let go := f_equal; [ fequal_base | ] in
                match goal with
              -  | |- (_,_,_) = (_,_,_) ⇒ go
              -  | |- (_,_,_,_) = (_,_,_,_) ⇒ go
              -  | |- (_,_,_,_,_) = (_,_,_,_,_) ⇒ go
              -  | |- (_,_,_,_,_,_) = (_,_,_,_,_,_) ⇒ go
              -  | |- _f_equal
              +  | ⊢ (_,_,_) = (_,_,_) ⇒ go
              +  | ⊢ (_,_,_,_) = (_,_,_,_) ⇒ go
              +  | ⊢ (_,_,_,_,_) = (_,_,_,_,_) ⇒ go
              +  | ⊢ (_,_,_,_,_,_) = (_,_,_,_,_,_) ⇒ go
              +  | ⊢ _f_equal
                end.

              Tactic Notation "fequal" :=
                fequal_base.
              @@ -3148,22 +3148,22 @@

              LibTacticsA Collection of Handy Gene (* --we do not import Eqdep because it imports nasty hints automatically
                  From TLC Require Import Eqdep. *)


              Axiom inj_pair2 : (* is in fact derivable from the axioms in LibAxiom.v *)
              -   (U : Type) (P : UType) (p : U) (x y : P p),
              +  (U : Type) (P : UType) (p : U) (x y : P p),
                existT P p x = existT P p yx = y.
              -(* Proof using. apply Eqdep.EqdepTheory.inj_pair2. Qed.*)

              +(* Proof using. apply Eqdep.EqdepTheory.inj_pair2. Qed. *)

              Ltac inverts_tactic H i1 i2 i3 i4 i5 i6 :=
                let rec go i1 i2 i3 i4 i5 i6 :=
                  match goal with
              -    | |- (ltac_Mark_) ⇒ intros _
              -    | |- (?x = ?y_) ⇒ let H := fresh "TEMP" in intro H;
              +    | ⊢ (ltac_Mark_) ⇒ intros _
              +    | ⊢ (?x = ?y_) ⇒ let H := fresh "TEMP" in intro H;
                                         first [ subst x | subst y ];
                                         go i1 i2 i3 i4 i5 i6
              -    | |- (existT ?P ?p ?x = existT ?P ?p ?y_) ⇒
              +    | ⊢ (existT ?P ?p ?x = existT ?P ?p ?y_) ⇒
                       let H := fresh "TEMP" in intro H;
                       generalize (@inj_pair2 _ P p x y H);
                       clear H; go i1 i2 i3 i4 i5 i6
              -    | |- (?P → ?Q) ⇒ i1; go i2 i3 i4 i5 i6 ltac:(intro)
              -    | |- ( _, _) ⇒ intro; go i1 i2 i3 i4 i5 i6
              +    | ⊢ (?P → ?Q) ⇒ i1; go i2 i3 i4 i5 i6 ltac:(intro)
              +    | ⊢ (_, _) ⇒ intro; go i1 i2 i3 i4 i5 i6
                  end in
                generalize ltac_mark; invert keep H; go i1 i2 i3 i4 i5 i6;
                unfold eq' in *.
              @@ -3265,15 +3265,15 @@

              LibTacticsA Collection of Handy Gene Ltac inverts_as_tactic H :=
                let rec go tt :=
                  match goal with
              -    | |- (ltac_Mark_) ⇒ intros _
              -    | |- (?x = ?y_) ⇒ let H := fresh "TEMP" in intro H;
              +    | ⊢ (ltac_Mark_) ⇒ intros _
              +    | ⊢ (?x = ?y_) ⇒ let H := fresh "TEMP" in intro H;
                                         first [ subst x | subst y ];
                                         go tt
              -    | |- (existT ?P ?p ?x = existT ?P ?p ?y_) ⇒
              +    | ⊢ (existT ?P ?p ?x = existT ?P ?p ?y_) ⇒
                       let H := fresh "TEMP" in intro H;
                       generalize (@inj_pair2 _ P p x y H);
                       clear H; go tt
              -    | |- ( _, _) ⇒
              +    | ⊢ (_, _) ⇒
                     intro; let H := get_last_hyp tt in mark_to_generalize H; go tt
                  end in
                pose ltac_mark; inversion H;
              @@ -3331,8 +3331,8 @@

              LibTacticsA Collection of Handy Gene Ltac injects_tactic H :=
                let rec go _ :=
                  match goal with
              -    | |- (ltac_Mark_) ⇒ intros _
              -    | |- (?x = ?y_) ⇒ let H := fresh "TEMP" in intro H;
              +    | ⊢ (ltac_Mark_) ⇒ intros _
              +    | ⊢ (?x = ?y_) ⇒ let H := fresh "TEMP" in intro H;
                                         first [ subst x | subst y | idtac ];
                                         go tt
                  end in
              @@ -3505,8 +3505,8 @@

              LibTacticsA Collection of Handy Gene   case_if_on_tactic E Eq.

              Tactic Notation "case_if" "as" simple_intropattern(Eq) :=
                match goal with
              -  | |- context [if ?B then _ else _] ⇒ case_if_on B as Eq
              -  | K: context [if ?B then _ else _] |- _case_if_on B as Eq
              +  | ⊢ context [if ?B then _ else _] ⇒ case_if_on B as Eq
              +  | K: context [if ?B then _ else _] ⊢ _case_if_on B as Eq
                end.

              Tactic Notation "case_if" "in" hyp(H) "as" simple_intropattern(Eq) :=
                match type of H with context [if ?B then _ else _] ⇒
              @@ -3537,8 +3537,8 @@

              LibTacticsA Collection of Handy Gene   cases_if_on_tactic E Eq.

              Tactic Notation "cases_if" "as" simple_intropattern(Eq) :=
                match goal with
              -  | |- context [if ?B then _ else _] ⇒ cases_if_on B as Eq
              -  | K: context [if ?B then _ else _] |- _cases_if_on B as Eq
              +  | ⊢ context [if ?B then _ else _] ⇒ cases_if_on B as Eq
              +  | K: context [if ?B then _ else _] ⊢ _cases_if_on B as Eq
                end.

              Tactic Notation "cases_if" "in" hyp(H) "as" simple_intropattern(Eq) :=
                match type of H with context [if ?B then _ else _] ⇒
              @@ -3572,8 +3572,8 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "destruct_if"
               "as" simple_intropattern(Eq1) simple_intropattern(Eq2) :=
                match goal with
              -  | |- context [if ?B then _ else _] ⇒ destruct B as [Eq1|Eq2]
              -  | K: context [if ?B then _ else _] |- _destruct B as [Eq1|Eq2]
              +  | ⊢ context [if ?B then _ else _] ⇒ destruct B as [Eq1|Eq2]
              +  | K: context [if ?B then _ else _] ⊢ _destruct B as [Eq1|Eq2]
                end;
                destruct_if_post.

              Tactic Notation "destruct_if" "in" hyp(H)
              @@ -3615,9 +3615,9 @@

              LibTacticsA Collection of Handy Gene   end.

              Ltac destruct_head_match_core cont :=
                match goal with
              -  | |- ?T1 = ?T2first [ let E := find_head_match T1 in cont E
              +  | ⊢ ?T1 = ?T2first [ let E := find_head_match T1 in cont E
                                        | let E := find_head_match T2 in cont E ]
              -  | |- ?T1let E := find_head_match T1 in cont E
              +  | ⊢ ?T1let E := find_head_match T1 in cont E
                end;
                destruct_if_post.

              Tactic Notation "destruct_head_match" "as" simple_intropattern(I) :=
              @@ -3657,8 +3657,8 @@

              LibTacticsA Collection of Handy Gene   end; case_if_post Eq.

              Tactic Notation "cases_if'" "as" simple_intropattern(Eq) :=
                match goal with
              -  | |- context [if ?B then _ else _] ⇒ cases_if_on' B Eq
              -  | K: context [if ?B then _ else _] |- _cases_if_on' B Eq
              +  | ⊢ context [if ?B then _ else _] ⇒ cases_if_on' B Eq
              +  | K: context [if ?B then _ else _] ⊢ _cases_if_on' B Eq
                end.

              Tactic Notation "cases_if'" :=
                let Eq := fresh "C" in cases_if' as Eq.
              @@ -3675,7 +3675,7 @@

              LibTacticsA Collection of Handy Gene

              -Require Import Coq.Program.Equality.

              +From Coq Require Import Program.Equality.

              Ltac inductions_post :=
                unfold eq' in *.

              Tactic Notation "inductions" ident(E) :=
              @@ -3747,7 +3747,7 @@

              LibTacticsA Collection of Handy Gene     first [ clear X | fail 3 "the variable on which the induction is done appears in the hypotheses" ] in
                match T with
                (* Support for measures from LibWf, add this:
              -  | ?A -> nat =>
              +  | ?A -> nat =>
                   induction_wf_core_then IH (wf_measure E) X cont
                *)

                | ?A → ?AProp
              @@ -3784,23 +3784,23 @@

              LibTacticsA Collection of Handy Gene

              -Require Import Coq.Arith.Compare_dec.
              -Require Import Coq.omega.Omega.

              -Lemma induct_height_max2 : n1 n2 : nat,
              -   n, n1 < nn2 < n.
              +From Coq Require Import Arith.Compare_dec.
              +From Coq Require Import omega.Omega.

              +Lemma induct_height_max2 : n1 n2 : nat,
              +  n, n1 < nn2 < n.
              Proof using.
                intros. destruct (lt_dec n1 n2).
              -   (S n2). omega.
              -   (S n1). omega.
              +  (S n2). omega.
              +  (S n1). omega.
              Qed.

              Ltac induct_height_step x :=
                match goal with
              -  | H: _, _ |- _
              +  | H: _, __
                   let n := fresh "n" in let y := fresh "x" in
                   destruct H as [n ?];
                   forwards (y&?&?): induct_height_max2 n x;
                   induct_height_step y
              -  | _ (S x); eauto
              +  | _(S x); eauto
               end.

              Ltac induct_height := induct_height_step O.
              @@ -3830,7 +3830,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac clear_coind :=
              -  repeat match goal with H: COIND _ |- _clear H end.
              +  repeat match goal with H: COIND __clear H end.
              @@ -3870,11 +3870,11 @@

              LibTacticsA Collection of Handy Gene iff H can be used to prove an equivalence P Q and name H the hypothesis obtained in each case. The syntaxes iff and iff H1 H2 are also available to specify zero or two names. The tactic iff <- H - swaps the two subgoals, i.e. produces (Q -> P) as first subgoal. + swaps the two subgoals, i.e. produces (Q -> P) as first subgoal.

              -Lemma iff_intro_swap : (P Q : Prop),
              +Lemma iff_intro_swap : (P Q : Prop),
                (QP) → (PQ) → (PQ).
              Proof using. intuition. Qed.

              Tactic Notation "iff" simple_intropattern(H1) simple_intropattern(H2) :=
              @@ -3916,7 +3916,7 @@

              LibTacticsA Collection of Handy Gene   end.

              Ltac unfold_goal_until_conjunction :=
                match goal with
              -  | |- __idtac
              +  | ⊢ __idtac
                | _progress(unfolds); unfold_goal_until_conjunction
                end.

              Ltac get_term_conjunction_arity T :=
              @@ -3938,7 +3938,7 @@

              LibTacticsA Collection of Handy Gene          (* --TODO: warning this can loop... *)
                end.

              Ltac get_goal_conjunction_arity :=
              -  match goal with |- ?Tget_term_conjunction_arity T end.
              +  match goal with ⊢ ?Tget_term_conjunction_arity T end.

              @@ -4028,7 +4028,7 @@

              LibTacticsA Collection of Handy Gene   end.

              Ltac unfold_goal_until_disjunction :=
                match goal with
              -  | |- __idtac
              +  | ⊢ __idtac
                | _progress(unfolds); unfold_goal_until_disjunction
                end.

              Ltac get_term_disjunction_arity T :=
              @@ -4049,7 +4049,7 @@

              LibTacticsA Collection of Handy Gene          end
                end.

              Ltac get_goal_disjunction_arity :=
              -  match goal with |- ?Tget_term_disjunction_arity T end.
              +  match goal with ⊢ ?Tget_term_disjunction_arity T end.

              @@ -4132,7 +4132,7 @@

              LibTacticsA Collection of Handy Gene
              Tactic Notation "branches" :=
              -  match goal with h: __ |- _branches h end.

              +  match goal with h: ___branches h end.

              (* ---------------------------------------------------------------------- *)
              @@ -4144,14 +4144,14 @@

              LibTacticsA Collection of Handy Gene (* Underlying implementation of . *)

              Ltac get_term_existential_arity T :=
                match T with
              -  | x1 x2 x3 x4 x5 x6 x7 x8, _constr:(8)
              -  | x1 x2 x3 x4 x5 x6 x7, _constr:(7)
              -  | x1 x2 x3 x4 x5 x6, _constr:(6)
              -  | x1 x2 x3 x4 x5, _constr:(5)
              -  | x1 x2 x3 x4, _constr:(4)
              -  | x1 x2 x3, _constr:(3)
              -  | x1 x2, _constr:(2)
              -  | x1, _constr:(1)
              +  | x1 x2 x3 x4 x5 x6 x7 x8, _constr:(8)
              +  | x1 x2 x3 x4 x5 x6 x7, _constr:(7)
              +  | x1 x2 x3 x4 x5 x6, _constr:(6)
              +  | x1 x2 x3 x4 x5, _constr:(5)
              +  | x1 x2 x3 x4, _constr:(4)
              +  | x1 x2 x3, _constr:(3)
              +  | x1 x2, _constr:(2)
              +  | x1, _constr:(1)
                | _ → ?T'get_term_existential_arity T'
                | _let P := get_head T in
                       let T' := eval unfold P in T in
              @@ -4161,63 +4161,63 @@

              LibTacticsA Collection of Handy Gene          end
                end.

              Ltac get_goal_existential_arity :=
              -  match goal with |- ?Tget_term_existential_arity T end.
              +  match goal with ⊢ ?Tget_term_existential_arity T end.

              -T1 ... TN is a shorthand for T1; ...; TN. + T1 ... TN is a shorthand for T1; ...; TN. It is intended to prove goals of the form exist X1 .. XN, P. If an argument provided is __ (double underscore), then an - evar is introduced. T1 .. TN ___ is equivalent to - T1 .. TN __ __ __ with as many __ as possible. + evar is introduced. T1 .. TN ___ is equivalent to + T1 .. TN __ __ __ with as many __ as possible.
              Tactic Notation "exists_original" constr(T1) :=
              -   T1.
              +  T1.
              Tactic Notation "exists" constr(T1) :=
                match T1 with
                | ltac_wildesplit
                | ltac_wildsrepeat esplit
              -  | _ T1
              +  | _T1
                end.
              Tactic Notation "exists" constr(T1) constr(T2) :=
              -   T1; T2.
              +  T1; T2.
              Tactic Notation "exists" constr(T1) constr(T2) constr(T3) :=
              -   T1; T2; T3.
              +  T1; T2; T3.
              Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4) :=
              -   T1; T2; T3; T4.
              +  T1; T2; T3; T4.
              Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4)
               constr(T5) :=
              -   T1; T2; T3; T4; T5.
              +  T1; T2; T3; T4; T5.
              Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4)
               constr(T5) constr(T6) :=
              -   T1; T2; T3; T4; T5; T6.
              +  T1; T2; T3; T4; T5; T6.
              -For compatibility with Coq syntax, T1, .., TN is also provided. +For compatibility with Coq syntax, T1, .., TN is also provided.
              Tactic Notation "exists" constr(T1) "," constr(T2) :=
              -   T1 T2.
              +  T1 T2.
              Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) :=
              -   T1 T2 T3.
              +  T1 T2 T3.
              Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) :=
              -   T1 T2 T3 T4.
              +  T1 T2 T3 T4.
              Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) ","
               constr(T5) :=
              -   T1 T2 T3 T4 T5.
              +  T1 T2 T3 T4 T5.
              Tactic Notation "exists" constr(T1) "," constr(T2) "," constr(T3) "," constr(T4) ","
               constr(T5) "," constr(T6) :=
              -   T1 T2 T3 T4 T5 T6.

              -(* The tactic exists___ N is short for __ ... __
              -   with N double-underscores. The tactic is equivalent
              +  T1 T2 T3 T4 T5 T6.

              +(* The tactic exists___ N is short for  __ ... __
              +   with N double-underscores. The tactic  is equivalent
                 to calling exists___ N, where the value of N is obtained
                 by counting the number of existentials syntactically present
              -   at the head of the goal. The behaviour of differs
              -   from that of ___ is the case where the goal is a
              +   at the head of the goal. The behaviour of  differs
              +   from that of  ___ is the case where the goal is a
                 definition which yields an existential only after unfolding. *)


              Tactic Notation "exists___" constr(N) :=
                let rec aux N :=
              @@ -4248,8 +4248,8 @@

              LibTacticsA Collection of Handy Gene Ltac unpack_core :=
                repeat match goal with
              -  | H: __ |- _destruct H
              -  | H: (varname: _), _ |- _
              +  | H: ___destruct H
              +  | H: (varname: _), __
                    (* kludge to preserve the name of the quantified variable *)
                    let name := fresh varname in
                    destruct H as [name ?]
              @@ -4262,7 +4262,7 @@

              LibTacticsA Collection of Handy Gene       destruct H as [ h1 h2 ];
                    unpack_hypothesis h1;
                    unpack_hypothesis h2
              -  | (varname: _), _
              +  | (varname: _), _
                    (* kludge to preserve the name of the quantified variable *)
                    let name := fresh varname in
                    let body := fresh "TEMP" in
              @@ -4465,7 +4465,7 @@

              LibTacticsA Collection of Handy Gene Ltac auto_false_base cont :=
                try solve [
              -    intros_all; try match goal with |- __split end;
              +    intros_all; try match goal with__split end;
                  solve [ cont tt | intros_all; false; cont tt ] ].

              Tactic Notation "auto_false" :=
                 auto_false_base ltac:(fun ttauto).
              @@ -4552,19 +4552,19 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "false" "¬" constr(E) :=
                false_then E ltac:(fun _auto_tilde).
              Tactic Notation "false" "¬" constr(E0) constr(E1) :=
              -  false¬ (>> E0 E1).
              +  false¬(>> E0 E1).
              Tactic Notation "false" "¬" constr(E0) constr(E1) constr(E2) :=
              -  false¬ (>> E0 E1 E2).
              +  false¬(>> E0 E1 E2).
              Tactic Notation "false" "¬" constr(E0) constr(E1) constr(E2) constr(E3) :=
              -  false¬ (>> E0 E1 E2 E3).
              +  false¬(>> E0 E1 E2 E3).
              Tactic Notation "false" "¬" constr(E0) constr(E1) constr(E2) constr(E3) constr(E4) :=
              -  false¬ (>> E0 E1 E2 E3 E4).
              +  false¬(>> E0 E1 E2 E3 E4).
              Tactic Notation "tryfalse" "¬" :=
              -  try solve [ false¬ ].

              +  try solve [ false¬].

              Tactic Notation "asserts" "¬" simple_intropattern(H) ":" constr(E) :=
                asserts H: E; [ auto_tilde | idtac ].
              Tactic Notation "asserts" "¬" ":" constr(E) :=
              -  let H := fresh "H" in asserts¬ H: E.
              +  let H := fresh "H" in asserts¬H: E.
              Tactic Notation "cuts" "¬" simple_intropattern(H) ":" constr(E) :=
                cuts H: E; [ auto_tilde | idtac ].
              Tactic Notation "cuts" "¬" ":" constr(E) :=
              @@ -4829,19 +4829,32 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "exists___" "¬" :=
                exists___; auto_tilde.
              Tactic Notation "exists" "¬" constr(T1) :=
              -   T1; auto_tilde.
              +  T1; auto_tilde.
              Tactic Notation "exists" "¬" constr(T1) constr(T2) :=
              -   T1 T2; auto_tilde.
              +  T1 T2; auto_tilde.
              Tactic Notation "exists" "¬" constr(T1) constr(T2) constr(T3) :=
              -   T1 T2 T3; auto_tilde.
              +  T1 T2 T3; auto_tilde.
              Tactic Notation "exists" "¬" constr(T1) constr(T2) constr(T3) constr(T4) :=
              -   T1 T2 T3 T4; auto_tilde.
              +  T1 T2 T3 T4; auto_tilde.
              Tactic Notation "exists" "¬" constr(T1) constr(T2) constr(T3) constr(T4)
               constr(T5) :=
              -   T1 T2 T3 T4 T5; auto_tilde.
              +  T1 T2 T3 T4 T5; auto_tilde.
              Tactic Notation "exists" "¬" constr(T1) constr(T2) constr(T3) constr(T4)
               constr(T5) constr(T6) :=
              -   T1 T2 T3 T4 T5 T6; auto_tilde.
              +  T1 T2 T3 T4 T5 T6; auto_tilde.

              +Tactic Notation "exists" "¬" constr(T1) "," constr(T2) :=
              +  T1 T2; auto_tilde.
              +Tactic Notation "exists" "¬" constr(T1) "," constr(T2) "," constr(T3) :=
              +  T1 T2 T3; auto_tilde.
              +Tactic Notation "exists" "¬" constr(T1) "," constr(T2) "," constr(T3) ","
              constr(T4) :=
              +  T1 T2 T3 T4; auto_tilde.
              +Tactic Notation "exists" "¬" constr(T1) "," constr(T2) "," constr(T3) ","
              constr(T4) "," constr(T5) :=
              +  T1 T2 T3 T4 T5; auto_tilde.
              +Tactic Notation "exists" "¬" constr(T1) "," constr(T2) "," constr(T3) ","
              constr(T4) "," constr(T5) "," constr(T6) :=
              +  T1 T2 T3 T4 T5 T6; auto_tilde.

              @@ -5182,19 +5195,32 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "exists___" "*" :=
                exists___; auto_star.
              Tactic Notation "exists" "*" constr(T1) :=
              -   T1; auto_star.
              +  T1; auto_star.
              Tactic Notation "exists" "*" constr(T1) constr(T2) :=
              -   T1 T2; auto_star.
              +  T1 T2; auto_star.
              Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) :=
              -   T1 T2 T3; auto_star.
              +  T1 T2 T3; auto_star.
              Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4) :=
              -   T1 T2 T3 T4; auto_star.
              +  T1 T2 T3 T4; auto_star.
              Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4)
               constr(T5) :=
              -   T1 T2 T3 T4 T5; auto_star.
              +  T1 T2 T3 T4 T5; auto_star.
              Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4)
               constr(T5) constr(T6) :=
              -   T1 T2 T3 T4 T5 T6; auto_star.
              +  T1 T2 T3 T4 T5 T6; auto_star.

              +Tactic Notation "exists" "*" constr(T1) "," constr(T2) :=
              +  T1 T2; auto_star.
              +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) :=
              +  T1 T2 T3; auto_star.
              +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) ","
              +  constr(T4) :=
              +  T1 T2 T3 T4; auto_star.
              +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) ","
              constr(T4) "," constr(T5) :=
              +  T1 T2 T3 T4 T5; auto_star.
              +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) ","
              constr(T4) "," constr(T5) "," constr(T6) :=
              +  T1 T2 T3 T4 T5 T6; auto_star.

              @@ -5217,13 +5243,13 @@

              LibTacticsA Collection of Handy Gene Definition ltac_something (P:Type) (e:P) := e.

              Notation "'Something'" :=
                (@ltac_something _ _).

              -Lemma ltac_something_eq : (e:Type),
              +Lemma ltac_something_eq : (e:Type),
                e = (@ltac_something _ e).
              Proof using. auto. Qed.

              -Lemma ltac_something_hide : (e:Type),
              +Lemma ltac_something_hide : (e:Type),
                e → (@ltac_something _ e).
              Proof using. auto. Qed.

              -Lemma ltac_something_show : (e:Type),
              +Lemma ltac_something_show : (e:Type),
                (@ltac_something _ e) → e.
              Proof using. auto. Qed.

              @@ -5264,14 +5290,14 @@

              LibTacticsA Collection of Handy Gene
              Tactic Notation "hide_defs" :=
              -  repeat match goal with H := ?T |- _
              +  repeat match goal with H := ?T_
                  match T with
                  | @ltac_something _ _fail 1
                  | _change T with (@ltac_something _ T) in H
                  end
                end.

              Tactic Notation "show_defs" :=
              -  repeat match goal with H := (@ltac_something _ ?T) |- _
              +  repeat match goal with H := (@ltac_something _ ?T) ⊢ _
                  change (@ltac_something _ T) with T in H end.
              @@ -5296,9 +5322,9 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "show_hyps" :=
                repeat match goal with
              -    H: @ltac_something _ _ |- _show_hyp H end.

              +    H: @ltac_something _ __show_hyp H end.

              Tactic Notation "hide_hyps" :=
              -  repeat match goal with H: ?T |- _
              +  repeat match goal with H: ?T_
                  match type of T with
                  | Prop
                    match T with
              @@ -5372,7 +5398,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac sort_tactic :=
              -  try match goal with H: ?T |- _
              +  try match goal with H: ?T_
                match type of T with Prop
                  generalizes H; (try sort_tactic); intro
                end end.

              @@ -5394,7 +5420,7 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "clears" ident(X1) :=
                let rec doit _ :=
                match goal with
              -  | H:context[X1] |- _clear H; try (doit tt)
              +  | H:context[X1] ⊢ _clear H; try (doit tt)
                | _clear X1
                end in doit tt.
              Tactic Notation "clears" ident(X1) ident(X2) :=
              @@ -5420,7 +5446,7 @@

              LibTacticsA Collection of Handy Gene
                (* --TODO: rename to clears_var ? *)

              Ltac clears_tactic :=
              -  match goal with H: ?T |- _
              +  match goal with H: ?T_
                match type of T with
                | Propgeneralizes H; (try clears_tactic); intro
                | ?TTclear H; (try clears_tactic)
              @@ -5438,7 +5464,7 @@

              LibTacticsA Collection of Handy Gene
              Ltac clears_or_generalizes_all_core :=
              -  repeat match goal with H: _ |- _
              +  repeat match goal with H: __
                         first [ clear H | generalizes H] end.

              Tactic Notation "clears_all" :=
                generalize ltac_mark;
              @@ -5470,7 +5496,7 @@

              LibTacticsA Collection of Handy Gene Tactic Notation "clears_but" ident(H1) ident(H2) ident(H3) ident(H4) ident(H5) :=
                clears_but_core ltac:(fun _gen H1 H2 H3 H4 H5).

              Lemma demo_clears_all_and_clears_but :
              -   x y:nat, y < 2 → x = xx ≥ 2 → x < 3 → True.
              +  x y:nat, y < 2 → x = xx ≥ 2 → x < 3 → True.
              Proof using.
                introv M1 M2 M3. dup 6.
                (* clears_all clears all hypotheses. *)
              @@ -5491,7 +5517,7 @@

              LibTacticsA Collection of Handy Gene
              Tactic Notation "clears_last" :=
              -  match goal with H: ?T |- _clear H end.

              +  match goal with H: ?T_clear H end.

              Ltac clears_last_base N :=
                match number_to_nat N with
                | 0 ⇒ idtac
              @@ -5513,191 +5539,98 @@

              LibTacticsA Collection of Handy Gene

              Skipping Subgoals

              -
              - - DEPRECATED: the new "admit" tactics now works fine. - -
              - - The skip tactic can be used at any time to admit the current - goal. Using skip is much more efficient than using the Focus - top-level command to reach a particular subgoal. - -
              - - There are two possible implementations of skip. The first one - relies on the use of an existential variable. The second one - relies on an axiom of type False. Remark that the builtin tactic - admit is not applicable if the current goal contains uninstantiated - variables. - -
              - - The advantage of the first technique is that a proof using skip - must end with Admitted, since Qed will be rejected with the message - "uninstantiated existential variables". It is thereafter clear - that the development is incomplete. - -
              - - The advantage of the second technique is exactly the converse: one - may conclude the proof using Qed, and thus one saves the pain from - renaming Qed into Admitted and vice-versa all the time. - Note however, that it is still necessary to instantiate all the existential - variables introduced by other tactics in order for Qed to be accepted. - -
              - - The two implementation are provided, so that you can select the one that - suits you best. By default skip' uses the first implementation, and - skip uses the second implementation. -
              -
              +
              -Ltac skip_with_existential :=
              -  match goal with |- ?G
              -    let H := fresh "TEMP" in evar(H:G); eexact H end.

              -(* TO BE DEPRECATED: *)
              -Parameter skip_axiom : False.
              -  (* To obtain a safe development, change to skip_axiom : True *)
              -Ltac skip_with_axiom :=
              -  elimtype False; apply skip_axiom.

              +
              +(* SF DOES NOT NEED an alternative implementation of the skip tactic *)

              Tactic Notation "skip" :=
              -  skip_with_axiom.
              -Tactic Notation "skip'" :=
              -  skip_with_existential.

              -(* SF DOES NOT NEED THIS
              -(* For backward compatibility *)
              -Tactic Notation "admit" :=
              -  skip.
              -*)

              +  admit.
              demo is like admit but it documents the fact that admit is intended
              + Tactic Notation "demo" :=
                skip.
              -skip H: T adds an assumption named H of type T to the +admits H: T adds an assumption named H of type T to the current context, blindly assuming that it is true. - skip: T and skip H_asserts: T and skip_asserts: T - are other possible syntax. - Note that H may be an intro pattern. - The syntax skip H1 .. HN: T can be used when T is a - conjunction of N items. + admit: T is another possible syntax. + Note that H may be an intro pattern.
              -Tactic Notation "skip" simple_intropattern(I) ":" constr(T) :=
              +Tactic Notation "admits" simple_intropattern(I) ":" constr(T) :=
                asserts I: T; [ skip | ].
              -Tactic Notation "skip" ":" constr(T) :=
              -  let H := fresh "TEMP" in skip H: T.
              -Tactic Notation "skip" "¬" ":" constr(T) :=
              -  skip: T; auto_tilde.
              -Tactic Notation "skip" "*" ":" constr(T) :=
              -  skip: T; auto_star.

              -Tactic Notation "skip" simple_intropattern(I1)
              simple_intropattern(I2) ":" constr(T) :=
              -  skip [I1 I2]: T.
              -Tactic Notation "skip" simple_intropattern(I1)
              simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) :=
              -  skip [I1 [I2 I3]]: T.
              -Tactic Notation "skip" simple_intropattern(I1)
              simple_intropattern(I2) simple_intropattern(I3)
              simple_intropattern(I4) ":" constr(T) :=
              -  skip [I1 [I2 [I3 I4]]]: T.
              -Tactic Notation "skip" simple_intropattern(I1)
              simple_intropattern(I2) simple_intropattern(I3)
              simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) :=
              -  skip [I1 [I2 [I3 [I4 I5]]]]: T.
              -Tactic Notation "skip" simple_intropattern(I1)
              simple_intropattern(I2) simple_intropattern(I3)
              simple_intropattern(I4) simple_intropattern(I5)
              simple_intropattern(I6) ":" constr(T) :=
              -  skip [I1 [I2 [I3 [I4 [I5 I6]]]]]: T.

              -Tactic Notation "skip_asserts" simple_intropattern(I) ":" constr(T) :=
              -  skip I: T.
              -Tactic Notation "skip_asserts" ":" constr(T) :=
              -  skip: T.
              +Tactic Notation "admits" ":" constr(T) :=
              +  let H := fresh "TEMP" in admits H: T.
              +Tactic Notation "admits" "¬" ":" constr(T) :=
              +  admits: T; auto_tilde.
              +Tactic Notation "admits" "*" ":" constr(T) :=
              +  admits: T; auto_star.
              -skip_cuts T simply replaces the current goal with T. +admit_cuts T simply replaces the current goal with T.
              -Tactic Notation "skip_cuts" constr(T) :=
              +Tactic Notation "admit_cuts" constr(T) :=
                cuts: T; [ skip | ].
              -skip_goal H applies to any goal. It simply assumes +admit_goal H applies to any goal. It simply assumes the current goal to be true. The assumption is named "H". It is useful to set up proof by induction or coinduction. - Syntax skip_goal is also accepted. + Syntax admit_goal is also accepted.
              -Tactic Notation "skip_goal" ident(H) :=
              -  match goal with |- ?Gskip H: G end.

              -Tactic Notation "skip_goal" :=
              -  let IH := fresh "IH" in skip_goal IH.
              +Tactic Notation "admit_goal" ident(H) :=
              +  match goal with ⊢ ?Gadmits H: G end.

              +Tactic Notation "admit_goal" :=
              +  let IH := fresh "IH" in admit_goal IH.
              -skip_rewrite T can be applied when T is an equality. +admit_rewrite T can be applied when T is an equality. It blindly assumes this equality to be true, and rewrite it in the goal.
              -Tactic Notation "skip_rewrite" constr(T) :=
              -  let M := fresh "TEMP" in skip_asserts M: T; rewrite M; clear M.
              +Tactic Notation "admit_rewrite" constr(T) :=
              +  let M := fresh "TEMP" in admits M: T; rewrite M; clear M.
              -skip_rewrite T in H is similar as rewrite_skip, except that +admit_rewrite T in H is similar as admit_rewrite, except that it rewrites in hypothesis H.
              -Tactic Notation "skip_rewrite" constr(T) "in" hyp(H) :=
              -  let M := fresh "TEMP" in skip_asserts M: T; rewrite M in H; clear M.
              +Tactic Notation "admit_rewrite" constr(T) "in" hyp(H) :=
              +  let M := fresh "TEMP" in admits M: T; rewrite M in H; clear M.
              -skip_rewrites_all T is similar as rewrite_skip, except that +admit_rewrites_all T is similar as admit_rewrite, except that it rewrites everywhere (goal and all hypotheses).
              -Tactic Notation "skip_rewrite_all" constr(T) :=
              -  let M := fresh "TEMP" in skip_asserts M: T; rewrite_all M; clear M.
              +Tactic Notation "admit_rewrite_all" constr(T) :=
              +  let M := fresh "TEMP" in admits M: T; rewrite_all M; clear M.
              -skip_induction E applies to any goal. It simply assumes - the current goal to be true (the assumption is named "IH" by - default), and call destruct E instead of induction E. - It is useful to try and set up a proof by induction - first, and fix the applications of the induction hypotheses - during a second pass on the Proof using. -
              -
              -(* --TODO: deprecated *)

              -Tactic Notation "skip_induction" constr(E) :=
              -  let IH := fresh "IH" in skip_goal IH; destruct E.

              -Tactic Notation "skip_induction" constr(E) "as" simple_intropattern(I) :=
              -  let IH := fresh "IH" in skip_goal IH; destruct E as I.
              -
              - -
              -forwards_nounfold_skip_sides_then E ltac:(fun K ..) +forwards_nounfold_admit_sides_then E ltac:(fun K ..) is like forwards: E but it provides the resulting term to a continuation, under the name K, and it admits any side-condition produced by the instantiation of E, @@ -5706,7 +5639,7 @@

              LibTacticsA Collection of Handy Gene
              Inductive ltac_goal_to_discard := ltac_goal_to_discard_intro.

              -Ltac forwards_nounfold_skip_sides_then S cont :=
              +Ltac forwards_nounfold_admit_sides_then S cont :=
                let MARK := fresh "TEMP" in
                generalize ltac_goal_to_discard_intro;
                intro MARK;
              @@ -5714,7 +5647,7 @@

              LibTacticsA Collection of Handy Gene     clear MARK;
                  cont K);
                match goal with
              -  | MARK: ltac_goal_to_discard |- _skip
              +  | MARK: ltac_goal_to_discard_skip
                | _idtac
                end.

              (* ********************************************************************** *)
              @@ -5739,9 +5672,9 @@

              LibTacticsA Collection of Handy Gene   Tactic Notation "subst" "*" :=
                  subst; auto_star.
              End LibTacticsCompatibility.

              -Open Scope nat_scope.
              +Open Scope nat_scope.

              +(* Sat Jan 26 15:15:46 UTC 2019 *)

              -

              diff --git a/plf-current/LibTactics.v b/plf-current/LibTactics.v index 2f11820b..2d5fa35d 100644 --- a/plf-current/LibTactics.v +++ b/plf-current/LibTactics.v @@ -74,7 +74,6 @@ Ltac idcont tt := Inductive Boxer : Type := | boxer : forall (A:Type), A -> Boxer. - (* ================================================================= *) (** ** Optional Arguments for Tactics *) @@ -88,7 +87,6 @@ Inductive Boxer : Type := Inductive ltac_No_arg : Set := | ltac_no_arg : ltac_No_arg. - (* ================================================================= *) (** ** Wildcard Arguments for Tactics *) @@ -111,7 +109,6 @@ Notation "'___'" := ltac_wilds : ltac_scope. Open Scope ltac_scope. - (* ================================================================= *) (** ** Position Markers *) @@ -156,7 +153,6 @@ Ltac intro_until_mark := | _ => intro; intro_until_mark end. - (* ================================================================= *) (** ** List of Arguments for Tactics *) @@ -250,7 +246,6 @@ Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13" := v12 at level 0, v13 at level 0) : ltac_scope. - (** The tactic [list_boxer_of] inputs a term [E] and returns a term of type "list boxer", according to the following rules: - if [E] is already of type "list Boxer", then it returns [E]; @@ -262,7 +257,6 @@ Ltac list_boxer_of E := | _ => constr:((boxer E)::nil) end. - (* ================================================================= *) (** ** Databases of Lemmas *) @@ -356,7 +350,6 @@ Ltac rm_inside E := Ltac fast_rm_inside E := rm_inside E. - (* ================================================================= *) (** ** Numbers as Arguments *) @@ -461,7 +454,6 @@ Tactic Notation "dup" constr(N) := Tactic Notation "dup" := dup 2. - (* ================================================================= *) (** ** Testing evars and non-evars *) @@ -480,7 +472,6 @@ Ltac is_evar_as_bool E := [ is_evar E; exact true | exact false ])). - (* ================================================================= *) (** ** Check No Evar in Goal *) @@ -505,7 +496,6 @@ Ltac with_evar_base T cont := Tactic Notation "with_evar" constr(T) tactic(cont) := with_evar_base T cont. - (* ================================================================= *) (** ** Tagging of Hypotheses *) @@ -517,7 +507,6 @@ Tactic Notation "with_evar" constr(T) tactic(cont) := Ltac get_last_hyp tt := match goal with H: _ |- _ => constr:(H) end. - (* ================================================================= *) (** ** More Tagging of Hypotheses *) @@ -540,7 +529,6 @@ Ltac mark_to_generalize H := let T := type of H in change T with (ltac_to_generalize T) in H. - (* ================================================================= *) (** ** Deconstructing Terms *) @@ -582,7 +570,6 @@ Ltac get_fun_arg E := | ?X1 ?X => constr:((X1,X)) end. - (* ================================================================= *) (** ** Action at Occurence and Action Not at Occurence *) @@ -628,7 +615,6 @@ Hint Unfold eq'. Notation "x '='' y" := (@eq' _ x y) (at level 70, y at next level). - (* ################################################################# *) (** * Common Tactics for Simplifying Goals Like [intuition] *) @@ -653,7 +639,6 @@ Ltac jauto_set := unfold not in *. - (* ################################################################# *) (** * Backward and Forward Chaining *) @@ -831,7 +816,6 @@ Tactic Notation "cuts" simple_intropattern(I1) simple_intropattern(I6) ":" constr(T) := cuts [I1 [I2 [I3 [I4 [I5 I6]]]]]: T. - (* ================================================================= *) (** ** Instantiation and Forward-Chaining *) @@ -960,7 +944,6 @@ Ltac build_app_hnts t vs final := end in go t vs. - (** newer version : support for typeclasses *) Ltac app_typeclass t cont := @@ -1045,7 +1028,6 @@ Ltac build_app_hnts t vs final ::= go t vs. (* --TODO: use local function for first [...] *) - (*--old version Ltac build_app_hnts t vs final := let rec go t vs := @@ -1089,7 +1071,6 @@ Ltac build_app_hnts t vs final := go t vs. *) - Ltac build_app args final := first [ match args with (@boxer ?T ?t)::?vs => @@ -1197,7 +1178,6 @@ Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" const constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := lets [I1 I2]: E0 A1 A2 A3 A4 A5. - (** [forwards H: (>> E0 E1 .. EN)] is short for [forwards H: (>> E0 E1 .. EN ___)]. The arguments [Ei] can be wildcards [__] (except [E0]). @@ -1448,7 +1428,6 @@ Tactic Notation "puts" ident(X) ":" constr(E) := Tactic Notation "puts" ":" constr(E) := let X := fresh "X" in pose (X := E). - (* ================================================================= *) (** ** Application of Tautologies *) @@ -1463,7 +1442,6 @@ Ltac logic_base E cont := Tactic Notation "logic" constr(E) := logic_base E ltac:(fun _ => tauto). - (* ================================================================= *) (** ** Application Modulo Equalities *) @@ -1574,7 +1552,6 @@ Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) constr(n3) := Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) := applys_eq H (>> n1 n2 n3 n4). - (* ================================================================= *) (** ** Absurd Goals *) @@ -1673,7 +1650,6 @@ Ltac false_neq_self_hyp := false_goal; apply H; reflexivity end. - (* ################################################################# *) (** * Introduction and Generalization *) @@ -1789,7 +1765,6 @@ Tactic Notation "intros_all" := Tactic Notation "intro_hnf" := intro; match goal with H: _ |- _ => hnf in H end. - (* ================================================================= *) (** ** Introduction using [=>] and [=>>] *) @@ -1899,7 +1874,6 @@ Tactic Notation "=>>" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I9) simple_intropattern(I10) := =>>; intros I1 I2 I3 I4 I5 I6 I7 I8 I9 I10. - (* ---------------------------------------------------------------------- *) (* ================================================================= *) (** ** Generalization *) @@ -1949,7 +1923,6 @@ Tactic Notation "generalizes" hyp(X1) hyp(X2) hyp(X3) := Tactic Notation "generalizes" hyp(X1) hyp(X2) hyp(X3) hyp(X4) := generalizes X1 X2 X3; generalizes X4. - (* ================================================================= *) (** ** Naming *) @@ -2087,7 +2060,6 @@ Tactic Notation "sets_eq_let" ident(X) := Tactic Notation "sets_eq_let" ident(X) "in" hyp(H) := sets_let_in_base H ltac:(fun E => sets_eq X: E). - (* ################################################################# *) (** * Rewriting *) @@ -2203,7 +2175,6 @@ Tactic Notation "rewrites" "<-" constr(E) "at" constr(K) "in" hyp(H) := match type of E with ?T1 = ?T2 => ltac_action_at K of T2 in H do (rewrites <- E in H) end. - (** ** Replace *) (** [replaces E with F] is the same as [replace E with F] except that @@ -2219,7 +2190,6 @@ Tactic Notation "replaces" constr(E) "with" constr(F) := Tactic Notation "replaces" constr(E) "with" constr(F) "in" hyp(H) := let T := fresh "TEMP" in assert (T: E = F); [ | replace E with F in H; clear T ]. - (** [replaces E at K with F] replaces the [K]-th occurence of [E] with [F] in the current goal. Syntax [replaces E at K with F in H] is also available. *) @@ -2230,7 +2200,6 @@ Tactic Notation "replaces" constr(E) "at" constr(K) "with" constr(F) := Tactic Notation "replaces" constr(E) "at" constr(K) "with" constr(F) "in" hyp(H) := let T := fresh "TEMP" in assert (T: E = F); [ | rewrites T at K in H; clear T ]. - (** ** Change *) (** [changes] is like [change] except that it does not silently @@ -2249,7 +2218,6 @@ Tactic Notation "changes" constr(E1) "with" constr(E2) "in" "*" := asserts_rewrite (E1 = E2) in *; [ reflexivity | ]. - (* ================================================================= *) (** ** Renaming *) @@ -2278,7 +2246,6 @@ Tactic Notation "renames" ident(X1) "to" ident(Y1) "," ident(X6) "to" ident(Y6) := renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4, X5 to Y5, X6 to Y6. - (* ================================================================= *) (** ** Unfolding *) @@ -2369,7 +2336,6 @@ Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3) "," constr(H4) "," constr(H5) := folds H1; folds H2; folds H3; folds H4; folds H5. - (* ================================================================= *) (** ** Simplification *) @@ -2419,7 +2385,6 @@ Tactic Notation "unsimpls" constr(E) := Notation "'nosimpl' t" := (match tt with tt => t end) (at level 10). - (* ================================================================= *) (** ** Reduction *) @@ -2509,7 +2474,6 @@ Ltac subst_eq_base E := Tactic Notation "subst_eq" constr(E) := subst_eq_base E. - (* ================================================================= *) (** ** Tactics to Work with Proof Irrelevance *) @@ -2530,7 +2494,6 @@ Tactic Notation "pi_rewrite" constr(E) := Tactic Notation "pi_rewrite" constr(E) "in" hyp(H) := pi_rewrite_base E ltac:(fun X => rewrite X in H). - (* ================================================================= *) (** ** Proving Equalities *) @@ -2571,7 +2534,6 @@ Tactic Notation "fequals_rec" := repeat (progress fequals). - (* ################################################################# *) (** * Inversion *) @@ -2620,7 +2582,6 @@ Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := invert_tactic H (fun H => invert keep H as I1 I2 I3). - (* ================================================================= *) (** ** Inversion with Substitution *) @@ -2633,7 +2594,7 @@ Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1) Axiom inj_pair2 : (* is in fact derivable from the axioms in LibAxiom.v *) forall (U : Type) (P : U -> Type) (p : U) (x y : P p), existT P p x = existT P p y -> x = y. -(* Proof using. apply Eqdep.EqdepTheory.inj_pair2. Qed.*) +(* Proof using. apply Eqdep.EqdepTheory.inj_pair2. Qed. *) Ltac inverts_tactic H i1 i2 i3 i4 i5 i6 := let rec go i1 i2 i3 i4 i5 i6 := @@ -2761,7 +2722,6 @@ Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) simple_intropattern(I8) := inverts H as; introv I1 I2 I3 I4 I5 I6 I7 I8. - (** [lets_inverts E as I1 .. IN] is intuitively equivalent to [inverts E], with the difference that it applies to any expression and not just to the name of an hypothesis. *) @@ -2784,7 +2744,6 @@ Tactic Notation "lets_inverts" constr(E) "as" simple_intropattern(I1) lets_inverts_base E ltac:(fun H => inverts H as I1 I2 I3 I4). - (* ================================================================= *) (** ** Injection with Substitution *) @@ -2831,7 +2790,6 @@ Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) := injection H; intros X1 X2 X3 X4 X5. - (* ================================================================= *) (** ** Inversion and Injection with Substitution --rough implementation *) @@ -2877,7 +2835,6 @@ Tactic Notation "injections" "keep" hyp(H) := Tactic Notation "injections" "keep" hyp(H) := injection H; clear H; intros; subst. - (* ================================================================= *) (** ** Case Analysis *) @@ -2942,7 +2899,6 @@ Tactic Notation "case_if" := Tactic Notation "case_if" "in" hyp(H) := let Eq := fresh "C" in case_if in H as Eq. - (** [cases_if] is similar to [case_if] with two main differences: if it creates an equality of the form [x = y] and then substitutes it in the goal *) @@ -3016,7 +2972,6 @@ Tactic Notation "destruct_if" := Tactic Notation "destruct_if" "in" hyp(H) := let Eq := fresh "C" in destruct_if in H as Eq Eq. - (** ---BROKEN since v8.5beta2. TODO: cleanup. [destruct_head_match] performs a case analysis on the argument @@ -3049,7 +3004,6 @@ Tactic Notation "destruct_head_match" "as" simple_intropattern(I) := Tactic Notation "destruct_head_match" := destruct_head_match_core ltac:(fun E => destruct E). - (**--provided for compatibility with [remember] *) (** [cases' E] is similar to [case_eq E] except that it generates the @@ -3084,7 +3038,6 @@ Tactic Notation "cases_if'" "as" simple_intropattern(Eq) := Tactic Notation "cases_if'" := let Eq := fresh "C" in cases_if' as Eq. - (* ################################################################# *) (** * Induction *) @@ -3092,7 +3045,7 @@ Tactic Notation "cases_if'" := [inductions E gen X1 .. XN] is a shorthand for [dependent induction E generalizing X1 .. XN]. *) -Require Import Coq.Program.Equality. +From Coq Require Import Program.Equality. Ltac inductions_post := unfold eq' in *. @@ -3183,8 +3136,8 @@ Tactic Notation "induction_wf" ":" constr(E) ident(X) := judgment that includes a counter for the maximal height (see LibTacticsDemos for an example) *) -Require Import Coq.Arith.Compare_dec. -Require Import Coq.omega.Omega. +From Coq Require Import Arith.Compare_dec. +From Coq Require Import omega.Omega. Lemma induct_height_max2 : forall n1 n2 : nat, exists n, n1 < n /\ n2 < n. @@ -3206,7 +3159,6 @@ Ltac induct_height_step x := Ltac induct_height := induct_height_step O. - (* ################################################################# *) (** * Coinduction *) @@ -3237,7 +3189,6 @@ Tactic Notation "abstracts" tactic(tac) := clear_coind; tac. - (* ################################################################# *) (** * Decidable Equality *) @@ -3250,7 +3201,6 @@ Ltac decides_equality_tactic := Tactic Notation "decides_equality" := decides_equality_tactic. - (* ################################################################# *) (** * Equivalence *) @@ -3277,7 +3227,6 @@ Tactic Notation "iff" "<-" simple_intropattern(H) := Tactic Notation "iff" "<-" := let H := fresh "H" in iff <- H. - (* ################################################################# *) (** * N-ary Conjunctions and Disjunctions *) @@ -3368,7 +3317,6 @@ Tactic Notation "destructs" constr(N) constr(T) := let N := number_to_nat N in destructs_conjunction_tactic N T. - (** Proving goals which are N-ary disjunctions *) (** Underlying implementation of [branch]. *) @@ -3432,7 +3380,6 @@ Tactic Notation "branch" constr(K) "of" constr(N) := let K := number_to_nat K in branch_tactic K N. - (** N-ary Disjunction Deconstruction *) (** Underlying implementation of [branches]. *) @@ -3468,8 +3415,9 @@ Tactic Notation "branches" constr(N) constr(T) := Tactic Notation "branches" := match goal with h: _ \/ _ |- _ => branches h end. -(* ---------------------------------------------------------------------- *) -(** N-ary Existentials *) +(* ---------------------------------------------------------------------- + + N-ary Existentials *) (* Underlying implementation of [exists]. *) @@ -3600,7 +3548,6 @@ Tactic Notation "unpack" := Tactic Notation "unpack" constr(H) := unpack_hypothesis H. - (* ################################################################# *) (** * Tactics to Prove Typeclass Instances *) @@ -3617,11 +3564,9 @@ Tactic Notation "typeclass" := Tactic Notation "solve_typeclass" := solve [ eauto with typeclass_instances ]. - (* ################################################################# *) (** * Tactics to Invoke Automation *) - (* ================================================================= *) (** ** Definitions for Parsing Compatibility *) @@ -3640,7 +3585,6 @@ Tactic Notation "right" := Tactic Notation "left" := left. - (* ================================================================= *) (** ** [hint] to Add Hints Local to a Lemma *) @@ -3656,7 +3600,6 @@ Tactic Notation "hint" constr(E1) "," constr(E2) "," constr(E3) := Tactic Notation "hint" constr(E1) "," constr(E2) "," constr(E3) "," constr(E4) := hint E1; hint E2; hint(E3); hint(E4 ). - (* ================================================================= *) (** ** [jauto], a New Automation Tactic *) @@ -3678,7 +3621,6 @@ Tactic Notation "jauto_fast" := Tactic Notation "iauto" := try solve [intuition eauto]. - (* ================================================================= *) (** ** Definitions of Automation Tactics *) @@ -3699,11 +3641,11 @@ Ltac auto_tilde := auto_tilde_default. Ltac auto_star_default := try solve [ jauto ]. Ltac auto_star := auto_star_default. - (** [autos~] is a notation for tactic [auto_tilde]. It may be followed by lemmas (or proofs terms) which auto will be able to use - for solving the goal. *) -(** [autos] is an alias for [autos~] *) + for solving the goal. + + [autos] is an alias for [autos~] *) Tactic Notation "autos" := auto_tilde. @@ -3748,7 +3690,6 @@ Tactic Notation "auto_false" "*" := Tactic Notation "dauto" := dintuition eauto. - (* ================================================================= *) (** ** Parsing for Light Automation *) @@ -4130,6 +4071,19 @@ Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) constr(T6) := exists T1 T2 T3 T4 T5 T6; auto_tilde. +Tactic Notation "exists" "~" constr(T1) "," constr(T2) := + exists T1 T2; auto_tilde. +Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) := + exists T1 T2 T3; auto_tilde. +Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," + constr(T4) := + exists T1 T2 T3 T4; auto_tilde. +Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," + constr(T4) "," constr(T5) := + exists T1 T2 T3 T4 T5; auto_tilde. +Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," + constr(T4) "," constr(T5) "," constr(T6) := + exists T1 T2 T3 T4 T5 T6; auto_tilde. (* ================================================================= *) (** ** Parsing for Strong Automation *) @@ -4311,7 +4265,6 @@ Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) := specializes H A1 A2 A3 A4 A5; auto_star. - Tactic Notation "fapply" "*" constr(E) := fapply E; auto_star. Tactic Notation "sapply" "*" constr(E) := @@ -4464,7 +4417,6 @@ Tactic Notation "cases_if'" "*" "as" ident(H) := Tactic Notation "cases_if'" "*" := cases_if'; auto_star. - Tactic Notation "decides_equality" "*" := decides_equality; auto_star. @@ -4511,7 +4463,19 @@ Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4) constr(T5) constr(T6) := exists T1 T2 T3 T4 T5 T6; auto_star. - +Tactic Notation "exists" "*" constr(T1) "," constr(T2) := + exists T1 T2; auto_star. +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) := + exists T1 T2 T3; auto_star. +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) "," + constr(T4) := + exists T1 T2 T3 T4; auto_star. +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) "," + constr(T4) "," constr(T5) := + exists T1 T2 T3 T4 T5; auto_star. +Tactic Notation "exists" "*" constr(T1) "," constr(T2) "," constr(T3) "," + constr(T4) "," constr(T5) "," constr(T6) := + exists T1 T2 T3 T4 T5 T6; auto_star. (* ################################################################# *) (** * Tactics to Sort Out the Proof Context *) @@ -4575,7 +4539,6 @@ Tactic Notation "show_defs" := repeat match goal with H := (@ltac_something _ ?T) |- _ => change (@ltac_something _ T) with T in H end. - (** [hide_hyp H] replaces the type of [H] with the notation [Something] and [show_hyp H] reveals the type of the hypothesis. Note that the hidden type of [H] remains convertible the real type of [H]. *) @@ -4664,7 +4627,6 @@ Ltac sort_tactic := Tactic Notation "sort" := sort_tactic. - (* ================================================================= *) (** ** Clearing Hypotheses *) @@ -4772,158 +4734,72 @@ Ltac clears_last_base N := Tactic Notation "clears_last" constr(N) := clears_last_base N. - (* ################################################################# *) (** * Tactics for Development Purposes *) (* ================================================================= *) (** ** Skipping Subgoals *) -(** DEPRECATED: the new "admit" tactics now works fine. - - The [skip] tactic can be used at any time to admit the current - goal. Using [skip] is much more efficient than using the [Focus] - top-level command to reach a particular subgoal. - - There are two possible implementations of [skip]. The first one - relies on the use of an existential variable. The second one - relies on an axiom of type [False]. Remark that the builtin tactic - [admit] is not applicable if the current goal contains uninstantiated - variables. - - The advantage of the first technique is that a proof using [skip] - must end with [Admitted], since [Qed] will be rejected with the message - "[uninstantiated existential variables]". It is thereafter clear - that the development is incomplete. - - The advantage of the second technique is exactly the converse: one - may conclude the proof using [Qed], and thus one saves the pain from - renaming [Qed] into [Admitted] and vice-versa all the time. - Note however, that it is still necessary to instantiate all the existential - variables introduced by other tactics in order for [Qed] to be accepted. - - The two implementation are provided, so that you can select the one that - suits you best. By default [skip'] uses the first implementation, and - [skip] uses the second implementation. -*) - -Ltac skip_with_existential := - match goal with |- ?G => - let H := fresh "TEMP" in evar(H:G); eexact H end. - -(* TO BE DEPRECATED: *) -Parameter skip_axiom : False. - (* To obtain a safe development, change to [skip_axiom : True] *) -Ltac skip_with_axiom := - elimtype False; apply skip_axiom. +(* SF DOES NOT NEED an alternative implementation of the [skip] tactic *) Tactic Notation "skip" := - skip_with_axiom. -Tactic Notation "skip'" := - skip_with_existential. - -(* SF DOES NOT NEED THIS -(* For backward compatibility *) -Tactic Notation "admit" := - skip. -*) + admit. (** [demo] is like [admit] but it documents the fact that admit is intended *) + Tactic Notation "demo" := skip. -(** [skip H: T] adds an assumption named [H] of type [T] to the +(** [admits H: T] adds an assumption named [H] of type [T] to the current context, blindly assuming that it is true. - [skip: T] and [skip H_asserts: T] and [skip_asserts: T] - are other possible syntax. - Note that H may be an intro pattern. - The syntax [skip H1 .. HN: T] can be used when [T] is a - conjunction of [N] items. *) + [admit: T] is another possible syntax. + Note that H may be an intro pattern. *) -Tactic Notation "skip" simple_intropattern(I) ":" constr(T) := +Tactic Notation "admits" simple_intropattern(I) ":" constr(T) := asserts I: T; [ skip | ]. -Tactic Notation "skip" ":" constr(T) := - let H := fresh "TEMP" in skip H: T. -Tactic Notation "skip" "~" ":" constr(T) := - skip: T; auto_tilde. -Tactic Notation "skip" "*" ":" constr(T) := - skip: T; auto_star. - -Tactic Notation "skip" simple_intropattern(I1) - simple_intropattern(I2) ":" constr(T) := - skip [I1 I2]: T. -Tactic Notation "skip" simple_intropattern(I1) - simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) := - skip [I1 [I2 I3]]: T. -Tactic Notation "skip" simple_intropattern(I1) - simple_intropattern(I2) simple_intropattern(I3) - simple_intropattern(I4) ":" constr(T) := - skip [I1 [I2 [I3 I4]]]: T. -Tactic Notation "skip" simple_intropattern(I1) - simple_intropattern(I2) simple_intropattern(I3) - simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) := - skip [I1 [I2 [I3 [I4 I5]]]]: T. -Tactic Notation "skip" simple_intropattern(I1) - simple_intropattern(I2) simple_intropattern(I3) - simple_intropattern(I4) simple_intropattern(I5) - simple_intropattern(I6) ":" constr(T) := - skip [I1 [I2 [I3 [I4 [I5 I6]]]]]: T. +Tactic Notation "admits" ":" constr(T) := + let H := fresh "TEMP" in admits H: T. +Tactic Notation "admits" "~" ":" constr(T) := + admits: T; auto_tilde. +Tactic Notation "admits" "*" ":" constr(T) := + admits: T; auto_star. -Tactic Notation "skip_asserts" simple_intropattern(I) ":" constr(T) := - skip I: T. -Tactic Notation "skip_asserts" ":" constr(T) := - skip: T. +(** [admit_cuts T] simply replaces the current goal with [T]. *) -(** [skip_cuts T] simply replaces the current goal with [T]. *) - -Tactic Notation "skip_cuts" constr(T) := +Tactic Notation "admit_cuts" constr(T) := cuts: T; [ skip | ]. -(** [skip_goal H] applies to any goal. It simply assumes +(** [admit_goal H] applies to any goal. It simply assumes the current goal to be true. The assumption is named "H". It is useful to set up proof by induction or coinduction. - Syntax [skip_goal] is also accepted.*) + Syntax [admit_goal] is also accepted.*) -Tactic Notation "skip_goal" ident(H) := - match goal with |- ?G => skip H: G end. +Tactic Notation "admit_goal" ident(H) := + match goal with |- ?G => admits H: G end. -Tactic Notation "skip_goal" := - let IH := fresh "IH" in skip_goal IH. +Tactic Notation "admit_goal" := + let IH := fresh "IH" in admit_goal IH. -(** [skip_rewrite T] can be applied when [T] is an equality. +(** [admit_rewrite T] can be applied when [T] is an equality. It blindly assumes this equality to be true, and rewrite it in the goal. *) -Tactic Notation "skip_rewrite" constr(T) := - let M := fresh "TEMP" in skip_asserts M: T; rewrite M; clear M. +Tactic Notation "admit_rewrite" constr(T) := + let M := fresh "TEMP" in admits M: T; rewrite M; clear M. -(** [skip_rewrite T in H] is similar as [rewrite_skip], except that +(** [admit_rewrite T in H] is similar as [admit_rewrite], except that it rewrites in hypothesis [H]. *) -Tactic Notation "skip_rewrite" constr(T) "in" hyp(H) := - let M := fresh "TEMP" in skip_asserts M: T; rewrite M in H; clear M. +Tactic Notation "admit_rewrite" constr(T) "in" hyp(H) := + let M := fresh "TEMP" in admits M: T; rewrite M in H; clear M. -(** [skip_rewrites_all T] is similar as [rewrite_skip], except that +(** [admit_rewrites_all T] is similar as [admit_rewrite], except that it rewrites everywhere (goal and all hypotheses). *) -Tactic Notation "skip_rewrite_all" constr(T) := - let M := fresh "TEMP" in skip_asserts M: T; rewrite_all M; clear M. - -(** [skip_induction E] applies to any goal. It simply assumes - the current goal to be true (the assumption is named "IH" by - default), and call [destruct E] instead of [induction E]. - It is useful to try and set up a proof by induction - first, and fix the applications of the induction hypotheses - during a second pass on the Proof using. *) -(* --TODO: deprecated *) - -Tactic Notation "skip_induction" constr(E) := - let IH := fresh "IH" in skip_goal IH; destruct E. +Tactic Notation "admit_rewrite_all" constr(T) := + let M := fresh "TEMP" in admits M: T; rewrite_all M; clear M. -Tactic Notation "skip_induction" constr(E) "as" simple_intropattern(I) := - let IH := fresh "IH" in skip_goal IH; destruct E as I. - -(** [forwards_nounfold_skip_sides_then E ltac:(fun K => ..)] +(** [forwards_nounfold_admit_sides_then E ltac:(fun K => ..)] is like [forwards: E] but it provides the resulting term to a continuation, under the name [K], and it admits any side-condition produced by the instantiation of [E], @@ -4931,7 +4807,7 @@ Tactic Notation "skip_induction" constr(E) "as" simple_intropattern(I) := Inductive ltac_goal_to_discard := ltac_goal_to_discard_intro. -Ltac forwards_nounfold_skip_sides_then S cont := +Ltac forwards_nounfold_admit_sides_then S cont := let MARK := fresh "TEMP" in generalize ltac_goal_to_discard_intro; intro MARK; @@ -4944,7 +4820,6 @@ Ltac forwards_nounfold_skip_sides_then S cont := end. - (* ********************************************************************** *) (* ################################################################# *) (** * Compatibility with standard library *) @@ -4964,4 +4839,5 @@ End LibTacticsCompatibility. Open Scope nat_scope. -(** $Date$ *) + +(* Sat Jan 26 15:15:46 UTC 2019 *) diff --git a/plf-current/LibTacticsTest.v b/plf-current/LibTacticsTest.v index 9e4a4fbf..f26f31e3 100644 --- a/plf-current/LibTacticsTest.v +++ b/plf-current/LibTacticsTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:40 UTC 2019 *) diff --git a/plf-current/Makefile b/plf-current/Makefile index c5fec41c..0d5a7dcd 100644 --- a/plf-current/Makefile +++ b/plf-current/Makefile @@ -797,4 +797,3 @@ debug: .PHONY: debug .DEFAULT_GOAL := all -include .depend diff --git a/plf-current/Maps.v b/plf-current/Maps.v index 23ab3229..e7bc610b 100644 --- a/plf-current/Maps.v +++ b/plf-current/Maps.v @@ -20,11 +20,11 @@ 因为我们一直小心地将自己的定义和定理的命名与标准库中的部分保持一致, 无论它们在哪里重复。 *) -Require Import Coq.Arith.Arith. -Require Import Coq.Bool.Bool. +From Coq Require Import Arith.Arith. +From Coq Require Import Bool.Bool. Require Export Coq.Strings.String. -Require Import Coq.Logic.FunctionalExtensionality. -Require Import Coq.Lists.List. +From Coq Require Import Logic.FunctionalExtensionality. +From Coq Require Import Lists.List. Import ListNotations. (** 标准库的文档见 @@ -35,16 +35,14 @@ Import ListNotations. (* ################################################################# *) (** * 标识符 *) -(** First, we need a type for the keys that we use to index into our - maps. In [Lists.v] we introduced a fresh type [id] for this - purpose; for the rest of _Software Foundations_ we will use the - [string] type from Coq's standard library. *) +(** 首先我们需要键的类型来对映射进行索引。在 [Lists.v] 中, + 我们为类似的目的引入了 [id] 类型。而在_'《软件基础》'_后面的部分, + 我们会使用 Coq 标准库中的 [string] 类型。 *) -(** To compare strings, we define the function [eqb_string], which - internally uses the function [string_dec] from Coq's string - library. *) +(** 为了比较字符串,我们定义了 [eqb_string] 函数,它在内部使用 Coq + 字符串库中的 [string_dec] 函数。 *) -Definition eqb_string x y := +Definition eqb_string (x y : string) : bool := if string_dec x y then true else false. (** (函数 [string_dec] 来自于 Coq 的字符串标准库。如果你查看 @@ -55,18 +53,17 @@ Definition eqb_string x y := 与一个标签一起来指出具体是哪一个。不过就目前来说,你可以把它当做一个 花哨的 [bool]。) *) -(** Now we need a few basic properties of string equality... *) -Theorem eqb_string_refl : forall s, true = eqb_string s s. +(** 现在我们需要一些关于字符串相等性的基本性质... *) +Theorem eqb_string_refl : forall s : string, true = eqb_string s s. Proof. intros s. unfold eqb_string. destruct (string_dec s s) as [|Hs]. - reflexivity. - destruct Hs. reflexivity. Qed. -(** The following useful property follows from an analogous - lemma about strings: *) +(** 以下有用的性质可由类似的字符串引理推出: *) Theorem eqb_string_true_iff : forall x y : string, - eqb_string x y = true <-> x = y. + eqb_string x y = true <-> x = y. Proof. intros x y. unfold eqb_string. @@ -80,13 +77,12 @@ Qed. (** 类似地: *) Theorem eqb_string_false_iff : forall x y : string, - eqb_string x y = false - <-> x <> y. + eqb_string x y = false <-> x <> y. Proof. intros x y. rewrite <- eqb_string_true_iff. rewrite not_true_iff_false. reflexivity. Qed. -(** This handy variant follows just by rewriting: *) +(** 以下方便使用的变体只需通过改写就能得出: *) Theorem false_eqb_string : forall x y : string, x <> y -> eqb_string x y = false. @@ -108,7 +104,7 @@ Proof. (** 我们会分两步构建偏映射。首先,我们定义一个_'全映射'_类型, 它在某个映射中查找不存在的键时会返回默认值。 *) -Definition total_map (A:Type) := string -> A. +Definition total_map (A : Type) := string -> A. (** 直观上来说,一个元素类型为 [A] 的全映射不过就是个根据 [string] 来查找 [A] 的函数。 *) @@ -116,14 +112,14 @@ Definition total_map (A:Type) := string -> A. (** 给定函数 [t_empty] 一个默认元素,它会产生一个空的全映射。 此映射在应用到任何字符串时都会返回默认元素。 *) -Definition t_empty {A:Type} (v : A) : total_map A := +Definition t_empty {A : Type} (v : A) : total_map A := (fun _ => v). (** 更有趣的是 [update] 函数,它和之前一样,接受一个映射 [m]、一个键 [x] 以及一个值 [v],并返回一个将 [x] 映射到 [v] 的新映射;其它键则与 [m] 中原来的保持一致。 *) -Definition t_update {A:Type} (m : total_map A) +Definition t_update {A : Type} (m : total_map A) (x : string) (v : A) := fun x' => if eqb_string x x' then v else m x'. @@ -140,30 +136,22 @@ Definition examplemap := (** 接下来,我们引入一些新的记法来方便映射的使用。 *) (** 首先,我们会使用以下记法,根据一个默认值来创建空的全映射。 *) -Notation "{ --> d }" := (t_empty d) (at level 0). +Notation "'_' '!->' v" := (t_empty v) + (at level 100, right associativity). -(** 然后,我们引入一种方便的记法,通过一些绑定来扩展现有的映射。 *) +Example example_empty := (_ !-> false). -(** (这种记法的定义有点丑,因为 Coq 的记法机制不太适应递归记法, - 这是我们能做到最好的了。) *) - -Notation "m '&' { a --> x }" := - (t_update m a x) (at level 20). -Notation "m '&' { a --> x ; b --> y }" := - (t_update (m & { a --> x }) b y) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z }" := - (t_update (m & { a --> x ; b --> y }) c z) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t }" := - (t_update (m & { a --> x ; b --> y ; c --> z }) d t) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" := - (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 20). -Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" := - (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 20). +(** 然后,我们引入一种方便的记法,通过一些绑定来扩展现有的映射。 *) +Notation "x '!->' v ';' m" := (t_update m x v) + (at level 100, v at next level, right associativity). (** 前面的 [examplemap] 现在可以定义如下: *) Definition examplemap' := - { --> false } & { "foo" --> true ; "bar" --> true }. + ( "bar" !-> true; + "foo" !-> true; + _ !-> false + ). (** 到这里就完成了全映射的定义。注意我们无需定义 [find] 操作, 因为它不过就是个函数应用! *) @@ -186,45 +174,49 @@ Proof. reflexivity. Qed. (** (其中有些证明需要函数的外延性公理,我们在[Logic]一节中讨论过它)。 *) -(** **** 练习:1 星, optional (t_apply_empty) *) -(** 首先,空映射对于所有的键都会返回默认元素(即,空映射总是返回默认元素): *) +(** **** 练习:1 星, standard, optional (t_apply_empty) -Lemma t_apply_empty: forall (A:Type) (x: string) (v: A), { --> v } x = v. + 首先,空映射对于所有的键都会返回默认元素(即,空映射总是返回默认元素): *) + +Lemma t_apply_empty : forall (A : Type) (x : string) (v : A), + (_ !-> v) x = v. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_eq) *) -(** 接着,如果将映射 [m] 的键 [x] 关联的值更新为 [v],然后在 [update] +(** **** 练习:2 星, standard, optional (t_update_eq) + + 接着,如果将映射 [m] 的键 [x] 关联的值更新为 [v],然后在 [update] 产生的新映射中查找 [x],就会得到 [v](即,更新某个键的映射, 查找它就会得到更新后的值): *) -Lemma t_update_eq : forall A (m: total_map A) x v, - (m & {x --> v}) x = v. +Lemma t_update_eq : forall (A : Type) (m : total_map A) x v, + (x !-> v ; m) x = v. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_neq) *) -(** 此外,如果将映射 [m] 的键 [x1] 更新后在返回的结果中查找_'另一个'_键 +(** **** 练习:2 星, standard, optional (t_update_neq) + + 此外,如果将映射 [m] 的键 [x1] 更新后在返回的结果中查找_'另一个'_键 [x2],那么得到的结果与在 [m] 中查找它的结果相同 (即,更新某个键的映射,不影响其它键的映射): *) -Theorem t_update_neq : forall (X:Type) v x1 x2 - (m : total_map X), - x1 <> x2 -> - (m & {x1 --> v}) x2 = m x2. +Theorem t_update_neq : forall (A : Type) (m : total_map A) x1 x2 v, + x1 <> x2 -> + (x1 !-> v ; m) x2 = m x2. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_shadow) *) -(** 如果将映射 [m] 的键 [x] 关联的值更新为 [v1] 后,又将同一个键 [x] +(** **** 练习:2 星, standard, optional (t_update_shadow) + + 如果将映射 [m] 的键 [x] 关联的值更新为 [v1] 后,又将同一个键 [x] 更新为另一个值 [v2],那么产生的映射与仅将第二次 [update] 应用于 [m] 所得到的映射表现一致(即二者应用到同一键时产生的结果相同): *) -Lemma t_update_shadow : forall A (m: total_map A) v1 v2 x, - m & {x --> v1 ; x --> v2} = m & {x --> v2}. +Lemma t_update_shadow : forall (A : Type) (m : total_map A) x v1 v2, + (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -233,39 +225,44 @@ Proof. (Reflection idioms)来证明会十分方便。我们首先通过证明基本的_'互映引理'_, 将 [id] 上的相等关系命题与布尔函数 [eqb_id] 关联起来。*) -(** **** 练习:2 星, optional (eqb_stringP) *) -(** 请仿照[IndProp]一章中对 [eqb_natP] 的证明来证明以下引理: *) +(** **** 练习:2 星, standard, optional (eqb_stringP) + + 请仿照[IndProp]一章中对 [eqb_natP] 的证明来证明以下引理: *) -Lemma eqb_stringP : forall x y, reflect (x = y) (eqb_string x y). +Lemma eqb_stringP : forall x y : string, + reflect (x = y) (eqb_string x y). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 现在,给定 [string] 类型的字符串 [x1] 和 [x2],我们可以在使用 +(** 现在,给定 [string] 类型的字符串 [x1] 和 [x2],我们可以在使用策略 [destruct (eqb_stringP x1 x2)] 对 [eqb_string x1 x2] 的结果进行分类讨论的同时,生成关于 [x1] 和 [x2] (在 [=] 的意义上) 的相等关系前提。 *) -(** **** 练习:2 星 (t_update_same) *) -(** 请仿照[IndProp]一章中的示例,用 [eqb_stringP] 来证明以下定理, +(** **** 练习:2 星, standard (t_update_same) + + 请仿照[IndProp]一章中的示例,用 [eqb_stringP] 来证明以下定理, 它陈述了:如果我们用映射 [m] 中已经与键 [x] 相关联的值更新了 [x], 那么其结果与 [m] 相等: *) -Theorem t_update_same : forall X x (m : total_map X), - m & { x --> m x } = m. - Proof. +Theorem t_update_same : forall (A : Type) (m : total_map A) x, + (x !-> m x ; m) = m. +Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, recommended (t_update_permute) *) -(** 使用 [eqb_stringP] 来证明最后一个 [update] 函数的性质: +(** **** 练习:3 星, standard, recommended (t_update_permute) + + 使用 [eqb_stringP] 来证明最后一个 [update] 函数的性质: 如果我们更新了映射 [m] 中两个不同的键,那么更新的顺序无关紧要。 *) -Theorem t_update_permute : forall (X:Type) v1 v2 x1 x2 - (m : total_map X), - x2 <> x1 -> - m & { x2 --> v2 ; x1 --> v1 } - = m & { x1 --> v1 ; x2 --> v2 }. +Theorem t_update_permute : forall (A : Type) (m : total_map A) + v1 v2 x1 x2, + x2 <> x1 -> + (x1 !-> v1 ; x2 !-> v2 ; m) + = + (x2 !-> v2 ; x1 !-> v1 ; m). Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -276,77 +273,72 @@ Proof. (** 最后,我们在全映射之上定义_'偏映射'_。元素类型为 [A] 的偏映射不过就是个 元素类型为 [option A],默认元素为 [None] 的全映射。 *) -Definition partial_map (A:Type) := total_map (option A). +Definition partial_map (A : Type) := total_map (option A). -Definition empty {A:Type} : partial_map A := +Definition empty {A : Type} : partial_map A := t_empty None. -Definition update {A:Type} (m : partial_map A) +Definition update {A : Type} (m : partial_map A) (x : string) (v : A) := - m & { x --> (Some v) }. - -(** 我们用双花括号为偏映射引入类似的记法。 **) - -Notation "m '&' {{ a --> x }}" := - (update m a x) (at level 20). -Notation "m '&' {{ a --> x ; b --> y }}" := - (update (m & {{ a --> x }}) b y) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z }}" := - (update (m & {{ a --> x ; b --> y }}) c z) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t }}" := - (update (m & {{ a --> x ; b --> y ; c --> z }}) d t) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}" := - (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t }}) e u) (at level 20). -Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }}" := - (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}) f v) (at level 20). + (x !-> Some v ; m). + +(** 我们为偏映射引入类似的记法。 **) +Notation "x '|->' v ';' m" := (update m x v) + (at level 100, v at next level, right associativity). + +(** 当最后一种情况为空时,我们也可以隐藏它。 *) +Notation "x '|->' v" := (update empty x v) + (at level 100). + +Example examplepmap := + ("Church" |-> true ; "Turing" |-> false). (** 现在我们将所有关于全映射的基本引理直接转换成对应的偏映射引理。 *) -Lemma apply_empty : forall (A: Type) (x: string), @empty A x = None. +Lemma apply_empty : forall (A : Type) (x : string), + @empty A x = None. Proof. intros. unfold empty. rewrite t_apply_empty. reflexivity. Qed. -Lemma update_eq : forall A (m: partial_map A) x v, - (m & {{ x --> v }}) x = Some v. +Lemma update_eq : forall (A : Type) (m : partial_map A) x v, + (x |-> v ; m) x = Some v. Proof. intros. unfold update. rewrite t_update_eq. reflexivity. Qed. -Theorem update_neq : forall (X:Type) v x1 x2 - (m : partial_map X), - x2 <> x1 -> - (m & {{ x2 --> v }}) x1 = m x1. +Theorem update_neq : forall (A : Type) (m : partial_map A) x1 x2 v, + x2 <> x1 -> + (x2 |-> v ; m) x1 = m x1. Proof. - intros X v x1 x2 m H. + intros A m x1 x2 v H. unfold update. rewrite t_update_neq. reflexivity. apply H. Qed. -Lemma update_shadow : forall A (m: partial_map A) v1 v2 x, - m & {{ x --> v1 ; x --> v2 }} = m & {{x --> v2}}. +Lemma update_shadow : forall (A : Type) (m : partial_map A) x v1 v2, + (x |-> v2 ; x |-> v1 ; m) = (x |-> v2 ; m). Proof. - intros A m v1 v2 x1. unfold update. rewrite t_update_shadow. + intros A m x v1 v2. unfold update. rewrite t_update_shadow. reflexivity. Qed. -Theorem update_same : forall X v x (m : partial_map X), - m x = Some v -> - m & {{x --> v}} = m. +Theorem update_same : forall (A : Type) (m : partial_map A) x v, + m x = Some v -> + (x |-> v ; m) = m. Proof. - intros X v x m H. unfold update. rewrite <- H. + intros A m x v H. unfold update. rewrite <- H. apply t_update_same. Qed. -Theorem update_permute : forall (X:Type) v1 v2 x1 x2 - (m : partial_map X), - x2 <> x1 -> - m & {{x2 --> v2 ; x1 --> v1}} - = m & {{x1 --> v1 ; x2 --> v2}}. +Theorem update_permute : forall (A : Type) (m : partial_map A) + x1 x2 v1 v2, + x2 <> x1 -> + (x1 |-> v1 ; x2 |-> v2 ; m) = (x2 |-> v2 ; x1 |-> v1 ; m). Proof. - intros X v1 v2 x1 x2 m. unfold update. + intros A m x1 x2 v1 v2. unfold update. apply t_update_permute. Qed. - +(* Sat Jan 26 15:15:42 UTC 2019 *) diff --git a/plf-current/MapsTest.v b/plf-current/MapsTest.v index 435bd3e2..59c1ecfe 100644 --- a/plf-current/MapsTest.v +++ b/plf-current/MapsTest.v @@ -38,7 +38,7 @@ idtac " ". idtac "#> t_update_same". idtac "Possible points: 2". check_type @t_update_same ( -(forall (X : Type) (x : string) (m : total_map X), m & {x --> m x} = m)). +(forall (A : Type) (m : total_map A) (x : string), (x !-> m x; m) = m)). idtac "Assumptions:". Abort. Print Assumptions t_update_same. @@ -51,8 +51,8 @@ idtac " ". idtac "#> t_update_permute". idtac "Possible points: 3". check_type @t_update_permute ( -(forall (X : Type) (v1 v2 : X) (x1 x2 : string) (m : total_map X), - x2 <> x1 -> m & {x2 --> v2; x1 --> v1} = m & {x1 --> v1; x2 --> v2})). +(forall (A : Type) (m : total_map A) (v1 v2 : A) (x1 x2 : string), + x2 <> x1 -> (x1 !-> v1; x2 !-> v2; m) = (x2 !-> v2; x1 !-> v1; m))). idtac "Assumptions:". Abort. Print Assumptions t_update_permute. @@ -74,3 +74,5 @@ Print Assumptions t_update_permute. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:48 UTC 2019 *) diff --git a/plf-current/MoreStlc.html b/plf-current/MoreStlc.html index edbda008..0357c6b6 100644 --- a/plf-current/MoreStlc.html +++ b/plf-current/MoreStlc.html @@ -39,10 +39,11 @@

              MoreStlc扩展简单类型 Lambda- From PLF Require Import Types.
              From PLF Require Import Smallstep.
              From PLF Require Import Stlc.
              +From Coq Require Import Strings.String.

              -

              STLC 的简单扩展

              +

              STLC 的简单扩展

              @@ -54,7 +55,7 @@

              MoreStlc扩展简单类型 Lambda- 在类型层面上是简单和直接的。
              -

              数值

              +

              数值

              @@ -64,13 +65,13 @@

              MoreStlc扩展简单类型 Lambda- 添加机器整数或浮点数这些类型同样直接,当然语言中数值的规格也会更加精确。
              -

              Let 绑定

              +

              Let 绑定

              当写一个复杂的表达式时,为一些子表达式命名常常可以避免重复计算和提高可读性。 多数语言都提供了多种这样的机制。比如,在 OCaml(以及 Coq)中,我们可以写 let - x=t1 in t2,意思是说“首先归约 t1 到一个值,并绑定到 x 上,同时继续对 t2 + x=t1 in t2,意思是说“首先归约 t1 到一个值,并绑定到 x 上,同时继续对 t2 归约。”
              @@ -102,7 +103,7 @@

              MoreStlc扩展简单类型 Lambda- 归约规则:

              ->> P'->> P'
              Q' ->> QQ' ->> Q (hoare_consequence)  
              - + @@ -110,7 +111,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Let1)  

              let x=t1 in t2 ==> let x=t1' in t2let x=t1 in t2 --> let x=t1' in t2
              @@ -123,13 +124,13 @@

              MoreStlc扩展简单类型 Lambda-

              - +

              let x=v1 in t2 ==> [x:=v1]t2let x=v1 in t2 --> [x:=v1]t2
              定型规则:
              - + @@ -137,13 +138,13 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T1      Gamma & {{x-->T1}} |- t2 : T2Gamma ⊢ t1 ∈ T1      x>T1; Gamma ⊢ t2 ∈ T2 (T_Let)  

              Gamma |- let x=t1 in t2 : T2Gamma ⊢ let x=t1 in t2 ∈ T2
              -

              二元组

              +

              二元组

              @@ -177,18 +178,18 @@

              MoreStlc扩展简单类型 Lambda- 语法:
                      t ::=                项
              +           | ...
                          | (t,t)             二元组
                          | t.fst             第一个元素
                          | t.snd             第二个元素
              -           | ...
               
                      v ::=                值
              -           | (v,v)             二元组值
                          | ...
              +           | (v,v)             二元组值
               
                      T ::=                类型
              -           | T * T             积类型
                          | ...
              +           | T * T             积类型
               
              @@ -198,7 +199,7 @@

              MoreStlc扩展简单类型 Lambda-
              - + @@ -206,12 +207,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Pair1)  

              (t1,t2) ==> (t1',t2)(t1,t2--> (t1',t2)
              - + @@ -219,12 +220,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t2 ==> t2't2 --> t2' (ST_Pair2)  

              (v1,t2) ==> (v1,t2')(v1,t2--> (v1,t2')
              - + @@ -232,7 +233,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Fst1)  

              t1.fst ==> t1'.fstt1.fst --> t1'.fst
              @@ -245,12 +246,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +

              (v1,v2).fst ==> v1(v1,v2).fst --> v1
              - + @@ -258,7 +259,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Snd1)  

              t1.snd ==> t1'.sndt1.snd --> t1'.snd
              @@ -271,7 +272,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +

              (v1,v2).snd ==> v2(v1,v2).snd --> v2
              @@ -293,7 +294,7 @@

              MoreStlc扩展简单类型 Lambda-
              - + @@ -301,12 +302,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T1       Gamma |- t2 : T2Gamma ⊢ t1 ∈ T1     Gamma ⊢ t2 ∈ T2 (T_Pair)  

              Gamma |- (t1,t2) : T1*T2Gamma ⊢ (t1,t2) ∈ T1*T2
              - + @@ -314,12 +315,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T11*T12Gamma ⊢ t ∈ T1*T2 (T_Fst)  

              Gamma |- t1.fst : T11Gamma ⊢ t.fst ∈ T1
              - + @@ -327,7 +328,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T11*T12Gamma ⊢ t ∈ T1*T2 (T_Snd)  

              Gamma |- t1.snd : T12Gamma ⊢ t.snd ∈ T2
              @@ -335,32 +336,32 @@

              MoreStlc扩展简单类型 Lambda- T_Pair 是说如果 t1 有类型 T1t2 有类型 T2, 那么 (t1,t2) 有类型 T1*T2 。相反,T_FstT_Snd 告诉我们, - 如果 t1 为积类型 T11*T12(即,如果 t1 会归约为一个二元组), - 那么二元组的投影的类型为 T11T12。 + 如果 t1 为积类型 T1*T2(即,如果 t1 会归约为一个二元组), + 那么二元组的投影的类型为 T1T2
              -

              单元素类型

              +

              单元素类型

              另一个在 ML 语言家族中经常出现的基础类型是只含有一个元素的类型(singleton type),即 Unit。 它只含有一个常量项 unit(以小写 u 开头),以及一个类型规则使 unit 成为 - Unit 的一个元素。我们同时添加 unit 到可作为值的项的集合中,确实,unit + Unit 的一个元素。我们同时添加 unit 到可作为值的项的集合中,确实,unitUnit 类型的表达式唯一可能的归约结果。
              语法:
                      t ::=                Terms
              -           | unit              unit value
              -           | ...
              +           | ...               (other terms same as before)
              +           | unit              unit
               
                      v ::=                Values
              -           | unit              unit
                          | ...
              +           | unit              unit value
               
                      T ::=                Types
              -           | Unit              Unit type
                          | ...
              +           | Unit              unit type
               
              定型规则:
              @@ -373,14 +374,14 @@

              MoreStlc扩展简单类型 Lambda-

              - +

              Gamma |- unit : UnitGamma ⊢ unit ∈ Unit
              看起来似乎有些奇怪,我们为什么要定义只含有一个元素的类型呢? - 毕竟,难道不是每个计算都不会在这样的类型中居留吗? + 毕竟,难道不是每个计算都不会在这样的类型中居留吗?
              @@ -390,12 +391,12 @@

              MoreStlc扩展简单类型 Lambda- 在这样的语言中,Unit 类型为仅有副作用的表达式提供了一个方便的类型。
              -

              和类型

              +

              和类型

              - 一些程序需要处理具有两种不同形式的值。比如说,在会计应用中我们想要根据名字 - 识别号码来搜索某个雇员。这个搜索函数可以返回匹配到的值,返回一个错误代码。 + 一些程序需要处理具有两种不同形式的值。比如说,在一个大学数据库中中我们想要根据名字 + 识别号码来搜索某个学生。这个搜索函数可以返回匹配到的值,返回一个错误代码。
              @@ -409,28 +410,28 @@

              MoreStlc扩展简单类型 Lambda- 我们在创建这些类型的值时,会为值标记(tagging)上其成分类型。 比如说,如果 n 是自然数,那么 inl nNat+Bool 的一个元素; - 类似地,如果 b 的类型为 Bool,那么 inr bNat+Bool + 类似地,如果 b 的类型为 Bool,那么 inr bNat+Bool 的一个元素。 如果把标签 inlinr 看作函数,其类型解释了他们的名字:
              -       inl : Nat -> Nat + Bool
              -       inr : Bool -> Nat + Bool
              +       inl ∈ Nat  -> Nat + Bool
              +       inr ∈ Bool -> Nat + Bool
               
              - 这两个函数分别将 NatBool 的元素“注入”进和类型 Nat+Bool + 这两个函数分别将 NatBool 的元素“注入”进和类型 Nat+Bool 的左成分或右成分中。(但其实我们不必将其作为函数形式化:inlinr 是关键字,而且 inl tinr t 是基本的语法形式,而非函数应用。)
              - 一般来说,被 inl 标记的 T1 的元素加上被 inr + 一般来说,被 inl 标记的 T1 的元素加上被 inr 标记的 T2 的元素一同构成了 T1 + T2 的元素。
              - 和类型的一个重要用途是传递错误: + 我们之前在 Coq 编程中见过,和类型的一个重要用途是传递错误:
              -      div : Nat -> Nat -> (Nat + Unit) =
              +      div ∈ Nat -> Nat -> (Nat + Unit)
                     div =
                       \x:Nat. \y:Nat.
              -          if iszero y then
              +          test iszero y then
                           inr unit
                         else
                           inl ...
              @@ -439,16 +440,17 @@ 

              MoreStlc扩展简单类型 Lambda- 类型是同构的——也即,我们很容易写出他们的转换函数。
              - 为了使用和类型和元素,我们引入 case 语句(Coq 中 match + 为了使用和类型和元素,我们引入 case 语句(Coq 中 match 的非常简化版)用于解构他们。比如说,下面的程序将 Nat+Bool 的值转为了 Nat
              +    getNat ∈ Nat+Bool -> Nat
                   getNat =
                     \x:Nat+Bool.
                       case x of
                         inl n => n
              -        | inr b => if b then 1 else 0
              +        | inr b => test b then 1 else 0
               
              更加形式化地讲……
              @@ -456,21 +458,21 @@

              MoreStlc扩展简单类型 Lambda- 语法:
                      t ::=                项
              +           | ...               (和前面一样的其它项)
                          | inl T t           左标记
                          | inr T t           右标记
                          | case t of         模式匹配
                              inl x => t
                            | inr x => t
              -           | ...
               
                      v ::=                值
              +           | ...
                          | inl T v           标记过的值(左)
                          | inr T v           标记过的值(右)
              -           | ...
               
                      T ::=                类型
              -           | T + T             和类型
                          | ...
              +           | T + T             和类型
               
              @@ -481,7 +483,7 @@

              MoreStlc扩展简单类型 Lambda-
              - + @@ -489,12 +491,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Inl)  

              inl T t1 ==> inl T t1'inl T2 t1 --> inl T2 t1'
              - + @@ -502,12 +504,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't2 --> t2' (ST_Inr)  

              inr T t1 ==> inr T t1'inr T1 t2 --> inr T1 t2'
              - + @@ -515,7 +517,7 @@

              MoreStlc扩展简单类型 Lambda-

              - + @@ -532,11 +534,11 @@

              MoreStlc扩展简单类型 Lambda-

              - + - +
              t0 ==> t0't0 --> t0' (ST_Case)  

              case t0 of inl x1 ⇒ t1 | inr x2 ⇒ t2 ==>case t0 of inl x1 ⇒ t1 | inr x2 ⇒ t2 -->

              case (inl T v0) of inl x1 ⇒ t1 | inr x2 ⇒ t2case (inl T2 v1) of inl x1 ⇒ t1 | inr x2 ⇒ t2
              ==>  [x1:=v0]t1-->  [x1:=v1]t1
              @@ -549,11 +551,11 @@

              MoreStlc扩展简单类型 Lambda-

              - + - +

              case (inr T v0) of inl x1 ⇒ t1 | inr x2 ⇒ t2case (inr T1 v2) of inl x1 ⇒ t1 | inr x2 ⇒ t2
              ==>  [x2:=v0]t2-->  [x2:=v1]t2
              @@ -562,7 +564,7 @@

              MoreStlc扩展简单类型 Lambda- 定型规则:
              - + @@ -570,12 +572,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 :  T1Gamma ⊢ t1 ∈ T1 (T_Inl)  

              Gamma |- inl T2 t1 : T1 + T2Gamma ⊢ inl T2 t1 ∈ T1 + T2
              - + @@ -583,20 +585,20 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T2Gamma ⊢ t2 ∈ T2 (T_Inr)  

              Gamma |- inr T1 t1 : T1 + T2Gamma ⊢ inr T1 t2 ∈ T1 + T2
              - + - + - + @@ -604,16 +606,16 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t0 : T1+T2Gamma ⊢ t ∈ T1+T2
              Gamma , x1:T1 |- t1 : Tx1>T1; Gamma ⊢ t1 ∈ T
              Gamma , x2:T2 |- t2 : Tx2>T2; Gamma ⊢ t2 ∈ T (T_Case)  

              Gamma |- case t0 of inl x1 ⇒ t1 | inr x2 ⇒ t2 : TGamma ⊢ case t of inl x1 ⇒ t1 | inr x2 ⇒ t2 ∈ T
              为了让类型关系简单一点,在 inlinr 规则中我们使用了类型注释,我们在处理 函数的类型时也是这么做的。
              - 如果没有这额外的类型信息,一旦我们确定了 t1 为类型 T1,类型规则 + 如果没有这额外的类型信息,一旦我们确定了 t1 为类型 T1,类型规则 T_Inl 则必须有能力为 inl t1 推导出类型 T1 + T2,而其中 T2 - 可为任意类型。比如说,我们可以同时推导出 inl 5 : Nat + Nat 和 + 可为任意类型。比如说,我们可以同时推导出 inl 5 : Nat + Natinl 5 : Nat + Bool(以及无数个这样的类型)。这一特性(技术上说, 是类型唯一性的丧失)意味着我们无法像之前处理其他特性那样仅仅通过“自底向上地 阅读类型规则”来构造出类型检查的算法。 @@ -625,7 +627,7 @@

              MoreStlc扩展简单类型 Lambda- 现实语言采用了其他方法),但这种方法易于理解和形式化。
              -

              列表

              +

              列表

              @@ -649,9 +651,9 @@

              MoreStlc扩展简单类型 Lambda- 例如,下面的函数计算了一个数值列表的前两个元素之和:
                     \x:List Nat.
              -      lcase x of nil => 0
              -         | a::x' => lcase x' of nil => a
              -                       | b::x'' => a+b
              +      lcase x of nil   => 0
              +               | a::x' => lcase x' of nil    => a
              +                                    | b::x'' => a+b
               
              @@ -659,19 +661,20 @@

              MoreStlc扩展简单类型 Lambda- 语法:
                      t ::=                项
              +           | ...
                          | nil T
                          | cons t t
              -           | lcase t of nil => t | x::x => t
              -           | ...
              +           | lcase t of nil  => t
              +                      | x::x => t
               
                      v ::=                值
              +           | ...
                          | nil T             nil 值
                          | cons v v          cons 值
              -           | ...
               
                      T ::=                类型
              -           | List T            T 类型列表
                          | ...
              +           | List T            T 类型列表
               
              @@ -679,7 +682,7 @@

              MoreStlc扩展简单类型 Lambda- 归约规则:
              - + @@ -687,12 +690,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Cons1)  

              cons t1 t2 ==> cons t1' t2cons t1 t2 --> cons t1' t2
              - + @@ -700,12 +703,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t2 ==> t2't2 --> t2' (ST_Cons2)  

              cons v1 t2 ==> cons v1 t2'cons v1 t2 --> cons v1 t2'
              - + @@ -713,7 +716,7 @@

              MoreStlc扩展简单类型 Lambda-

              - + @@ -734,7 +737,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Lcase1)  

              (lcase t1 of nil ⇒ t2 | xh::xt ⇒ t3) ==>(lcase t1 of nil ⇒ t2 | xh::xt ⇒ t3-->
              ==> t2--> t2
              @@ -751,7 +754,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              ==> [xh:=vh,xt:=vt]t3--> [xh:=vh,xt:=vt]t3
              @@ -768,12 +771,12 @@

              MoreStlc扩展简单类型 Lambda-
              - Gamma |- nil T : List T + Gamma ⊢ nil T ∈ List T
              - + @@ -781,20 +784,20 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T      Gamma |- t2 : List TGamma ⊢ t1 ∈ T      Gamma ⊢ t2 ∈ List T (T_Cons)  

              Gamma |- cons t1 t2: List TGamma ⊢ cons t1 t2 ∈ List T
              - + - + - + @@ -802,13 +805,13 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : List T1Gamma ⊢ t1 ∈ List T1
              Gamma |- t2 : TGamma ⊢ t2 ∈ T
              Gamma , h:T1, t:List T1 |- t3 : T(h>T1; t>List T1; Gamma) ⊢ t3 ∈ T (T_Lcase)  

              Gamma |- (lcase t1 of nil ⇒ t2 | h::t ⇒ t3) : TGamma ⊢ (lcase t1 of nil ⇒ t2 | h::t ⇒ t3) ∈ T
              -

              一般递归

              +

              一般递归

              @@ -816,18 +819,18 @@

              MoreStlc扩展简单类型 Lambda- 如下方式定义阶乘函数:
                     fact = \x:Nat.
              -                if x=0 then 1 else x * (fact (pred x)))
              +                test x=0 then 1 else x * (fact (pred x)))
               
              请注意绑定的右侧使用了绑定左侧的变量名——这在我们之前的 let 中是不被允许的。
              - 直接形式化这种“递归定义”机制是可行的,但也需要一点额外的努力:特别是,在 step + 直接形式化这种“递归定义”机制是可行的,但也需要一些额外的努力:特别是,在 step 关系中,我们需要给递归函数的定义传递一个“环境”。
              - 还有另外一种一样强大(但可能对程序员没那么方便)的方式来形式化递归函数, - 这种方式更加直接:我们不直接写递归的定义,而是定义一个叫做 fix + 还有另外一种有点啰嗦但一样强大的方式来形式化递归函数, + 这种方式更加直接:我们不直接写递归的定义,而是定义一个叫做 fix不动点算子(fixed-point operator),它会在归约时“展开”定义右侧表达式中 出现的递归定义。 @@ -836,15 +839,15 @@

              MoreStlc扩展简单类型 Lambda- 比如说,以下程序
                     fact = \x:Nat.
              -                if x=0 then 1 else x * (fact (pred x)))
              +                test x=0 then 1 else x * (fact (pred x)))
               
              可以改写为:
                     fact =
                         fix
              -            (\f:Nat->Nat.
              +            (\f:Nat->Nat.
                              \x:Nat.
              -                  if x=0 then 1 else x * (f (pred x)))
              +                  test x=0 then 1 else x * (f (pred x)))
               
              我们可用如下方式把前者转换为后者: @@ -888,7 +891,7 @@

              MoreStlc扩展简单类型 Lambda-
              (“不动点”在这里的含义与数学上的不动点是完全相同的,也即函数 f 的一个不动点 - 是对于输入 xf(x) = x。这里,类型为 (NatNat)->(NatNat) + 是对于输入 xf(x) = x。这里,类型为 (NatNat)->(NatNat) 的函数 F 的一个不动点是类型为 NatNat 的函数 f,使得 F ff 的行为完全相同。)
              @@ -896,13 +899,13 @@

              MoreStlc扩展简单类型 Lambda- 语法:
                      t ::=                项
              -           | fix t             不动点算子
                          | ...
              +           | fix t             不动点算子
               
              归约规则:
              - + @@ -910,7 +913,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Fix1)  

              fix t1 ==> fix t1'fix t1 --> fix t1'
              @@ -923,13 +926,13 @@

              MoreStlc扩展简单类型 Lambda-

              - +

              fix (\xf:T1.t2) ==> [xf:=fix (\xf:T1.t2)] t2fix (\xf:T1.t2) --> [xf:=fix (\xf:T1.t2)] t2
              定型规则:
              - + @@ -937,7 +940,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t1 : T1->T1Gamma ⊢ t1 ∈ T1->T1 (T_Fix)  

              Gamma |- fix t1 : T1Gamma ⊢ fix t1 ∈ T1
              @@ -945,81 +948,81 @@

              MoreStlc扩展简单类型 Lambda- 让我们以 fact 3 = fix F 3 为例看看 ST_FixAbs 是如何工作的,其中
              -    F = (\f. \x. if x=0 then 1 else x * (f (pred x)))
              +    F = (\f. \x. test x=0 then 1 else x * (f (pred x)))
               
              (简洁起见,我们省略了类型注解)。
                   fix F 3
               
              -==> ST_FixAbs + ST_App1 +--> ST_FixAbs + ST_App1
              -    (\x. if x=0 then 1 else x * (fix F (pred x))) 3
              +    (\x. test x=0 then 1 else x * (fix F (pred x))) 3
               
              -==> ST_AppAbs +--> ST_AppAbs
              -    if 3=0 then 1 else 3 * (fix F (pred 3))
              +    test 3=0 then 1 else 3 * (fix F (pred 3))
               
              -==> ST_If0_Nonzero +--> ST_Test0_Nonzero
                   3 * (fix F (pred 3))
               
              -==> ST_FixAbs + ST_Mult2 +--> ST_FixAbs + ST_Mult2
              -    3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 3))
              +    3 * ((\x. test x=0 then 1 else x * (fix F (pred x))) (pred 3))
               
              -==> ST_PredNat + ST_Mult2 + ST_App2 +--> ST_PredNat + ST_Mult2 + ST_App2
              -    3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 2)
              +    3 * ((\x. test x=0 then 1 else x * (fix F (pred x))) 2)
               
              -==> ST_AppAbs + ST_Mult2 +--> ST_AppAbs + ST_Mult2
              -    3 * (if 2=0 then 1 else 2 * (fix F (pred 2)))
              +    3 * (test 2=0 then 1 else 2 * (fix F (pred 2)))
               
              -==> ST_If0_Nonzero + ST_Mult2 +--> ST_Test0_Nonzero + ST_Mult2
                   3 * (2 * (fix F (pred 2)))
               
              -==> ST_FixAbs + 2 x ST_Mult2 +--> ST_FixAbs + 2 x ST_Mult2
              -    3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 2)))
              +    3 * (2 * ((\x. test x=0 then 1 else x * (fix F (pred x))) (pred 2)))
               
              -==> ST_PredNat + 2 x ST_Mult2 + ST_App2 +--> ST_PredNat + 2 x ST_Mult2 + ST_App2
              -    3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 1))
              +    3 * (2 * ((\x. test x=0 then 1 else x * (fix F (pred x))) 1))
               
              -==> ST_AppAbs + 2 x ST_Mult2 +--> ST_AppAbs + 2 x ST_Mult2
              -    3 * (2 * (if 1=0 then 1 else 1 * (fix F (pred 1))))
              +    3 * (2 * (test 1=0 then 1 else 1 * (fix F (pred 1))))
               
              -==> ST_If0_Nonzero + 2 x ST_Mult2 +--> ST_Test0_Nonzero + 2 x ST_Mult2
                   3 * (2 * (1 * (fix F (pred 1))))
               
              -==> ST_FixAbs + 3 x ST_Mult2 +--> ST_FixAbs + 3 x ST_Mult2
              -    3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 1))))
              +    3 * (2 * (1 * ((\x. test x=0 then 1 else x * (fix F (pred x))) (pred 1))))
               
              -==> ST_PredNat + 3 x ST_Mult2 + ST_App2 +--> ST_PredNat + 3 x ST_Mult2 + ST_App2
              -    3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 0)))
              +    3 * (2 * (1 * ((\x. test x=0 then 1 else x * (fix F (pred x))) 0)))
               
              -==> ST_AppAbs + 3 x ST_Mult2 +--> ST_AppAbs + 3 x ST_Mult2
              -    3 * (2 * (1 * (if 0=0 then 1 else 0 * (fix F (pred 0)))))
              +    3 * (2 * (1 * (test 0=0 then 1 else 0 * (fix F (pred 0)))))
               
              -==> ST_If0Zero + 3 x ST_Mult2 +--> ST_Test0Zero + 3 x ST_Mult2
                   3 * (2 * (1 * 1))
               
              -==> ST_MultNats + 2 x ST_Mult2 +--> ST_MultNats + 2 x ST_Mult2
                   3 * (2 * 1)
               
              -==> ST_MultNats + ST_Mult2 +--> ST_MultNats + ST_Mult2
                   3 * 2
               
              -==> ST_MultNats +--> ST_MultNats
                   6
               
              @@ -1030,20 +1033,20 @@

              MoreStlc扩展简单类型 Lambda- fix 并不会保证所定义的函数一定停机。
              -

              练习:1 星, optional (halve_fix)

              +

              练习:1 星, standard, optional (halve_fix)

              请将下面非形式化的定义使用 fix 写出:
                     halve =
                       \x:Nat.
              -           if x=0 then 0
              -           else if (pred x)=0 then 0
              -           else 1 + (halve (pred (pred x))))
              +           test x=0 then 0
              +           else test (pred x)=0 then 0
              +           else 1 + (halve (pred (pred x)))
               
              (* 请在此处解答 *)
              -

              练习:1 星, optional (fact_steps)

              +

              练习:1 星, standard, optional (fact_steps)

              请分步骤写下 fact 1 如何归约为正规式(假定有一般算数操作的归约规则)。
              @@ -1064,7 +1067,7 @@

              MoreStlc扩展简单类型 Lambda-

              由规则 T_FixT_Abs,这个项的类型为 T。由规则 ST_FixAbs, - 这个项重复地归约为它自身。因此,它是类型 T不停机项(diverging element)。 + 这个项重复地归约为它自身。因此,它是类型 T不停机项(diverging element)
              @@ -1072,10 +1075,10 @@

              MoreStlc扩展简单类型 Lambda-
                   equal =
                     fix
              -        (\eq:Nat->Nat->Bool.
              +        (\eq:Nat->Nat->Bool.
                          \m:Nat. \n:Nat.
              -             if m=0 then iszero n
              -             else if n=0 then false
              +             test m=0 then iszero n
              +             else test n=0 then fls
                            else eq (pred m) (pred n))
               
              最后的例子展示了如何用 fix 定一个二元组的递归函数(规则 T_Fix @@ -1083,9 +1086,9 @@

              MoreStlc扩展简单类型 Lambda-
                     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
              +          (\eo: (Nat->Bool * Nat->Bool).
              +             let e = \n:Nat. test n=0 then tru else eo.snd (pred n) in
              +             let o = \n:Nat. test n=0 then fls else eo.fst (pred n) in
                            (e,o))
               
                     even = evenodd.fst
              @@ -1095,31 +1098,34 @@ 

              MoreStlc扩展简单类型 Lambda-

              -

              字段组

              +

              字段组

              作为 STLC 最后的一个基础扩展,让我们简要地学习一下如何定义字段组(record) - 及其类型。直观地说,字段组可以通过从两个方面一般化二元组来得到:他们是 n + 及其类型。直观地说,字段组可以通过从两个方面一般化二元组来得到:他们是 n 元(而不仅仅是二元)的而且可以通过标签(label)(而不仅仅是位置)来访问字段。
              Syntax:
                      t ::=                          Terms
              +           | ...
                          | {i1=t1, ..., in=tn}         record
                          | t.i                         projection
              -           | ...
               
                      v ::=                          Values
              -           | {i1=v1, ..., in=vn}         record value
                          | ...
              +           | {i1=v1, ..., in=vn}         record value
               
                      T ::=                          Types
              -           | {i1:T1, ..., in:Tn}         record type
                          | ...
              +           | {i1:T1, ..., in:Tn}         record type
               
              - 对二元组的一般化是很容易的。但是需要提醒的是,这里描述的方式要比之前章节中的 + +
              + + 对二元组的一般化是很容易的。但是需要提醒的是,这里描述的方式要比之前章节中的 非形式语法更加非形式:我们多处使用了“...”来描述“任意数量的某项”, 我们还省略了“字段组的标签不应当重复”这个附加条件。
              @@ -1130,7 +1136,7 @@

              MoreStlc扩展简单类型 Lambda- 归约规则:
              - + @@ -1138,16 +1144,16 @@

              MoreStlc扩展简单类型 Lambda-

              - + - +
              ti ==> ti'ti --> ti' (ST_Rcd)  

              {i1=v1, ..., im=vm, in=ti, ...}{i1=v1, ..., im=vm, in=ti , ...}
              ==> {i1=v1, ..., im=vm, in=ti', ...}--> {i1=v1, ..., im=vm, in=ti', ...}
              - + @@ -1155,7 +1161,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              t1 ==> t1't1 --> t1' (ST_Proj1)  

              t1.i ==> t1'.it1.i --> t1'.i
              @@ -1168,21 +1174,40 @@

              MoreStlc扩展简单类型 Lambda-

              - + -

              {..., i=vi, ...}.i ==> vi{..., i=vi, ...}.i --> vi
              再次提醒,这些规则是非形式化的。比如说,第一个规则应当被读做“如果 ti - 是最左边的非值字段,且如果 ti 前进一步归约到 ti',那么整个字段组归约为……”。 - 最后一个规则的意思是说应当只有一个名字为 i 的字段,而其他的字段必须指向值。 -
              - - -
              - - 类型规则同样简单: -
              - + + + + + + + + + + + + + + + +
              Gamma |- t1 : T1     ...     Gamma |- tn : Tn]]] *)
              (** 再次提醒,这些规则是非形式化的。比如说,第一个规则应当被读做“如果 [ti]
              是最左边的非值字段,且如果 [ti] 前进一步归约到 [ti'],那么整个字段组归约为……”。
              最后一个规则的意思是说应当只有一个名字为 [i] 的字段,而其他的字段必须指向值。*)
              + + + + + + + + + + + + + + @@ -1190,12 +1215,12 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              (**
              类型规则同样简单:
              [[[
              Gamma ⊢ t1 ∈ T1     ...     Gamma ⊢ tn ∈ Tn (T_Rcd)  

              Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}Gamma ⊢ {i1=t1, ..., in=tn} ∈ {i1:T1, ..., in:Tn}
              - + @@ -1203,7 +1228,7 @@

              MoreStlc扩展简单类型 Lambda-

              - +
              Gamma |- t : {..., i:Ti, ...}Gamma ⊢ t ∈ {..., i:Ti, ...} (T_Proj)  

              Gamma |- t.i : TiGamma ⊢ t.i ∈ Ti
              @@ -1219,7 +1244,7 @@

              MoreStlc扩展简单类型 Lambda- 它允许我们给出程序员易读的错误信息)。但是这些形式化的规则并不是十分容易和其他 部分配合,因为上面出现的 ... 需要被替换为显式的量词(quantification) 或推导式(comprehension)。基于这个原因,本章最后的扩展练习中并没有包括字段组。 - (这里非形式化地讨论字段组仍然非常有用,因为它为 Sub + (这里非形式化地讨论字段组仍然非常有用,因为它为 Sub 一章中对子类型的讨论提供了基础。)
              @@ -1229,7 +1254,7 @@

              MoreStlc扩展简单类型 Lambda-
            • 此外,我们还可以用一种更简单的方式来表达字段组——比如说,相比与使用单一的构造子 直接地构造整个字段组,我们可以使用二元的表示,其中一个构造子表示空字段组, 另一个用于为已有的字段组添加一个新的字段。如果我们主要的兴趣在于学习带字段组 - 的演算的元理论,那么这种方式的定义和证明更加简单优雅。在 Records + 的演算的元理论,那么这种方式的定义和证明更加简单优雅。在 Records 一章中我们会学习此种处理方式。
              @@ -1244,11 +1269,12 @@

              MoreStlc扩展简单类型 Lambda-

            • -

              编码字段组(选读)

              +

              编码字段组(选读)

              - 让我们看看如何只使用二元组和 unit 来编码字段组。 + 让我们看看如何只使用二元组和 unit 来编码字段组。(这种聪明的编码来自于 + Luca Cardelli,基于它也会扩展到具有子类型的系统观察。)
              @@ -1260,21 +1286,20 @@

              MoreStlc扩展简单类型 Lambda-
              -      {}                 ---->  unit
              -      {t1, t2, ..., tn}  ---->  (t1, trest)
              -                                其中 {t2, ..., tn} ----> trest
              +      {}                 ---->  unit
              +      {t1, t2, ..., tn}  ---->  (t1, trest)
              +                                其中 {t2, ..., tn} ----> trest
               
              类似地,我们可以用积类型来表示元组类型:
              -      {}                 ---->  Unit
              -      {T1, T2, ..., Tn}  ---->  T1 * TRest
              -                                其中 {T2, ..., Tn} ----> TRest
              +      {}                 ---->  Unit
              +      {T1, T2, ..., Tn}  ---->  T1 * TRest
              +                                其中 {T2, ..., Tn} ----> TRest
               
              从元组中投影出元素的操作可以被编码为连续使用多次(或零次)第二投影操作, 最后使用第一投影操作:
              -      t.0        ---->  t.fst
              -      t.(n+1)    ---->  (t.snd).n
              +      t.0 ----> t.fst t.(n+1) ----> (t.snd).n
               
              下一步,假设在字段组的标签上存在某种全序,那么我们可以为每个标签关联一个唯一的自然数。 这个数被乘坐标签的位置。比如说,我们可以像下面这样指派位置: @@ -1292,12 +1317,9 @@

              MoreStlc扩展简单类型 Lambda- 我们根据字段的位置对他们排序,并使用这些位置来把字段组编码为元组(也即,嵌套的二元组)。 例如:
              -      {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}
              +      {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}
               
              请注意,每个字段都出现在他们标签所关联的位置,因此元组的大小取决与有最高位置的标签, 我们把未使用的位置填充为 unit 值。 @@ -1306,13 +1328,12 @@

              MoreStlc扩展简单类型 Lambda- 我们在编码字段组类型时使用同样的方式:
              -      {a:Nat, b:Nat}      ---->   {Nat,Nat}
              -      {c:Nat, a:Nat}      ---->   {Nat,Unit,Nat}
              -      {f:Nat,c:Nat}       ---->   {Unit,Unit,Nat,Unit,Unit,Nat}
              +      {a:Nat,b:Nat} ----> {Nat,Nat} {c:Nat,a:Nat} ----> {Nat,Unit,Nat}
              +      {f:Nat,c:Nat} ----> {Unit,Unit,Nat,Unit,Unit,Nat}
               
              最后,字段组投影被编码为在正确的位置上对元组投影:
              -      t.l  ---->  t.(l 的位置)
              +      t.l ----> t.(l 的位置)
               
              我们不难用这种编码来验证以“直接”形式表达的字段组的类型规则。(除了我们编码的是排序后的字段, 剩下的归约规则几乎已经被验证了。) @@ -1324,7 +1345,7 @@

              MoreStlc扩展简单类型 Lambda- 的编译器所做的正是如此。
              -

              变种类型(选读)

              +

              变种类型(选读)

              @@ -1336,18 +1357,25 @@

              MoreStlc扩展简单类型 Lambda- 这些 n 元变种类型提供了足够的机制来构造任意的归纳数据类型,比如列表和树。 唯一缺少的东西是在类型定义中递归(recursion)。在本书中我们不会讲解这些, - 但在许多其他的教材中可以学习到他们,例如 Types and Programming Languages + 但在许多其他的教材中可以学习到他们,例如 Types and Programming Languages 一书 [Pierce 2002]

              -

              练习:形式化以上扩展

              +

              练习:形式化以上扩展

              -
              +
              +
              + +
              +Module STLCExtended.
              +
              -

              练习:5 星 (STLC_extensions)

              - 在接下来的练习中,你将会形式化本章中描述的一些扩展。我们提供了必要的项和类型的语法, - 以及一些例子用于测试你的定义是否工作。你需要完成剩下的定义,并相应地扩展证明。 +
              +

              练习:3 星, standard (STLCE_definitions)

              + 在接下来的一系列练习中,你将会形式化本章中描述的一些扩展。 + 我们提供了必要的项和类型的语法,以及一些例子用于测试你的定义是否工作。 + 你需要完成剩下的定义,并相应地扩展证明。
              @@ -1392,48 +1420,35 @@

              MoreStlc扩展简单类型 Lambda- 一个比较好的策略是一次完成一个扩展,分两部完成全部练习, 而不是尝试一次从头到尾完成本文件中所有的练习。 - 对每个定义或证明,首先仔细阅读已经提供的部分,可回顾 Stlc + 对每个定义或证明,首先仔细阅读已经提供的部分,可回顾 Stlc 一章中的文本,并展开嵌套的注释复习细节。

              -
              - -Module STLCExtended.
              -
              -

              语法

              +

              语法


              Inductive ty : Type :=
              -  | TArrow : tytyty
              -  | TNat : ty
              -  | TUnit : ty
              -  | TProd : tytyty
              -  | TSum : tytyty
              -  | TList : tyty.

              +  | Arrow : tytyty
              +  | Nat : ty
              +  | Sum : tytyty
              +  | List : tyty
              +  | Unit : ty
              +  | Prod : tytyty.

              Inductive tm : Type :=
                (* 纯 STLC *)
              -  | tvar : stringtm
              -  | tapp : tmtmtm
              -  | tabs : stringtytmtm
              +  | var : stringtm
              +  | app : tmtmtm
              +  | abs : stringtytmtm
                (* 数值 *)
              -  | tnat : nattm
              -  | tsucc : tmtm
              -  | tpred : tmtm
              -  | tmult : tmtmtm
              -  | tif0 : tmtmtmtm
              -  (* 二元组 *)
              -  | tpair : tmtmtm
              -  | tfst : tmtm
              -  | tsnd : tmtm
              -  (* 单元 *)
              -  | tunit : tm
              -  (* let *)
              -  | tlet : stringtmtmtm
              -          (* i.e., let x = t1 in t2 *)
              +  | const : nattm
              +  | scc : tmtm
              +  | prd : tmtm
              +  | mlt : tmtmtm
              +  | test0 : tmtmtmtm
                (* 和 *)
                | tinl : tytmtm
                | tinr : tytmtm
              @@ -1444,51 +1459,63 @@

              MoreStlc扩展简单类型 Lambda-   | tcons : tmtmtm
                | tlcase : tmtmstringstringtmtm
                         (* i.e., lcase t1 of | nil t2 | x::y t3 *)
              +  (* unit *)
              +  | unit : tm
              +
              +  (* You are going to be working on the following extensions: *)
              +
              +  (* pairs *)
              +  | pair : tmtmtm
              +  | fst : tmtm
              +  | snd : tmtm
              +  (* let *)
              +  | tlet : stringtmtmtm
              +         (* i.e., let x = t1 in t2 *)
                (* fix *)
                | tfix : tmtm.

              -请注意,简洁起见,我们省略了布尔值,但提供了 if0 用于测试 0 值和作为条件语句。 +请注意,简洁起见,我们省略了布尔值,但提供了 test0 用于测试 0 值和作为条件语句。 也即,当有:
              -       if x = 0 then ... else ...
              +       test x = 0 then ... else ...
               
              我们可以写做:
              -       if0 x then ... else ...
              +       test0 x then ... else ...
               
              -

              替换

              +

              替换


              -Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
              +Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
                match t with
              -  | tvar y
              +  (* pure STLC *)
              +  | var y
                    if eqb_string x y then s else t
              -  | tabs y T t1
              -      tabs y T (if eqb_string 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)
              -  (* 请在此处解答 *)
              -  | tunittunit
              -  (* 请在此处解答 *)
              +  | abs y T t1
              +      abs y T (if eqb_string x y then t1 else (subst x s t1))
              +  | app t1 t2
              +      app (subst x s t1) (subst x s t2)
              +  (* numbers *)
              +  | const n
              +      const n
              +  | scc t1
              +      scc (subst x s t1)
              +  | prd t1
              +      prd (subst x s t1)
              +  | mlt t1 t2
              +      mlt (subst x s t1) (subst x s t2)
              +  | test0 t1 t2 t3
              +      test0 (subst x s t1) (subst x s t2) (subst x s t3)
              +  (* sums *)
                | tinl T t1
                    tinl T (subst x s t1)
                | tinr T t1
              @@ -1497,6 +1524,7 @@

              MoreStlc扩展简单类型 Lambda-       tcase (subst x s t0)
                       y1 (if eqb_string x y1 then t1 else (subst x s t1))
                       y2 (if eqb_string x y2 then t2 else (subst x s t2))
              +  (* lists *)
                | tnil T
                    tnil T
                | tcons t1 t2
              @@ -1507,14 +1535,24 @@

              MoreStlc扩展简单类型 Lambda-            t3
                       else if eqb_string x y2 then t3
                            else (subst x s t3))
              +  (* unit *)
              +  | unitunit
              +
              +  (* Complete the following cases. *)
              +
              +  (* pairs *)
              +  (* 请在此处解答 *)
              +  (* let *)
                (* 请在此处解答 *)
              -  | _t (* ... and delete this line *)
              +  (* fix *)
              +  (* 请在此处解答 *)
              +  | _t (* ... and delete this line when you finish the exercise *)
                end.

              Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).

              -

              归约

              +

              归约

              @@ -1523,119 +1561,125 @@

              MoreStlc扩展简单类型 Lambda-
              Inductive value : tmProp :=
              -  | v_abs : x T11 t12,
              -      value (tabs x T11 t12)
              +  (* In pure STLC, function abstractions are values: *)
              +  | v_abs : x T11 t12,
              +      value (abs x T11 t12)
                (* 数值是值: *)
              -  | v_nat : n1,
              -      value (tnat n1)
              -  (* 成分为值的二元组是值: *)
              -  | v_pair : v1 v2,
              -      value v1
              -      value v2
              -      value (tpair v1 v2)
              -  (* unit 总是值: *)
              -  | v_unit : value tunit
              +  | v_nat : n1,
              +      value (const n1)
                (* 带标记的值也是值: *)
              -  | v_inl : v T,
              +  | v_inl : v T,
                    value v
                    value (tinl T v)
              -  | v_inr : v T,
              +  | v_inr : v T,
                    value v
                    value (tinr T v)
                (* 列表是值当且仅当其头部(head)和尾部(tail)均为值:*)
              -  | v_lnil : T, value (tnil T)
              -  | v_lcons : v1 vl,
              +  | v_lnil : T, value (tnil T)
              +  | v_lcons : v1 vl,
                    value v1
                    value vl
              -      value (tcons v1 vl).

              +      value (tcons v1 vl)
              +  (* A unit is always a value *)
              +  | v_unit : value unit
              +  (* A pair is a value if both components are: *)
              +  | v_pair : v1 v2,
              +      value v1
              +      value v2
              +      value (pair v1 v2).

              Hint Constructors value.

              -Reserved Notation "t1 '==>' t2" (at level 40).

              +Reserved Notation "t1 '-->' t2" (at level 40).

              Inductive step : tmtmProp :=
              -  | ST_AppAbs : x T11 t12 v2,
              +  (* pure STLC *)
              +  | 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',
              +         (app (abs x T11 t12) v2) --> [x:=v2]t12
              +  | ST_App1 : t1 t1' t2,
              +         t1 --> t1'
              +         (app t1 t2) --> (app t1' t2)
              +  | ST_App2 : v1 t2 t2',
                       value v1
              -         t2 ==> t2'
              -         (tapp v1 t2) ==> (tapp v1 t2')
              -  (* 自然数 *)
              -  | 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',
              +         t2 --> t2'
              +         (app v1 t2) --> (app v1 t2')
              +  (* 数值 *)
              +  | ST_Succ1 : t1 t1',
              +       t1 --> t1'
              +       (scc t1) --> (scc t1')
              +  | ST_SuccNat : n1,
              +       (scc (const n1)) --> (const (S n1))
              +  | ST_Pred : t1 t1',
              +       t1 --> t1'
              +       (prd t1) --> (prd t1')
              +  | ST_PredNat : n1,
              +       (prd (const n1)) --> (const (pred n1))
              +  | ST_Mult1 : t1 t1' t2,
              +       t1 --> t1'
              +       (mlt t1 t2) --> (mlt 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
              +       t2 --> t2'
              +       (mlt v1 t2) --> (mlt v1 t2')
              +  | ST_Mulconsts : n1 n2,
              +       (mlt (const n1) (const n2)) --> (const (mult n1 n2))
              +  | ST_Test01 : t1 t1' t2 t3,
              +       t1 --> t1'
              +       (test0 t1 t2 t3) --> (test0 t1' t2 t3)
              +  | ST_Test0Zero : t2 t3,
              +       (test0 (const 0) t2 t3) --> t2
              +  | ST_Test0Nonzero : n t2 t3,
              +       (test0 (const (S n)) t2 t3) --> t3
              +  (* 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))
              +
              +  (* Add rules for the following extensions. *)
              +
                (* 二元组 *)
                (* 请在此处解答 *)
                (* let *)
                (* 请在此处解答 *)
              -  (* 和 *)
              -  | 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
              -  (* 列表 *)
              -  | 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 *)
                (* 请在此处解答 *)

              -where "t1 '==>' t2" := (step t1 t2).

              +where "t1 '-->' t2" := (step t1 t2).

              Notation multistep := (multi step).
              -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40).

              +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).

              Hint Constructors step.
              -

              定型

              +

              定型

              @@ -1649,81 +1693,96 @@

              MoreStlc扩展简单类型 Lambda-

              -Reserved Notation "Gamma '|-' t '∈' T" (at level 40).

              +Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).

              Inductive has_type : contexttmtyProp :=
              -  (* 基本项的定型规则 *)
              -  | T_Var : Gamma x T,
              +  (* 纯 STLC 的定型规则 *)
              +  | T_Var : Gamma x T,
                    Gamma x = Some T
              -      Gamma |- (tvar x) ∈ T
              -  | T_Abs : Gamma x T11 T12 t12,
              -      (update Gamma x T11) |- t12T12
              -      Gamma |- (tabs x T11 t12) ∈ (TArrow T11 T12)
              -  | T_App : T1 T2 Gamma t1 t2,
              -      Gamma |- t1 ∈ (TArrow T1 T2) →
              -      Gamma |- t2T1
              -      Gamma |- (tapp t1 t2) ∈ T2
              -  (* 自然数 *)
              -  | T_Nat : Gamma n1,
              -      Gamma |- (tnat n1) ∈ TNat
              -  | T_Succ : Gamma t1,
              -      Gamma |- t1TNat
              -      Gamma |- (tsucc t1) ∈ TNat
              -  | T_Pred : Gamma t1,
              -      Gamma |- t1TNat
              -      Gamma |- (tpred t1) ∈ TNat
              -  | T_Mult : Gamma t1 t2,
              -      Gamma |- t1TNat
              -      Gamma |- t2TNat
              -      Gamma |- (tmult t1 t2) ∈ TNat
              -  | T_If0 : Gamma t1 t2 t3 T1,
              -      Gamma |- t1TNat
              -      Gamma |- t2T1
              -      Gamma |- t3T1
              -      Gamma |- (tif0 t1 t2 t3) ∈ T1
              -  (* 二元组 *)
              +      Gamma ⊢ (var x) ∈ T
              +  | T_Abs : Gamma x T11 T12 t12,
              +      (update Gamma x T11) ⊢ t12T12
              +      Gamma ⊢ (abs x T11 t12) ∈ (Arrow T11 T12)
              +  | T_App : T1 T2 Gamma t1 t2,
              +      Gammat1 ∈ (Arrow T1 T2) →
              +      Gammat2T1
              +      Gamma ⊢ (app t1 t2) ∈ T2
              +  (* 数值 *)
              +  | T_Nat : Gamma n1,
              +      Gamma ⊢ (const n1) ∈ Nat
              +  | T_Succ : Gamma t1,
              +      Gammat1Nat
              +      Gamma ⊢ (scc t1) ∈ Nat
              +  | T_Pred : Gamma t1,
              +      Gammat1Nat
              +      Gamma ⊢ (prd t1) ∈ Nat
              +  | T_Mult : Gamma t1 t2,
              +      Gammat1Nat
              +      Gammat2Nat
              +      Gamma ⊢ (mlt t1 t2) ∈ Nat
              +  | T_Test0 : Gamma t1 t2 t3 T1,
              +      Gammat1Nat
              +      Gammat2T1
              +      Gammat3T1
              +      Gamma ⊢ (test0 t1 t2 t3) ∈ T1
              +  (* 和 *)
              +  | T_Inl : Gamma t1 T1 T2,
              +      Gammat1T1
              +      Gamma ⊢ (tinl T2 t1) ∈ (Sum T1 T2)
              +  | T_Inr : Gamma t2 T1 T2,
              +      Gammat2T2
              +      Gamma ⊢ (tinr T1 t2) ∈ (Sum T1 T2)
              +  | T_Case : Gamma t0 x1 T1 t1 x2 T2 t2 T,
              +      Gammat0 ∈ (Sum T1 T2) →
              +      (update Gamma x1 T1) ⊢ t1T
              +      (update Gamma x2 T2) ⊢ t2T
              +      Gamma ⊢ (tcase t0 x1 t1 x2 t2) ∈ T
              +  (* 列表 *)
              +  | T_Nil : Gamma T,
              +      Gamma ⊢ (tnil T) ∈ (List T)
              +  | T_Cons : Gamma t1 t2 T1,
              +      Gammat1T1
              +      Gammat2 ∈ (List T1) →
              +      Gamma ⊢ (tcons t1 t2) ∈ (List T1)
              +  | T_Lcase : Gamma t1 T1 t2 x1 x2 t3 T2,
              +      Gammat1 ∈ (List T1) →
              +      Gammat2T2
              +      (update (update Gamma x2 (List T1)) x1 T1) ⊢ t3T2
              +      Gamma ⊢ (tlcase t1 t2 x1 x2 t3) ∈ T2
              +  (* unit *)
              +  | T_Unit : Gamma,
              +      GammaunitUnit
              +
              +  (* Add rules for the following extensions. *)
              +
              +  (* pairs *)
                (* 请在此处解答 *)
              -  (* 单元 *)
              -  | T_Unit : Gamma,
              -      Gamma |- tunitTUnit
                (* let *)
                (* 请在此处解答 *)
              -  (* 和 *)
              -  | T_Inl : Gamma t1 T1 T2,
              -      Gamma |- t1T1
              -      Gamma |- (tinl T2 t1) ∈ (TSum T1 T2)
              -  | T_Inr : Gamma t2 T1 T2,
              -      Gamma |- t2T2
              -      Gamma |- (tinr T1 t2) ∈ (TSum T1 T2)
              -  | T_Case : Gamma t0 x1 T1 t1 x2 T2 t2 T,
              -      Gamma |- t0 ∈ (TSum T1 T2) →
              -      (update Gamma x1 T1) |- t1T
              -      (update Gamma x2 T2) |- t2T
              -      Gamma |- (tcase t0 x1 t1 x2 t2) ∈ T
              -  (* 列表 *)
              -  | T_Nil : Gamma T,
              -      Gamma |- (tnil T) ∈ (TList T)
              -  | T_Cons : Gamma t1 t2 T1,
              -      Gamma |- t1T1
              -      Gamma |- t2 ∈ (TList T1) →
              -      Gamma |- (tcons t1 t2) ∈ (TList T1)
              -  | T_Lcase : Gamma t1 T1 t2 x1 x2 t3 T2,
              -      Gamma |- t1 ∈ (TList T1) →
              -      Gamma |- t2T2
              -      (update (update Gamma x2 (TList T1)) x1 T1) |- t3T2
              -      Gamma |- (tlcase t1 t2 x1 x2 t3) ∈ T2
                (* fix *)
                (* 请在此处解答 *)

              -where "Gamma '|-' t '∈' T" := (has_type Gamma t T).

              -Hint Constructors has_type.
              +where "Gamma '⊢' t '∈' T" := (has_type Gamma t T).

              +Hint Constructors has_type.

              +(* 请勿修改下面这一行: *)
              +Definition manual_grade_for_extensions_definition : option (nat*string) := None.
              + +
              -

              例子

              +

              例子

              +

              练习:3 星, standard (STLCE_examples)

              本节形式化了一些上文中出现的例子(以及一些其他的例子)。 + +
              + + 只要你为通过测试实现了足够的定义,就取消证明的注释并将 Admitted 替换为 Qed。 + +
              + 最开始我们会专注于某些特性,而在开始证明这些特性之前,你可以用一些例子先来 测试一下你的定义是否合理。后面的例子会整合全部的特性,因此你需要在完成所有的 定义后再阅读这部分。 @@ -1734,7 +1793,7 @@

              MoreStlc扩展简单类型 Lambda-

              -

              基础

              +

              基础

              @@ -1768,7 +1827,7 @@

              MoreStlc扩展简单类型 Lambda-
              - 下面的 Hint 定义是说,当 auto 遇到一个形如 (Gamma |- (tapp e1 e1) T) + 下面的 Hint 定义是说,当 auto 遇到一个形如 (Gamma (app e1 e1) T) 的目标时,它应当考虑使用 eapply T_App,并为中间的类型 T1 留下一个存在变量。 lcase 与此类似。这个变量在后面为 e1e2 搜索类型导出式的过程中会被填补。 我们还引入一个提示用于搜索形如等式的证明目标;这对使用 T_Var 的情景非常有用 @@ -1776,7 +1835,7 @@

              MoreStlc扩展简单类型 Lambda-

              -Hint Extern 2 (has_type _ (tapp _ _) _) ⇒
              +Hint Extern 2 (has_type _ (app _ _) _) ⇒
                eapply T_App; auto.
              Hint Extern 2 (has_type _ (tlcase _ _ _ _ _) _) ⇒
                eapply T_Lcase; auto.
              @@ -1784,51 +1843,43 @@

              MoreStlc扩展简单类型 Lambda-

              -

              数值

              +

              数值


              Module Numtest.

              -(* if0 (pred (succ (pred (2 * 0))) then 5 else 6 *)
              +(* test0 (pred (succ (pred (2 * 0))) then 5 else 6 *)
              Definition test :=
              -  tif0
              -    (tpred
              -      (tsucc
              -        (tpred
              -          (tmult
              -            (tnat 2)
              -            (tnat 0)))))
              -    (tnat 5)
              -    (tnat 6).
              -
              - -
              -当你完成足够的定义后将注释括号移除。 -
              -
              - -(* 
              -Example typechecks :
              -  empty |- test ∈ TNat.
              -Proof.
              -  unfold test.
              +  test0
              +    (prd
              +      (scc
              +        (prd
              +          (mlt
              +            (const 2)
              +            (const 0)))))
              +    (const 5)
              +    (const 6).

              +Example typechecks :
              +  emptytestNat.
              +Proof.
              +  unfold test.
                (* 这里的类型导出式非常深,因此我们需要将 auto 的最大搜索深度从 5 改为 10。 *)
              -  auto 10.
              -Qed.
              -
              -Example numtest_reduces :
              -  test ==>* tnat 5.
              -Proof.
              +  auto 10.
              +(* 请在此处解答 *) Admitted.

              +Example numtest_reduces :
              +  test -->* const 5.
              +Proof.
              +(* 
                unfold test. normalize.
              -Qed.
              -*)


              +*)

              +(* 请在此处解答 *) Admitted.

              End Numtest.
              -

              +

              @@ -1837,27 +1888,30 @@

              MoreStlc扩展简单类型 Lambda- Module Prodtest.

              (* ((5,6),7).fst.snd *)
              Definition test :=
              -  tsnd
              -    (tfst
              -      (tpair
              -        (tpair
              -          (tnat 5)
              -          (tnat 6))
              -        (tnat 7))).

              +  snd
              +    (fst
              +      (pair
              +        (pair
              +          (const 5)
              +          (const 6))
              +        (const 7))).

              +Example typechecks :
              +  emptytestNat.
              +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: typechecks *)

              +Example reduces :
              +  test -->* const 6.
              +Proof.
              (* 
              -Example typechecks :
              -  empty |- test ∈ TNat.
              -Proof. unfold test. eauto 15. Qed.
              -
              -Example reduces :
              -  test ==>* tnat 6.
              -Proof. unfold test. normalize. Qed.
              -*)


              +  unfold test. normalize.
              +*)

              +(* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: reduces *)

              End Prodtest.

              -

              let

              +

              let

              @@ -1868,22 +1922,25 @@

              MoreStlc扩展简单类型 Lambda- Definition test :=
                tlet
                  x
              -    (tpred (tnat 6))
              -    (tsucc (tvar x)).

              +    (prd (const 6))
              +    (scc (var x)).

              +Example typechecks :
              +  emptytestNat.
              +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: typechecks *)

              +Example reduces :
              +  test -->* const 6.
              +Proof.
              (* 
              -Example typechecks :
              -  empty |- test ∈ TNat.
              -Proof. unfold test. eauto 15. Qed.
              -
              -Example reduces :
              -  test ==>* tnat 6.
              -Proof. unfold test. normalize. Qed.
              -*)


              +  unfold test. normalize.
              +*)

              +(* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: reduces *)

              End LetTest.

              -

              +

              @@ -1894,50 +1951,52 @@

              MoreStlc扩展简单类型 Lambda-      inl x => x
                 | inr y => y *)


              Definition test :=
              -  tcase (tinl TNat (tnat 5))
              -    x (tvar x)
              -    y (tvar y).

              +  tcase (tinl Nat (const 5))
              +    x (var x)
              +    y (var y).

              +Example typechecks :
              +  emptytestNat.
              +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted.

              +Example reduces :
              +  test -->* (const 5).
              +Proof.
              (* 
              -Example typechecks :
              -  empty |- test ∈ TNat.
              -Proof. unfold test. eauto 15. Qed.
              -
              -Example reduces :
              -  test ==>* (tnat 5).
              -Proof. unfold test. normalize. Qed.
              -*)


              +  unfold test. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.

              End Sumtest1.

              Module Sumtest2.

              (* let processSum =
                   \x:Nat+Nat.
                      case x of
                        inl n => n
              -          inr n => if0 n then 1 else 0 in
              +          inr n => test0 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)))).

              +    (abs x (Sum Nat Nat)
              +      (tcase (var x)
              +         n (var n)
              +         n (test0 (var n) (const 1) (const 0))))
              +    (pair
              +      (app (var processSum) (tinl Nat (const 5)))
              +      (app (var processSum) (tinr Nat (const 5)))).

              +Example typechecks :
              +  emptytest ∈ (Prod Nat Nat).
              +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted.

              +Example reduces :
              +  test -->* (pair (const 5) (const 0)).
              +Proof.
              (* 
              -Example typechecks :
              -  empty |- test ∈ (TProd TNat TNat).
              -Proof. unfold test. eauto 15. Qed.
              -
              -Example reduces :
              -  test ==>* (tpair (tnat 5) (tnat 0)).
              -Proof. unfold test. normalize. Qed.
              -*)


              +  unfold test. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.

              End Sumtest2.

              -

              列表

              +

              列表

              @@ -1950,24 +2009,25 @@

              MoreStlc扩展简单类型 Lambda-    | 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))).

              +    (tcons (const 5) (tcons (const 6) (tnil Nat)))
              +    (tlcase (var l)
              +       (const 0)
              +       x y (mlt (var x) (var x))).

              +Example typechecks :
              +  emptytestNat.
              +Proof. unfold test. eauto 20. (* 请在此处解答 *) Admitted.

              +Example reduces :
              +  test -->* (const 25).
              +Proof.
              (* 
              -Example typechecks :
              -  empty |- test ∈ TNat.
              -Proof. unfold test. eauto 20. Qed.
              -
              -Example reduces :
              -  test ==>* (tnat 25).
              -Proof. unfold test. normalize. Qed.
              -*)


              +  unfold test. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.

              End ListTest.

              -

              fix

              +

              fix

              @@ -1975,19 +2035,19 @@

              MoreStlc扩展简单类型 Lambda-
              Module FixTest1.

              (* fact := fix
              -             (\f:nat->nat.
              +             (\f:nat->nat.
                              \a:nat.
              -                   if a=0 then 1 else a * (f (pred a))) *)

              +                   test 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))))))).
              +    (abs f (Arrow Nat Nat)
              +      (abs a Nat
              +        (test0
              +           (var a)
              +           (const 1)
              +           (mlt
              +              (var a)
              +              (app (var f) (prd (var a))))))).

              @@ -1995,95 +2055,101 @@

              MoreStlc扩展简单类型 Lambda-

              +Example typechecks :
              +  emptyfact ∈ (Arrow Nat Nat).
              +Proof. unfold fact. auto 10. (* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: typechecks *)

              +Example reduces :
              +  (app fact (const 4)) -->* (const 24).
              +Proof.
              (* 
              -Example fact_typechecks :
              -  empty |- fact ∈ (TArrow TNat TNat).
              -Proof. unfold fact. auto 10.
              -Qed.
              -*)


              -(* 
              -Example fact_example:
              -  (tapp fact (tnat 4)) ==>* (tnat 24).
              -Proof. unfold fact. normalize. Qed.
              -*)


              +  unfold fact. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: reduces *)

              End FixTest1.

              Module FixTest2.

              (* map :=
              -     \g:nat->nat.
              +     \g:nat->nat.
                     fix
              -         (\f:nat->nat.
              +         (\f:nat->nat.
                          \l:nat.
                             case l of
              -               |  -> 
              -               | x::l -> (g x)::(f l)) *)

              +               |  -> 
              +               | x::l -> (g x)::(f l)) *)
              Definition map :=
              -  tabs g (TArrow TNat TNat)
              +  abs g (Arrow Nat Nat)
                  (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))))))).

              +      (abs f (Arrow (List Nat) (List Nat))
              +        (abs l (List Nat)
              +          (tlcase (var l)
              +            (tnil Nat)
              +            a l (tcons (app (var g) (var a))
              +                         (app (var f) (var l))))))).

              +Example typechecks :
              +  emptymap
              +    (Arrow (Arrow Nat Nat)
              +      (Arrow (List Nat)
              +        (List Nat))).
              +Proof. unfold map. auto 10. (* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: typechecks *)

              +Example reduces :
              +  app (app map (abs a Nat (scc (var a))))
              +         (tcons (const 1) (tcons (const 2) (tnil Nat)))
              +  -->* (tcons (const 2) (tcons (const 3) (tnil Nat))).
              +Proof.
              (* 
              -(* 请确保你已将上面最后一个 Hint Extern 从注释中移出。 *)
              -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.
              -*)


              +  unfold map. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: reduces *)

              End FixTest2.

              Module FixTest3.

              (* equal =
                    fix
              -        (\eq:Nat->Nat->Bool.
              +        (\eq:Nat->Nat->Bool.
                         \m:Nat. \n:Nat.
              -             if0 m then (if0 n then 1 else 0)
              -             else if0 n then 0
              +             test0 m then (test0 n then 1 else 0)
              +             else test0 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)))))))).

              +    (abs eq (Arrow Nat (Arrow Nat Nat))
              +      (abs m Nat
              +        (abs n Nat
              +          (test0 (var m)
              +            (test0 (var n) (const 1) (const 0))
              +            (test0 (var n)
              +              (const 0)
              +              (app (app (var eq)
              +                              (prd (var m)))
              +                      (prd (var n)))))))).

              +Example typechecks :
              +  emptyequal ∈ (Arrow Nat (Arrow Nat Nat)).
              +Proof. unfold equal. auto 10. (* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: typechecks *)

              +Example reduces :
              +  (app (app equal (const 4)) (const 4)) -->* (const 1).
              +Proof.
              (* 
              -Example equal_typechecks :
              -  empty |- equal ∈ (TArrow TNat (TArrow TNat TNat)).
              -Proof. unfold equal. auto 10.
              -Qed.
              -*)


              +  unfold equal. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: reduces *)

              +Example reduces2 :
              +  (app (app equal (const 4)) (const 5)) -->* (const 0).
              +Proof.
              (* 
              -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.
              -*)


              +  unfold equal. normalize.
              +*)
              +(* 请在此处解答 *) Admitted.

              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
              +           (\eo: (Nat->Nat * Nat->Nat).
              +              let e = \n:Nat. test0 n then 1 else eo.snd (pred n) in
              +              let o = \n:Nat. test0 n then 0 else eo.fst (pred n) in
                            (e,o)) in
                  let even = evenodd.fst in
                  let odd  = evenodd.snd in
              @@ -2092,38 +2158,41 @@

              MoreStlc扩展简单类型 Lambda- 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))))).

              +      (abs eo (Prod (Arrow Nat Nat) (Arrow Nat Nat))
              +        (pair
              +          (abs n Nat
              +            (test0 (var n)
              +              (const 1)
              +              (app (snd (var eo)) (prd (var n)))))
              +          (abs n Nat
              +            (test0 (var n)
              +              (const 0)
              +              (app (fst (var eo)) (prd (var n))))))))
              +  (tlet even (fst (var evenodd))
              +  (tlet odd (snd (var evenodd))
              +  (pair
              +    (app (var even) (const 3))
              +    (app (var even) (const 4))))).

              +Example typechecks :
              +  emptyeotest ∈ (Prod Nat Nat).
              +Proof. unfold eotest. eauto 30. (* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: typechecks *)

              +Example reduces :
              +  eotest -->* (pair (const 0) (const 1)).
              +Proof.
              (* 
              -Example eotest_typechecks :
              -  empty |- eotest ∈ (TProd TNat TNat).
              -Proof. unfold eotest. eauto 30.
              -Qed.
              -*)


              -(* 
              -Example eotest_example1:
              -  eotest ==>* (tpair (tnat 0) (tnat 1)).
              -Proof. unfold eotest. normalize. Qed.
              -*)


              +  unfold eotest. normalize.
              +*)

              +(* 请在此处解答 *) Admitted.
              +(* GRADE_THEOREM 0.25: reduces *)

              End FixTest4.

              End Examples.

              + +
              -

              定型的性质

              +

              定型的性质

              @@ -2131,39 +2200,48 @@

              MoreStlc扩展简单类型 Lambda-

              -

              可归约性

              +

              可归约性

              + +
              + +

              练习:3 星, standard (STLCE_progress)

              + Complete the proof of progress. +
              + + 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.
              -
              +
              -
              -Theorem progress : t T,
              -     empty |- tT
              -     value t t', t ==> t'.
              +Theorem progress : t T,
              +     emptytT
              +     value tt', t --> t'.
              Proof with eauto.
              -  (* 定理:假设 empty |- t : T,那么
              -       1. t 是值,或
              -       2. 存在某个 t' 使得 t ==> t'
              -     证明:对类型导出式进行归纳。*)

                intros t T Ht.
                remember empty as Gamma.
                generalize dependent HeqGamma.
                induction Ht; intros HeqGamma; subst.
                - (* T_Var *)
              -    (* 给定的类型导出式中的最后规则不可能是 
              -       T_Var, 因为它不可能是 empty |- x : T 这种情形(因为上下文为空). *)

              +    (* 给定的类型导出式中的最后规则不可能是
              +       T_Var, 因为它不可能是 empty x : T 这种情形(因为上下文为空). *)

                  inversion H.
                - (* T_Abs *)
              -    (* 如果规则 T_Abs 最后被使用,那么 
              -       t = tabs x T11 t12,也即一个值。 *)

              +    (* 如果规则 T_Abs 最后被使用,那么
              +       t = abs x T11 t12,也即一个值。 *)

                  left...
                - (* T_App *)
                  (* 如果最后被使用的规则是 T_App,那么 t = t1 t2
                     且有规则的形式我们可以知道
              -         empty |- t1 : T1 T2
              -         empty |- t2 : T1
              +         empty t1 : T1 T2
              +         empty t2 : T1
                     由归纳假设,t1 和 2 均要么是值,要么可前进一步。*)

                  right.
                  destruct IHHt1; subst...
              @@ -2171,18 +2249,18 @@

              MoreStlc扩展简单类型 Lambda-       destruct IHHt2; subst...
                    * (* t2 是值 *)
                      (* 如果 t1 和 t2 同时为值,那么我们可得
              -           t1 = tabs x T11 t12,因为抽象是函数类型唯一可能的值。
              +           t1 = abs x T11 t12,因为抽象是函数类型唯一可能的值。
                         但由规则 ST_AppAbs 可得
              -           (tabs x T11 t12) t2 ==> [x:=t2]t12。*)

              +           (abs x T11 t12) t2 --> [x:=t2]t12。*)

                      inversion H; subst; try solve_by_invert.
              -         (subst x t2 t12)...
              +        (subst x t2 t12)...
                    * (* t2 可前进 *)
              -        (* 如果 t1 是值且 t2 ==> t2'
              -           那么由 ST_App2 可得 t1 t2 ==> t1 t2'。 *)

              -        inversion H0 as [t2' Hstp]. (tapp t1 t2')...
              +        (* 如果 t1 是值且 t2 --> t2'
              +           那么由 ST_App2 可得 t1 t2 --> t1 t2'。 *)

              +        inversion H0 as [t2' Hstp]. (app t1 t2')...
                  + (* t1 可前进 *)
              -      (* 最后,如果 t1 ==> t1',那么由 ST_App1 可得 t1 t2 ==> t1' t2。*)
              -      inversion H as [t1' Hstp]. (tapp t1' t2)...
              +      (* 最后,如果 t1 --> t1',那么由 ST_App1 可得 t1 t2 --> t1' t2。*)
              +      inversion H as [t1' Hstp]. (app t1' t2)...
                - (* T_Nat *)
                  left...
                - (* T_Succ *)
              @@ -2190,19 +2268,19 @@

              MoreStlc扩展简单类型 Lambda-     destruct IHHt...
                  + (* t1 是值 *)
                    inversion H; subst; try solve_by_invert.
              -       (tnat (S n1))...
              +      (const (S n1))...
                  + (* t1 可前进 *)
                    inversion H as [t1' Hstp].
              -       (tsucc t1')...
              +      (scc t1')...
                - (* T_Pred *)
                  right.
                  destruct IHHt...
                  + (* t1 是值 *)
                    inversion H; subst; try solve_by_invert.
              -       (tnat (pred n1))...
              +      (const (pred n1))...
                  + (* t1 可前进 *)
                    inversion H as [t1' Hstp].
              -       (tpred t1')...
              +      (prd t1')...
                - (* T_Mult *)
                  right.
                  destruct IHHt1...
              @@ -2211,31 +2289,26 @@

              MoreStlc扩展简单类型 Lambda-       * (* t2 是值 *)
                      inversion H; subst; try solve_by_invert.
                      inversion H0; subst; try solve_by_invert.
              -         (tnat (mult n1 n0))...
              +        (const (mult n1 n0))...
                    * (* t2 可前进 *)
                      inversion H0 as [t2' Hstp].
              -         (tmult t1 t2')...
              +        (mlt t1 t2')...
                  + (* t1 可前进 *)
                    inversion H as [t1' Hstp].
              -       (tmult t1' t2)...
              -  - (* T_If0 *)
              +      (mlt t1' t2)...
              +  - (* T_Test0 *)
                  right.
                  destruct IHHt1...
                  + (* t1 是值 *)
                    inversion H; subst; try solve_by_invert.
                    destruct n1 as [|n1'].
                    * (* n1=0 *)
              -         t2...
              +        t2...
                    * (* n1<>0 *)
              -         t3...
              +        t3...
                  + (* t1 可前进 *)
                    inversion H as [t1' H0].
              -       (tif0 t1' t2 t3)...
              -  (* 请在此处解答 *)
              -  - (* T_Unit *)
              -    left...
              -  (* let *)
              -  (* 请在此处解答 *)
              +      (test0 t1' t2 t3)...
                - (* T_Inl *)
                  destruct IHHt...
                  + (* t1 可前进 *)
              @@ -2252,12 +2325,12 @@

              MoreStlc扩展简单类型 Lambda-     + (* t0 是值 *)
                    inversion H; subst; try solve_by_invert.
                    * (* t0 是 inl *)
              -         ([x1:=v]t1)...
              +        ([x1:=v]t1)...
                    * (* t0 是 inr *)
              -         ([x2:=v]t2)...
              +        ([x2:=v]t2)...
                  + (* t0 可前进 *)
                    inversion H as [t0' Hstp].
              -       (tcase t0' x1 t1 x2 t2)...
              +      (tcase t0' x1 t1 x2 t2)...
                - (* T_Nil *)
                  left...
                - (* T_Cons *)
              @@ -2266,119 +2339,141 @@

              MoreStlc扩展简单类型 Lambda-       destruct IHHt2...
                    * (* 尾部(tail)可前进 *)
                      right. inversion H0 as [t2' Hstp].
              -         (tcons t1 t2')...
              +        (tcons t1 t2')...
                  + (* 头部可前进 *)
                    right. inversion H as [t1' Hstp].
              -       (tcons t1' t2)...
              +      (tcons t1' t2)...
                - (* T_Lcase *)
                  right.
                  destruct IHHt1...
                  + (* t1 是值 *)
                    inversion H; subst; try solve_by_invert.
                    * (* t1=tnil *)
              -         t2...
              +        t2...
                    * (* t1=tcons v1 vl *)
              -         ([x2:=vl]([x1:=v1]t3))...
              +        ([x2:=vl]([x1:=v1]t3))...
                  + (* t1 可前进 *)
                    inversion H as [t1' Hstp].
              -       (tlcase t1' t2 x1 x2 t3)...
              +      (tlcase t1' t2 x1 x2 t3)...
              +  - (* T_Unit *)
              +    left...

              +  (* Complete the proof. *)

              +  (* pairs *)
              +  (* 请在此处解答 *)
              +  (* let *)
              +  (* 请在此处解答 *)
                (* fix *)
                (* 请在此处解答 *)
              -Qed.
              +(* 请在此处解答 *) Admitted.

              + +
              +(* 请勿修改下面这一行: *)
              +Definition manual_grade_for_progress : option (nat*string) := None.
              + +
              -

              上下文不变性

              +

              上下文不变性

              +
              + +

              练习:3 星, standard (STLCE_context_invariance)

              + Complete the definition of appears_free_in, and the proofs of + context_invariance and free_in_context.
              -
              +
              -
              Inductive appears_free_in : stringtmProp :=
              -  | afi_var : x,
              -      appears_free_in x (tvar x)
              -  | afi_app1 : x t1 t2,
              -      appears_free_in x t1appears_free_in x (tapp t1 t2)
              -  | afi_app2 : x t1 t2,
              -      appears_free_in x t2appears_free_in x (tapp t1 t2)
              -  | afi_abs : x y T11 t12,
              +  | afi_var : x,
              +      appears_free_in x (var x)
              +  | afi_app1 : x t1 t2,
              +      appears_free_in x t1appears_free_in x (app t1 t2)
              +  | afi_app2 : x t1 t2,
              +      appears_free_in x t2appears_free_in x (app t1 t2)
              +  | afi_abs : x y T11 t12,
                      yx
                      appears_free_in x t12
              -        appears_free_in x (tabs y T11 t12)
              -  (* 自然数 *)
              -  | afi_succ : x t,
              +        appears_free_in x (abs y T11 t12)
              +  (* 数值 *)
              +  | afi_succ : x t,
                   appears_free_in x t
              -     appears_free_in x (tsucc t)
              -  | afi_pred : x t,
              +     appears_free_in x (scc 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 (prd 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 (mlt 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 (mlt t1 t2)
              +  | afi_test01 : 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 (test0 t1 t2 t3)
              +  | afi_test02 : 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 (test0 t1 t2 t3)
              +  | afi_test03 : x t1 t2 t3,
                   appears_free_in x t3
              -     appears_free_in x (tif0 t1 t2 t3)
              -  (* 二元组 *)
              -  (* 请在此处解答 *)
              -  (* let *)
              -  (* 请在此处解答 *)
              -  (* 和 *)
              -  | afi_inl : x t T,
              +     appears_free_in x (test0 t1 t2 t3)
              +  (* sums *)
              +  | afi_inl : x t T,
                    appears_free_in x t
                    appears_free_in x (tinl T t)
              -  | afi_inr : x 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,
              +  | 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,
              +  | afi_case1 : x t0 x1 t1 x2 t2,
                    x1x
                    appears_free_in x t1
                    appears_free_in x (tcase t0 x1 t1 x2 t2)
              -  | afi_case2 : x t0 x1 t1 x2 t2,
              +  | afi_case2 : x t0 x1 t1 x2 t2,
                    x2x
                    appears_free_in x t2
                    appears_free_in x (tcase t0 x1 t1 x2 t2)
                (* 列表 *)
              -  | afi_cons1 : x t1 t2,
              +  | afi_cons1 : x t1 t2,
                   appears_free_in x t1
                   appears_free_in x (tcons t1 t2)
              -  | afi_cons2 : x 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,
              +  | 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,
              +  | 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,
              +  | afi_lcase3 : x t1 t2 y1 y2 t3,
                   y1x
                   y2x
                   appears_free_in x t3
                   appears_free_in x (tlcase t1 t2 y1 y2 t3)
              +
              +  (* Add rules for the following extensions. *)
              +
              +  (* pairs *)
              +  (* 请在此处解答 *)
              +  (* let *)
              +  (* 请在此处解答 *)
                (* fix *)
                (* 请在此处解答 *)
              .

              Hint Constructors appears_free_in.

              -Lemma context_invariance : Gamma Gamma' t S,
              -     Gamma |- tS
              -     ( x, appears_free_in x tGamma x = Gamma' x) →
              -     Gamma' |- tS.
              +Lemma context_invariance : Gamma Gamma' t S,
              +     GammatS
              +     (x, appears_free_in x tGamma x = Gamma' x) →
              +     Gamma'tS.
              -Proof with eauto.
              +(* Increasing the depth of eauto allows some more simple cases to
              +   be dispatched automatically. *)

              +Proof with eauto 30.
                intros. generalize dependent Gamma'.
                induction H;
                  intros Gamma' Heqv...
              @@ -2388,14 +2483,6 @@

              MoreStlc扩展简单类型 Lambda-     apply T_Abs... apply IHhas_type. intros y Hafi.
                  unfold update, t_update.
                  destruct (eqb_stringP x y)...
              -  - (* T_Mult *)
              -    apply T_Mult...
              -  - (* T_If0 *)
              -    apply T_If0...
              -  (* pair *)
              -  (* 请在此处解答 *)
              -  (* let *)
              -  (* 请在此处解答 *)
                - (* T_Case *)
                  eapply T_Case...
                  + apply IHhas_type2. intros y Hafi.
              @@ -2404,80 +2491,87 @@

              MoreStlc扩展简单类型 Lambda-     + apply IHhas_type3. intros y Hafi.
                    unfold update, t_update.
                    destruct (eqb_stringP x2 y)...
              -  - (* T_Cons *)
              -    apply T_Cons...
                - (* T_Lcase *)
                  eapply T_Lcase... apply IHhas_type3. intros y Hafi.
                  unfold update, t_update.
                  destruct (eqb_stringP x1 y)...
              -    destruct (eqb_stringP x2 y)...
              -Qed.
              +    destruct (eqb_stringP x2 y)...

              +  (* Complete the proof. *)

              +  (* 请在此处解答 *) Admitted.


              -Lemma free_in_context : x t T Gamma,
              +Lemma free_in_context : x t T Gamma,
                 appears_free_in x t
              -   Gamma |- tT
              -    T', Gamma x = Some T'.
              +   GammatT
              +   T', Gamma x = Some T'.
              Proof with eauto.
                intros x t T Gamma Hafi Htyp.
                induction Htyp; inversion Hafi; subst...
                - (* T_Abs *)
              -    destruct IHHtyp as [T' Hctx]... T'.
              +    destruct IHHtyp as [T' Hctx]... T'.
                  unfold update, t_update in Hctx.
                  rewrite false_eqb_string in Hctx...
              -  (* let *)
              -  (* 请在此处解答 *)
                (* T_Case *)
                - (* left *)
              -    destruct IHHtyp2 as [T' Hctx]... T'.
              +    destruct IHHtyp2 as [T' Hctx]... T'.
                  unfold update, t_update in Hctx.
                  rewrite false_eqb_string in Hctx...
                - (* right *)
              -    destruct IHHtyp3 as [T' Hctx]... T'.
              +    destruct IHHtyp3 as [T' Hctx]... T'.
                  unfold update, t_update in Hctx.
                  rewrite false_eqb_string in Hctx...
                - (* T_Lcase *)
                  clear Htyp1 IHHtyp1 Htyp2 IHHtyp2.
              -    destruct IHHtyp3 as [T' Hctx]... T'.
              +    destruct IHHtyp3 as [T' Hctx]... T'.
                  unfold update, t_update in Hctx.
                  rewrite false_eqb_string in Hctx...
              -    rewrite false_eqb_string in Hctx...
              -Qed.
              +    rewrite false_eqb_string in Hctx...

              +  (* Complete the proof. *)

              +  (* 请在此处解答 *) Admitted.
              + +
              +(* 请勿修改下面这一行: *)
              +Definition manual_grade_for_context_invariance : option (nat*string) := None.
              + +
              -

              替换

              +

              替换

              + +
              +

              练习:2 星, standard (STLCE_subst_preserves_typing)

              + Complete the proof of substitution_preserves_typing.
              -
              +
              -
              -Lemma substitution_preserves_typing : Gamma x U v t S,
              -     (update Gamma x U) |- tS
              -     empty |- vU
              -     Gamma |- ([x:=v]t) ∈ S.
              +Lemma substitution_preserves_typing : Gamma x U v t S,
              +     (update Gamma x U) ⊢ tS
              +     emptyvU
              +     Gamma ⊢ ([x:=v]t) ∈ S.
              Proof with eauto.
              -  (* 定理:如果 Gamma,x:U |- t : S 且 empty |- v : U,那么
              -     Gamma |- x:=vt : S。 *)

              +  (* 定理:如果 (x>U ; Gamma) t S 且 empty v U,那么
              +     Gamma [x:=v]t S. *)

                intros Gamma x U v t S Htypt Htypv.
                generalize dependent Gamma. generalize dependent S.
              -  (* 证明:对项 t 进行归纳。除了 tvar 和 tabs 外,多数情形可直接从 IH 得证。
              +  (* 证明:对项 t 进行归纳。除了 var 和 abs 外,多数情形可直接从 IH 得证。
                   他们不是自动完成的,因为我们需要推理变量之间如何交互。*)

                induction t;
                  intros S Gamma Htypt; simpl; inversion Htypt; subst...
              -  - (* tvar *)
              +  - (* var *)
                  simpl. rename s into y.
              -    (* 如果 t = y,那么通过反演 update Gamma x U y = Some S
              +    (* 如果 t = y,那么通过反演 update Gamma x U y = Some S
                     我们知道
              -         empty |- v : U 且
              -         Gamma,x:U |- y : S
              -       我们想要证明 Gamma |- [x:=v]y : S
              +           empty v U 且
              +           (x>U;Gamma) y S
              +       我们想要证明 Gamma [x:=v]y S

                     有两个情形需要考虑: x=y 或 xy。 *)

                  unfold update, t_update in H1.
              @@ -2485,7 +2579,7 @@

              MoreStlc扩展简单类型 Lambda-     + (* x=y *)
                    (* 如果 x = y,那么我们知道 U = S,并且
                       [x:=v]y = v。因此我们必须证明如果
              -         empty |- v : U 那么 Gamma |- v : U
              +         empty v U 那么 Gamma v U
                       我们已经证明了一个更一般的定理,叫做上下文不变性(context invariance)。*)

                    subst.
                    inversion H1; subst. clear H1.
              @@ -2496,45 +2590,46 @@

              MoreStlc扩展简单类型 Lambda-       inversion HT'.
                  + (* x<>y *)
                  (* 如果 x y,那么 Gamma y = Some S 并且替换不会产生任何影响。
              -      我们可以通过 T_Var 证明 Gamma |- y : S。 *)

              +      我们可以通过 T_Var 证明 Gamma y S。 *)

                    apply T_Var...
              -  - (* tabs *)
              +  - (* abs *)
                  rename s into y. rename t into T11.
              -    (* 如果 t = tabs y T11 t0, 那么我们知道
              -         Gamma,x:U |- tabs y T11 t0 : T11T12
              -         Gamma,x:U,y:T11 |- t0 : T12
              -         empty |- v : U
              -       作为归纳假设(IH),我们知道对所有的 S Gamma,
              -         Gamma,x:U |- t0 : S Gamma |- [x:=v]t0 : S.
              +    (* 如果 t = abs y T11 t0,那么我们知道
              +         (x>U;Gamma) abs y T11 t0 T11T12
              +         (y>T11;x>U;Gamma) t0 T12
              +         empty v U
              +       根据归纳假设(IH),我们知道对所有的 S 和 Gamma
              +         若 (x>U;Gamma) t0 S
              +         则 Gamma [x:=v]t0 S
              +
                     我们可以计算
              -         x:=vt = tabs y T11 (if eqb_string x y then t0 else x:=vt0)
              -       且我们必须证明 Gamma |- [x:=v]t : T11T12
              +         [x:=v]t = abs y T11 (if eqb_string x y then t0 else [x:=v]t0)
              +       且我们必须证明 Gamma [x:=v]t T11T12.  We know
                     我们知道可以通过 T_Abs 来达到此目的,因此剩下的便是证明:
              -         Gamma,y:T11 |- if eqb_string x y then t0 else [x:=v]t0 : T12
              -       我们考虑两个情形: x = y 和 x y
              +         (y>T11;Gamma) if eqb_string x y then t0 else [x:=v]t0 + T12
              +       我们考虑两个情形: x = y and x y.
                  *)

                  apply T_Abs...
                  destruct (eqb_stringP x y) as [Hxy|Hxy].
                  + (* x=y *)
                  (* 如果 x = y,那么替换不会产生任何影响。
              -       上下文不变性展示了 Gamma,y:U,y:T11 和 Gamma,y:T11 是等价的。
              -       因为前一个上下文展示了 t0 : T12,后者也同样。 *)

              +       上下文不变性展示了 y:T11;y>U;Gamma 和 y>T11;Gamma 是等价的。
              +       因为前一个上下文展示了 t0 T12,后者也同样。 *)

                    eapply context_invariance...
                    subst.
                    intros x Hafi. unfold update, t_update.
                    destruct (eqb_string y x)...
                  + (* x<>y *)
                    (* 如果 x y,那么归纳假设和上下文不变性允许我们证明
              -           Gamma,x:U,y:T11 |- t0 : T12       =>
              -           Gamma,y:T11,x:U |- t0 : T12       =>
              -           Gamma,y:T11 |- [x:=v]t0 : T12 *)

              +           (y>T11;x>U;Gamma) t0 T12       =>
              +           (x>U;y>T11;Gamma) t0 T12       =>
              +           (y>T11;Gamma) [x:=v]t0 T12 *)
                    apply IHt. eapply context_invariance...
                    intros z Hafi. unfold update, t_update.
                    destruct (eqb_stringP y z) as [Hyz|Hyz]...
                    subst.
                    rewrite false_eqb_string...
              -  (* let *)
              -  (* 请在此处解答 *)
                - (* tcase *)
                  rename s into x1. rename s0 into x2.
                  eapply T_Case...
              @@ -2585,59 +2680,65 @@

              MoreStlc扩展简单类型 Lambda-         destruct (eqb_stringP y1 z)...
                      subst. rewrite false_eqb_string...
                      destruct (eqb_stringP y2 z)...
              -        subst. rewrite false_eqb_string...
              -Qed.
              +        subst. rewrite false_eqb_string...

              +  (* Complete the proof. *)

              +  (* 请在此处解答 *) Admitted.

              + +
              +(* 请勿修改下面这一行: *)
              +Definition manual_grade_for_substitution_preserves_typing : option (nat*string) := None.
              + +
              -

              保型性

              +

              保型性

              +
              + +

              练习:3 星, standard (STLCE_preservation)

              + Complete the proof of preservation.
              -
              +
              -
              -Theorem preservation : t t' T,
              -     empty |- tT
              -     t ==> t'
              -     empty |- t'T.
              +Theorem preservation : t t' T,
              +     emptytT
              +     t --> t'
              +     emptyt'T.
              Proof with eauto.
                intros t t' T HT.
              -  (* 定理:如果 empty |- t : T 且 t ==> t',那么
              -     empty |- t' : T。 *)

              +  (* 定理:如果 empty t T 且 t --> t',那么
              +     empty t' T. *)

                remember empty as Gamma. generalize dependent HeqGamma.
                generalize dependent t'.
              -  (* 证明:对给定的类型导出式进行归纳。许多情形是矛盾的(T_VarT_Abs),  
              +  (* 证明:对给定的类型导出式进行归纳。许多情形是矛盾的(T_VarT_Abs),
                   我们只证明有趣的那几个情形。*)

                induction HT;
                  intros t' HeqGamma HE; subst; inversion HE; subst...
                - (* T_App *)
                  (* 如果最后被使用的规则是 T_App,那么 t = t1 t2
              -        且有三个规则会被用于证明 t ==> t'
              +        且有三个规则会被用于证明 t --> t'
                     ST_App1ST_App2,和 ST_AppAbs
                     在前两个情形中,结果可直接从归纳假设中得证。 *)

                  inversion HE; subst...
                  + (* ST_AppAbs *)
                    (* 对于第三个情形,假设
              -           t1 = tabs x T11 t12
              +           t1 = abs x T11 t12
                       且
                         t2 = v2
              -         我们必须证明 empty |- [x:=v2]t12 : T2
              +         我们必须证明 empty [x:=v2]t12 T2
                       由假设,我们可得
              -             empty |- tabs x T11 t12 : T1T2
              +             empty tabs x T11 t12 T1T2
                       且,由反演可得
              -             x:T1 |- t12 : T2
              +             x:T1 t12 T2
                       我们已经证明了类型在替换下的不变性,且根据假设可得
              -             empty |- v2 : T1
              +             empty v2 T1
                       证毕。 *)

                    apply substitution_preserves_typing with T1...
                    inversion HT1...
              -  (* fst and snd *)
              -  (* 请在此处解答 *)
              -  (* let *)
              -  (* 请在此处解答 *)
                (* T_Case *)
                - (* ST_CaseInl *)
                  inversion HT1; subst.
              @@ -2648,24 +2749,28 @@

              MoreStlc扩展简单类型 Lambda-   - (* T_Lcase *)
                  + (* ST_LcaseCons *)
                    inversion HT1; subst.
              -      apply substitution_preserves_typing with (TList T1)...
              -      apply substitution_preserves_typing with T1...
              +      apply substitution_preserves_typing with (List T1)...
              +      apply substitution_preserves_typing with T1...

              +  (* Complete the proof. *)

              +  (* fst and snd *)
              +  (* 请在此处解答 *)
              +  (* let *)
              +  (* 请在此处解答 *)
                (* fix *)
                (* 请在此处解答 *)
              -Qed.
              +(* 请在此处解答 *) Admitted.


              -End STLCExtended.

              (* 请勿修改下面这一行: *)
              -Definition manual_grade_for_STLC_extensions : option (nat*string) := None.
              +Definition manual_grade_for_preservation : option (nat*string) := None.
              -
              -
              +
              - +End STLCExtended.

              +(* Sat Jan 26 15:15:44 UTC 2019 *)
              diff --git a/plf-current/MoreStlc.v b/plf-current/MoreStlc.v index 53997865..74d35d71 100644 --- a/plf-current/MoreStlc.v +++ b/plf-current/MoreStlc.v @@ -5,6 +5,7 @@ From PLF Require Import Maps. From PLF Require Import Types. From PLF Require Import Smallstep. From PLF Require Import Stlc. +From Coq Require Import Strings.String. (* ################################################################# *) (** * STLC 的简单扩展 *) @@ -27,7 +28,7 @@ From PLF Require Import Stlc. (** 当写一个复杂的表达式时,为一些子表达式命名常常可以避免重复计算和提高可读性。 多数语言都提供了多种这样的机制。比如,在 OCaml(以及 Coq)中,我们可以写 [let - x=t1 in t2],意思是说“首先归约 [t1] 到一个值,并绑定到 [x] 上,同时继续对 [t2] + x=t1 in t2],意思是说“首先归约 [t1] 到一个值,并绑定到 [x] 上,同时继续对 [t2] 归约。” 我们的 [let] 绑定使用的求值策略和 OCaml 相同,均为标准的_'传值调用(call-by-value)'_, @@ -49,18 +50,18 @@ From PLF Require Import Stlc. (** 归约规则: - t1 ==> t1' + t1 --> t1' ---------------------------------- (ST_Let1) - let x=t1 in t2 ==> let x=t1' in t2 + let x=t1 in t2 --> let x=t1' in t2 ---------------------------- (ST_LetValue) - let x=v1 in t2 ==> [x:=v1]t2 + let x=v1 in t2 --> [x:=v1]t2 定型规则: - Gamma |- t1 : T1 Gamma & {{x-->T1}} |- t2 : T2 - --------------------------------------------------- (T_Let) - Gamma |- let x=t1 in t2 : T2 + Gamma |- t1 \in T1 x|->T1; Gamma |- t2 \in T2 + -------------------------------------------------- (T_Let) + Gamma |- let x=t1 in t2 \in T2 *) (* ================================================================= *) @@ -90,44 +91,43 @@ From PLF Require Import Stlc. (** 语法: t ::= 项 + | ... | (t,t) 二元组 | t.fst 第一个元素 | t.snd 第二个元素 - | ... v ::= 值 - | (v,v) 二元组值 | ... + | (v,v) 二元组值 T ::= 类型 - | T * T 积类型 | ... + | T * T 积类型 *) -(** 我们需要几个新的归约规则来描述二元组和投影操作的行为。*) -(** +(** 我们需要几个新的归约规则来描述二元组和投影操作的行为。 - t1 ==> t1' + t1 --> t1' -------------------- (ST_Pair1) - (t1,t2) ==> (t1',t2) + (t1,t2) --> (t1',t2) - t2 ==> t2' + t2 --> t2' -------------------- (ST_Pair2) - (v1,t2) ==> (v1,t2') + (v1,t2) --> (v1,t2') - t1 ==> t1' + t1 --> t1' ------------------ (ST_Fst1) - t1.fst ==> t1'.fst + t1.fst --> t1'.fst ------------------ (ST_FstPair) - (v1,v2).fst ==> v1 + (v1,v2).fst --> v1 - t1 ==> t1' + t1 --> t1' ------------------ (ST_Snd1) - t1.snd ==> t1'.snd + t1.snd --> t1'.snd ------------------ (ST_SndPair) - (v1,v2).snd ==> v2 + (v1,v2).snd --> v2 *) (** 规则 [ST_FstPair] 和 [ST_SndPair] 是说,我们可以对完全归约的二元组 @@ -140,57 +140,57 @@ From PLF Require Import Stlc. 是一个值。二元组的成员必须是值,这一点保证了当二元组作为参数传入一个函数时已经 完全归约了。*) -(** 二元组和投影的类型规则十分直接。 *) -(** +(** 二元组和投影的类型规则十分直接。 - Gamma |- t1 : T1 Gamma |- t2 : T2 - --------------------------------------- (T_Pair) - Gamma |- (t1,t2) : T1*T2 + Gamma |- t1 \in T1 Gamma |- t2 \in T2 + ----------------------------------------- (T_Pair) + Gamma |- (t1,t2) \in T1*T2 - Gamma |- t1 : T11*T12 - --------------------- (T_Fst) - Gamma |- t1.fst : T11 + Gamma |- t \in T1*T2 + --------------------- (T_Fst) + Gamma |- t.fst \in T1 - Gamma |- t1 : T11*T12 - --------------------- (T_Snd) - Gamma |- t1.snd : T12 + Gamma |- t \in T1*T2 + --------------------- (T_Snd) + Gamma |- t.snd \in T2 *) (** [T_Pair] 是说如果 [t1] 有类型 [T1] 且 [t2] 有类型 [T2], 那么 [(t1,t2)] 有类型 [T1*T2] 。相反,[T_Fst] 和 [T_Snd] 告诉我们, - 如果 [t1] 为积类型 [T11*T12](即,如果 [t1] 会归约为一个二元组), - 那么二元组的投影的类型为 [T11] 和 [T12]。*) + 如果 [t1] 为积类型 [T1*T2](即,如果 [t1] 会归约为一个二元组), + 那么二元组的投影的类型为 [T1] 和 [T2]。*) (* ================================================================= *) (** ** 单元素类型 *) -(** 另一个在 ML 语言家族中经常出现的基础类型是只含有一个元素的类型(singleton type),即 [Unit]。*) -(** 它只含有一个常量项 [unit](以小写 [u] 开头),以及一个类型规则使 [unit] 成为 - [Unit] 的一个元素。我们同时添加 [unit] 到可作为值的项的集合中,确实,[unit] +(** 另一个在 ML 语言家族中经常出现的基础类型是只含有一个元素的类型(singleton type),即 [Unit]。 + + 它只含有一个常量项 [unit](以小写 [u] 开头),以及一个类型规则使 [unit] 成为 + [Unit] 的一个元素。我们同时添加 [unit] 到可作为值的项的集合中,确实,[unit] 是 [Unit] 类型的表达式唯一可能的归约结果。 *) (** 语法: t ::= Terms - | unit unit value - | ... + | ... (other terms same as before) + | unit unit v ::= Values - | unit unit | ... + | unit unit value T ::= Types - | Unit Unit type | ... + | Unit unit type 定型规则: - -------------------- (T_Unit) - Gamma |- unit : Unit + ---------------------- (T_Unit) + Gamma |- unit \in Unit *) (** 看起来似乎有些奇怪,我们为什么要定义只含有一个元素的类型呢? - 毕竟,难道不是每个计算都不会在这样的类型中居留吗? + 毕竟,难道不是每个计算都不会在这样的类型中居留吗? 这是个好问题,而且确实在 STLC 中 [Unit] 类型并不是特别重要(尽管后面我们会看 到它的两个用处)。在更丰富的语言中,使用 [Unit] 类型来处理_'副作用(side effect)'_ @@ -200,127 +200,125 @@ From PLF Require Import Stlc. (* ================================================================= *) (** ** 和类型 *) -(** 一些程序需要处理具有两种不同形式的值。比如说,在会计应用中我们想要根据名字_'或'_ - 识别号码来搜索某个雇员。这个搜索函数可以返回匹配到的值,_'或'_返回一个错误代码。 +(** 一些程序需要处理具有两种不同形式的值。比如说,在一个大学数据库中中我们想要根据名字 + _'或'_识别号码来搜索某个学生。这个搜索函数可以返回匹配到的值,_'或'_返回一个错误代码。 有很多二元_'和类型(sum type)'_(有时候也叫做_'不交并(disjoint union)'_) 的具体例子,他们描述了从一个或两个给定类型的值的集合,例如: Nat + Bool -*) -(** + 我们在创建这些类型的值时,会为值_'标记(tagging)'_上其成分类型。 比如说,如果 [n] 是自然数,那么 [inl n] 是 [Nat+Bool] 的一个元素; - 类似地,如果 [b] 的类型为 [Bool],那么 [inr b] 是 [Nat+Bool] + 类似地,如果 [b] 的类型为 [Bool],那么 [inr b] 是 [Nat+Bool] 的一个元素。 如果把标签 [inl] 和 [inr] 看作函数,其类型解释了他们的名字: - inl : Nat -> Nat + Bool - inr : Bool -> Nat + Bool + inl \in Nat -> Nat + Bool + inr \in Bool -> Nat + Bool - 这两个函数分别将 [Nat] 或 [Bool] 的元素“注入”进和类型 [Nat+Bool] + 这两个函数分别将 [Nat] 或 [Bool] 的元素“注入”进和类型 [Nat+Bool] 的左成分或右成分中。(但其实我们不必将其作为函数形式化:[inl] 和 [inr] 是关键字,而且 [inl t] 和 [inr t] 是基本的语法形式,而非函数应用。) *) -(** 一般来说,被 [inl] 标记的 [T1] 的元素加上被 [inr] +(** 一般来说,被 [inl] 标记的 [T1] 的元素加上被 [inr] 标记的 [T2] 的元素一同构成了 [T1 + T2] 的元素。 *) -(** 和类型的一个重要用途是传递错误: +(** 我们之前在 Coq 编程中见过,和类型的一个重要用途是传递错误: - div : Nat -> Nat -> (Nat + Unit) = + div \in Nat -> Nat -> (Nat + Unit) div = \x:Nat. \y:Nat. - if iszero y then + test iszero y then inr unit else inl ... -*) -(** 事实上,上面的 [Nat + Unit] 类型与 Coq 中的 [option nat] + + 事实上,上面的 [Nat + Unit] 类型与 Coq 中的 [option nat] 类型是同构的——也即,我们很容易写出他们的转换函数。 *) -(** 为了_'使用'_和类型和元素,我们引入 [case] 语句(Coq 中 [match] - 的非常简化版)用于解构他们。比如说,下面的程序将 [Nat+Bool] 的值转为了 [Nat]:*) -(** +(** 为了_'使用'_和类型和元素,我们引入 [case] 语句(Coq 中 [match] + 的非常简化版)用于解构他们。比如说,下面的程序将 [Nat+Bool] 的值转为了 [Nat]: + getNat \in Nat+Bool -> Nat getNat = \x:Nat+Bool. case x of inl n => n - | inr b => if b then 1 else 0 -*) -(** 更加形式化地讲…… *) + | inr b => test b then 1 else 0 + + 更加形式化地讲…… *) (** 语法: t ::= 项 + | ... (和前面一样的其它项) | inl T t 左标记 | inr T t 右标记 | case t of 模式匹配 inl x => t | inr x => t - | ... v ::= 值 + | ... | inl T v 标记过的值(左) | inr T v 标记过的值(右) - | ... T ::= 类型 - | T + T 和类型 | ... + | T + T 和类型 *) (** 归约规则: + t1 --> t1' + ------------------------ (ST_Inl) + inl T2 t1 --> inl T2 t1' - t1 ==> t1' - ---------------------- (ST_Inl) - inl T t1 ==> inl T t1' - - t1 ==> t1' - ---------------------- (ST_Inr) - inr T t1 ==> inr T t1' + t2 --> t2' + ------------------------ (ST_Inr) + inr T1 t2 --> inr T1 t2' - t0 ==> t0' - ------------------------------------------- (ST_Case) - case t0 of inl x1 => t1 | inr x2 => t2 ==> - case t0' of inl x1 => t1 | inr x2 => t2 + 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_CaseInl) + case (inl T2 v1) of inl x1 => t1 | inr x2 => t2 + --> [x1:=v1]t1 - ---------------------------------------------- (ST_CaseInr) - case (inr T v0) of inl x1 => t1 | inr x2 => t2 - ==> [x2:=v0]t2 + ----------------------------------------------- (ST_CaseInr) + case (inr T1 v2) of inl x1 => t1 | inr x2 => t2 + --> [x2:=v1]t2 *) (** 定型规则: - Gamma |- t1 : T1 - ---------------------------- (T_Inl) - Gamma |- inl T2 t1 : T1 + T2 + Gamma |- t1 \in T1 + ------------------------------ (T_Inl) + Gamma |- inl T2 t1 \in T1 + T2 - Gamma |- t1 : T2 - ---------------------------- (T_Inr) - Gamma |- inr T1 t1 : T1 + T2 + Gamma |- t2 \in T2 + ------------------------------- (T_Inr) + Gamma |- inr T1 t2 \in 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 + Gamma |- t \in T1+T2 + x1|->T1; Gamma |- t1 \in T + x2|->T2; Gamma |- t2 \in T + ---------------------------------------------------- (T_Case) + Gamma |- case t of inl x1 => t1 | inr x2 => t2 \in T 为了让类型关系简单一点,在 [inl] 和 [inr] 规则中我们使用了类型注释,我们在处理 函数的类型时也是这么做的。*) -(** 如果没有这额外的类型信息,一旦我们确定了 [t1] 为类型 [T1],类型规则 +(** 如果没有这额外的类型信息,一旦我们确定了 [t1] 为类型 [T1],类型规则 [T_Inl] 则必须有能力为 [inl t1] 推导出类型 [T1 + T2],而其中 [T2] - 可为任意类型。比如说,我们可以同时推导出 [inl 5 : Nat + Nat] 和 + 可为任意类型。比如说,我们可以同时推导出 [inl 5 : Nat + Nat] 和 [inl 5 : Nat + Bool](以及无数个这样的类型)。这一特性(技术上说, 是类型唯一性的丧失)意味着我们无法像之前处理其他特性那样仅仅通过“自底向上地 阅读类型规则”来构造出类型检查的算法。 - + 有很多种方式处理这个难题。最简单的方法,也是我们在这里采用的,就是要求程序员 在注入时显式地提供和类型“另一侧”的类型。这对程序员会产生一些负担(因此很多 现实语言采用了其他方法),但这种方法易于理解和形式化。*) @@ -343,67 +341,67 @@ From PLF Require Import Stlc. (** 例如,下面的函数计算了一个数值列表的前两个元素之和: \x:List Nat. - lcase x of nil => 0 - | a::x' => lcase x' of nil => a - | b::x'' => a+b -*) -(** + lcase x of nil => 0 + | a::x' => lcase x' of nil => a + | b::x'' => a+b + 语法: t ::= 项 + | ... | nil T | cons t t - | lcase t of nil => t | x::x => t - | ... + | lcase t of nil => t + | x::x => t v ::= 值 + | ... | nil T nil 值 | cons v v cons 值 - | ... T ::= 类型 - | List T T 类型列表 | ... + | List T T 类型列表 *) (** 归约规则: - t1 ==> t1' + t1 --> t1' -------------------------- (ST_Cons1) - cons t1 t2 ==> cons t1' t2 + cons t1 t2 --> cons t1' t2 - t2 ==> t2' + t2 --> t2' -------------------------- (ST_Cons2) - cons v1 t2 ==> cons v1 t2' + cons v1 t2 --> cons v1 t2' - t1 ==> t1' - ---------------------------------------- (ST_Lcase1) - (lcase t1 of nil => t2 | xh::xt => t3) ==> + 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 + --> t2 - ----------------------------------------------- (ST_LcaseCons) + ------------------------------------------------ (ST_LcaseCons) (lcase (cons vh vt) of nil => t2 | xh::xt => t3) - ==> [xh:=vh,xt:=vt]t3 + --> [xh:=vh,xt:=vt]t3 *) (** 定型规则: - ----------------------- (T_Nil) - Gamma |- nil T : List T + ------------------------- (T_Nil) + Gamma |- nil T \in List T - Gamma |- t1 : T Gamma |- t2 : List T - ----------------------------------------- (T_Cons) - Gamma |- cons t1 t2: List T + Gamma |- t1 \in T Gamma |- t2 \in List T + --------------------------------------------- (T_Cons) + Gamma |- cons t1 t2 \in 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 + Gamma |- t1 \in List T1 + Gamma |- t2 \in T + (h|->T1; t|->List T1; Gamma) |- t3 \in T + --------------------------------------------------- (T_Lcase) + Gamma |- (lcase t1 of nil => t2 | h::t => t3) \in T *) (* ================================================================= *) @@ -413,22 +411,22 @@ From PLF Require Import Stlc. 如下方式定义阶乘函数: fact = \x:Nat. - if x=0 then 1 else x * (fact (pred x))) + test x=0 then 1 else x * (fact (pred x))) 请注意绑定的右侧使用了绑定左侧的变量名——这在我们之前的 [let] 中是不被允许的。 - 直接形式化这种“递归定义”机制是可行的,但也需要一点额外的努力:特别是,在 [step] + 直接形式化这种“递归定义”机制是可行的,但也需要一些额外的努力:特别是,在 [step] 关系中,我们需要给递归函数的定义传递一个“环境”。*) -(** 还有另外一种一样强大(但可能对程序员没那么方便)的方式来形式化递归函数, - 这种方式更加直接:我们不直接写递归的定义,而是定义一个叫做 [fix] +(** 还有另外一种有点啰嗦但一样强大的方式来形式化递归函数, + 这种方式更加直接:我们不直接写递归的定义,而是定义一个叫做 [fix] 的_'不动点算子(fixed-point operator)'_,它会在归约时“展开”定义右侧表达式中 出现的递归定义。 比如说,以下程序 fact = \x:Nat. - if x=0 then 1 else x * (fact (pred x))) + test x=0 then 1 else x * (fact (pred x))) 可以改写为: @@ -436,9 +434,9 @@ From PLF Require Import Stlc. fix (\f:Nat->Nat. \x:Nat. - if x=0 then 1 else x * (f (pred x))) -*) -(** 我们可用如下方式把前者转换为后者: + test x=0 then 1 else x * (f (pred x))) + + 我们可用如下方式把前者转换为后者: - 在 [fact] 的定义的右侧表达式中,替换递归引用的 [fact] 为一个新的变量 [f]。 @@ -459,109 +457,109 @@ From PLF Require Import Stlc. 所有输入 [n] 都有正确结果的函数。 (“不动点”在这里的含义与数学上的不动点是完全相同的,也即函数 [f] 的一个不动点 - 是对于输入 [x] 有 [f(x) = x]。这里,类型为 [(Nat->Nat)->(Nat->Nat)] + 是对于输入 [x] 有 [f(x) = x]。这里,类型为 [(Nat->Nat)->(Nat->Nat)] 的函数 [F] 的一个不动点是类型为 [Nat->Nat] 的函数 [f],使得 [F f] 与 [f] 的行为完全相同。) *) (** 语法: t ::= 项 - | fix t 不动点算子 | ... + | fix t 不动点算子 归约规则: - t1 ==> t1' + t1 --> t1' ------------------ (ST_Fix1) - fix t1 ==> fix t1' + fix t1 --> fix t1' -------------------------------------------- (ST_FixAbs) - fix (\xf:T1.t2) ==> [xf:=fix (\xf:T1.t2)] t2 + fix (\xf:T1.t2) --> [xf:=fix (\xf:T1.t2)] t2 定型规则: - Gamma |- t1 : T1->T1 - -------------------- (T_Fix) - Gamma |- fix t1 : T1 + Gamma |- t1 \in T1->T1 + ---------------------- (T_Fix) + Gamma |- fix t1 \in T1 *) (** 让我们以 [fact 3 = fix F 3] 为例看看 [ST_FixAbs] 是如何工作的,其中 - F = (\f. \x. if x=0 then 1 else x * (f (pred x))) + F = (\f. \x. test x=0 then 1 else x * (f (pred x))) (简洁起见,我们省略了类型注解)。 fix F 3 -[==>] [ST_FixAbs] + [ST_App1] +[-->] [ST_FixAbs] + [ST_App1] - (\x. if x=0 then 1 else x * (fix F (pred x))) 3 + (\x. test x=0 then 1 else x * (fix F (pred x))) 3 -[==>] [ST_AppAbs] +[-->] [ST_AppAbs] - if 3=0 then 1 else 3 * (fix F (pred 3)) + test 3=0 then 1 else 3 * (fix F (pred 3)) -[==>] [ST_If0_Nonzero] +[-->] [ST_Test0_Nonzero] 3 * (fix F (pred 3)) -[==>] [ST_FixAbs + ST_Mult2] +[-->] [ST_FixAbs + ST_Mult2] - 3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 3)) + 3 * ((\x. test x=0 then 1 else x * (fix F (pred x))) (pred 3)) -[==>] [ST_PredNat + ST_Mult2 + ST_App2] +[-->] [ST_PredNat + ST_Mult2 + ST_App2] - 3 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 2) + 3 * ((\x. test x=0 then 1 else x * (fix F (pred x))) 2) -[==>] [ST_AppAbs + ST_Mult2] +[-->] [ST_AppAbs + ST_Mult2] - 3 * (if 2=0 then 1 else 2 * (fix F (pred 2))) + 3 * (test 2=0 then 1 else 2 * (fix F (pred 2))) -[==>] [ST_If0_Nonzero + ST_Mult2] +[-->] [ST_Test0_Nonzero + ST_Mult2] 3 * (2 * (fix F (pred 2))) -[==>] [ST_FixAbs + 2 x ST_Mult2] +[-->] [ST_FixAbs + 2 x ST_Mult2] - 3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 2))) + 3 * (2 * ((\x. test x=0 then 1 else x * (fix F (pred x))) (pred 2))) -[==>] [ST_PredNat + 2 x ST_Mult2 + ST_App2] +[-->] [ST_PredNat + 2 x ST_Mult2 + ST_App2] - 3 * (2 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 1)) + 3 * (2 * ((\x. test x=0 then 1 else x * (fix F (pred x))) 1)) -[==>] [ST_AppAbs + 2 x ST_Mult2] +[-->] [ST_AppAbs + 2 x ST_Mult2] - 3 * (2 * (if 1=0 then 1 else 1 * (fix F (pred 1)))) + 3 * (2 * (test 1=0 then 1 else 1 * (fix F (pred 1)))) -[==>] [ST_If0_Nonzero + 2 x ST_Mult2] +[-->] [ST_Test0_Nonzero + 2 x ST_Mult2] 3 * (2 * (1 * (fix F (pred 1)))) -[==>] [ST_FixAbs + 3 x ST_Mult2] +[-->] [ST_FixAbs + 3 x ST_Mult2] - 3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) (pred 1)))) + 3 * (2 * (1 * ((\x. test x=0 then 1 else x * (fix F (pred x))) (pred 1)))) -[==>] [ST_PredNat + 3 x ST_Mult2 + ST_App2] +[-->] [ST_PredNat + 3 x ST_Mult2 + ST_App2] - 3 * (2 * (1 * ((\x. if x=0 then 1 else x * (fix F (pred x))) 0))) + 3 * (2 * (1 * ((\x. test x=0 then 1 else x * (fix F (pred x))) 0))) -[==>] [ST_AppAbs + 3 x ST_Mult2] +[-->] [ST_AppAbs + 3 x ST_Mult2] - 3 * (2 * (1 * (if 0=0 then 1 else 0 * (fix F (pred 0))))) + 3 * (2 * (1 * (test 0=0 then 1 else 0 * (fix F (pred 0))))) -[==>] [ST_If0Zero + 3 x ST_Mult2] +[-->] [ST_Test0Zero + 3 x ST_Mult2] 3 * (2 * (1 * 1)) -[==>] [ST_MultNats + 2 x ST_Mult2] +[-->] [ST_MultNats + 2 x ST_Mult2] 3 * (2 * 1) -[==>] [ST_MultNats + ST_Mult2] +[-->] [ST_MultNats + ST_Mult2] 3 * 2 -[==>] [ST_MultNats] +[-->] [ST_MultNats] 6 *) @@ -569,25 +567,27 @@ From PLF Require Import Stlc. (** 特别重要的一点是,不同于 Coq 中的 [Fixpoint] 定义, [fix] 并不会保证所定义的函数一定停机。*) -(** **** 练习:1 星, optional (halve_fix) *) -(** 请将下面非形式化的定义使用 [fix] 写出: +(** **** 练习:1 星, standard, optional (halve_fix) + + 请将下面非形式化的定义使用 [fix] 写出: halve = \x:Nat. - if x=0 then 0 - else if (pred x)=0 then 0 - else 1 + (halve (pred (pred x)))) + test x=0 then 0 + else test (pred x)=0 then 0 + else 1 + (halve (pred (pred x))) (* 请在此处解答 *) -*) -(** [] *) -(** **** 练习:1 星, optional (fact_steps) *) -(** 请分步骤写下 [fact 1] 如何归约为正规式(假定有一般算数操作的归约规则)。 + [] *) + +(** **** 练习:1 星, standard, optional (fact_steps) + + 请分步骤写下 [fact 1] 如何归约为正规式(假定有一般算数操作的归约规则)。 (* 请在此处解答 *) -*) -(** [] *) + + [] *) (** 对任意类型 [T],构造类型为 [T->T] 的函数的不动点的能力带了了一些令人惊讶的推论。 特别是,这意味着_'每个'_类型都存在某个项。我们可以观察到,对每个类型 [T], @@ -596,7 +596,7 @@ From PLF Require Import Stlc. fix (\x:T.x) 由规则 [T_Fix] 和 [T_Abs],这个项的类型为 [T]。由规则 [ST_FixAbs], - 这个项重复地归约为它自身。因此,它是类型 [T] 的_'不停机项(diverging element)'_。 + 这个项重复地归约为它自身。因此,它是类型 [T] 的_'不停机项(diverging element)'_。 从更为实用的角度,下面提供一个使用 [fix] 定义两个参数的递归函数: @@ -604,18 +604,18 @@ From PLF Require Import Stlc. fix (\eq:Nat->Nat->Bool. \m:Nat. \n:Nat. - if m=0 then iszero n - else if n=0 then false + test m=0 then iszero n + else test n=0 then fls else eq (pred m) (pred n)) -*) -(** 最后的例子展示了如何用 [fix] 定一个_'二元组'_的递归函数(规则 [T_Fix] + + 最后的例子展示了如何用 [fix] 定一个_'二元组'_的递归函数(规则 [T_Fix] 中的 [T1] 并不需要函数类型): 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 + let e = \n:Nat. test n=0 then tru else eo.snd (pred n) in + let o = \n:Nat. test n=0 then fls else eo.fst (pred n) in (e,o)) even = evenodd.fst @@ -626,57 +626,59 @@ From PLF Require Import Stlc. (** ** 字段组 *) (** 作为 STLC 最后的一个基础扩展,让我们简要地学习一下如何定义_'字段组(record)'_ - 及其类型。直观地说,字段组可以通过从两个方面一般化二元组来得到:他们是 n + 及其类型。直观地说,字段组可以通过从两个方面一般化二元组来得到:他们是 n 元(而不仅仅是二元)的而且可以通过_'标签(label)'_(而不仅仅是位置)来访问字段。 *) (** Syntax: t ::= Terms + | ... | {i1=t1, ..., in=tn} record | t.i projection - | ... v ::= Values - | {i1=v1, ..., in=vn} record value | ... + | {i1=v1, ..., in=vn} record value T ::= Types - | {i1:T1, ..., in:Tn} record type | ... + | {i1:T1, ..., in:Tn} record type +*) - 对二元组的一般化是很容易的。但是需要提醒的是,这里描述的方式要比之前章节中的 +(** 对二元组的一般化是很容易的。但是需要提醒的是,这里描述的方式要比之前章节中的 非形式语法_'更加'_非形式:我们多处使用了“[...]”来描述“任意数量的某项”, 我们还省略了“字段组的标签不应当重复”这个附加条件。*) (** 归约规则: - ti ==> ti' + ti --> ti' ------------------------------------ (ST_Rcd) - {i1=v1, ..., im=vm, in=ti, ...} - ==> {i1=v1, ..., im=vm, in=ti', ...} + {i1=v1, ..., im=vm, in=ti , ...} + --> {i1=v1, ..., im=vm, in=ti', ...} - t1 ==> t1' + t1 --> t1' -------------- (ST_Proj1) - t1.i ==> t1'.i + t1.i --> t1'.i ------------------------- (ST_ProjRcd) - {..., i=vi, ...}.i ==> vi + {..., i=vi, ...}.i --> vi +]]] - 再次提醒,这些规则是非形式化的。比如说,第一个规则应当被读做“如果 [ti] + 再次提醒,这些规则是非形式化的。比如说,第一个规则应当被读做“如果 [ti] 是最左边的非值字段,且如果 [ti] 前进一步归约到 [ti'],那么整个字段组归约为……”。 最后一个规则的意思是说应当只有一个名字为 [i] 的字段,而其他的字段必须指向值。*) (** 类型规则同样简单: - Gamma |- t1 : T1 ... Gamma |- tn : Tn - -------------------------------------------------- (T_Rcd) - Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn} + Gamma |- t1 \in T1 ... Gamma |- tn \in Tn + ---------------------------------------------------- (T_Rcd) + Gamma |- {i1=t1, ..., in=tn} \in {i1:T1, ..., in:Tn} - Gamma |- t : {..., i:Ti, ...} - ----------------------------- (T_Proj) - Gamma |- t.i : Ti + Gamma |- t \in {..., i:Ti, ...} + ------------------------------- (T_Proj) + Gamma |- t.i \in Ti *) (** 有许多种方式来形式化上面的描述。 @@ -686,29 +688,29 @@ From PLF Require Import Stlc. 它允许我们给出程序员易读的错误信息)。但是这些形式化的规则并不是十分容易和其他 部分配合,因为上面出现的 [...] 需要被替换为显式的量词(quantification) 或推导式(comprehension)。基于这个原因,本章最后的扩展练习中并没有包括字段组。 - (这里非形式化地讨论字段组仍然非常有用,因为它为 [Sub] + (这里非形式化地讨论字段组仍然非常有用,因为它为 [Sub] 一章中对子类型的讨论提供了基础。) - 此外,我们还可以用一种更简单的方式来表达字段组——比如说,相比与使用单一的构造子 直接地构造整个字段组,我们可以使用二元的表示,其中一个构造子表示空字段组, 另一个用于为已有的字段组添加一个新的字段。如果我们主要的兴趣在于学习带字段组 - 的演算的元理论,那么这种方式的定义和证明更加简单优雅。在 [Records] + 的演算的元理论,那么这种方式的定义和证明更加简单优雅。在 [Records] 一章中我们会学习此种处理方式。 - + - 最后,如果我们想的话,也可以通过使用二元组和积类型构造复杂的表达式并模拟字段组 来完全避免形式化字段组。在下一节中我们简要地描述这种方式。 *) (* ----------------------------------------------------------------- *) (** *** 编码字段组(选读) *) -(** 让我们看看如何只使用二元组和 [unit] 来编码字段组。 +(** 让我们看看如何只使用二元组和 [unit] 来编码字段组。(这种聪明的编码来自于 + Luca Cardelli,基于它也会扩展到具有子类型的系统观察。) 首先,我们可以用嵌套的二元组和 [unit] 值来编码任意大小的_'元组'_。为了避免重载 已有的二元组记法 [(t1,t2)],我们使用无标签的花括号来表示元组,例如 [{}] 是空元组,[{5}] 是只有一个元素的元组,[{5,6}] 是二元组, 而 [{5,6,7}] 是一个三元组,以此类推。 - {} ----> unit {t1, t2, ..., tn} ----> (t1, trest) 其中 {t2, ..., tn} ----> trest @@ -722,8 +724,7 @@ From PLF Require Import Stlc. 从元组中投影出元素的操作可以被编码为连续使用多次(或零次)第二投影操作, 最后使用第一投影操作: - t.0 ----> t.fst - t.(n+1) ----> (t.snd).n + t.0 ----> t.fst t.(n+1) ----> (t.snd).n 下一步,假设在字段组的标签上存在某种全序,那么我们可以为每个标签关联一个唯一的自然数。 这个数被乘坐标签的_'位置'_。比如说,我们可以像下面这样指派位置: @@ -741,25 +742,21 @@ From PLF Require Import Stlc. 我们根据字段的位置对他们排序,并使用这些位置来把字段组编码为元组(也即,嵌套的二元组)。 例如: - {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} + {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} 请注意,每个字段都出现在他们标签所关联的位置,因此元组的大小取决与有最高位置的标签, 我们把未使用的位置填充为 [unit] 值。 我们在编码字段组类型时使用同样的方式: - {a:Nat, b:Nat} ----> {Nat,Nat} - {c:Nat, a:Nat} ----> {Nat,Unit,Nat} - {f:Nat,c:Nat} ----> {Unit,Unit,Nat,Unit,Unit,Nat} + {a:Nat,b:Nat} ----> {Nat,Nat} {c:Nat,a:Nat} ----> {Nat,Unit,Nat} + {f:Nat,c:Nat} ----> {Unit,Unit,Nat,Unit,Unit,Nat} 最后,字段组投影被编码为在正确的位置上对元组投影: - t.l ----> t.(l 的位置) + t.l ----> t.(l 的位置) 我们不难用这种编码来验证以“直接”形式表达的字段组的类型规则。(除了我们编码的是排序后的字段, 剩下的归约规则几乎已经被验证了。) *) @@ -778,15 +775,19 @@ From PLF Require Import Stlc. 这些 n 元变种类型提供了足够的机制来构造任意的归纳数据类型,比如列表和树。 唯一缺少的东西是在类型定义中_'递归(recursion)'_。在本书中我们不会讲解这些, - 但在许多其他的教材中可以学习到他们,例如 Types and Programming Languages + 但在许多其他的教材中可以学习到他们,例如 Types and Programming Languages 一书 [Pierce 2002] (in Bib.v)。*) (* ################################################################# *) (** * 练习:形式化以上扩展 *) -(** **** 练习:5 星 (STLC_extensions) *) -(** 在接下来的练习中,你将会形式化本章中描述的一些扩展。我们提供了必要的项和类型的语法, - 以及一些例子用于测试你的定义是否工作。你需要完成剩下的定义,并相应地扩展证明。 +Module STLCExtended. + +(** **** 练习:3 星, standard (STLCE_definitions) + + 在接下来的一系列练习中,你将会形式化本章中描述的一些扩展。 + 我们提供了必要的项和类型的语法,以及一些例子用于测试你的定义是否工作。 + 你需要完成剩下的定义,并相应地扩展证明。 作为开始,我们提供了下列实现: - 数值 @@ -801,42 +802,31 @@ From PLF Require Import Stlc. 一个比较好的策略是一次完成一个扩展,分两部完成全部练习, 而不是尝试一次从头到尾完成本文件中所有的练习。 - 对每个定义或证明,首先仔细阅读已经提供的部分,可回顾 [Stlc] + 对每个定义或证明,首先仔细阅读已经提供的部分,可回顾 [Stlc] 一章中的文本,并展开嵌套的注释复习细节。*) -Module STLCExtended. - (* ----------------------------------------------------------------- *) (** *** 语法 *) Inductive ty : Type := - | TArrow : ty -> ty -> ty - | TNat : ty - | TUnit : ty - | TProd : ty -> ty -> ty - | TSum : ty -> ty -> ty - | TList : ty -> ty. + | Arrow : ty -> ty -> ty + | Nat : ty + | Sum : ty -> ty -> ty + | List : ty -> ty + | Unit : ty + | Prod : ty -> ty -> ty. Inductive tm : Type := (* 纯 STLC *) - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm (* 数值 *) - | tnat : nat -> tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tmult : tm -> tm -> tm - | tif0 : tm -> tm -> tm -> tm - (* 二元组 *) - | tpair : tm -> tm -> tm - | tfst : tm -> tm - | tsnd : tm -> tm - (* 单元 *) - | tunit : tm - (* let *) - | tlet : string -> tm -> tm -> tm - (* i.e., [let x = t1 in t2] *) + | const : nat -> tm + | scc : tm -> tm + | prd : tm -> tm + | mlt : tm -> tm -> tm + | test0 : tm -> tm -> tm -> tm (* 和 *) | tinl : ty -> tm -> tm | tinr : ty -> tm -> tm @@ -847,43 +837,55 @@ Inductive tm : Type := | tcons : tm -> tm -> tm | tlcase : tm -> tm -> string -> string -> tm -> tm (* i.e., [lcase t1 of | nil => t2 | x::y => t3] *) + (* unit *) + | unit : tm + + (* You are going to be working on the following extensions: *) + + (* pairs *) + | pair : tm -> tm -> tm + | fst : tm -> tm + | snd : tm -> tm + (* let *) + | tlet : string -> tm -> tm -> tm + (* i.e., [let x = t1 in t2] *) (* fix *) | tfix : tm -> tm. -(** 请注意,简洁起见,我们省略了布尔值,但提供了 [if0] 用于测试 0 值和作为条件语句。 +(** 请注意,简洁起见,我们省略了布尔值,但提供了 [test0] 用于测试 0 值和作为条件语句。 也即,当有: - if x = 0 then ... else ... + test x = 0 then ... else ... 我们可以写做: - if0 x then ... else ... + test0 x then ... else ... *) (* ----------------------------------------------------------------- *) (** *** 替换 *) -Fixpoint subst (x:string) (s:tm) (t:tm) : tm := +Fixpoint subst (x : string) (s : tm) (t : tm) : tm := match t with - | tvar y => + (* pure STLC *) + | var y => if eqb_string x y then s else t - | tabs y T t1 => - tabs y T (if eqb_string 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) - (* 请在此处解答 *) - | tunit => tunit - (* 请在此处解答 *) + | abs y T t1 => + abs y T (if eqb_string x y then t1 else (subst x s t1)) + | app t1 t2 => + app (subst x s t1) (subst x s t2) + (* numbers *) + | const n => + const n + | scc t1 => + scc (subst x s t1) + | prd t1 => + prd (subst x s t1) + | mlt t1 t2 => + mlt (subst x s t1) (subst x s t2) + | test0 t1 t2 t3 => + test0 (subst x s t1) (subst x s t2) (subst x s t3) + (* sums *) | tinl T t1 => tinl T (subst x s t1) | tinr T t1 => @@ -892,6 +894,7 @@ Fixpoint subst (x:string) (s:tm) (t:tm) : tm := tcase (subst x s t0) y1 (if eqb_string x y1 then t1 else (subst x s t1)) y2 (if eqb_string x y2 then t2 else (subst x s t2)) + (* lists *) | tnil T => tnil T | tcons t1 t2 => @@ -902,31 +905,34 @@ Fixpoint subst (x:string) (s:tm) (t:tm) : tm := t3 else if eqb_string x y2 then t3 else (subst x s t3)) + (* unit *) + | unit => unit + + (* Complete the following cases. *) + + (* pairs *) + (* 请在此处解答 *) + (* let *) + (* 请在此处解答 *) + (* fix *) (* 请在此处解答 *) - | _ => t (* ... and delete this line *) + | _ => t (* ... and delete this line when you finish the exercise *) end. Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). - (* ----------------------------------------------------------------- *) (** *** 归约 *) (** 下面我们定义语言的值。 *) Inductive value : tm -> Prop := + (* In pure STLC, function abstractions are values: *) | v_abs : forall x T11 t12, - value (tabs x T11 t12) + value (abs x T11 t12) (* 数值是值: *) | v_nat : forall n1, - value (tnat n1) - (* 成分为值的二元组是值: *) - | v_pair : forall v1 v2, - value v1 -> - value v2 -> - value (tpair v1 v2) - (* unit 总是值: *) - | v_unit : value tunit + value (const n1) (* 带标记的值也是值: *) | v_inl : forall v T, value v -> @@ -939,94 +945,106 @@ Inductive value : tm -> Prop := | v_lcons : forall v1 vl, value v1 -> value vl -> - value (tcons v1 vl). + value (tcons v1 vl) + (* A unit is always a value *) + | v_unit : value unit + (* A pair is a value if both components are: *) + | v_pair : forall v1 v2, + value v1 -> + value v2 -> + value (pair v1 v2). Hint Constructors value. -Reserved Notation "t1 '==>' t2" (at level 40). +Reserved Notation "t1 '-->' t2" (at level 40). Inductive step : tm -> tm -> Prop := + (* pure STLC *) | ST_AppAbs : forall x T11 t12 v2, value v2 -> - (tapp (tabs x T11 t12) v2) ==> [x:=v2]t12 + (app (abs x T11 t12) v2) --> [x:=v2]t12 | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) + t1 --> t1' -> + (app t1 t2) --> (app t1' t2) | ST_App2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - (tapp v1 t2) ==> (tapp v1 t2') - (* 自然数 *) + t2 --> t2' -> + (app v1 t2) --> (app v1 t2') + (* 数值 *) | ST_Succ1 : forall t1 t1', - t1 ==> t1' -> - (tsucc t1) ==> (tsucc t1') + t1 --> t1' -> + (scc t1) --> (scc t1') | ST_SuccNat : forall n1, - (tsucc (tnat n1)) ==> (tnat (S n1)) + (scc (const n1)) --> (const (S n1)) | ST_Pred : forall t1 t1', - t1 ==> t1' -> - (tpred t1) ==> (tpred t1') + t1 --> t1' -> + (prd t1) --> (prd t1') | ST_PredNat : forall n1, - (tpred (tnat n1)) ==> (tnat (pred n1)) + (prd (const n1)) --> (const (pred n1)) | ST_Mult1 : forall t1 t1' t2, - t1 ==> t1' -> - (tmult t1 t2) ==> (tmult t1' t2) + t1 --> t1' -> + (mlt t1 t2) --> (mlt 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 - (* 二元组 *) - (* 请在此处解答 *) - (* let *) - (* 请在此处解答 *) - (* 和 *) + t2 --> t2' -> + (mlt v1 t2) --> (mlt v1 t2') + | ST_Mulconsts : forall n1 n2, + (mlt (const n1) (const n2)) --> (const (mult n1 n2)) + | ST_Test01 : forall t1 t1' t2 t3, + t1 --> t1' -> + (test0 t1 t2 t3) --> (test0 t1' t2 t3) + | ST_Test0Zero : forall t2 t3, + (test0 (const 0) t2 t3) --> t2 + | ST_Test0Nonzero : forall n t2 t3, + (test0 (const (S n)) t2 t3) --> t3 + (* sums *) | ST_Inl : forall t1 t1' T, - t1 ==> t1' -> - (tinl T t1) ==> (tinl T t1') + t1 --> t1' -> + (tinl T t1) --> (tinl T t1') | ST_Inr : forall t1 t1' T, - t1 ==> t1' -> - (tinr T t1) ==> (tinr T t1') + 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) + 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 + (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 - (* 列表 *) + (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) + t1 --> t1' -> + (tcons t1 t2) --> (tcons t1' t2) | ST_Cons2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - (tcons v1 t2) ==> (tcons v1 t2') + 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) + 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 + (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)) + value v1 -> + value vl -> + (tlcase (tcons v1 vl) t2 x1 x2 t3) + --> (subst x2 vl (subst x1 v1 t3)) + + (* Add rules for the following extensions. *) + + (* 二元组 *) + (* 请在此处解答 *) + (* let *) + (* 请在此处解答 *) (* fix *) (* 请在此处解答 *) -where "t1 '==>' t2" := (step t1 t2). +where "t1 '-->' t2" := (step t1 t2). Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40). Hint Constructors step. @@ -1040,66 +1058,69 @@ Definition context := partial_map ty. Reserved Notation "Gamma '|-' t '\in' T" (at level 40). Inductive has_type : context -> tm -> ty -> Prop := - (* 基本项的定型规则 *) + (* 纯 STLC 的定型规则 *) | T_Var : forall Gamma x T, Gamma x = Some T -> - Gamma |- (tvar x) \in T + Gamma |- (var x) \in T | T_Abs : forall Gamma x T11 T12 t12, (update Gamma x T11) |- t12 \in T12 -> - Gamma |- (tabs x T11 t12) \in (TArrow T11 T12) + Gamma |- (abs x T11 t12) \in (Arrow T11 T12) | T_App : forall T1 T2 Gamma t1 t2, - Gamma |- t1 \in (TArrow T1 T2) -> + Gamma |- t1 \in (Arrow T1 T2) -> Gamma |- t2 \in T1 -> - Gamma |- (tapp t1 t2) \in T2 - (* 自然数 *) + Gamma |- (app t1 t2) \in T2 + (* 数值 *) | T_Nat : forall Gamma n1, - Gamma |- (tnat n1) \in TNat + Gamma |- (const n1) \in Nat | T_Succ : forall Gamma t1, - Gamma |- t1 \in TNat -> - Gamma |- (tsucc t1) \in TNat + Gamma |- t1 \in Nat -> + Gamma |- (scc t1) \in Nat | T_Pred : forall Gamma t1, - Gamma |- t1 \in TNat -> - Gamma |- (tpred t1) \in TNat + Gamma |- t1 \in Nat -> + Gamma |- (prd t1) \in Nat | 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 |- t1 \in Nat -> + Gamma |- t2 \in Nat -> + Gamma |- (mlt t1 t2) \in Nat + | T_Test0 : forall Gamma t1 t2 t3 T1, + Gamma |- t1 \in Nat -> Gamma |- t2 \in T1 -> Gamma |- t3 \in T1 -> - Gamma |- (tif0 t1 t2 t3) \in T1 - (* 二元组 *) - (* 请在此处解答 *) - (* 单元 *) - | T_Unit : forall Gamma, - Gamma |- tunit \in TUnit - (* let *) - (* 请在此处解答 *) + Gamma |- (test0 t1 t2 t3) \in T1 (* 和 *) | T_Inl : forall Gamma t1 T1 T2, Gamma |- t1 \in T1 -> - Gamma |- (tinl T2 t1) \in (TSum T1 T2) + Gamma |- (tinl T2 t1) \in (Sum T1 T2) | T_Inr : forall Gamma t2 T1 T2, Gamma |- t2 \in T2 -> - Gamma |- (tinr T1 t2) \in (TSum T1 T2) + Gamma |- (tinr T1 t2) \in (Sum T1 T2) | T_Case : forall Gamma t0 x1 T1 t1 x2 T2 t2 T, - Gamma |- t0 \in (TSum T1 T2) -> + Gamma |- t0 \in (Sum T1 T2) -> (update Gamma x1 T1) |- t1 \in T -> (update Gamma x2 T2) |- t2 \in T -> Gamma |- (tcase t0 x1 t1 x2 t2) \in T (* 列表 *) | T_Nil : forall Gamma T, - Gamma |- (tnil T) \in (TList T) + Gamma |- (tnil T) \in (List T) | T_Cons : forall Gamma t1 t2 T1, Gamma |- t1 \in T1 -> - Gamma |- t2 \in (TList T1) -> - Gamma |- (tcons t1 t2) \in (TList T1) + Gamma |- t2 \in (List T1) -> + Gamma |- (tcons t1 t2) \in (List T1) | T_Lcase : forall Gamma t1 T1 t2 x1 x2 t3 T2, - Gamma |- t1 \in (TList T1) -> + Gamma |- t1 \in (List T1) -> Gamma |- t2 \in T2 -> - (update (update Gamma x2 (TList T1)) x1 T1) |- t3 \in T2 -> + (update (update Gamma x2 (List T1)) x1 T1) |- t3 \in T2 -> Gamma |- (tlcase t1 t2 x1 x2 t3) \in T2 + (* unit *) + | T_Unit : forall Gamma, + Gamma |- unit \in Unit + + (* Add rules for the following extensions. *) + + (* pairs *) + (* 请在此处解答 *) + (* let *) + (* 请在此处解答 *) (* fix *) (* 请在此处解答 *) @@ -1107,10 +1128,19 @@ where "Gamma '|-' t '\in' T" := (has_type Gamma t T). Hint Constructors has_type. +(* 请勿修改下面这一行: *) +Definition manual_grade_for_extensions_definition : option (nat*string) := None. +(** [] *) + (* ================================================================= *) (** ** 例子 *) -(** 本节形式化了一些上文中出现的例子(以及一些其他的例子)。 +(** **** 练习:3 星, standard (STLCE_examples) + + 本节形式化了一些上文中出现的例子(以及一些其他的例子)。 + + 只要你为通过测试实现了足够的定义,就取消证明的注释并将 [Admitted] 替换为 [Qed]。 + 最开始我们会专注于某些特性,而在开始证明这些特性之前,你可以用一些例子先来 测试一下你的定义是否合理。后面的例子会整合全部的特性,因此你需要在完成所有的 定义后再阅读这部分。*) @@ -1144,13 +1174,13 @@ Notation eo := "eo". (** 下面,我们为 Coq 提供一些提示来自动地搜索类型导出式。你不需要理解这部分的全部细节—— 大概看一下便可,当你需要自己扩展 [auto] 时可再回过头来学习。 - 下面的 [Hint] 定义是说,当 [auto] 遇到一个形如 [(Gamma |- (tapp e1 e1) \in T)] + 下面的 [Hint] 定义是说,当 [auto] 遇到一个形如 [(Gamma |- (app e1 e1) \in T)] 的目标时,它应当考虑使用 [eapply T_App],并为中间的类型 T1 留下一个存在变量。 [lcase] 与此类似。这个变量在后面为 [e1] 和 [e2] 搜索类型导出式的过程中会被填补。 我们还引入一个提示用于搜索形如等式的证明目标;这对使用 [T_Var] 的情景非常有用 (其含有一个等式作为前提条件)。 *) -Hint Extern 2 (has_type _ (tapp _ _) _) => +Hint Extern 2 (has_type _ (app _ _) _) => eapply T_App; auto. Hint Extern 2 (has_type _ (tlcase _ _ _ _ _) _) => eapply T_Lcase; auto. @@ -1161,35 +1191,33 @@ Hint Extern 2 (_ = _) => compute; reflexivity. Module Numtest. -(* if0 (pred (succ (pred (2 * 0))) then 5 else 6 *) +(* test0 (pred (succ (pred (2 * 0))) then 5 else 6 *) Definition test := - tif0 - (tpred - (tsucc - (tpred - (tmult - (tnat 2) - (tnat 0))))) - (tnat 5) - (tnat 6). - -(** 当你完成足够的定义后将注释括号移除。 *) + test0 + (prd + (scc + (prd + (mlt + (const 2) + (const 0))))) + (const 5) + (const 6). -(* Example typechecks : - empty |- test \in TNat. + empty |- test \in Nat. Proof. unfold test. (* 这里的类型导出式非常深,因此我们需要将 [auto] 的最大搜索深度从 5 改为 10。 *) auto 10. -Qed. +(* 请在此处解答 *) Admitted. Example numtest_reduces : - test ==>* tnat 5. + test -->* const 5. Proof. +(* unfold test. normalize. -Qed. *) +(* 请在此处解答 *) Admitted. End Numtest. @@ -1200,23 +1228,27 @@ Module Prodtest. (* ((5,6),7).fst.snd *) Definition test := - tsnd - (tfst - (tpair - (tpair - (tnat 5) - (tnat 6)) - (tnat 7))). + snd + (fst + (pair + (pair + (const 5) + (const 6)) + (const 7))). -(* Example typechecks : - empty |- test \in TNat. -Proof. unfold test. eauto 15. Qed. + empty |- test \in Nat. +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: typechecks *) Example reduces : - test ==>* tnat 6. -Proof. unfold test. normalize. Qed. + test -->* const 6. +Proof. +(* + unfold test. normalize. *) +(* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: reduces *) End Prodtest. @@ -1229,18 +1261,22 @@ Module LetTest. Definition test := tlet x - (tpred (tnat 6)) - (tsucc (tvar x)). + (prd (const 6)) + (scc (var x)). -(* Example typechecks : - empty |- test \in TNat. -Proof. unfold test. eauto 15. Qed. + empty |- test \in Nat. +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: typechecks *) Example reduces : - test ==>* tnat 6. -Proof. unfold test. normalize. Qed. + test -->* const 6. +Proof. +(* + unfold test. normalize. *) +(* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: reduces *) End LetTest. @@ -1254,19 +1290,21 @@ Module Sumtest1. | inr y => y *) Definition test := - tcase (tinl TNat (tnat 5)) - x (tvar x) - y (tvar y). + tcase (tinl Nat (const 5)) + x (var x) + y (var y). -(* Example typechecks : - empty |- test \in TNat. -Proof. unfold test. eauto 15. Qed. + empty |- test \in Nat. +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted. Example reduces : - test ==>* (tnat 5). -Proof. unfold test. normalize. Qed. + test -->* (const 5). +Proof. +(* + unfold test. normalize. *) +(* 请在此处解答 *) Admitted. End Sumtest1. @@ -1276,29 +1314,31 @@ Module Sumtest2. \x:Nat+Nat. case x of inl n => n - inr n => if0 n then 1 else 0 in + inr n => test0 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)))). + (abs x (Sum Nat Nat) + (tcase (var x) + n (var n) + n (test0 (var n) (const 1) (const 0)))) + (pair + (app (var processSum) (tinl Nat (const 5))) + (app (var processSum) (tinr Nat (const 5)))). -(* Example typechecks : - empty |- test \in (TProd TNat TNat). -Proof. unfold test. eauto 15. Qed. + empty |- test \in (Prod Nat Nat). +Proof. unfold test. eauto 15. (* 请在此处解答 *) Admitted. Example reduces : - test ==>* (tpair (tnat 5) (tnat 0)). -Proof. unfold test. normalize. Qed. + test -->* (pair (const 5) (const 0)). +Proof. +(* + unfold test. normalize. *) +(* 请在此处解答 *) Admitted. End Sumtest2. @@ -1314,20 +1354,22 @@ Module ListTest. Definition test := tlet l - (tcons (tnat 5) (tcons (tnat 6) (tnil TNat))) - (tlcase (tvar l) - (tnat 0) - x y (tmult (tvar x) (tvar x))). + (tcons (const 5) (tcons (const 6) (tnil Nat))) + (tlcase (var l) + (const 0) + x y (mlt (var x) (var x))). -(* Example typechecks : - empty |- test \in TNat. -Proof. unfold test. eauto 20. Qed. + empty |- test \in Nat. +Proof. unfold test. eauto 20. (* 请在此处解答 *) Admitted. Example reduces : - test ==>* (tnat 25). -Proof. unfold test. normalize. Qed. + test -->* (const 25). +Proof. +(* + unfold test. normalize. *) +(* 请在此处解答 *) Admitted. End ListTest. @@ -1339,32 +1381,33 @@ Module FixTest1. (* fact := fix (\f:nat->nat. \a:nat. - if a=0 then 1 else a * (f (pred a))) *) + test 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))))))). + (abs f (Arrow Nat Nat) + (abs a Nat + (test0 + (var a) + (const 1) + (mlt + (var a) + (app (var f) (prd (var a))))))). (** (警告:[fact] 可能通过了类型检查但仍然会有一些类型规则是错误的!) *) -(* -Example fact_typechecks : - empty |- fact \in (TArrow TNat TNat). -Proof. unfold fact. auto 10. -Qed. -*) +Example typechecks : + empty |- fact \in (Arrow Nat Nat). +Proof. unfold fact. auto 10. (* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: typechecks *) +Example reduces : + (app fact (const 4)) -->* (const 24). +Proof. (* -Example fact_example: - (tapp fact (tnat 4)) ==>* (tnat 24). -Proof. unfold fact. normalize. Qed. + unfold fact. normalize. *) +(* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: reduces *) End FixTest1. @@ -1379,30 +1422,33 @@ Module FixTest2. | [] -> [] | x::l -> (g x)::(f l)) *) Definition map := - tabs g (TArrow TNat TNat) + abs g (Arrow Nat Nat) (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))))))). + (abs f (Arrow (List Nat) (List Nat)) + (abs l (List Nat) + (tlcase (var l) + (tnil Nat) + a l (tcons (app (var g) (var a)) + (app (var f) (var l))))))). -(* -(* 请确保你已将上面最后一个 [Hint Extern] 从注释中移出。 *) -Example map_typechecks : +Example 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. + (Arrow (Arrow Nat Nat) + (Arrow (List Nat) + (List Nat))). +Proof. unfold map. auto 10. (* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: typechecks *) + +Example reduces : + app (app map (abs a Nat (scc (var a)))) + (tcons (const 1) (tcons (const 2) (tnil Nat))) + -->* (tcons (const 2) (tcons (const 3) (tnil Nat))). +Proof. +(* + unfold map. normalize. *) +(* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: reduces *) End FixTest2. @@ -1412,41 +1458,44 @@ Module FixTest3. fix (\eq:Nat->Nat->Bool. \m:Nat. \n:Nat. - if0 m then (if0 n then 1 else 0) - else if0 n then 0 + test0 m then (test0 n then 1 else 0) + else test0 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)))))))). + (abs eq (Arrow Nat (Arrow Nat Nat)) + (abs m Nat + (abs n Nat + (test0 (var m) + (test0 (var n) (const 1) (const 0)) + (test0 (var n) + (const 0) + (app (app (var eq) + (prd (var m))) + (prd (var n)))))))). -(* -Example equal_typechecks : - empty |- equal \in (TArrow TNat (TArrow TNat TNat)). -Proof. unfold equal. auto 10. -Qed. -*) +Example typechecks : + empty |- equal \in (Arrow Nat (Arrow Nat Nat)). +Proof. unfold equal. auto 10. (* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: typechecks *) +Example reduces : + (app (app equal (const 4)) (const 4)) -->* (const 1). +Proof. (* -Example equal_example1: - (tapp (tapp equal (tnat 4)) (tnat 4)) ==>* (tnat 1). -Proof. unfold equal. normalize. Qed. + unfold equal. normalize. *) +(* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: reduces *) +Example reduces2 : + (app (app equal (const 4)) (const 5)) -->* (const 0). +Proof. (* -Example equal_example2: - (tapp (tapp equal (tnat 4)) (tnat 5)) ==>* (tnat 0). -Proof. unfold equal. normalize. Qed. + unfold equal. normalize. *) +(* 请在此处解答 *) Admitted. End FixTest3. @@ -1455,8 +1504,8 @@ 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 + let e = \n:Nat. test0 n then 1 else eo.snd (pred n) in + let o = \n:Nat. test0 n then 0 else eo.fst (pred n) in (e,o)) in let even = evenodd.fst in let odd = evenodd.snd in @@ -1466,38 +1515,40 @@ Module FixTest4. 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))))). + (abs eo (Prod (Arrow Nat Nat) (Arrow Nat Nat)) + (pair + (abs n Nat + (test0 (var n) + (const 1) + (app (snd (var eo)) (prd (var n))))) + (abs n Nat + (test0 (var n) + (const 0) + (app (fst (var eo)) (prd (var n)))))))) + (tlet even (fst (var evenodd)) + (tlet odd (snd (var evenodd)) + (pair + (app (var even) (const 3)) + (app (var even) (const 4))))). -(* -Example eotest_typechecks : - empty |- eotest \in (TProd TNat TNat). -Proof. unfold eotest. eauto 30. -Qed. -*) +Example typechecks : + empty |- eotest \in (Prod Nat Nat). +Proof. unfold eotest. eauto 30. (* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: typechecks *) +Example reduces : + eotest -->* (pair (const 0) (const 1)). +Proof. (* -Example eotest_example1: - eotest ==>* (tpair (tnat 0) (tnat 1)). -Proof. unfold eotest. normalize. Qed. + unfold eotest. normalize. *) +(* 请在此处解答 *) Admitted. +(* GRADE_THEOREM 0.25: reduces *) End FixTest4. End Examples. +(** [] *) (* ================================================================= *) (** ** 定型的性质 *) @@ -1507,25 +1558,31 @@ End Examples. (* ----------------------------------------------------------------- *) (** *** 可归约性 *) +(** **** 练习:3 星, standard (STLCE_progress) + + Complete the proof of [progress]. + + Theorem: Suppose empty |- t \in T. Then either + 1. t is a value, or + 2. t --> t' for some t'. + + Proof: By induction on the given typing derivation. *) + Theorem progress : forall t T, empty |- t \in T -> - value t \/ exists t', t ==> t'. + value t \/ exists t', t --> t'. Proof with eauto. - (* 定理:假设 empty |- t : T,那么 - 1. t 是值,或 - 2. 存在某个 t' 使得 t ==> t' - 证明:对类型导出式进行归纳。*) intros t T Ht. remember empty as Gamma. generalize dependent HeqGamma. induction Ht; intros HeqGamma; subst. - (* T_Var *) - (* 给定的类型导出式中的最后规则不可能是 + (* 给定的类型导出式中的最后规则不可能是 [T_Var], 因为它不可能是 [empty |- x : T] 这种情形(因为上下文为空). *) inversion H. - (* T_Abs *) - (* 如果规则 [T_Abs] 最后被使用,那么 - [t = tabs x T11 t12],也即一个值。 *) + (* 如果规则 [T_Abs] 最后被使用,那么 + [t = abs x T11 t12],也即一个值。 *) left... - (* T_App *) (* 如果最后被使用的规则是 [T_App],那么 [t = t1 t2], @@ -1539,18 +1596,18 @@ Proof with eauto. destruct IHHt2; subst... * (* t2 是值 *) (* 如果 [t1] 和 [t2] 同时为值,那么我们可得 - [t1 = tabs x T11 t12],因为抽象是函数类型唯一可能的值。 + [t1 = abs x T11 t12],因为抽象是函数类型唯一可能的值。 但由规则 [ST_AppAbs] 可得 - [(tabs x T11 t12) t2 ==> [x:=t2]t12]。*) + [(abs x T11 t12) t2 --> [x:=t2]t12]。*) inversion H; subst; try solve_by_invert. exists (subst x t2 t12)... * (* t2 可前进 *) - (* 如果 [t1] 是值且 [t2 ==> t2'], - 那么由 [ST_App2] 可得 [t1 t2 ==> t1 t2']。 *) - inversion H0 as [t2' Hstp]. exists (tapp t1 t2')... + (* 如果 [t1] 是值且 [t2 --> t2'], + 那么由 [ST_App2] 可得 [t1 t2 --> t1 t2']。 *) + inversion H0 as [t2' Hstp]. exists (app t1 t2')... + (* t1 可前进 *) - (* 最后,如果 [t1 ==> t1'],那么由 [ST_App1] 可得 [t1 t2 ==> t1' t2]。*) - inversion H as [t1' Hstp]. exists (tapp t1' t2)... + (* 最后,如果 [t1 --> t1'],那么由 [ST_App1] 可得 [t1 t2 --> t1' t2]。*) + inversion H as [t1' Hstp]. exists (app t1' t2)... - (* T_Nat *) left... - (* T_Succ *) @@ -1558,19 +1615,19 @@ Proof with eauto. destruct IHHt... + (* t1 是值 *) inversion H; subst; try solve_by_invert. - exists (tnat (S n1))... + exists (const (S n1))... + (* t1 可前进 *) inversion H as [t1' Hstp]. - exists (tsucc t1')... + exists (scc t1')... - (* T_Pred *) right. destruct IHHt... + (* t1 是值 *) inversion H; subst; try solve_by_invert. - exists (tnat (pred n1))... + exists (const (pred n1))... + (* t1 可前进 *) inversion H as [t1' Hstp]. - exists (tpred t1')... + exists (prd t1')... - (* T_Mult *) right. destruct IHHt1... @@ -1579,14 +1636,14 @@ Proof with eauto. * (* t2 是值 *) inversion H; subst; try solve_by_invert. inversion H0; subst; try solve_by_invert. - exists (tnat (mult n1 n0))... + exists (const (mult n1 n0))... * (* t2 可前进 *) inversion H0 as [t2' Hstp]. - exists (tmult t1 t2')... + exists (mlt t1 t2')... + (* t1 可前进 *) inversion H as [t1' Hstp]. - exists (tmult t1' t2)... - - (* T_If0 *) + exists (mlt t1' t2)... + - (* T_Test0 *) right. destruct IHHt1... + (* t1 是值 *) @@ -1598,12 +1655,7 @@ Proof with eauto. exists t3... + (* t1 可前进 *) inversion H as [t1' H0]. - exists (tif0 t1' t2 t3)... - (* 请在此处解答 *) - - (* T_Unit *) - left... - (* let *) - (* 请在此处解答 *) + exists (test0 t1' t2 t3)... - (* T_Inl *) destruct IHHt... + (* t1 可前进 *) @@ -1650,51 +1702,65 @@ Proof with eauto. + (* t1 可前进 *) inversion H as [t1' Hstp]. exists (tlcase t1' t2 x1 x2 t3)... + - (* T_Unit *) + left... + + (* Complete the proof. *) + + (* pairs *) + (* 请在此处解答 *) + (* let *) + (* 请在此处解答 *) (* fix *) (* 请在此处解答 *) -Qed. +(* 请在此处解答 *) Admitted. + +(* 请勿修改下面这一行: *) +Definition manual_grade_for_progress : option (nat*string) := None. +(** [] *) (* ----------------------------------------------------------------- *) (** *** 上下文不变性 *) +(** **** 练习:3 星, standard (STLCE_context_invariance) + + Complete the definition of [appears_free_in], and the proofs of + [context_invariance] and [free_in_context]. *) + Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) + appears_free_in x t1 -> appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) + appears_free_in x t2 -> appears_free_in x (app t1 t2) | afi_abs : forall x y T11 t12, y <> x -> appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) - (* 自然数 *) + appears_free_in x (abs y T11 t12) + (* 数值 *) | afi_succ : forall x t, appears_free_in x t -> - appears_free_in x (tsucc t) + appears_free_in x (scc t) | afi_pred : forall x t, appears_free_in x t -> - appears_free_in x (tpred t) + appears_free_in x (prd t) | afi_mult1 : forall x t1 t2, appears_free_in x t1 -> - appears_free_in x (tmult t1 t2) + appears_free_in x (mlt 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 (mlt t1 t2) + | afi_test01 : 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 (test0 t1 t2 t3) + | afi_test02 : 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 (test0 t1 t2 t3) + | afi_test03 : forall x t1 t2 t3, appears_free_in x t3 -> - appears_free_in x (tif0 t1 t2 t3) - (* 二元组 *) - (* 请在此处解答 *) - (* let *) - (* 请在此处解答 *) - (* 和 *) + appears_free_in x (test0 t1 t2 t3) + (* sums *) | afi_inl : forall x t T, appears_free_in x t -> appears_free_in x (tinl T t) @@ -1730,6 +1796,13 @@ Inductive appears_free_in : string -> tm -> Prop := y2 <> x -> appears_free_in x t3 -> appears_free_in x (tlcase t1 t2 y1 y2 t3) + + (* Add rules for the following extensions. *) + + (* pairs *) + (* 请在此处解答 *) + (* let *) + (* 请在此处解答 *) (* fix *) (* 请在此处解答 *) . @@ -1740,7 +1813,9 @@ 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. +(* Increasing the depth of [eauto] allows some more simple cases to + be dispatched automatically. *) +Proof with eauto 30. intros. generalize dependent Gamma'. induction H; intros Gamma' Heqv... @@ -1750,14 +1825,6 @@ Proof with eauto. apply T_Abs... apply IHhas_type. intros y Hafi. unfold update, t_update. destruct (eqb_stringP x y)... - - (* T_Mult *) - apply T_Mult... - - (* T_If0 *) - apply T_If0... - (* pair *) - (* 请在此处解答 *) - (* let *) - (* 请在此处解答 *) - (* T_Case *) eapply T_Case... + apply IHhas_type2. intros y Hafi. @@ -1766,14 +1833,15 @@ Proof with eauto. + apply IHhas_type3. intros y Hafi. unfold update, t_update. destruct (eqb_stringP x2 y)... - - (* T_Cons *) - apply T_Cons... - (* T_Lcase *) eapply T_Lcase... apply IHhas_type3. intros y Hafi. unfold update, t_update. destruct (eqb_stringP x1 y)... destruct (eqb_stringP x2 y)... -Qed. + + (* Complete the proof. *) + + (* 请在此处解答 *) Admitted. Lemma free_in_context : forall x t T Gamma, appears_free_in x t -> @@ -1786,8 +1854,6 @@ Proof with eauto. destruct IHHtyp as [T' Hctx]... exists T'. unfold update, t_update in Hctx. rewrite false_eqb_string in Hctx... - (* let *) - (* 请在此处解答 *) (* T_Case *) - (* left *) destruct IHHtyp2 as [T' Hctx]... exists T'. @@ -1803,31 +1869,42 @@ Proof with eauto. unfold update, t_update in Hctx. rewrite false_eqb_string in Hctx... rewrite false_eqb_string in Hctx... -Qed. + + (* Complete the proof. *) + + (* 请在此处解答 *) Admitted. + +(* 请勿修改下面这一行: *) +Definition manual_grade_for_context_invariance : option (nat*string) := None. +(** [] *) (* ----------------------------------------------------------------- *) (** *** 替换 *) +(** **** 练习:2 星, standard (STLCE_subst_preserves_typing) + + Complete the proof of [substitution_preserves_typing]. *) + Lemma substitution_preserves_typing : forall Gamma x U v t S, (update Gamma x U) |- t \in S -> empty |- v \in U -> Gamma |- ([x:=v]t) \in S. Proof with eauto. - (* 定理:如果 Gamma,x:U |- t : S 且 empty |- v : U,那么 - Gamma |- [x:=v]t : S。 *) + (* 定理:如果 [(x|->U ; Gamma) |- t \in S] 且 [empty |- v \in U],那么 + [Gamma |- [x:=v]t \in S]. *) intros Gamma x U v t S Htypt Htypv. generalize dependent Gamma. generalize dependent S. - (* 证明:对项 t 进行归纳。除了 tvar 和 tabs 外,多数情形可直接从 IH 得证。 + (* 证明:对项 [t] 进行归纳。除了 [var] 和 [abs] 外,多数情形可直接从 IH 得证。 他们不是自动完成的,因为我们需要推理变量之间如何交互。*) induction t; intros S Gamma Htypt; simpl; inversion Htypt; subst... - - (* tvar *) + - (* var *) simpl. rename s into y. - (* 如果 t = y,那么通过反演 [update Gamma x U y = Some S], + (* 如果 [t = y],那么通过反演 [update Gamma x U y = Some S] 我们知道 - [empty |- v : U] 且 - [Gamma,x:U |- y : S]。 - 我们想要证明 [Gamma |- [x:=v]y : S]。 + [empty |- v \in U] 且 + [(x|->U;Gamma) |- y \in S]。 + 我们想要证明 [Gamma |- [x:=v]y \in S]。 有两个情形需要考虑: [x=y] 或 [x<>y]。 *) unfold update, t_update in H1. @@ -1835,7 +1912,7 @@ Proof with eauto. + (* x=y *) (* 如果 [x = y],那么我们知道 [U = S],并且 [[x:=v]y = v]。因此我们必须证明如果 - [empty |- v : U] 那么 [Gamma |- v : U]。 + [empty |- v \in U] 那么 [Gamma |- v \in U]。 我们已经证明了一个更一般的定理,叫做上下文不变性(context invariance)。*) subst. inversion H1; subst. clear H1. @@ -1846,45 +1923,46 @@ Proof with eauto. inversion HT'. + (* x<>y *) (* 如果 [x <> y],那么 [Gamma y = Some S] 并且替换不会产生任何影响。 - 我们可以通过 [T_Var] 证明 [Gamma |- y : S]。 *) + 我们可以通过 [T_Var] 证明 [Gamma |- y \in S]。 *) apply T_Var... - - (* tabs *) + - (* abs *) rename s into y. rename t into T11. - (* 如果 [t = tabs y T11 t0], 那么我们知道 - [Gamma,x:U |- tabs y T11 t0 : T11->T12] - [Gamma,x:U,y:T11 |- t0 : T12] - [empty |- v : U] - 作为归纳假设(IH),我们知道对所有的 S Gamma, - [Gamma,x:U |- t0 : S -> Gamma |- [x:=v]t0 : S]. + (* 如果 [t = abs y T11 t0],那么我们知道 + [(x|->U;Gamma) |- abs y T11 t0 \in T11->T12] + [(y|->T11;x|->U;Gamma) |- t0 \in T12] + [empty |- v \in U] + 根据归纳假设(IH),我们知道对所有的 [S] 和 [Gamma], + 若 [(x|->U;Gamma) |- t0 \in S] + 则 [Gamma |- [x:=v]t0 \in S]。 + 我们可以计算 - [x:=v]t = tabs y T11 (if eqb_string x y then t0 else [x:=v]t0) - 且我们必须证明 [Gamma |- [x:=v]t : T11->T12]。 + [[x:=v]t = abs y T11 (if eqb_string x y then t0 else [x:=v]t0)] + 且我们必须证明 [Gamma |- [x:=v]t \in T11->T12]. We know 我们知道可以通过 [T_Abs] 来达到此目的,因此剩下的便是证明: - [Gamma,y:T11 |- if eqb_string x y then t0 else [x:=v]t0 : T12] - 我们考虑两个情形: [x = y] 和 [x <> y]。 + [(y|->T11;Gamma) |- if eqb_string x y then t0 else [x:=v]t0 + \in T12] + 我们考虑两个情形: [x = y] and [x <> y]. *) apply T_Abs... destruct (eqb_stringP x y) as [Hxy|Hxy]. + (* x=y *) (* 如果 [x = y],那么替换不会产生任何影响。 - 上下文不变性展示了 [Gamma,y:U,y:T11] 和 [Gamma,y:T11] 是等价的。 - 因为前一个上下文展示了 [t0 : T12],后者也同样。 *) + 上下文不变性展示了 [y:T11;y|->U;Gamma] 和 [y|->T11;Gamma] 是等价的。 + 因为前一个上下文展示了 [t0 \in T12],后者也同样。 *) eapply context_invariance... subst. intros x Hafi. unfold update, t_update. destruct (eqb_string y x)... + (* x<>y *) (* 如果 [x <> y],那么归纳假设和上下文不变性允许我们证明 - [Gamma,x:U,y:T11 |- t0 : T12] => - [Gamma,y:T11,x:U |- t0 : T12] => - [Gamma,y:T11 |- [x:=v]t0 : T12] *) + [(y|->T11;x|->U;Gamma) |- t0 \in T12] => + [(x|->U;y|->T11;Gamma) |- t0 \in T12] => + [(y|->T11;Gamma) |- [x:=v]t0 \in T12] *) apply IHt. eapply context_invariance... intros z Hafi. unfold update, t_update. destruct (eqb_stringP y z) as [Hyz|Hyz]... subst. rewrite false_eqb_string... - (* let *) - (* 请在此处解答 *) - (* tcase *) rename s into x1. rename s0 into x2. eapply T_Case... @@ -1936,50 +2014,57 @@ Proof with eauto. subst. rewrite false_eqb_string... destruct (eqb_stringP y2 z)... subst. rewrite false_eqb_string... -Qed. + + (* Complete the proof. *) + + (* 请在此处解答 *) Admitted. + +(* 请勿修改下面这一行: *) +Definition manual_grade_for_substitution_preserves_typing : option (nat*string) := None. +(** [] *) (* ----------------------------------------------------------------- *) (** *** 保型性 *) +(** **** 练习:3 星, standard (STLCE_preservation) + + Complete the proof of [preservation]. *) + Theorem preservation : forall t t' T, empty |- t \in T -> - t ==> t' -> + t --> t' -> empty |- t' \in T. Proof with eauto. intros t t' T HT. - (* 定理:如果 [empty |- t : T] 且 [t ==> t'],那么 - [empty |- t' : T]。 *) + (* 定理:如果 [empty |- t \in T] 且 [t --> t'],那么 + [empty |- t' \in T]. *) remember empty as Gamma. generalize dependent HeqGamma. generalize dependent t'. - (* 证明:对给定的类型导出式进行归纳。许多情形是矛盾的([T_Var], [T_Abs]), + (* 证明:对给定的类型导出式进行归纳。许多情形是矛盾的([T_Var], [T_Abs]), 我们只证明有趣的那几个情形。*) induction HT; intros t' HeqGamma HE; subst; inversion HE; subst... - (* T_App *) (* 如果最后被使用的规则是 [T_App],那么 [t = t1 t2], - 且有三个规则会被用于证明 [t ==> t']: + 且有三个规则会被用于证明 [t --> t']: [ST_App1],[ST_App2],和 [ST_AppAbs]。 在前两个情形中,结果可直接从归纳假设中得证。 *) inversion HE; subst... + (* ST_AppAbs *) (* 对于第三个情形,假设 - [t1 = tabs x T11 t12] + [t1 = abs x T11 t12] 且 [t2 = v2]。 - 我们必须证明 [empty |- [x:=v2]t12 : T2]。 + 我们必须证明 [empty |- [x:=v2]t12 \in T2]。 由假设,我们可得 - [empty |- tabs x T11 t12 : T1->T2] + [empty |- tabs x T11 t12 \in T1->T2] 且,由反演可得 - [x:T1 |- t12 : T2] + [x:T1 |- t12 \in T2] 我们已经证明了类型在替换下的不变性,且根据假设可得 - [empty |- v2 : T1] + [empty |- v2 \in T1] 证毕。 *) apply substitution_preserves_typing with T1... inversion HT1... - (* fst and snd *) - (* 请在此处解答 *) - (* let *) - (* 请在此处解答 *) (* T_Case *) - (* ST_CaseInl *) inversion HT1; subst. @@ -1990,16 +2075,23 @@ Proof with eauto. - (* T_Lcase *) + (* ST_LcaseCons *) inversion HT1; subst. - apply substitution_preserves_typing with (TList T1)... + apply substitution_preserves_typing with (List T1)... apply substitution_preserves_typing with T1... + + (* Complete the proof. *) + + (* fst and snd *) + (* 请在此处解答 *) + (* let *) + (* 请在此处解答 *) (* fix *) (* 请在此处解答 *) -Qed. - -End STLCExtended. +(* 请在此处解答 *) Admitted. (* 请勿修改下面这一行: *) -Definition manual_grade_for_STLC_extensions : option (nat*string) := None. +Definition manual_grade_for_preservation : option (nat*string) := None. (** [] *) -(** $Date$ *) +End STLCExtended. + +(* Sat Jan 26 15:15:44 UTC 2019 *) diff --git a/plf-current/MoreStlcTest.v b/plf-current/MoreStlcTest.v index c1fff387..b98c0c70 100644 --- a/plf-current/MoreStlcTest.v +++ b/plf-current/MoreStlcTest.v @@ -32,24 +32,245 @@ Import Check. Goal True. -idtac "------------------- STLC_extensions --------------------". +idtac "------------------- STLCE_definitions --------------------". idtac " ". -idtac "#> Manually graded: STLC_extensions". -idtac "Possible points: 5". -print_manual_grade manual_grade_for_STLC_extensions. +idtac "#> Manually graded: STLCExtended.extensions_definition". +idtac "Possible points: 3". +print_manual_grade STLCExtended.manual_grade_for_extensions_definition. idtac " ". +idtac "------------------- STLCE_examples --------------------". idtac " ". -idtac "Max points - standard: 5". -idtac "Max points - advanced: 5". +idtac "#> STLCExtended.Examples.Prodtest.typechecks". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.Prodtest.typechecks ( +(STLCExtended.has_type (@Maps.empty STLCExtended.ty) + STLCExtended.Examples.Prodtest.test STLCExtended.Nat)). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.Prodtest.typechecks. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.Prodtest.reduces". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.Prodtest.reduces ( +(STLCExtended.multistep STLCExtended.Examples.Prodtest.test + (STLCExtended.const 6))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.Prodtest.reduces. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.LetTest.typechecks". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.LetTest.typechecks ( +(STLCExtended.has_type (@Maps.empty STLCExtended.ty) + STLCExtended.Examples.LetTest.test STLCExtended.Nat)). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.LetTest.typechecks. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.LetTest.reduces". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.LetTest.reduces ( +(STLCExtended.multistep STLCExtended.Examples.LetTest.test + (STLCExtended.const 6))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.LetTest.reduces. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest1.typechecks". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest1.typechecks ( +(STLCExtended.has_type (@Maps.empty STLCExtended.ty) + STLCExtended.Examples.FixTest1.fact + (STLCExtended.Arrow STLCExtended.Nat STLCExtended.Nat))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest1.typechecks. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest1.reduces". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest1.reduces ( +(STLCExtended.multistep + (STLCExtended.app STLCExtended.Examples.FixTest1.fact + (STLCExtended.const 4)) (STLCExtended.const 24))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest1.reduces. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest2.typechecks". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest2.typechecks ( +(STLCExtended.has_type (@Maps.empty STLCExtended.ty) + STLCExtended.Examples.FixTest2.map + (STLCExtended.Arrow (STLCExtended.Arrow STLCExtended.Nat STLCExtended.Nat) + (STLCExtended.Arrow (STLCExtended.List STLCExtended.Nat) + (STLCExtended.List STLCExtended.Nat))))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest2.typechecks. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest2.reduces". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest2.reduces ( +(STLCExtended.multistep + (STLCExtended.app + (STLCExtended.app STLCExtended.Examples.FixTest2.map + (STLCExtended.abs "a" STLCExtended.Nat + (STLCExtended.scc (STLCExtended.var "a")))) + (STLCExtended.tcons (STLCExtended.const 1) + (STLCExtended.tcons (STLCExtended.const 2) + (STLCExtended.tnil STLCExtended.Nat)))) + (STLCExtended.tcons (STLCExtended.const 2) + (STLCExtended.tcons (STLCExtended.const 3) + (STLCExtended.tnil STLCExtended.Nat))))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest2.reduces. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest3.typechecks". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest3.typechecks ( +(STLCExtended.has_type (@Maps.empty STLCExtended.ty) + STLCExtended.Examples.FixTest3.equal + (STLCExtended.Arrow STLCExtended.Nat + (STLCExtended.Arrow STLCExtended.Nat STLCExtended.Nat)))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest3.typechecks. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest3.reduces". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest3.reduces ( +(STLCExtended.multistep + (STLCExtended.app + (STLCExtended.app STLCExtended.Examples.FixTest3.equal + (STLCExtended.const 4)) (STLCExtended.const 4)) + (STLCExtended.const 1))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest3.reduces. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest4.typechecks". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest4.typechecks ( +(STLCExtended.has_type (@Maps.empty STLCExtended.ty) + STLCExtended.Examples.FixTest4.eotest + (STLCExtended.Prod STLCExtended.Nat STLCExtended.Nat))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest4.typechecks. +Goal True. +idtac " ". + +idtac "#> STLCExtended.Examples.FixTest4.reduces". +idtac "Possible points: 0.25". +check_type @STLCExtended.Examples.FixTest4.reduces ( +(STLCExtended.multistep STLCExtended.Examples.FixTest4.eotest + (STLCExtended.pair (STLCExtended.const 0) (STLCExtended.const 1)))). +idtac "Assumptions:". +Abort. +Print Assumptions STLCExtended.Examples.FixTest4.reduces. +Goal True. +idtac " ". + +idtac "------------------- STLCE_progress --------------------". +idtac " ". + +idtac "#> Manually graded: STLCExtended.progress". +idtac "Possible points: 3". +print_manual_grade STLCExtended.manual_grade_for_progress. +idtac " ". + +idtac "------------------- STLCE_context_invariance --------------------". +idtac " ". + +idtac "#> Manually graded: STLCExtended.context_invariance". +idtac "Possible points: 3". +print_manual_grade STLCExtended.manual_grade_for_context_invariance. +idtac " ". + +idtac "------------------- STLCE_subst_preserves_typing --------------------". +idtac " ". + +idtac "#> Manually graded: STLCExtended.substitution_preserves_typing". +idtac "Possible points: 2". +print_manual_grade STLCExtended.manual_grade_for_substitution_preserves_typing. +idtac " ". + +idtac "------------------- STLCE_preservation --------------------". +idtac " ". + +idtac "#> Manually graded: STLCExtended.preservation". +idtac "Possible points: 3". +print_manual_grade STLCExtended.manual_grade_for_preservation. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 17". +idtac "Max points - advanced: 17". idtac "". idtac "********** Summary **********". idtac "". idtac "********** Standard **********". -idtac "---------- STLC_extensions ---------". +idtac "---------- extensions_definition ---------". +idtac "MANUAL". +idtac "---------- STLCExtended.Examples.Prodtest.typechecks ---------". +Print Assumptions STLCExtended.Examples.Prodtest.typechecks. +idtac "---------- STLCExtended.Examples.Prodtest.reduces ---------". +Print Assumptions STLCExtended.Examples.Prodtest.reduces. +idtac "---------- STLCExtended.Examples.LetTest.typechecks ---------". +Print Assumptions STLCExtended.Examples.LetTest.typechecks. +idtac "---------- STLCExtended.Examples.LetTest.reduces ---------". +Print Assumptions STLCExtended.Examples.LetTest.reduces. +idtac "---------- STLCExtended.Examples.FixTest1.typechecks ---------". +Print Assumptions STLCExtended.Examples.FixTest1.typechecks. +idtac "---------- STLCExtended.Examples.FixTest1.reduces ---------". +Print Assumptions STLCExtended.Examples.FixTest1.reduces. +idtac "---------- STLCExtended.Examples.FixTest2.typechecks ---------". +Print Assumptions STLCExtended.Examples.FixTest2.typechecks. +idtac "---------- STLCExtended.Examples.FixTest2.reduces ---------". +Print Assumptions STLCExtended.Examples.FixTest2.reduces. +idtac "---------- STLCExtended.Examples.FixTest3.typechecks ---------". +Print Assumptions STLCExtended.Examples.FixTest3.typechecks. +idtac "---------- STLCExtended.Examples.FixTest3.reduces ---------". +Print Assumptions STLCExtended.Examples.FixTest3.reduces. +idtac "---------- STLCExtended.Examples.FixTest4.typechecks ---------". +Print Assumptions STLCExtended.Examples.FixTest4.typechecks. +idtac "---------- STLCExtended.Examples.FixTest4.reduces ---------". +Print Assumptions STLCExtended.Examples.FixTest4.reduces. +idtac "---------- progress ---------". +idtac "MANUAL". +idtac "---------- context_invariance ---------". +idtac "MANUAL". +idtac "---------- substitution_preserves_typing ---------". +idtac "MANUAL". +idtac "---------- preservation ---------". idtac "MANUAL". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:18 UTC 2019 *) diff --git a/plf-current/Norm.html b/plf-current/Norm.html index 47f3c7f7..9d87f4f1 100644 --- a/plf-current/Norm.html +++ b/plf-current/Norm.html @@ -35,7 +35,8 @@

              NormNormalization of STLC

              Set Warnings "-notation-overridden,-parsing".
              -Require Import Coq.Lists.List. Import ListNotations.
              +From Coq Require Import Lists.List. Import ListNotations.
              +From Coq Require Import Strings.String.
              From PLF Require Import Maps.
              From PLF Require Import Smallstep.

              Hint Constructors multi.

              @@ -91,7 +92,7 @@

              NormNormalization of STLC

              -

              练习:2 星 (norm_fail)

              +

              练习:2 星, standard (norm_fail)

              Where do we fail if we attempt to prove normalization by a straightforward induction on the size of a well-typed term?
              @@ -106,7 +107,7 @@

              NormNormalization of STLC

              -

              练习:5 星, recommended (norm)

              +

              练习:5 星, standard, recommended (norm)

              The best ways to understand an intricate proof like this is are (1) to help fill it in and (2) to extend it. We've left out some parts of the following development, including some proofs of lemmas @@ -141,24 +142,24 @@

              NormNormalization of STLC

              Inductive ty : Type :=
              -  | TBool : ty
              -  | TArrow : tytyty
              -  | TProd : tytyty
              +  | Bool : ty
              +  | Arrow : tytyty
              +  | Prod : tytyty
              .

              Inductive tm : Type :=
                  (* pure STLC *)
              -  | tvar : stringtm
              -  | tapp : tmtmtm
              -  | tabs : stringtytmtm
              +  | var : stringtm
              +  | app : tmtmtm
              +  | abs : stringtytmtm
                  (* pairs *)
              -  | tpair : tmtmtm
              -  | tfst : tmtm
              -  | tsnd : tmtm
              +  | pair : tmtmtm
              +  | fst : tmtm
              +  | snd : tmtm
                  (* booleans *)
              -  | ttrue : tm
              -  | tfalse : tm
              -  | tif : tmtmtmtm.
              -          (* i.e., if t0 then t1 else t2 *)
              +  | tru : tm
              +  | fls : tm
              +  | test : tmtmtmtm.
              +          (* i.e., test t0 then t1 else t2 *)
              @@ -170,17 +171,17 @@

              NormNormalization of STLC

              Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
                match t with
              -  | tvar yif eqb_string x y then s else t
              -  | tabs y T t1
              -      tabs y T (if eqb_string x y then t1 else (subst x s t1))
              -  | tapp t1 t2tapp (subst x s t1) (subst x s t2)
              -  | tpair t1 t2tpair (subst x s t1) (subst x s t2)
              -  | tfst t1tfst (subst x s t1)
              -  | tsnd t1tsnd (subst x s t1)
              -  | ttruettrue
              -  | tfalsetfalse
              -  | tif t0 t1 t2
              -      tif (subst x s t0) (subst x s t1) (subst x s t2)
              +  | var yif eqb_string x y then s else t
              +  | abs y T t1
              +      abs y T (if eqb_string x y then t1 else (subst x s t1))
              +  | app t1 t2app (subst x s t1) (subst x s t2)
              +  | pair t1 t2pair (subst x s t1) (subst x s t2)
              +  | fst t1fst (subst x s t1)
              +  | snd t1snd (subst x s t1)
              +  | trutru
              +  | flsfls
              +  | test t0 t1 t2
              +      test (subst x s t0) (subst x s t1) (subst x s t2)
                end.

              Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
              @@ -193,65 +194,65 @@

              NormNormalization of STLC

              Inductive value : tmProp :=
              -  | v_abs : x T11 t12,
              -      value (tabs x T11 t12)
              -  | v_pair : v1 v2,
              +  | v_abs : x T11 t12,
              +      value (abs x T11 t12)
              +  | v_pair : v1 v2,
                    value v1
                    value v2
              -      value (tpair v1 v2)
              -  | v_true : value ttrue
              -  | v_false : value tfalse
              +      value (pair v1 v2)
              +  | v_tru : value tru
              +  | v_fls : value fls
              .

              Hint Constructors value.

              -Reserved Notation "t1 '==>' t2" (at level 40).

              +Reserved Notation "t1 '-->' t2" (at level 40).

              Inductive step : tmtmProp :=
              -  | ST_AppAbs : x T11 t12 v2,
              +  | 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',
              +         (app (abs x T11 t12) v2) --> [x:=v2]t12
              +  | ST_App1 : t1 t1' t2,
              +         t1 --> t1'
              +         (app t1 t2) --> (app t1' t2)
              +  | ST_App2 : v1 t2 t2',
                       value v1
              -         t2 ==> t2'
              -         (tapp v1 t2) ==> (tapp v1 t2')
              +         t2 --> t2'
              +         (app v1 t2) --> (app v1 t2')
                (* pairs *)
              -  | ST_Pair1 : t1 t1' t2,
              -        t1 ==> t1'
              -        (tpair t1 t2) ==> (tpair t1' t2)
              -  | ST_Pair2 : v1 t2 t2',
              +  | ST_Pair1 : t1 t1' t2,
              +        t1 --> t1'
              +        (pair t1 t2) --> (pair t1' t2)
              +  | ST_Pair2 : v1 t2 t2',
                      value v1
              -        t2 ==> t2'
              -        (tpair v1 t2) ==> (tpair v1 t2')
              -  | ST_Fst : t1 t1',
              -        t1 ==> t1'
              -        (tfst t1) ==> (tfst t1')
              -  | ST_FstPair : v1 v2,
              +        t2 --> t2'
              +        (pair v1 t2) --> (pair v1 t2')
              +  | ST_Fst : t1 t1',
              +        t1 --> t1'
              +        (fst t1) --> (fst t1')
              +  | ST_FstPair : v1 v2,
                      value v1
                      value v2
              -        (tfst (tpair v1 v2)) ==> v1
              -  | ST_Snd : t1 t1',
              -        t1 ==> t1'
              -        (tsnd t1) ==> (tsnd t1')
              -  | ST_SndPair : v1 v2,
              +        (fst (pair v1 v2)) --> v1
              +  | ST_Snd : t1 t1',
              +        t1 --> t1'
              +        (snd t1) --> (snd t1')
              +  | ST_SndPair : v1 v2,
                      value v1
                      value v2
              -        (tsnd (tpair v1 v2)) ==> v2
              +        (snd (pair v1 v2)) --> v2
                (* booleans *)
              -  | ST_IfTrue : t1 t2,
              -        (tif ttrue t1 t2) ==> t1
              -  | ST_IfFalse : t1 t2,
              -        (tif tfalse t1 t2) ==> t2
              -  | ST_If : t0 t0' t1 t2,
              -        t0 ==> t0'
              -        (tif t0 t1 t2) ==> (tif t0' t1 t2)
              +  | ST_TestTrue : t1 t2,
              +        (test tru t1 t2) --> t1
              +  | ST_TestFalse : t1 t2,
              +        (test fls t1 t2) --> t2
              +  | ST_Test : t0 t0' t1 t2,
              +        t0 --> t0'
              +        (test t0 t1 t2) --> (test t0' t1 t2)

              -where "t1 '==>' t2" := (step t1 t2).

              +where "t1 '-->' t2" := (step t1 t2).

              Notation multistep := (multi step).
              -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40).

              +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).

              Hint Constructors step.

              Notation step_normal_form := (normal_form step).

              -Lemma value__normal : t, value tstep_normal_form t.
              +Lemma value__normal : t, value tstep_normal_form t.
              Proof with eauto.
              @@ -270,40 +271,40 @@

              NormNormalization of STLC

              Definition context := partial_map ty.

              Inductive has_type : contexttmtyProp :=
                (* Typing rules for proper terms *)
              -  | T_Var : Gamma x T,
              +  | T_Var : Gamma x T,
                    Gamma x = Some T
              -      has_type Gamma (tvar x) T
              -  | T_Abs : Gamma x T11 T12 t12,
              +      has_type Gamma (var x) T
              +  | T_Abs : Gamma x T11 T12 t12,
                    has_type (update Gamma x T11) t12 T12
              -      has_type Gamma (tabs x T11 t12) (TArrow T11 T12)
              -  | T_App : T1 T2 Gamma t1 t2,
              -      has_type Gamma t1 (TArrow T1 T2) →
              +      has_type Gamma (abs x T11 t12) (Arrow T11 T12)
              +  | T_App : T1 T2 Gamma t1 t2,
              +      has_type Gamma t1 (Arrow T1 T2) →
                    has_type Gamma t2 T1
              -      has_type Gamma (tapp t1 t2) T2
              +      has_type Gamma (app t1 t2) T2
                (* pairs *)
              -  | T_Pair : Gamma t1 t2 T1 T2,
              +  | T_Pair : Gamma t1 t2 T1 T2,
                    has_type Gamma t1 T1
                    has_type Gamma t2 T2
              -      has_type Gamma (tpair t1 t2) (TProd T1 T2)
              -  | T_Fst : Gamma t T1 T2,
              -      has_type Gamma t (TProd T1 T2) →
              -      has_type Gamma (tfst t) T1
              -  | T_Snd : Gamma t T1 T2,
              -      has_type Gamma t (TProd T1 T2) →
              -      has_type Gamma (tsnd t) T2
              +      has_type Gamma (pair t1 t2) (Prod T1 T2)
              +  | T_Fst : Gamma t T1 T2,
              +      has_type Gamma t (Prod T1 T2) →
              +      has_type Gamma (fst t) T1
              +  | T_Snd : Gamma t T1 T2,
              +      has_type Gamma t (Prod T1 T2) →
              +      has_type Gamma (snd t) T2
                (* booleans *)
              -  | T_True : Gamma,
              -      has_type Gamma ttrue TBool
              -  | T_False : Gamma,
              -      has_type Gamma tfalse TBool
              -  | T_If : Gamma t0 t1 t2 T,
              -      has_type Gamma t0 TBool
              +  | T_True : Gamma,
              +      has_type Gamma tru Bool
              +  | T_False : Gamma,
              +      has_type Gamma fls Bool
              +  | T_Test : Gamma t0 t1 t2 T,
              +      has_type Gamma t0 Bool
                    has_type Gamma t1 T
                    has_type Gamma t2 T
              -      has_type Gamma (tif t0 t1 t2) T
              +      has_type Gamma (test t0 t1 t2) T
              .

              Hint Constructors has_type.

              -Hint Extern 2 (has_type _ (tapp _ _) _) ⇒ eapply T_App; auto.
              +Hint Extern 2 (has_type _ (app _ _) _) ⇒ eapply T_App; auto.
              Hint Extern 2 (_ = _) ⇒ compute; reflexivity.
              @@ -315,46 +316,46 @@

              NormNormalization of STLC

              Inductive appears_free_in : stringtmProp :=
              -  | afi_var : x,
              -      appears_free_in x (tvar x)
              -  | afi_app1 : x t1 t2,
              -      appears_free_in x t1appears_free_in x (tapp t1 t2)
              -  | afi_app2 : x t1 t2,
              -      appears_free_in x t2appears_free_in x (tapp t1 t2)
              -  | afi_abs : x y T11 t12,
              +  | afi_var : x,
              +      appears_free_in x (var x)
              +  | afi_app1 : x t1 t2,
              +      appears_free_in x t1appears_free_in x (app t1 t2)
              +  | afi_app2 : x t1 t2,
              +      appears_free_in x t2appears_free_in x (app t1 t2)
              +  | afi_abs : x y T11 t12,
                      yx
                      appears_free_in x t12
              -        appears_free_in x (tabs y T11 t12)
              +        appears_free_in x (abs y T11 t12)
                (* pairs *)
              -  | afi_pair1 : x t1 t2,
              +  | 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 (pair 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 (pair 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 (fst t)
              +  | afi_snd : x t,
                    appears_free_in x t
              -      appears_free_in x (tsnd t)
              +      appears_free_in x (snd t)
                (* booleans *)
              -  | afi_if0 : x t0 t1 t2,
              +  | afi_test0 : x t0 t1 t2,
                    appears_free_in x t0
              -      appears_free_in x (tif t0 t1 t2)
              -  | afi_if1 : x t0 t1 t2,
              +      appears_free_in x (test t0 t1 t2)
              +  | afi_test1 : x t0 t1 t2,
                    appears_free_in x t1
              -      appears_free_in x (tif t0 t1 t2)
              -  | afi_if2 : x t0 t1 t2,
              +      appears_free_in x (test t0 t1 t2)
              +  | afi_test2 : x t0 t1 t2,
                    appears_free_in x t2
              -      appears_free_in x (tif t0 t1 t2)
              +      appears_free_in x (test t0 t1 t2)
              .

              Hint Constructors appears_free_in.

              Definition closed (t:tm) :=
              -   x, ¬ appears_free_in x t.

              -Lemma context_invariance : Gamma Gamma' t S,
              +  x, ¬appears_free_in x t.

              +Lemma context_invariance : Gamma Gamma' t S,
                   has_type Gamma t S
              -     ( x, appears_free_in x tGamma x = Gamma' x) →
              +     (x, appears_free_in x tGamma x = Gamma' x) →
                   has_type Gamma' t S.
              @@ -369,30 +370,30 @@

              NormNormalization of STLC

              unfold update, t_update. destruct (eqb_stringP x y)...
                - (* T_Pair *)
                  apply T_Pair...
              -  - (* T_If *)
              -    eapply T_If...
              +  - (* T_Test *)
              +    eapply T_Test...
              Qed.

              -Lemma free_in_context : x t T Gamma,
              +Lemma free_in_context : x t T Gamma,
                 appears_free_in x t
                 has_type Gamma t T
              -    T', Gamma x = Some T'.
              +   T', Gamma x = Some T'.
              Proof with eauto.
                intros x t T Gamma Hafi Htyp.
                induction Htyp; inversion Hafi; subst...
                - (* T_Abs *)
              -    destruct IHHtyp as [T' Hctx]... T'.
              +    destruct IHHtyp as [T' Hctx]... T'.
                  unfold update, t_update in Hctx.
                  rewrite false_eqb_string in Hctx...
              Qed.

              -Corollary typable_empty__closed : t T,
              +Corollary typable_empty__closed : t T,
                  has_type empty t T
                  closed t.
              @@ -411,38 +412,38 @@

              NormNormalization of STLC


              -Lemma substitution_preserves_typing : Gamma x U v t S,
              +Lemma substitution_preserves_typing : Gamma x U v t S,
                   has_type (update Gamma x U) t S
                   has_type empty v U
                   has_type Gamma ([x:=v]t) S.
              Proof with eauto.
              -  (* Theorem: If Gamma,x:U |- t : S and empty |- v : U, then
              -     Gamma |- (x:=vt) S. *)

              +  (* Theorem: If Gamma,x:U ⊢ t : S and empty ⊢ v : U, then
              +     Gamma ⊢ (x:=vt) 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.
              +     from the IH, with the exception of var and abs.
                   The former aren't automatic because we must reason about how the
                   variables interact. *)

                induction t;
                  intros S Gamma Htypt; simpl; inversion Htypt; subst...
              -  - (* tvar *)
              +  - (* var *)
                  simpl. rename s into y.
                  (* If t = y, we know that
              -         empty |- v : U and
              -         Gamma,x:U |- y : S
              +         empty v : U and
              +         Gamma,x:U y : S
                     and, by inversion, update Gamma x U y = Some S.  We want to
              -       show that Gamma |- [x:=v]y : S.
              +       show that Gamma [x:=v]y : S.

                     There are two cases to consider: either x=y or xy. *)

                  unfold update, t_update in H1.
                  destruct (eqb_stringP x y).
                  + (* 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
              +       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.
                    inversion H1; subst. clear H1.
              @@ -452,22 +453,22 @@

              NormNormalization of STLC

              inversion HT'.
                  + (* 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. *)

              +         effect.  We can show that Gamma y : S by T_Var. *)
                    apply T_Var...
              -  - (* tabs *)
              +  - (* abs *)
                  rename s into y. rename t into T11.
              -    (* If t = tabs y T11 t0, then we know that
              -         Gamma,x:U |- tabs y T11 t0 : T11T12
              -         Gamma,x:U,y:T11 |- t0 : T12
              -         empty |- v : U
              +    (* If t = abs y T11 t0, then we know that
              +         Gamma,x:U abs y T11 t0 : T11T12
              +         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.
              +         Gamma,x:U t0 : S Gamma [x:=v]t0 S.

                     We can calculate that
              -         x:=vt = tabs y T11 (if eqb_string x y then t0 else x:=vt0)
              -       And we must show that Gamma |- [x:=v]t : T11T12.  We know
              +         x:=vt = abs y T11 (if eqb_string x y then t0 else x:=vt0)
              +       And we must show that Gamma [x:=v]t : T11T12.  We know
                     we will do so using T_Abs, so it remains to be shown that:
              -         Gamma,y:T11 |- if eqb_string x y then t0 else [x:=v]t0 : T12
              +         Gamma,y:T11 if eqb_string x y then t0 else [x:=v]t0 : T12
                     We consider two cases: x = y and x y.
                  *)

                  apply T_Abs...
              @@ -483,9 +484,9 @@

              NormNormalization of STLC

              destruct
              (eqb_string y x)...
                  + (* 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 *)

              +         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 update, t_update.
                    destruct (eqb_stringP y z)...
              @@ -494,15 +495,15 @@

              NormNormalization of STLC


              -Theorem preservation : t t' T,
              +Theorem preservation : t t' T,
                   has_type empty t T
              -     t ==> t'
              +     t --> t'
                   has_type empty t' T.
              Proof with eauto.
                intros t t' T HT.
              -  (* Theorem: If empty |- t : T and t ==> t', then empty |- t' : T. *)
              +  (* 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
              @@ -511,22 +512,22 @@

              NormNormalization of STLC

              intros
              t' HeqGamma HE; subst; inversion HE; subst...
                - (* 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_App1ST_App2, and
              +       could have been used to show t --> t'ST_App1ST_App2, and
                     ST_AppAbs. In the first two cases, the result follows directly from
                     the IH. *)

                  inversion HE; subst...
                  + (* ST_AppAbs *)
                    (* For the third case, suppose
              -           t1 = tabs x T11 t12
              +           t1 = abs x T11 t12
                       and
                         t2 = v2.
              -         We must show that empty |- [x:=v2]t12 : T2.
              +         We must show that empty [x:=v2]t12 : T2.
                       We know by assumption that
              -             empty |- tabs x T11 t12 : T1T2
              +             empty abs x T11 t12 : T1T2
                       and by inversion
              -             x:T1 |- t12 : T2
              +             x:T1 t12 : T2
                       We have already proven that substitution_preserves_typing and
              -             empty |- v2 : T1
              +             empty v2 : T1
                       by assumption, so we are done. *)

                    apply substitution_preserves_typing with T1...
                    inversion HT1...
              @@ -593,11 +594,11 @@

              NormNormalization of STLC

              inversion H2; subst.
                   + apply value__normal in H...
                   + apply value__normal in H0...
              -   - (* ST_IfTrue *)
              +   - (* ST_TestTrue *)
                     inversion H3.
              -   - (* ST_IfFalse *)
              +   - (* ST_TestFalse *)
                     inversion H3.
              -   (* ST_If *)
              +   (* ST_Test *)
                 - inversion E1.
                 - inversion E1.
                 - f_equal...
              @@ -627,7 +628,7 @@

              NormNormalization of STLC

              -Definition halts (t:tm) : Prop := t', t ==>* t'value t'.
              +Definition halts (t:tm) : Prop := t', t -->* t'value t'.
              @@ -635,12 +636,12 @@

              NormNormalization of STLC

              -Lemma value_halts : v, value vhalts v.
              +Lemma value_halts : v, value vhalts v.
              Proof.
                intros v H. unfold halts.
              -   v. split.
              +  v. split.
                apply multi_refl.
                assumption.
              Qed.
              @@ -697,7 +698,7 @@

              NormNormalization of STLC

              P of all closed terms of type A, we proceed by proving, by induction on types, that all terms of type A _possess_ property P, all terms of type AA _preserve_ property P, all - terms of type (AA)->(AA) _preserve the property of preserving_ + terms of type (AA)->(AA) _preserve the property of preserving_ property P, and so on. We do this by defining a family of properties, indexed by types. For the base type A, the property is just P. For functional types, it says that the function should map @@ -714,13 +715,13 @@

              NormNormalization of STLC

                    Inductive R : ty → tm → Prop :=
              -      | R_bool :  b thas_type empty t TBool →
              +      | R_bool : b thas_type empty t Bool →
                                    halts t →
              -                      R TBool t
              -      | R_arrow :  T1 T2 thas_type empty t (TArrow T1 T2) →
              +                      R Bool t
              +      | R_arrow : T1 T2 thas_type empty t (Arrow T1 T2) →
                                    halts t →
              -                      ( sR T1 s → R T2 (tapp t s)) →
              -                      R (TArrow T1 T2t. +                      (sR T1 s → R T2 (app t s)) →
              +                      R (Arrow T1 T2t.
              @@ -728,7 +729,7 @@

              NormNormalization of STLC

              R_arrow, namely (s, R T1 s R TS (tapp t s)), and + R_arrow, namely ( s, R T1 s R TS (app t s)), and specifically the R T1 s part, that violates this rule. (The outermost arrows separating the constructor arguments don't count when applying this rule; otherwise we could never have genuinely inductive @@ -749,11 +750,11 @@

              NormNormalization of STLC

              Fixpoint R (T:ty) (t:tm) {struct T} : Prop :=
                has_type empty t Thalts t
                (match T with
              -   | TBoolTrue
              -   | TArrow T1 T2 ⇒ ( s, R T1 sR T2 (tapp t s))
              +   | BoolTrue
              +   | Arrow T1 T2 ⇒ (s, R T1 sR T2 (app t s))

                 (* ... edit the next line when dealing with products *)
              -   | TProd T1 T2False
              +   | Prod T1 T2False (* FILL IN HERE *)
                 end).
              @@ -764,7 +765,7 @@

              NormNormalization of STLC

              -Lemma R_halts : {T} {t}, R T thalts t.
              +Lemma R_halts : {T} {t}, R T thalts t.
              Proof.
              @@ -773,7 +774,7 @@

              NormNormalization of STLC


              -Lemma R_typable_empty : {T} {t}, R T thas_type empty t T.
              +Lemma R_typable_empty : {T} {t}, R T thas_type empty t T.
              Proof.
              @@ -810,20 +811,20 @@

              NormNormalization of STLC

              -Lemma step_preserves_halting : t t', (t ==> t') → (halts thalts t').
              +Lemma step_preserves_halting : t t', (t --> t') → (halts thalts t').
              Proof.
               intros t t' ST. unfold halts.
               split.
              - - (* -> *)
              + - (* -> *)
                intros [t'' [STM V]].
                inversion STM; subst.
              -   exfalso. apply value__normal in V. unfold normal_form in V. apply V. t'. auto.
              -   rewrite (step_deterministic _ _ _ ST H). t''. split; assumption.
              +   exfalso. apply value__normal in V. unfold normal_form in V. apply V. t'. auto.
              +   rewrite (step_deterministic _ _ _ ST H). t''. split; assumption.
               - (* <- *)
                intros [t'0 [STM V]].
              -   t'0. split; eauto.
              +  t'0. split; eauto.
              Qed.
              @@ -841,17 +842,17 @@

              NormNormalization of STLC

              -Lemma step_preserves_R : T t t', (t ==> t') → R T tR T t'.
              +Lemma step_preserves_R : T t t', (t --> t') → R T tR T t'.
              Proof.
               induction T; intros t t' E Rt; unfold R; fold R; unfold R in Rt; fold R in Rt;
                             destruct Rt as [typable_empty_t [halts_t RRt]].
              -  (* TBool *)
              +  (* Bool *)
                split. eapply preservation; eauto.
                split. apply (step_preserves_halting _ _ E); eauto.
                auto.
              -  (* TArrow *)
              +  (* Arrow *)
                split. eapply preservation; eauto.
                split. apply (step_preserves_halting _ _ E); eauto.
                intros.
              @@ -867,8 +868,8 @@

              NormNormalization of STLC

              -Lemma multistep_preserves_R : T t t',
              -  (t ==>* t') → R T tR T t'.
              +Lemma multistep_preserves_R : T t t',
              +  (t -->* t') → R T tR T t'.
              Proof.
              @@ -885,8 +886,8 @@

              NormNormalization of STLC

              -Lemma step_preserves_R' : T t t',
              -  has_type empty t T → (t ==> t') → R T t'R T t.
              +Lemma step_preserves_R' : T t t',
              +  has_type empty t T → (t --> t') → R T t'R T t.
              Proof.
              @@ -894,8 +895,8 @@

              NormNormalization of STLC


              -Lemma multistep_preserves_R' : T t t',
              -  has_type empty t T → (t ==>* t') → R T t'R T t.
              +Lemma multistep_preserves_R' : T t t',
              +  has_type empty t T → (t -->* t') → R T t'R T t.
              Proof.
              @@ -919,7 +920,7 @@

              NormNormalization of STLC

              tabs x T1 t2 belongs to R_(T1T2) should involve applying the + abs x T1 t2 belongs to R_(T1T2) should involve applying the induction hypothesis to show that t2 belongs to R_(T2). But R_(T2) is defined to be a set of _closed_ terms, while t2 may contain x free, so this does not make sense. @@ -934,14 +935,14 @@

              NormNormalization of STLC

              - If x1:T1,..xn:Tn |- t : T and v1,...,vn are values such that + If x1:T1,..xn:Tn t : T and v1,...,vn are values such that R T1 v1, R T2 v2, ..., R Tn vn, then R T ([x1:=v1][x2:=v2]...[xn:=vn]t).
              The proof will proceed by induction on the typing derivation - x1:T1,..xn:Tn |- t : T; the most interesting case will be the one + x1:T1,..xn:Tn t : T; the most interesting case will be the one for abstraction.
              @@ -971,10 +972,10 @@

              NormNormalization of STLC

              ...,y:bool,...,y:nat,... and a corresponding term substitution written as ...[y:=(tbool - true)]...[y:=(tnat 3)]...t. Since environments are extended from + true)]...[y:=(const 3)]...t. Since environments are extended from left to right, the binding y:nat hides the binding y:bool; since substitutions are performed right to left, we do the substitution - y:=(tnat 3) first, so that the substitution y:=(tbool true) has + y:=(const 3) first, so that the substitution y:=(tbool true) has no effect. Substitution thus correctly preserves the type of the term.
              @@ -1044,7 +1045,7 @@

              NormNormalization of STLC

              Inductive instantiation : tassenvProp :=
              | V_nil :
                  instantiation nil nil
              -| V_cons : x T v c e,
              +| V_cons : x T v c e,
                  value vR T v
                  instantiation c e
                  instantiation ((x,T)::c) ((x,v)::e).
              @@ -1063,9 +1064,9 @@

              NormNormalization of STLC

              -Lemma vacuous_substitution : t x,
              -     ¬ appears_free_in x t
              -      t', [x:=t']t = t.
              +Lemma vacuous_substitution : t x,
              +     ¬appears_free_in x t
              +     t', [x:=t']t = t.
              Proof with eauto.
              @@ -1073,9 +1074,9 @@

              NormNormalization of STLC


              -Lemma subst_closed: t,
              +Lemma subst_closed: t,
                   closed t
              -      x t', [x:=t']t = t.
              +     x t', [x:=t']t = t.
              Proof.
              @@ -1083,39 +1084,39 @@

              NormNormalization of STLC


              -Lemma subst_not_afi : t x v,
              -    closed v → ¬ appears_free_in x ([x:=v]t).
              +Lemma subst_not_afi : t x v,
              +    closed v → ¬appears_free_in x ([x:=v]t).
              Proof with eauto. (* rather slow this way *)
                unfold closed, not.
                induction t; intros x v P A; simpl in A.
              -    - (* tvar *)
              +    - (* var *)
                   destruct (eqb_stringP x s)...
                   inversion A; subst. auto.
              -    - (* tapp *)
              +    - (* app *)
                   inversion A; subst...
              -    - (* tabs *)
              +    - (* abs *)
                   destruct (eqb_stringP x s)...
                   + inversion A; subst...
                   + inversion A; subst...
              -    - (* tpair *)
              +    - (* pair *)
                   inversion A; subst...
              -    - (* tfst *)
              +    - (* fst *)
                   inversion A; subst...
              -    - (* tsnd *)
              +    - (* snd *)
                   inversion A; subst...
              -    - (* ttrue *)
              +    - (* tru *)
                   inversion A.
              -    - (* tfalse *)
              +    - (* fls *)
                   inversion A.
              -    - (* tif *)
              +    - (* test *)
                   inversion A; subst...
              Qed.

              -Lemma duplicate_subst : t' x t v,
              +Lemma duplicate_subst : t' x t v,
                closed v → [x:=t]([x:=v]t') = [x:=v]t'.
              @@ -1125,7 +1126,7 @@

              NormNormalization of STLC


              -Lemma swap_subst : t x x1 v v1,
              +Lemma swap_subst : t x x1 v v1,
                  xx1
                  closed vclosed v1
                  [x1:=v1]([x:=v]t) = [x:=v]([x1:=v1]t).
              @@ -1133,7 +1134,7 @@

              NormNormalization of STLC

              Proof with eauto.
               induction t; intros; simpl.
              -  - (* tvar *)
              +  - (* var *)
                 destruct (eqb_stringP x s); destruct (eqb_stringP x1 s).
                 + subst. exfalso...
                 + subst. simpl. rewrite <- eqb_string_refl. apply subst_closed...
              @@ -1150,7 +1151,7 @@

              NormNormalization of STLC


              -Lemma msubst_closed: t, closed t ss, msubst ss t = t.
              +Lemma msubst_closed: t, closed tss, msubst ss t = t.
              Proof.
              @@ -1179,7 +1180,7 @@

              NormNormalization of STLC

              -Lemma subst_msubst: env x v t, closed vclosed_env env
              +Lemma subst_msubst: env x v t, closed vclosed_env env
                  msubst env ([x:=v]t) = [x:=v](msubst (drop x env) t).
              @@ -1194,11 +1195,11 @@

              NormNormalization of STLC


              -Lemma msubst_var: ss x, closed_env ss
              -   msubst ss (tvar x) =
              +Lemma msubst_var: ss x, closed_env ss
              +   msubst ss (var x) =
                 match lookup x ss with
                 | Some tt
              -   | Nonetvar x
              +   | Nonevar x
                end.
              @@ -1213,8 +1214,8 @@

              NormNormalization of STLC


              -Lemma msubst_abs: ss x T t,
              -  msubst ss (tabs x T t) = tabs x T (msubst (drop x ss) t).
              +Lemma msubst_abs: ss x T t,
              +  msubst ss (abs x T t) = abs x T (msubst (drop x ss) t).
              Proof.
              @@ -1226,7 +1227,7 @@

              NormNormalization of STLC


              -Lemma msubst_app : ss t1 t2, msubst ss (tapp t1 t2) = tapp (msubst ss t1) (msubst ss t2).
              +Lemma msubst_app : ss t1 t2, msubst ss (app t1 t2) = app (msubst ss t1) (msubst ss t2).
              Proof.
              @@ -1256,7 +1257,7 @@

              NormNormalization of STLC

              -Lemma mupdate_lookup : (c : tass) (x:string),
              +Lemma mupdate_lookup : (c : tass) (x:string),
                  lookup x c = (mupdate empty c) x.
              @@ -1268,7 +1269,7 @@

              NormNormalization of STLC


              -Lemma mupdate_drop : (c: tass) Gamma x x',
              +Lemma mupdate_drop : (c: tass) Gamma x x',
                    mupdate Gamma (drop x c) x'
                  = if eqb_string x x' then Gamma x' else mupdate Gamma c x'.
              @@ -1295,10 +1296,10 @@

              NormNormalization of STLC

              -Lemma instantiation_domains_match: {c} {e},
              +Lemma instantiation_domains_match: {c} {e},
                  instantiation c e
              -     {x} {T},
              -      lookup x c = Some T t, lookup x e = Some t.
              +    {x} {T},
              +      lookup x c = Some Tt, lookup x e = Some t.
              Proof.
              @@ -1310,7 +1311,7 @@

              NormNormalization of STLC


              -Lemma instantiation_env_closed : c e,
              +Lemma instantiation_env_closed : c e,
                instantiation c eclosed_env e.
              @@ -1324,9 +1325,9 @@

              NormNormalization of STLC


              -Lemma instantiation_R : c e,
              +Lemma instantiation_R : c e,
                  instantiation c e
              -     x t T,
              +    x t T,
                    lookup x c = Some T
                    lookup x e = Some tR T t.
              @@ -1341,9 +1342,9 @@

              NormNormalization of STLC


              -Lemma instantiation_drop : c env,
              +Lemma instantiation_drop : c env,
                  instantiation c env
              -     x, instantiation (drop x c) (drop x env).
              +    x, instantiation (drop x c) (drop x env).
              Proof.
              @@ -1363,8 +1364,8 @@

              NormNormalization of STLC

              -Lemma multistep_App2 : v t t',
              -  value v → (t ==>* t') → (tapp v t) ==>* (tapp v t').
              +Lemma multistep_App2 : v t t',
              +  value v → (t -->* t') → (app v t) -->* (app v t').
              Proof.
              @@ -1393,9 +1394,9 @@

              NormNormalization of STLC

              -Lemma msubst_preserves_typing : c e,
              +Lemma msubst_preserves_typing : c e,
                   instantiation c e
              -      Gamma t S, has_type (mupdate Gamma c) t S
              +     Gamma t S, has_type (mupdate Gamma c) t S
                   has_type Gamma (msubst e t) S.
              @@ -1415,7 +1416,7 @@

              NormNormalization of STLC

              -Lemma msubst_R : c env t T,
              +Lemma msubst_R : c env t T,
                  has_type (mupdate empty c) t T
                  instantiation c env
                  R T (msubst env t).
              @@ -1426,7 +1427,7 @@

              NormNormalization of STLC

              generalize dependent env0.
                (* We need to generalize the hypothesis a bit before setting up the induction. *)
                remember (mupdate empty c) as Gamma.
              -  assert ( x, Gamma x = lookup x c).
              +  assert (x, Gamma x = lookup x c).
                  intros. rewrite HeqGamma. rewrite mupdate_lookup. auto.
                clear HeqGamma.
                generalize dependent c.
              @@ -1439,7 +1440,7 @@

              NormNormalization of STLC

              rewrite msubst_abs.
                  (* We'll need variants of the following fact several times, so its simplest to
                     establish it just once. *)

              -    assert (WT: has_type empty (tabs x T11 (msubst (drop x env0) t12)) (TArrow T11 T12)).
              +    assert (WT: has_type empty (abs x T11 (msubst (drop x env0) t12)) (Arrow T11 T12)).
                  { eapply T_Abs. eapply msubst_preserves_typing.
                    { eapply instantiation_drop; eauto. }
                    eapply context_invariance.
              @@ -1488,7 +1489,7 @@

              NormNormalization of STLC

              -Theorem normalization : t T, has_type empty t Thalts t.
              +Theorem normalization : t T, has_type empty t Thalts t.
              Proof.
              @@ -1499,8 +1500,10 @@

              NormNormalization of STLC

              eapply V_nil.
              Qed.
              -
              +
              +(* Sat Jan 26 15:15:45 UTC 2019 *)
              +
              diff --git a/plf-current/Norm.v b/plf-current/Norm.v index 3cef0609..96a03624 100644 --- a/plf-current/Norm.v +++ b/plf-current/Norm.v @@ -1,7 +1,8 @@ (** * Norm: Normalization of STLC *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Lists.List. Import ListNotations. +From Coq Require Import Lists.List. Import ListNotations. +From Coq Require Import Strings.String. From PLF Require Import Maps. From PLF Require Import Smallstep. @@ -48,8 +49,9 @@ Hint Constructors multi. entirely trivial to prove, since each reduction of a term can duplicate redexes in subterms. *) -(** **** 练习:2 星 (norm_fail) *) -(** Where do we fail if we attempt to prove normalization by a +(** **** 练习:2 星, standard (norm_fail) + + Where do we fail if we attempt to prove normalization by a straightforward induction on the size of a well-typed term? *) (* 请在此处解答 *) @@ -58,8 +60,9 @@ Hint Constructors multi. Definition manual_grade_for_norm_fail : option (nat*string) := None. (** [] *) -(** **** 练习:5 星, recommended (norm) *) -(** The best ways to understand an intricate proof like this is +(** **** 练习:5 星, standard, recommended (norm) + + The best ways to understand an intricate proof like this is are (1) to help fill it in and (2) to extend it. We've left out some parts of the following development, including some proofs of lemmas and the all the cases involving products and conditionals. Fill them @@ -82,42 +85,42 @@ Definition manual_grade_for_norm : option (nat*string) := None. (** *** Syntax and Operational Semantics *) Inductive ty : Type := - | TBool : ty - | TArrow : ty -> ty -> ty - | TProd : ty -> ty -> ty + | Bool : ty + | Arrow : ty -> ty -> ty + | Prod : ty -> ty -> ty . Inductive tm : Type := (* pure STLC *) - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm (* pairs *) - | tpair : tm -> tm -> tm - | tfst : tm -> tm - | tsnd : tm -> tm + | pair : tm -> tm -> tm + | fst : tm -> tm + | snd : tm -> tm (* booleans *) - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. - (* i.e., [if t0 then t1 else t2] *) + | tru : tm + | fls : tm + | test : tm -> tm -> tm -> tm. + (* i.e., [test t0 then t1 else t2] *) (* ----------------------------------------------------------------- *) (** *** Substitution *) Fixpoint subst (x:string) (s:tm) (t:tm) : tm := match t with - | tvar y => if eqb_string x y then s else t - | tabs y T t1 => - tabs y T (if eqb_string x y then t1 else (subst x s t1)) - | tapp t1 t2 => tapp (subst x s t1) (subst x s t2) - | 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) - | ttrue => ttrue - | tfalse => tfalse - | tif t0 t1 t2 => - tif (subst x s t0) (subst x s t1) (subst x s t2) + | var y => if eqb_string x y then s else t + | abs y T t1 => + abs y T (if eqb_string x y then t1 else (subst x s t1)) + | app t1 t2 => app (subst x s t1) (subst x s t2) + | pair t1 t2 => pair (subst x s t1) (subst x s t2) + | fst t1 => fst (subst x s t1) + | snd t1 => snd (subst x s t1) + | tru => tru + | fls => fls + | test t0 t1 t2 => + test (subst x s t0) (subst x s t1) (subst x s t2) end. Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). @@ -127,65 +130,65 @@ Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). Inductive value : tm -> Prop := | v_abs : forall x T11 t12, - value (tabs x T11 t12) + value (abs x T11 t12) | v_pair : forall v1 v2, value v1 -> value v2 -> - value (tpair v1 v2) - | v_true : value ttrue - | v_false : value tfalse + value (pair v1 v2) + | v_tru : value tru + | v_fls : value fls . Hint Constructors value. -Reserved Notation "t1 '==>' t2" (at level 40). +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 + (app (abs x T11 t12) v2) --> [x:=v2]t12 | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) + t1 --> t1' -> + (app t1 t2) --> (app t1' t2) | ST_App2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - (tapp v1 t2) ==> (tapp v1 t2') + t2 --> t2' -> + (app v1 t2) --> (app v1 t2') (* pairs *) | ST_Pair1 : forall t1 t1' t2, - t1 ==> t1' -> - (tpair t1 t2) ==> (tpair t1' t2) + t1 --> t1' -> + (pair t1 t2) --> (pair t1' t2) | ST_Pair2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - (tpair v1 t2) ==> (tpair v1 t2') + t2 --> t2' -> + (pair v1 t2) --> (pair v1 t2') | ST_Fst : forall t1 t1', - t1 ==> t1' -> - (tfst t1) ==> (tfst t1') + t1 --> t1' -> + (fst t1) --> (fst t1') | ST_FstPair : forall v1 v2, value v1 -> value v2 -> - (tfst (tpair v1 v2)) ==> v1 + (fst (pair v1 v2)) --> v1 | ST_Snd : forall t1 t1', - t1 ==> t1' -> - (tsnd t1) ==> (tsnd t1') + t1 --> t1' -> + (snd t1) --> (snd t1') | ST_SndPair : forall v1 v2, value v1 -> value v2 -> - (tsnd (tpair v1 v2)) ==> v2 + (snd (pair v1 v2)) --> v2 (* booleans *) - | ST_IfTrue : forall t1 t2, - (tif ttrue t1 t2) ==> t1 - | ST_IfFalse : forall t1 t2, - (tif tfalse t1 t2) ==> t2 - | ST_If : forall t0 t0' t1 t2, - t0 ==> t0' -> - (tif t0 t1 t2) ==> (tif t0' t1 t2) + | ST_TestTrue : forall t1 t2, + (test tru t1 t2) --> t1 + | ST_TestFalse : forall t1 t2, + (test fls t1 t2) --> t2 + | ST_Test : forall t0 t0' t1 t2, + t0 --> t0' -> + (test t0 t1 t2) --> (test t0' t1 t2) -where "t1 '==>' t2" := (step t1 t2). +where "t1 '-->' t2" := (step t1 t2). Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40). Hint Constructors step. @@ -205,40 +208,40 @@ Inductive has_type : context -> tm -> ty -> Prop := (* Typing rules for proper terms *) | T_Var : forall Gamma x T, Gamma x = Some T -> - has_type Gamma (tvar x) T + has_type Gamma (var x) T | T_Abs : forall Gamma x T11 T12 t12, has_type (update Gamma x T11) t12 T12 -> - has_type Gamma (tabs x T11 t12) (TArrow T11 T12) + has_type Gamma (abs x T11 t12) (Arrow T11 T12) | T_App : forall T1 T2 Gamma t1 t2, - has_type Gamma t1 (TArrow T1 T2) -> + has_type Gamma t1 (Arrow T1 T2) -> has_type Gamma t2 T1 -> - has_type Gamma (tapp t1 t2) T2 + has_type Gamma (app t1 t2) T2 (* pairs *) | T_Pair : forall Gamma t1 t2 T1 T2, has_type Gamma t1 T1 -> has_type Gamma t2 T2 -> - has_type Gamma (tpair t1 t2) (TProd T1 T2) + has_type Gamma (pair t1 t2) (Prod T1 T2) | T_Fst : forall Gamma t T1 T2, - has_type Gamma t (TProd T1 T2) -> - has_type Gamma (tfst t) T1 + has_type Gamma t (Prod T1 T2) -> + has_type Gamma (fst t) T1 | T_Snd : forall Gamma t T1 T2, - has_type Gamma t (TProd T1 T2) -> - has_type Gamma (tsnd t) T2 + has_type Gamma t (Prod T1 T2) -> + has_type Gamma (snd t) T2 (* booleans *) | T_True : forall Gamma, - has_type Gamma ttrue TBool + has_type Gamma tru Bool | T_False : forall Gamma, - has_type Gamma tfalse TBool - | T_If : forall Gamma t0 t1 t2 T, - has_type Gamma t0 TBool -> + has_type Gamma fls Bool + | T_Test : forall Gamma t0 t1 t2 T, + has_type Gamma t0 Bool -> has_type Gamma t1 T -> has_type Gamma t2 T -> - has_type Gamma (tif t0 t1 t2) T + has_type Gamma (test t0 t1 t2) T . Hint Constructors has_type. -Hint Extern 2 (has_type _ (tapp _ _) _) => eapply T_App; auto. +Hint Extern 2 (has_type _ (app _ _) _) => eapply T_App; auto. Hint Extern 2 (_ = _) => compute; reflexivity. (* ----------------------------------------------------------------- *) @@ -246,38 +249,38 @@ Hint Extern 2 (_ = _) => compute; reflexivity. Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) + appears_free_in x t1 -> appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) + appears_free_in x t2 -> appears_free_in x (app t1 t2) | afi_abs : forall x y T11 t12, y <> x -> appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) + appears_free_in x (abs y T11 t12) (* pairs *) | afi_pair1 : forall x t1 t2, appears_free_in x t1 -> - appears_free_in x (tpair t1 t2) + appears_free_in x (pair t1 t2) | afi_pair2 : forall x t1 t2, appears_free_in x t2 -> - appears_free_in x (tpair t1 t2) + appears_free_in x (pair t1 t2) | afi_fst : forall x t, appears_free_in x t -> - appears_free_in x (tfst t) + appears_free_in x (fst t) | afi_snd : forall x t, appears_free_in x t -> - appears_free_in x (tsnd t) + appears_free_in x (snd t) (* booleans *) - | afi_if0 : forall x t0 t1 t2, + | afi_test0 : forall x t0 t1 t2, appears_free_in x t0 -> - appears_free_in x (tif t0 t1 t2) - | afi_if1 : forall x t0 t1 t2, + appears_free_in x (test t0 t1 t2) + | afi_test1 : forall x t0 t1 t2, appears_free_in x t1 -> - appears_free_in x (tif t0 t1 t2) - | afi_if2 : forall x t0 t1 t2, + appears_free_in x (test t0 t1 t2) + | afi_test2 : forall x t0 t1 t2, appears_free_in x t2 -> - appears_free_in x (tif t0 t1 t2) + appears_free_in x (test t0 t1 t2) . Hint Constructors appears_free_in. @@ -300,8 +303,8 @@ Proof with eauto. unfold update, t_update. destruct (eqb_stringP x y)... - (* T_Pair *) apply T_Pair... - - (* T_If *) - eapply T_If... + - (* T_Test *) + eapply T_Test... Qed. Lemma free_in_context : forall x t T Gamma, @@ -338,12 +341,12 @@ Proof with eauto. 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. + from the IH, with the exception of var and abs. The former aren't automatic because we must reason about how the variables interact. *) induction t; intros S Gamma Htypt; simpl; inversion Htypt; subst... - - (* tvar *) + - (* var *) simpl. rename s into y. (* If t = y, we know that [empty |- v : U] and @@ -369,17 +372,17 @@ Proof with eauto. (* 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... - - (* tabs *) + - (* abs *) rename s 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] + (* If [t = abs y T11 t0], then we know that + [Gamma,x:U |- abs 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 eqb_string x y then t0 else [x:=v]t0) + [x:=v]t = abs y T11 (if eqb_string 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 eqb_string x y then t0 else [x:=v]t0 : T12] @@ -409,11 +412,11 @@ Qed. Theorem preservation : forall t t' T, has_type empty t T -> - t ==> t' -> + t --> t' -> has_type empty t' T. Proof with eauto. intros t t' T HT. - (* Theorem: If [empty |- t : T] and [t ==> t'], then [empty |- t' : T]. *) + (* 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 @@ -422,18 +425,18 @@ Proof with eauto. intros t' HeqGamma HE; subst; inversion HE; subst... - (* 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 + 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... + (* ST_AppAbs *) (* For the third case, suppose - [t1 = tabs x T11 t12] + [t1 = abs 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] + [empty |- abs x T11 t12 : T1->T2] and by inversion [x:T1 |- t12 : T2] We have already proven that substitution_preserves_typing and @@ -496,11 +499,11 @@ Proof with eauto. inversion H2; subst. + apply value__normal in H... + apply value__normal in H0... - - (* ST_IfTrue *) + - (* ST_TestTrue *) inversion H3. - - (* ST_IfFalse *) + - (* ST_TestFalse *) inversion H3. - (* ST_If *) + (* ST_Test *) - inversion E1. - inversion E1. - f_equal... @@ -520,7 +523,7 @@ Qed. Here's the key definition: *) -Definition halts (t:tm) : Prop := exists t', t ==>* t' /\ value t'. +Definition halts (t:tm) : Prop := exists t', t -->* t' /\ value t'. (** A trivial fact: *) @@ -578,19 +581,19 @@ Qed. Inductive proposition like this: Inductive R : ty -> tm -> Prop := - | R_bool : forall b t, has_type empty t TBool -> + | R_bool : forall b t, has_type empty t Bool -> halts t -> - R TBool t - | R_arrow : forall T1 T2 t, has_type empty t (TArrow T1 T2) -> + R Bool t + | R_arrow : forall T1 T2 t, has_type empty t (Arrow T1 T2) -> halts t -> - (forall s, R T1 s -> R T2 (tapp t s)) -> - R (TArrow T1 T2) t. + (forall s, R T1 s -> R T2 (app t s)) -> + R (Arrow T1 T2) t. Unfortunately, Coq rejects this definition because it violates the _strict positivity requirement_ for inductive definitions, which says that the type being defined must not occur to the left of an arrow in the type of a constructor argument. Here, it is the third argument to - [R_arrow], namely [(forall s, R T1 s -> R TS (tapp t s))], and + [R_arrow], namely [(forall s, R T1 s -> R TS (app t s))], and specifically the [R T1 s] part, that violates this rule. (The outermost arrows separating the constructor arguments don't count when applying this rule; otherwise we could never have genuinely inductive @@ -607,11 +610,11 @@ Qed. Fixpoint R (T:ty) (t:tm) {struct T} : Prop := has_type empty t T /\ halts t /\ (match T with - | TBool => True - | TArrow T1 T2 => (forall s, R T1 s -> R T2 (tapp t s)) + | Bool => True + | Arrow T1 T2 => (forall s, R T1 s -> R T2 (app t s)) (* ... edit the next line when dealing with products *) - | TProd T1 T2 => False + | Prod T1 T2 => False (* FILL IN HERE *) end). (** As immediate consequences of this definition, we have that every @@ -623,7 +626,6 @@ Proof. intros. destruct T; unfold R in H; inversion H; inversion H1; assumption. Qed. - Lemma R_typable_empty : forall {T} {t}, R T t -> has_type empty t T. Proof. intros. destruct T; unfold R in H; inversion H; inversion H1; assumption. @@ -634,7 +636,6 @@ Qed. [R_halts], that will show that every well-typed term halts in a value. *) - (* ================================================================= *) (** ** Membership in [R_T] Is Invariant Under Reduction *) @@ -650,7 +651,7 @@ Qed. determinstic. This lemma might still be true for nondeterministic languages, but the proof would be harder! *) -Lemma step_preserves_halting : forall t t', (t ==> t') -> (halts t <-> halts t'). +Lemma step_preserves_halting : forall t t', (t --> t') -> (halts t <-> halts t'). Proof. intros t t' ST. unfold halts. split. @@ -672,15 +673,15 @@ Qed. One requirement for staying in [R_T] is to stay in type [T]. In the forward direction, we get this from ordinary type Preservation. *) -Lemma step_preserves_R : forall T t t', (t ==> t') -> R T t -> R T t'. +Lemma step_preserves_R : forall T t t', (t --> t') -> R T t -> R T t'. Proof. induction T; intros t t' E Rt; unfold R; fold R; unfold R in Rt; fold R in Rt; destruct Rt as [typable_empty_t [halts_t RRt]]. - (* TBool *) + (* Bool *) split. eapply preservation; eauto. split. apply (step_preserves_halting _ _ E); eauto. auto. - (* TArrow *) + (* Arrow *) split. eapply preservation; eauto. split. apply (step_preserves_halting _ _ E); eauto. intros. @@ -692,7 +693,7 @@ Proof. (** The generalization to multiple steps is trivial: *) Lemma multistep_preserves_R : forall T t t', - (t ==>* t') -> R T t -> R T t'. + (t -->* t') -> R T t -> R T t'. Proof. intros T t t' STM; induction STM; intros. assumption. @@ -703,12 +704,12 @@ Qed. [T] before stepping as an additional hypothesis. *) Lemma step_preserves_R' : forall T t t', - has_type empty t T -> (t ==> t') -> R T t' -> R T t. + has_type empty t T -> (t --> t') -> R T t' -> R T t. Proof. (* 请在此处解答 *) Admitted. Lemma multistep_preserves_R' : forall T t t', - has_type empty t T -> (t ==>* t') -> R T t' -> R T t. + has_type empty t T -> (t -->* t') -> R T t' -> R T t. Proof. intros T t t' HT STM. induction STM; intros. @@ -726,7 +727,7 @@ Qed. somewhere involve induction on typing derivations!). The only technical difficulty here is in dealing with the abstraction case. Since we are arguing by induction, the demonstration that a term - [tabs x T1 t2] belongs to [R_(T1->T2)] should involve applying the + [abs x T1 t2] belongs to [R_(T1->T2)] should involve applying the induction hypothesis to show that [t2] belongs to [R_(T2)]. But [R_(T2)] is defined to be a set of _closed_ terms, while [t2] may contain [x] free, so this does not make sense. @@ -767,10 +768,10 @@ Qed. from right to left. To see that this is consistent, suppose we have an environment written as [...,y:bool,...,y:nat,...] and a corresponding term substitution written as [...[y:=(tbool - true)]...[y:=(tnat 3)]...t]. Since environments are extended from + true)]...[y:=(const 3)]...t]. Since environments are extended from left to right, the binding [y:nat] hides the binding [y:bool]; since substitutions are performed right to left, we do the substitution - [y:=(tnat 3)] first, so that the substitution [y:=(tbool true)] has + [y:=(const 3)] first, so that the substitution [y:=(tbool true)] has no effect. Substitution thus correctly preserves the type of the term. With these points in mind, the following definitions should make sense. @@ -854,26 +855,26 @@ Lemma subst_not_afi : forall t x v, Proof with eauto. (* rather slow this way *) unfold closed, not. induction t; intros x v P A; simpl in A. - - (* tvar *) + - (* var *) destruct (eqb_stringP x s)... inversion A; subst. auto. - - (* tapp *) + - (* app *) inversion A; subst... - - (* tabs *) + - (* abs *) destruct (eqb_stringP x s)... + inversion A; subst... + inversion A; subst... - - (* tpair *) + - (* pair *) inversion A; subst... - - (* tfst *) + - (* fst *) inversion A; subst... - - (* tsnd *) + - (* snd *) inversion A; subst... - - (* ttrue *) + - (* tru *) inversion A. - - (* tfalse *) + - (* fls *) inversion A. - - (* tif *) + - (* test *) inversion A; subst... Qed. @@ -889,7 +890,7 @@ Lemma swap_subst : forall t x x1 v v1, [x1:=v1]([x:=v]t) = [x:=v]([x1:=v1]t). Proof with eauto. induction t; intros; simpl. - - (* tvar *) + - (* var *) destruct (eqb_stringP x s); destruct (eqb_stringP x1 s). + subst. exfalso... + subst. simpl. rewrite <- eqb_string_refl. apply subst_closed... @@ -930,10 +931,10 @@ Proof. Qed. Lemma msubst_var: forall ss x, closed_env ss -> - msubst ss (tvar x) = + msubst ss (var x) = match lookup x ss with | Some t => t - | None => tvar x + | None => var x end. Proof. induction ss; intros. @@ -945,7 +946,7 @@ Proof. Qed. Lemma msubst_abs: forall ss x T t, - msubst ss (tabs x T t) = tabs x T (msubst (drop x ss) t). + msubst ss (abs x T t) = abs x T (msubst (drop x ss) t). Proof. induction ss; intros. reflexivity. @@ -953,7 +954,7 @@ Proof. simpl. destruct (eqb_string s x); simpl; auto. Qed. -Lemma msubst_app : forall ss t1 t2, msubst ss (tapp t1 t2) = tapp (msubst ss t1) (msubst ss t2). +Lemma msubst_app : forall ss t1 t2, msubst ss (app t1 t2) = app (msubst ss t1) (msubst ss t2). Proof. induction ss; intros. reflexivity. @@ -1041,14 +1042,13 @@ Proof. intros. unfold drop. destruct (eqb_string x x0); auto. constructor; eauto. Qed. - (* ----------------------------------------------------------------- *) (** *** Congruence Lemmas on Multistep *) (** We'll need just a few of these; add them as the demand arises. *) Lemma multistep_App2 : forall v t t', - value v -> (t ==>* t') -> (tapp v t) ==>* (tapp v t'). + value v -> (t -->* t') -> (app v t) -->* (app v t'). Proof. intros v t t' V STM. induction STM. apply multi_refl. @@ -1105,7 +1105,7 @@ Proof. rewrite msubst_abs. (* We'll need variants of the following fact several times, so its simplest to establish it just once. *) - assert (WT: has_type empty (tabs x T11 (msubst (drop x env0) t12)) (TArrow T11 T12)). + assert (WT: has_type empty (abs x T11 (msubst (drop x env0) t12)) (Arrow T11 T12)). { eapply T_Abs. eapply msubst_preserves_typing. { eapply instantiation_drop; eauto. } eapply context_invariance. @@ -1159,4 +1159,5 @@ Proof. eapply V_nil. Qed. -(** $Date$ *) + +(* Sat Jan 26 15:15:45 UTC 2019 *) diff --git a/plf-current/NormTest.v b/plf-current/NormTest.v index abce781e..a461bb55 100644 --- a/plf-current/NormTest.v +++ b/plf-current/NormTest.v @@ -63,3 +63,5 @@ idtac "MANUAL". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:38 UTC 2019 *) diff --git a/plf-current/PE.html b/plf-current/PE.html index bed39148..49c0ac30 100644 --- a/plf-current/PE.html +++ b/plf-current/PE.html @@ -88,21 +88,21 @@

              PE部分求值

              -Require Import Coq.Bool.Bool.
              -Require Import Coq.Arith.Arith.
              -Require Import Coq.Arith.EqNat.
              -Require Import Coq.Arith.PeanoNat. Import Nat.
              -Require Import Coq.omega.Omega.
              -Require Import Coq.Logic.FunctionalExtensionality.
              -Require Import Coq.Lists.List.
              -Import ListNotations.

              From PLF Require Import Maps.
              -From PLF Require Import Imp.
              +From Coq Require Import Bool.Bool.
              +From Coq Require Import Arith.Arith.
              +From Coq Require Import Arith.EqNat.
              +From Coq Require Import Arith.PeanoNat. Import Nat.
              +From Coq Require Import omega.Omega.
              +From Coq Require Import Logic.FunctionalExtensionality.
              +From Coq Require Import Lists.List.
              +Import ListNotations.

              From PLF Require Import Smallstep.
              +From PLF Require Import Imp.
              -

              一般化的常量折叠

              +

              一般化的常量折叠

              @@ -110,7 +110,7 @@

              PE部分求值

              在两个赋值语句中间时 X3,但不知道关于其他变量的任何信息。
              -

              部分状态

              +

              部分状态

              @@ -169,7 +169,7 @@

              PE部分求值

                let H := fresh "Heq" i j in
                destruct (eqb_stringP i j);
                [ subst j | ].

              -Theorem pe_domain: pe_st V n,
              +Theorem pe_domain: pe_st V n,
                pe_lookup pe_st V = Some n
                In V (map (@fst _ _) pe_st).
              Proof. intros pe_st V n H. induction pe_st as [| [V' n'] pe_st].
              @@ -188,7 +188,7 @@

              PE部分求值

                         |  => False
                         | b :: m => b = a \/ In a m
                          end
              -        : forall A : Type, A -> list A -> Prop *)
              +        : forall A : Type, A -> list A -> Prop *)
              @@ -197,8 +197,8 @@

              PE部分求值

              Check filter_In.
              -(* ===> filter_In : forall (A : Type) (f : A -> bool) (x : A) (l : list A),
              -            In x (filter f l) <-> In x l /\ f x = true  *)

              +(* ===> filter_In : forall (A : Type) (f : A -> bool) (x : A) (l : list A),
              +            In x (filter f l) <-> In x l /\ f x = true  *)

              @@ -219,9 +219,9 @@

              PE部分求值

              -Lemma inbP : A : Type, eqb : AAbool,
              -  ( a1 a2, reflect (a1 = a2) (eqb a1 a2)) →
              -   a l, reflect (In a l) (inb eqb a l).
              +Lemma inbP : A : Type, eqb : AAbool,
              +  (a1 a2, reflect (a1 = a2) (eqb a1 a2)) →
              +  a l, reflect (In a l) (inb eqb a l).
              Proof.
                intros A eqb beqP a l.
                induction l as [|a' l' IH].
              @@ -235,7 +235,7 @@

              PE部分求值

              -

              算术表达式

              +

              算术表达式

              @@ -274,11 +274,9 @@

              PE部分求值

              -Open Scope aexp_scope.
              -Open Scope bexp_scope.

              Example test_pe_aexp1:
              -  pe_aexp [(X,3)] (X + 1 + Y)
              -  = (4 + Y).
              +  pe_aexp [(X,3)] (X + 1 + Y)%imp
              +  = (4 + Y)%imp.
              Proof. reflexivity. Qed.
              @@ -286,8 +284,8 @@

              PE部分求值


              Example text_pe_aexp2:
              -  pe_aexp [(Y,3)] (X + 1 + Y)
              -  = (X + 1 + 3).
              +  pe_aexp [(Y,3)] (X + 1 + Y)%imp
              +  = (X + 1 + 3)%imp.
              Proof. reflexivity. Qed.
              @@ -303,9 +301,9 @@

              PE部分求值

              Definition pe_consistent (st:state) (pe_st:pe_state) :=
              -   V n, Some n = pe_lookup pe_st Vst V = n.

              -Theorem pe_aexp_correct_weak: st pe_st, pe_consistent st pe_st
              -   a, aeval st a = aeval st (pe_aexp pe_st a).
              +  V n, Some n = pe_lookup pe_st Vst V = n.

              +Theorem pe_aexp_correct_weak: st pe_st, pe_consistent st pe_st
              +  a, aeval st a = aeval st (pe_aexp pe_st a).
              Proof. unfold pe_consistent. intros st pe_st H a.
                induction a; simpl;
                  try reflexivity;
              @@ -386,8 +384,8 @@

              PE部分求值

                | (V,n)::pe_stt_update (pe_update st pe_st) V n
                end.

              Example test_pe_update:
              -  pe_update { Y --> 1 } [(X,3);(Z,2)]
              -  = { Y --> 1 ; Z --> 2 ; X --> 3 }.
              +  pe_update (Y !-> 1) [(X,3);(Z,2)]
              +  = (X !-> 3 ; Z !-> 2 ; Y !-> 1).
              Proof. reflexivity. Qed.
              @@ -400,7 +398,7 @@

              PE部分求值

              -Theorem pe_update_correct: st pe_st V0,
              +Theorem pe_update_correct: st pe_st V0,
                pe_update st pe_st V0 =
                match pe_lookup pe_st V0 with
                | Some nn
              @@ -419,12 +417,12 @@

              PE部分求值

              -Theorem pe_update_consistent: st pe_st,
              +Theorem pe_update_consistent: st pe_st,
                pe_consistent (pe_update st pe_st) pe_st.
              Proof. intros st pe_st V n H. rewrite pe_update_correct.
                destruct (pe_lookup pe_st V); inversion H. reflexivity. Qed.

              -Theorem pe_consistent_update: st pe_st,
              -  pe_consistent st pe_st V, st V = pe_update st pe_st V.
              +Theorem pe_consistent_update: st pe_st,
              +  pe_consistent st pe_stV, st V = pe_update st pe_st V.
              Proof. intros st pe_st H V. rewrite pe_update_correct.
                remember (pe_lookup pe_st V) as l. destruct l; auto. Qed.
              @@ -442,7 +440,7 @@

              PE部分求值

              -Theorem pe_aexp_correct: (pe_st:pe_state) (a:aexp) (st:state),
              +Theorem pe_aexp_correct: (pe_st:pe_state) (a:aexp) (st:state),
                aeval (pe_update st pe_st) a = aeval st (pe_aexp pe_st a).
              Proof.
                intros pe_st a st.
              @@ -457,7 +455,7 @@

              PE部分求值

              -

              布尔表达式

              +

              布尔表达式

              @@ -496,7 +494,7 @@

              PE部分求值

                    end
                end.

              Example test_pe_bexp1:
              -  pe_bexp [(X,3)] (!(X ≤ 3))
              +  pe_bexp [(X,3)] (~(X ≤ 3))%imp
                = false.
              @@ -504,8 +502,8 @@

              PE部分求值


              -Example test_pe_bexp2: b:bexp,
              -  b = !(X ≤ (X + 1)) →
              +Example test_pe_bexp2: b:bexp,
              +  b = (~(X ≤ (X + 1)))%imp
                pe_bexp [] b = b.
              Proof. intros b H. rewriteH. reflexivity. Qed.
              @@ -515,7 +513,7 @@

              PE部分求值

              -Theorem pe_bexp_correct: (pe_st:pe_state) (b:bexp) (st:state),
              +Theorem pe_bexp_correct: (pe_st:pe_state) (b:bexp) (st:state),
                beval (pe_update st pe_st) b = beval st (pe_bexp pe_st b).
              Proof.
                intros pe_st b st.
              @@ -537,7 +535,7 @@

              PE部分求值

              -

              无循环命令的部分求值

              +

              无循环命令的部分求值

              @@ -575,15 +573,20 @@

              PE部分求值

              -      (X ::= 3 ;; Y ::= Z * (X + X)
              -      / [] \\ (Y ::= Z * 6) / [(X,3)] +      [] / (X ::= 3 ;; Y ::= Z * (X + X)) \\ (Y ::= Z * 6) / [(X,3)]
              成立。对 X 的赋值出现在最终部分状态中,而非剩余命令中。 +
              -

              赋值

              + (写成 st =[ c1 ]⇒ c1' / st' 的形式会更接近于 Imp 使用的记法, + 或许这里需要改一下!) + +
              + +

              赋值

              @@ -596,7 +599,7 @@

              PE部分求值

              义函数 pe_addpe_remove。与 pe_update 类似,这些函数操作 某个具体的 list 表示的 pe_state,但定理 pe_add_correctpe_remove_correct 通过 pe_lookuppe_state 的解释定义了 - 他们的行为。 + 他们的行为。
              @@ -606,7 +609,7 @@

              PE部分求值

                | (V',n')::pe_stif eqb_string V V' then pe_remove pe_st V
                                    else (V',n') :: pe_remove pe_st V
                end.

              -Theorem pe_remove_correct: pe_st V V0,
              +Theorem pe_remove_correct: pe_st V V0,
                pe_lookup (pe_remove pe_st V) V0
                = if eqb_string V V0 then None else pe_lookup pe_st V0.
              Proof. intros pe_st V V0. induction pe_st as [| [V' n'] pe_st].
              @@ -621,7 +624,7 @@

              PE部分求值

              Qed.

              Definition pe_add (pe_st:pe_state) (V:string) (n:nat) : pe_state :=
                (V,n) :: pe_remove pe_st V.

              -Theorem pe_add_correct: pe_st V n V0,
              +Theorem pe_add_correct: pe_st V n V0,
                pe_lookup (pe_add pe_st V n) V0
                = if eqb_string V V0 then Some n else pe_lookup pe_st V0.
              Proof. intros pe_st V n V0. unfold pe_add. simpl.
              @@ -637,14 +640,14 @@

              PE部分求值

              -Theorem pe_update_update_remove: st pe_st V n,
              +Theorem pe_update_update_remove: st pe_st V n,
                t_update (pe_update st pe_st) V n =
                pe_update (t_update st V n) (pe_remove pe_st V).
              Proof. intros st pe_st V n. apply functional_extensionality.
                intros V0. unfold t_update. rewrite !pe_update_correct.
                rewrite pe_remove_correct. destruct (eqb_string V V0); reflexivity.
                Qed.

              -Theorem pe_update_update_add: st pe_st V n,
              +Theorem pe_update_update_add: st pe_st V n,
                t_update (pe_update st pe_st) V n =
                pe_update st (pe_add pe_st V n).
              Proof. intros st pe_st V n. apply functional_extensionality. intros V0.
              @@ -653,11 +656,11 @@

              PE部分求值

              -

              条件

              +

              条件

              - 比赋值语句的部分求值要麻烦一点的是条件语句 IFB b1 THEN c1 ELSE c2 FI。 + 比赋值语句的部分求值要麻烦一点的是条件语句 TEST b1 THEN c1 ELSE c2 FI。 如果 b1 被简化为 BTrueBFalse,那么会很容易:我们知道哪个分支 会被运行。如果 b1 不会被简化为常量,那么我们需要对两个分支部分地求值, 且最终的部分状态在两个分支上可能是不同的! @@ -670,9 +673,9 @@

              PE部分求值

                    X ::= 3;;
              -      IFB Y ≤ 4 THEN
              +      TEST Y ≤ 4 THEN
                        Y ::= 4;;
              -          IFB X ≤ Y THEN Y ::= 999 ELSE SKIP FI
              +          TEST X ≤ Y THEN Y ::= 999 ELSE SKIP FI
                    ELSE SKIP FI
              @@ -694,7 +697,7 @@

              PE部分求值

                    SKIP;;
              -      IFB Y ≤ 4 THEN
              +      TEST Y ≤ 4 THEN
                        SKIP;;
                        SKIP;;
                        Y ::= 4
              @@ -719,7 +722,7 @@

              PE部分求值

                | None, Nonefalse
                | _, _true
                end.

              -Theorem pe_disagree_domain: (pe_st1 pe_st2 : pe_state) (V:string),
              +Theorem pe_disagree_domain: (pe_st1 pe_st2 : pe_state) (V:string),
                true = pe_disagree_at pe_st1 pe_st2 V
                In V (map (@fst _ _) pe_st1 ++ map (@fst _ _) pe_st2).
              Proof. unfold pe_disagree_at. intros pe_st1 pe_st2 V H.
              @@ -745,11 +748,11 @@

              PE部分求值

                | x::l
                    x :: filter (fun yif eqb_string x y then false else true) (pe_unique l)
                end.

              -Theorem pe_unique_correct: l x,
              +Theorem pe_unique_correct: l x,
                In x lIn x (pe_unique l).
              Proof. intros l x. induction l as [| h t]. reflexivity.
                simpl in *. split.
              -  - (* -> *)
              +  - (* -> *)
                  intros. inversion H; clear H.
                    left. assumption.
                    destruct (eqb_stringP h x).
              @@ -765,13 +768,13 @@

              PE部分求值

              Definition pe_compare (pe_st1 pe_st2 : pe_state) : list string :=
                pe_unique (filter (pe_disagree_at pe_st1 pe_st2)
                  (map (@fst _ _) pe_st1 ++ map (@fst _ _) pe_st2)).

              -Theorem pe_compare_correct: pe_st1 pe_st2 V,
              +Theorem pe_compare_correct: pe_st1 pe_st2 V,
                pe_lookup pe_st1 V = pe_lookup pe_st2 V
              -  ¬ In V (pe_compare pe_st1 pe_st2).
              +  ¬In V (pe_compare pe_st1 pe_st2).
              Proof. intros pe_st1 pe_st2 V.
                unfold pe_compare. rewrite <- pe_unique_correct. rewrite filter_In.
                split; intros Heq.
              -  - (* -> *)
              +  - (* -> *)
                  intro. destruct H. unfold pe_disagree_at in H0. rewrite Heq in H0.
                  destruct (pe_lookup pe_st2 V).
                  rewrite <- beq_nat_refl in H0. inversion H0.
              @@ -809,7 +812,7 @@

              PE部分求值

                | [] ⇒ pe_st
                | V::idspe_remove (pe_removes pe_st ids) V
                end.

              -Theorem pe_removes_correct: pe_st ids V,
              +Theorem pe_removes_correct: pe_st ids V,
                pe_lookup (pe_removes pe_st ids) V =
                if inb eqb_string V ids then None else pe_lookup pe_st V.
              Proof. intros pe_st ids V. induction ids as [| V' ids]. reflexivity.
              @@ -818,7 +821,7 @@

              PE部分求值

                - rewrite <- eqb_string_refl. reflexivity.
                - rewrite false_eqb_string; try congruence. reflexivity.
              Qed.

              -Theorem pe_compare_removes: pe_st1 pe_st2 V,
              +Theorem pe_compare_removes: pe_st1 pe_st2 V,
                pe_lookup (pe_removes pe_st1 (pe_compare pe_st1 pe_st2)) V =
                pe_lookup (pe_removes pe_st2 (pe_compare pe_st1 pe_st2)) V.
              Proof.
              @@ -826,7 +829,7 @@

              PE部分求值

                destruct (inbP _ _ eqb_stringP V (pe_compare pe_st1 pe_st2)).
                - reflexivity.
                - apply pe_compare_correct. auto. Qed.

              -Theorem pe_compare_update: pe_st1 pe_st2 st,
              +Theorem pe_compare_update: pe_st1 pe_st2 st,
                pe_update st (pe_removes pe_st1 (pe_compare pe_st1 pe_st2)) =
                pe_update st (pe_removes pe_st2 (pe_compare pe_st1 pe_st2)).
              Proof. intros. apply functional_extensionality. intros V.
              @@ -864,19 +867,19 @@

              PE部分求值

                              | Nonest V
                              end
                         else st V.

              -Theorem assign_removes: pe_st ids st,
              +Theorem assign_removes: pe_st ids st,
                pe_update st pe_st =
                pe_update (assigned pe_st ids st) (pe_removes pe_st ids).
              Proof. intros pe_st ids st. apply functional_extensionality. intros V.
                rewrite !pe_update_correct. rewrite pe_removes_correct. unfold assigned.
                destruct (inbP _ _ eqb_stringP V ids); destruct (pe_lookup pe_st V); reflexivity.
              Qed.

              -Lemma ceval_extensionality: c st st1 st2,
              -  c / st \\ st1 → ( V, st1 V = st2 V) → c / st \\ st2.
              +Lemma ceval_extensionality: c st st1 st2,
              +  st =[ c ]⇒ st1 → (V, st1 V = st2 V) → st =[ c ]⇒ st2.
              Proof. intros c st st1 st2 H Heq.
                apply functional_extensionality in Heq. rewrite <- Heq. apply H. Qed.

              -Theorem eval_assign: pe_st ids st,
              -  assign pe_st ids / st \\ assigned pe_st ids st.
              +Theorem eval_assign: pe_st ids st,
              +  st =[ assign pe_st ids ]⇒ assigned pe_st ids st.
              Proof. intros pe_st ids st. induction ids as [| V ids]; simpl.
                - (*  *) eapply ceval_extensionality. apply E_Skip. reflexivity.
                - (* V::ids *)
              @@ -896,7 +899,7 @@

              PE部分求值

              -

              部分求值关系

              +

              部分求值关系

              @@ -909,34 +912,34 @@

              PE部分求值

              Reserved Notation "c1 '/' st '\\' c1' '/' st'"
                (at level 40, st at level 39, c1' at level 39).

              Inductive pe_com : compe_statecompe_stateProp :=
              -  | PE_Skip : pe_st,
              +  | PE_Skip : pe_st,
                    SKIP / pe_st \\ SKIP / pe_st
              -  | PE_AssStatic : pe_st a1 n1 l,
              +  | PE_AssStatic : pe_st a1 n1 l,
                    pe_aexp pe_st a1 = ANum n1
                    (l ::= a1) / pe_st \\ SKIP / pe_add pe_st l n1
              -  | PE_AssDynamic : pe_st a1 a1' l,
              +  | PE_AssDynamic : pe_st a1 a1' l,
                    pe_aexp pe_st a1 = a1'
              -      ( n, a1'ANum n) →
              +      (n, a1'ANum n) →
                    (l ::= a1) / pe_st \\ (l ::= a1') / pe_remove pe_st l
              -  | PE_Seq : pe_st pe_st' pe_st'' c1 c2 c1' c2',
              +  | PE_Seq : pe_st pe_st' pe_st'' c1 c2 c1' c2',
                    c1 / pe_st \\ c1' / pe_st'
                    c2 / pe_st' \\ c2' / pe_st''
                    (c1 ;; c2) / pe_st \\ (c1' ;; c2') / pe_st''
              -  | PE_IfTrue : pe_st pe_st' b1 c1 c2 c1',
              +  | PE_IfTrue : pe_st pe_st' b1 c1 c2 c1',
                    pe_bexp pe_st b1 = BTrue
                    c1 / pe_st \\ c1' / pe_st'
              -      (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st'
              -  | PE_IfFalse : pe_st pe_st' b1 c1 c2 c2',
              +      (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st'
              +  | PE_IfFalse : pe_st pe_st' b1 c1 c2 c2',
                    pe_bexp pe_st b1 = BFalse
                    c2 / pe_st \\ c2' / pe_st'
              -      (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st'
              -  | PE_If : pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2',
              +      (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st'
              +  | PE_If : pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2',
                    pe_bexp pe_st b1BTrue
                    pe_bexp pe_st b1BFalse
                    c1 / pe_st \\ c1' / pe_st1
                    c2 / pe_st \\ c2' / pe_st2
              -      (IFB b1 THEN c1 ELSE c2 FI) / pe_st
              -        \\ (IFB pe_bexp pe_st b1
              +      (TEST b1 THEN c1 ELSE c2 FI) / pe_st
              +        \\ (TEST pe_bexp pe_st b1
                           THEN c1' ;; assign pe_st1 (pe_compare pe_st1 pe_st2)
                           ELSE c2' ;; assign pe_st2 (pe_compare pe_st1 pe_st2) FI)
                          / pe_removes pe_st1 (pe_compare pe_st1 pe_st2)
              @@ -947,7 +950,7 @@

              PE部分求值

              -

              例子

              +

              例子

              @@ -958,26 +961,26 @@

              PE部分求值

              Example pe_example1:
              -  (X ::= 3 ;; Y ::= Z * (X + X))
              -  / [] \\ (SKIP;; Y ::= Z * 6) / [(X,3)].
              +  (X ::= 3 ;; Y ::= Z * (X + X))%imp
              +  / [] \\ (SKIP;; Y ::= Z * 6)%imp / [(X,3)].
              Proof. eapply PE_Seq. eapply PE_AssStatic. reflexivity.
                eapply PE_AssDynamic. reflexivity. intros n H. inversion H. Qed.

              Example pe_example2:
              -  (X ::= 3 ;; IFB X ≤ 4 THEN X ::= 4 ELSE SKIP FI)
              -  / [] \\ (SKIP;; SKIP) / [(X,4)].
              +  (X ::= 3 ;; TEST X ≤ 4 THEN X ::= 4 ELSE SKIP FI)%imp
              +  / [] \\ (SKIP;; SKIP)%imp / [(X,4)].
              Proof. eapply PE_Seq. eapply PE_AssStatic. reflexivity.
                eapply PE_IfTrue. reflexivity.
                eapply PE_AssStatic. reflexivity. Qed.

              Example pe_example3:
                (X ::= 3;;
              -   IFB Y ≤ 4 THEN
              +   TEST Y ≤ 4 THEN
                   Y ::= 4;;
              -     IFB X = Y THEN Y ::= 999 ELSE SKIP FI
              -   ELSE SKIP FI) / []
              +     TEST X = Y THEN Y ::= 999 ELSE SKIP FI
              +   ELSE SKIP FI)%imp / []
                \\ (SKIP;;
              -       IFB Y ≤ 4 THEN
              +       TEST Y ≤ 4 THEN
                       (SKIP;; SKIP);; (SKIP;; Y ::= 4)
              -       ELSE SKIP;; SKIP FI)
              +       ELSE SKIP;; SKIP FI)%imp
                    / [(X,3)].
              Proof. erewrite f_equal2 with (f := fun c st_ / _ \\ c / st).
                eapply PE_Seq. eapply PE_AssStatic. reflexivity.
              @@ -988,7 +991,7 @@

              PE部分求值

              -

              部分求值的正确性

              +

              部分求值的正确性

              @@ -1000,16 +1003,16 @@

              PE部分求值

                (at level 40, pe_st' at level 39, st at level 39).

              Inductive pe_ceval
                (c':com) (pe_st':pe_state) (st:state) (st'':state) : Prop :=
              -  | pe_ceval_intro : st',
              -    c' / st \\ st'
              +  | pe_ceval_intro : st',
              +    st =[ c' ]⇒ st'
                  pe_update st' pe_st' = st''
                  c' / pe_st' / st \\ st''
                where "c' '/' pe_st' '/' st '\\' st''" := (pe_ceval c' pe_st' st st'').

              Hint Constructors pe_ceval.

              Theorem pe_com_complete:
              -   c pe_st pe_st' c', c / pe_st \\ c' / pe_st'
              -   st st'',
              -  (c / pe_update st pe_st \\ st'') →
              +  c pe_st pe_st' c', c / pe_st \\ c' / pe_st'
              +  st st'',
              +  (pe_update st pe_st =[ c ]⇒ st'') →
                (c' / pe_st' / st \\ st'').
              Proof. intros c pe_st pe_st' c' Hpe.
                induction Hpe; intros st st'' Heval;
              @@ -1039,10 +1042,10 @@

              PE部分求值

                    rewrite <- assign_removes. eassumption.
              Qed.

              Theorem pe_com_sound:
              -   c pe_st pe_st' c', c / pe_st \\ c' / pe_st'
              -   st st'',
              +  c pe_st pe_st' c', c / pe_st \\ c' / pe_st'
              +  st st'',
                (c' / pe_st' / st \\ st'') →
              -  (c / pe_update st pe_st \\ st'').
              +  (pe_update st pe_st =[ c ]⇒ st'').
              Proof. intros c pe_st pe_st' c' Hpe.
                induction Hpe;
                  intros st st'' [st' Heval Heq];
              @@ -1075,18 +1078,18 @@

              PE部分求值

              Corollary pe_com_correct:
              -   c pe_st pe_st' c', c / pe_st \\ c' / pe_st'
              -   st st'',
              -  (c / pe_update st pe_st \\ st'') ↔
              +  c pe_st pe_st' c', c / pe_st \\ c' / pe_st'
              +  st st'',
              +  (pe_update st pe_st =[ c ]⇒ st'') ↔
                (c' / pe_st' / st \\ st'').
              Proof. intros c pe_st pe_st' c' H st st''. split.
              -  - (* -> *) apply pe_com_complete. apply H.
              +  - (* -> *) apply pe_com_complete. apply H.
                - (* <- *) apply pe_com_sound. apply H.
              Qed.
              -

              循环的部分求值

              +

              循环的部分求值

              @@ -1166,64 +1169,64 @@

              PE部分求值

              Reserved Notation "c1 '/' st '\\' c1' '/' st' '/' c''"
                (at level 40, st at level 39, c1' at level 39, st' at level 39).

              Inductive pe_com : compe_statecompe_statecomProp :=
              -  | PE_Skip : pe_st,
              +  | PE_Skip : pe_st,
                    SKIP / pe_st \\ SKIP / pe_st / SKIP
              -  | PE_AssStatic : pe_st a1 n1 l,
              +  | PE_AssStatic : pe_st a1 n1 l,
                    pe_aexp pe_st a1 = ANum n1
                    (l ::= a1) / pe_st \\ SKIP / pe_add pe_st l n1 / SKIP
              -  | PE_AssDynamic : pe_st a1 a1' l,
              +  | PE_AssDynamic : pe_st a1 a1' l,
                    pe_aexp pe_st a1 = a1'
              -      ( n, a1'ANum n) →
              +      (n, a1'ANum n) →
                    (l ::= a1) / pe_st \\ (l ::= a1') / pe_remove pe_st l / SKIP
              -  | PE_Seq : pe_st pe_st' pe_st'' c1 c2 c1' c2' c'',
              +  | PE_Seq : pe_st pe_st' pe_st'' c1 c2 c1' c2' c'',
                    c1 / pe_st \\ c1' / pe_st' / SKIP
                    c2 / pe_st' \\ c2' / pe_st'' / c''
                    (c1 ;; c2) / pe_st \\ (c1' ;; c2') / pe_st'' / c''
              -  | PE_IfTrue : pe_st pe_st' b1 c1 c2 c1' c'',
              +  | PE_IfTrue : pe_st pe_st' b1 c1 c2 c1' c'',
                    pe_bexp pe_st b1 = BTrue
                    c1 / pe_st \\ c1' / pe_st' / c''
              -      (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st' / c''
              -  | PE_IfFalse : pe_st pe_st' b1 c1 c2 c2' c'',
              +      (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st' / c''
              +  | PE_IfFalse : pe_st pe_st' b1 c1 c2 c2' c'',
                    pe_bexp pe_st b1 = BFalse
                    c2 / pe_st \\ c2' / pe_st' / c''
              -      (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st' / c''
              -  | PE_If : pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2' c'',
              +      (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st' / c''
              +  | PE_If : pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2' c'',
                    pe_bexp pe_st b1BTrue
                    pe_bexp pe_st b1BFalse
                    c1 / pe_st \\ c1' / pe_st1 / c''
                    c2 / pe_st \\ c2' / pe_st2 / c''
              -      (IFB b1 THEN c1 ELSE c2 FI) / pe_st
              -        \\ (IFB pe_bexp pe_st b1
              +      (TEST b1 THEN c1 ELSE c2 FI) / pe_st
              +        \\ (TEST pe_bexp pe_st b1
                           THEN c1' ;; assign pe_st1 (pe_compare pe_st1 pe_st2)
                           ELSE c2' ;; assign pe_st2 (pe_compare pe_st1 pe_st2) FI)
                          / pe_removes pe_st1 (pe_compare pe_st1 pe_st2)
                          / c''
              -  | PE_WhileFalse : pe_st b1 c1,
              +  | PE_WhileFalse : pe_st b1 c1,
                    pe_bexp pe_st b1 = BFalse
                    (WHILE b1 DO c1 END) / pe_st \\ SKIP / pe_st / SKIP
              -  | PE_WhileTrue : pe_st pe_st' pe_st'' b1 c1 c1' c2' c2'',
              +  | PE_WhileTrue : pe_st pe_st' pe_st'' b1 c1 c1' c2' c2'',
                    pe_bexp pe_st b1 = BTrue
                    c1 / pe_st \\ c1' / pe_st' / SKIP
                    (WHILE b1 DO c1 END) / pe_st' \\ c2' / pe_st'' / c2''
                    pe_compare pe_st pe_st'' ≠ [] →
                    (WHILE b1 DO c1 END) / pe_st \\ (c1';;c2') / pe_st'' / c2''
              -  | PE_While : pe_st pe_st' pe_st'' b1 c1 c1' c2' c2'',
              +  | PE_While : pe_st pe_st' pe_st'' b1 c1 c1' c2' c2'',
                    pe_bexp pe_st b1BFalse
                    pe_bexp pe_st b1BTrue
                    c1 / pe_st \\ c1' / pe_st' / SKIP
                    (WHILE b1 DO c1 END) / pe_st' \\ c2' / pe_st'' / c2''
                    pe_compare pe_st pe_st'' ≠ [] →
              -      (c2'' = SKIPc2'' = WHILE b1 DO c1 END) →
              +      (c2'' = SKIP%impc2'' = WHILE b1 DO c1 END%imp) →
                    (WHILE b1 DO c1 END) / pe_st
              -        \\ (IFB pe_bexp pe_st b1
              +        \\ (TEST pe_bexp pe_st b1
                           THEN c1';; c2';; assign pe_st'' (pe_compare pe_st pe_st'')
              -             ELSE assign pe_st (pe_compare pe_st pe_st'') FI)
              +             ELSE assign pe_st (pe_compare pe_st pe_st'') FI)%imp
                          / pe_removes pe_st (pe_compare pe_st pe_st'')
                          / c2''
              -  | PE_WhileFixedEnd : pe_st b1 c1,
              +  | PE_WhileFixedEnd : pe_st b1 c1,
                    pe_bexp pe_st b1BFalse
                    (WHILE b1 DO c1 END) / pe_st \\ SKIP / pe_st / (WHILE b1 DO c1 END)
              -  | PE_WhileFixedLoop : pe_st pe_st' pe_st'' b1 c1 c1' c2',
              +  | PE_WhileFixedLoop : pe_st pe_st' pe_st'' b1 c1 c1' c2',
                    pe_bexp pe_st b1 = BTrue
                    c1 / pe_st \\ c1' / pe_st' / SKIP
                    (WHILE b1 DO c1 END) / pe_st'
              @@ -1234,7 +1237,7 @@

              PE部分求值

                    (* 因为这里是一个无限循环,我们实际上应该开始抛弃剩下的程序:
                       (WHILE b1 DO c1 END) / pe_st
                       \\ SKIP / pe_st / (WHILE BTrue DO SKIP END) *)

              -  | PE_WhileFixed : pe_st pe_st' pe_st'' b1 c1 c1' c2',
              +  | PE_WhileFixed : pe_st pe_st' pe_st'' b1 c1 c1' c2',
                    pe_bexp pe_st b1BFalse
                    pe_bexp pe_st b1BTrue
                    c1 / pe_st \\ c1' / pe_st' / SKIP
              @@ -1249,7 +1252,7 @@

              PE部分求值

              -

              例子

              +

              例子

              @@ -1263,26 +1266,26 @@

              PE部分求值

                             [ simpl; reflexivity
                             | intuition eauto; solve_by_invert])).

              Definition square_loop: com :=
              -  WHILE 1 ≤ X DO
              +  (WHILE 1 ≤ X DO
                  Y ::= Y * Y;;
                  X ::= X - 1
              -  END.

              +  END)%imp.

              Example pe_loop_example1:
                square_loop / []
                \\ (WHILE 1 ≤ X DO
                       (Y ::= Y * Y;;
                        X ::= X - 1);; SKIP
              -       END) / [] / SKIP.
              +       END)%imp / [] / SKIP.
              Proof. erewrite f_equal2 with (f := fun c st_ / _ \\ c / st / SKIP).
                step PE_WhileFixed. step PE_WhileFixedEnd. reflexivity.
                reflexivity. reflexivity. Qed.

              Example pe_loop_example2:
              -  (X ::= 3;; square_loop) / []
              +  (X ::= 3;; square_loop)%imp / []
                \\ (SKIP;;
                     (Y ::= Y * Y;; SKIP);;
                     (Y ::= Y * Y;; SKIP);;
                     (Y ::= Y * Y;; SKIP);;
              -       SKIP) / [(X,0)] / SKIP.
              +       SKIP)%imp / [(X,0)] / SKIP%imp.
              Proof. erewrite f_equal2 with (f := fun c st_ / _ \\ c / st / SKIP).
                eapply PE_Seq. eapply PE_AssStatic. reflexivity.
                step PE_WhileTrue.
              @@ -1294,19 +1297,19 @@

              PE部分求值

              Example pe_loop_example3:
                (Z ::= 3;; subtract_slowly) / []
                \\ (SKIP;;
              -       IFB !(X = 0) THEN
              +       TEST ~(X = 0) THEN
                       (SKIP;; X ::= X - 1);;
              -         IFB !(X = 0) THEN
              +         TEST ~(X = 0) THEN
                         (SKIP;; X ::= X - 1);;
              -           IFB !(X = 0) THEN
              +           TEST ~(X = 0) THEN
                           (SKIP;; X ::= X - 1);;
              -             WHILE !(X = 0) DO
              +             WHILE ~(X = 0) DO
                             (SKIP;; X ::= X - 1);; SKIP
                           END;;
                           SKIP;; Z ::= 0
                         ELSE SKIP;; Z ::= 1 FI;; SKIP
                       ELSE SKIP;; Z ::= 2 FI;; SKIP
              -       ELSE SKIP;; Z ::= 3 FI) / [] / SKIP.
              +       ELSE SKIP;; Z ::= 3 FI)%imp / [] / SKIP.
              Proof. erewrite f_equal2 with (f := fun c st_ / _ \\ c / st / SKIP).
                eapply PE_Seq. eapply PE_AssStatic. reflexivity.
                step PE_While.
              @@ -1320,7 +1323,7 @@

              PE部分求值

                (X ::= 0;;
                 WHILE X ≤ 2 DO
                   X ::= 1 - X
              -   END) / [] \\ (SKIP;; WHILE true DO SKIP END) / [(X,0)] / SKIP.
              +   END)%imp / [] \\ (SKIP;; WHILE true DO SKIP END)%imp / [(X,0)] / SKIP.
              Proof. erewrite f_equal2 with (f := fun c st_ / _ \\ c / st / SKIP).
                eapply PE_Seq. eapply PE_AssStatic. reflexivity.
                step PE_WhileFixedLoop.
              @@ -1330,7 +1333,7 @@

              PE部分求值

              -

              正确性

              +

              正确性

              @@ -1342,27 +1345,27 @@

              PE部分求值

              Reserved Notation "c1 '/' st '\\' st' '#' n"
                (at level 40, st at level 39, st' at level 39).

              Inductive ceval_count : comstatestatenatProp :=
              -  | E'Skip : st,
              +  | E'Skip : st,
                    SKIP / st \\ st # 0
              -  | E'Ass : st a1 n l,
              +  | E'Ass : st a1 n l,
                    aeval st a1 = n
                    (l ::= a1) / st \\ (t_update st l n) # 0
              -  | E'Seq : c1 c2 st st' st'' n1 n2,
              +  | E'Seq : c1 c2 st st' st'' n1 n2,
                    c1 / st \\ st' # n1
                    c2 / st' \\ st'' # n2
                    (c1 ;; c2) / st \\ st'' # (n1 + n2)
              -  | E'IfTrue : st st' b1 c1 c2 n,
              +  | E'IfTrue : st st' b1 c1 c2 n,
                    beval st b1 = true
                    c1 / st \\ st' # n
              -      (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' # n
              -  | E'IfFalse : st st' b1 c1 c2 n,
              +      (TEST b1 THEN c1 ELSE c2 FI) / st \\ st' # n
              +  | E'IfFalse : st st' b1 c1 c2 n,
                    beval st b1 = false
                    c2 / st \\ st' # n
              -      (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' # n
              -  | E'WhileFalse : b1 st c1,
              +      (TEST b1 THEN c1 ELSE c2 FI) / st \\ st' # n
              +  | E'WhileFalse : b1 st c1,
                    beval st b1 = false
                    (WHILE b1 DO c1 END) / st \\ st # 0
              -  | E'WhileTrue : st st' st'' b1 c1 n1 n2,
              +  | E'WhileTrue : st st' st'' b1 c1 n1 n2,
                    beval st b1 = true
                    c1 / st \\ st' # n1
                    (WHILE b1 DO c1 END) / st' \\ st'' # n2
              @@ -1370,26 +1373,26 @@

              PE部分求值


                where "c1 '/' st '\\' st' # n" := (ceval_count c1 st st' n).

              Hint Constructors ceval_count.

              -Theorem ceval_count_complete: c st st',
              -  c / st \\ st' n, c / st \\ st' # n.
              +Theorem ceval_count_complete: c st st',
              +  st =[ c ]⇒ st'n, c / st \\ st' # n.
              Proof. intros c st st' Heval.
                induction Heval;
                  try inversion IHHeval1;
                  try inversion IHHeval2;
                  try inversion IHHeval;
                  eauto. Qed.

              -Theorem ceval_count_sound: c st st' n,
              -  c / st \\ st' # nc / st \\ st'.
              +Theorem ceval_count_sound: c st st' n,
              +  c / st \\ st' # nst =[ c ]⇒ st'.
              Proof. intros c st st' n Heval. induction Heval; eauto. Qed.

              -Theorem pe_compare_nil_lookup: pe_st1 pe_st2,
              +Theorem pe_compare_nil_lookup: pe_st1 pe_st2,
                pe_compare pe_st1 pe_st2 = [] →
              -   V, pe_lookup pe_st1 V = pe_lookup pe_st2 V.
              +  V, pe_lookup pe_st1 V = pe_lookup pe_st2 V.
              Proof. intros pe_st1 pe_st2 H V.
                apply (pe_compare_correct pe_st1 pe_st2 V).
                rewrite H. intro. inversion H0. Qed.

              -Theorem pe_compare_nil_update: pe_st1 pe_st2,
              +Theorem pe_compare_nil_update: pe_st1 pe_st2,
                pe_compare pe_st1 pe_st2 = [] →
              -   st, pe_update st pe_st1 = pe_update st pe_st2.
              +  st, pe_update st pe_st1 = pe_update st pe_st2.
              Proof. intros pe_st1 pe_st2 H st.
                apply functional_extensionality. intros V.
                rewrite !pe_update_correct.
              @@ -1398,26 +1401,25 @@

              PE部分求值

              Reserved Notation "c' '/' pe_st' '/' c'' '/' st '\\' st'' '#' n"
                (at level 40, pe_st' at level 39, c'' at level 39,
                 st at level 39, st'' at level 39).

              -Close Scope bexp_scope.

              Inductive pe_ceval_count (c':com) (pe_st':pe_state) (c'':com)
                                       (st:state) (st'':state) (n:nat) : Prop :=
              -  | pe_ceval_count_intro : st' n',
              -    c' / st \\ st'
              +  | pe_ceval_count_intro : st' n',
              +    st =[ c' ]⇒ st'
                  c'' / pe_update st' pe_st' \\ st'' # n'
                  n'n
                  c' / pe_st' / c'' / st \\ st'' # n
                where "c' '/' pe_st' '/' c'' '/' st '\\' st'' '#' n" :=
                      (pe_ceval_count c' pe_st' c'' st st'' n).

              Hint Constructors pe_ceval_count.

              -Lemma pe_ceval_count_le: c' pe_st' c'' st st'' n n',
              +Lemma pe_ceval_count_le: c' pe_st' c'' st st'' n n',
                n'n
                c' / pe_st' / c'' / st \\ st'' # n'
                c' / pe_st' / c'' / st \\ st'' # n.
              Proof. intros c' pe_st' c'' st st'' n n' Hle H. inversion H.
                econstructor; try eassumption. omega. Qed.

              Theorem pe_com_complete:
              -   c pe_st pe_st' c' c'', c / pe_st \\ c' / pe_st' / c''
              -   st st'' n,
              +  c pe_st pe_st' c' c'', c / pe_st \\ c' / pe_st' / c''
              +  st st'' n,
                (c / pe_update st pe_st \\ st'' # n) →
                (c' / pe_st' / c'' / st \\ st'' # n).
              Proof. intros c pe_st pe_st' c' c'' Hpe.
              @@ -1490,10 +1492,10 @@

              PE部分求值

                    econstructor; [ eapply E_WhileTrue; eauto | eassumption | omega].
              Qed.

              Theorem pe_com_sound:
              -   c pe_st pe_st' c' c'', c / pe_st \\ c' / pe_st' / c''
              -   st st'' n,
              +  c pe_st pe_st' c' c'', c / pe_st \\ c' / pe_st' / c''
              +  st st'' n,
                (c' / pe_st' / c'' / st \\ st'' # n) →
              -  (c / pe_update st pe_st \\ st'').
              +  (pe_update st pe_st =[ c ]⇒ st'').
              Proof. intros c pe_st pe_st' c' c'' Hpe.
                induction Hpe;
                  intros st st'' n [st' n' Heval Heval' Hle];
              @@ -1549,7 +1551,7 @@

              PE部分求值

                  apply loop_never_stops in Heval. inversion Heval.
                - (* PE_WhileFixed *)
                  clear - H1 IHHpe1 IHHpe2 Heval.
              -    remember (WHILE pe_bexp pe_st b1 DO c1';; c2' END) as c'.
              +    remember (WHILE pe_bexp pe_st b1 DO c1';; c2' END)%imp as c'.
                  induction Heval;
                    inversion Heqc'; subst; clear Heqc'.
                  + (* E_WhileFalse *) apply E_WhileFalse.
              @@ -1564,12 +1566,12 @@

              PE部分求值

                    rewrite <- (pe_compare_nil_update _ _ H1). eassumption. apply le_n.
              Qed.

              Corollary pe_com_correct:
              -   c pe_st pe_st' c', c / pe_st \\ c' / pe_st' / SKIP
              -   st st'',
              -  (c / pe_update st pe_st \\ st'') ↔
              -  ( st', c' / st \\ st'pe_update st' pe_st' = st'').
              +  c pe_st pe_st' c', c / pe_st \\ c' / pe_st' / SKIP
              +  st st'',
              +  (pe_update st pe_st =[ c ]⇒ st'') ↔
              +  (st', st =[ c' ]⇒ st'pe_update st' pe_st' = st'').
              Proof. intros c pe_st pe_st' c' H st st''. split.
              -  - (* -> *) intros Heval.
              +  - (* -> *) intros Heval.
                  apply ceval_count_complete in Heval. inversion Heval as [n Heval'].
                  apply pe_com_complete with (st:=st) (st'':=st'') (n:=n) in H.
                  inversion H as [? ? ? Hskip ?]. inversion Hskip. subst. eauto.
              @@ -1582,7 +1584,7 @@

              PE部分求值

              -

              流程图程序的部分求值

              +

              流程图程序的部分求值

              @@ -1593,7 +1595,7 @@

              PE部分求值

              能不会发生;在这里我们并不追求达成这一点。
              -

              基本块

              +

              基本块

              @@ -1651,8 +1653,8 @@

              PE部分求值

                | Assign i a kkeval (t_update st i (aeval st a)) k
                end.

              Example keval_example:
              -  keval { --> 0 } parity_body
              -  = ({ Y --> 0 ; X --> 1 }, loop).
              +  keval empty_st parity_body
              +  = ((X !-> 1 ; Y !-> 0), loop).
              Proof. reflexivity. Qed.
              @@ -1660,7 +1662,7 @@

              PE部分求值

              -

              流程图程序

              +

              流程图程序

              @@ -1689,15 +1691,15 @@

              PE部分求值

              Inductive peval {L:Type} (p : program L)
                : stateLstateLProp :=
              -  | E_None: st l,
              +  | E_None: st l,
                  p l = None
                  peval p st l st l
              -  | E_Some: st l k st' l' st'' l'',
              +  | E_Some: st l k st' l' st'' l'',
                  p l = Some k
                  keval st k = (st', l') →
                  peval p st' l' st'' l''
                  peval p st l st'' l''.

              -Example parity_eval: peval parity { --> 0 } entry { --> 0 } done.
              +Example parity_eval: peval parity empty_st entry empty_st done.
              Proof. erewrite f_equal with (f := fun stpeval _ _ _ st _).
                eapply E_Some. reflexivity. reflexivity.
                eapply E_Some. reflexivity. reflexivity.
              @@ -1707,7 +1709,7 @@

              PE部分求值

              -

              基本块和流程图程序的部分求值

              +

              基本块和流程图程序的部分求值

              @@ -1744,7 +1746,7 @@

              PE部分求值


              -Theorem pe_block_correct: (L:Type) st pe_st k st' pe_st' (l':L),
              +Theorem pe_block_correct: (L:Type) st pe_st k st' pe_st' (l':L),
                keval st (pe_block pe_st k) = (st', (pe_st', l')) →
                keval (pe_update st pe_st) k = (pe_update st' pe_st', l').
              Proof. intros. generalize dependent pe_st. generalize dependent st.
              @@ -1770,17 +1772,17 @@

              PE部分求值

                            end.

              Inductive pe_peval {L:Type} (p : program L)
                (st:state) (pe_st:pe_state) (l:L) (st'o:state) (l':L) : Prop :=
              -  | pe_peval_intro : st' pe_st',
              +  | pe_peval_intro : st' pe_st',
                  peval (pe_program p) st (pe_st, l) st' (pe_st', l') →
                  pe_update st' pe_st' = st'o
                  pe_peval p st pe_st l st'o l'.

              Theorem pe_program_correct:
              -   (L:Type) (p : program L) st pe_st l st'o l',
              +  (L:Type) (p : program L) st pe_st l st'o l',
                peval p (pe_update st pe_st) l st'o l'
                pe_peval p st pe_st l st'o l'.
              Proof. intros.
                split.
              -  - (* -> *) intros Heval.
              +  - (* -> *) intros Heval.
                  remember (pe_update st pe_st) as sto.
                  generalize dependent pe_st. generalize dependent st.
                  induction Heval as
              @@ -1812,9 +1814,9 @@

              PE部分求值

                    simpl in Hlookup. remember (p l) as k.
                    destruct k as [k|]; inversion Hlookup; subst.
                    eapply E_Some; eauto. apply pe_block_correct. apply Hkeval.
              -Qed.
              +Qed.

              +(* Sat Jan 26 15:15:46 UTC 2019 *)
              -
              diff --git a/plf-current/PE.v b/plf-current/PE.v index 46184e60..c3b75dda 100644 --- a/plf-current/PE.v +++ b/plf-current/PE.v @@ -27,18 +27,18 @@ X ::= 3;; Y ::= 4 - Y *) -Require Import Coq.Bool.Bool. -Require Import Coq.Arith.Arith. -Require Import Coq.Arith.EqNat. -Require Import Coq.Arith.PeanoNat. Import Nat. -Require Import Coq.omega.Omega. -Require Import Coq.Logic.FunctionalExtensionality. -Require Import Coq.Lists.List. +From PLF Require Import Maps. +From Coq Require Import Bool.Bool. +From Coq Require Import Arith.Arith. +From Coq Require Import Arith.EqNat. +From Coq Require Import Arith.PeanoNat. Import Nat. +From Coq Require Import omega.Omega. +From Coq Require Import Logic.FunctionalExtensionality. +From Coq Require Import Lists.List. Import ListNotations. -From PLF Require Import Maps. -From PLF Require Import Imp. From PLF Require Import Smallstep. +From PLF Require Import Imp. (* ################################################################# *) (** * 一般化的常量折叠 *) @@ -166,17 +166,14 @@ Fixpoint pe_aexp (pe_st : pe_state) (a : aexp) : aexp := (** 部分求值器会折叠起常量,但并不会应用加法的结合律。 *) -Open Scope aexp_scope. -Open Scope bexp_scope. - Example test_pe_aexp1: - pe_aexp [(X,3)] (X + 1 + Y) - = (4 + Y). + pe_aexp [(X,3)] (X + 1 + Y)%imp + = (4 + Y)%imp. Proof. reflexivity. Qed. Example text_pe_aexp2: - pe_aexp [(Y,3)] (X + 1 + Y) - = (X + 1 + 3). + pe_aexp [(Y,3)] (X + 1 + Y)%imp + = (X + 1 + 3)%imp. Proof. reflexivity. Qed. (** 现在,[pe_aexp] 在什么意义上是正确的呢?可以合理地将 [pe_aexp] 的正确性 @@ -239,8 +236,8 @@ Fixpoint pe_update (st:state) (pe_st:pe_state) : state := end. Example test_pe_update: - pe_update { Y --> 1 } [(X,3);(Z,2)] - = { Y --> 1 ; Z --> 2 ; X --> 3 }. + pe_update (Y !-> 1) [(X,3);(Z,2)] + = (X !-> 3 ; Z !-> 2 ; Y !-> 1). Proof. reflexivity. Qed. (** 尽管 [pe_update] 对一个具体的 [list] 表示的 [pe_state] 进行操作,它的行为完全 @@ -329,12 +326,12 @@ Fixpoint pe_bexp (pe_st : pe_state) (b : bexp) : bexp := end. Example test_pe_bexp1: - pe_bexp [(X,3)] (!(X <= 3)) + pe_bexp [(X,3)] (~(X <= 3))%imp = false. Proof. reflexivity. Qed. Example test_pe_bexp2: forall b:bexp, - b = !(X <= (X + 1)) -> + b = (~(X <= (X + 1)))%imp -> pe_bexp [] b = b. Proof. intros b H. rewrite -> H. reflexivity. Qed. @@ -385,10 +382,13 @@ Qed. 意思是对源程序 [c1] 在初始状态 [st] 中部分求值产生剩余程序 [c1'] 和最终部分状态 [st']。举个例子,我们想要让 - (X ::= 3 ;; Y ::= Z * (X + X) - / [] \\ (Y ::= Z * 6) / [(X,3)] + [] / (X ::= 3 ;; Y ::= Z * (X + X)) \\ (Y ::= Z * 6) / [(X,3)] - 成立。对 [X] 的赋值出现在最终部分状态中,而非剩余命令中。*) + 成立。对 [X] 的赋值出现在最终部分状态中,而非剩余命令中。 + + (写成 [st =[ c1 ]=> c1' / st'] 的形式会更接近于 [Imp] 使用的记法, + 或许这里需要改一下!) +*) (* ================================================================= *) (** ** 赋值 *) @@ -402,7 +402,7 @@ Qed. 义函数 [pe_add] 和 [pe_remove]。与 [pe_update] 类似,这些函数操作 某个具体的 [list] 表示的 [pe_state],但定理 [pe_add_correct] 和 [pe_remove_correct] 通过 [pe_lookup] 对 [pe_state] 的解释定义了 - 他们的行为。*) + 他们的行为。 *) Fixpoint pe_remove (pe_st:pe_state) (V:string) : pe_state := match pe_st with @@ -458,7 +458,7 @@ Proof. intros st pe_st V n. apply functional_extensionality. intros V0. (* ================================================================= *) (** ** 条件 *) -(** 比赋值语句的部分求值要麻烦一点的是条件语句 [IFB b1 THEN c1 ELSE c2 FI]。 +(** 比赋值语句的部分求值要麻烦一点的是条件语句 [TEST b1 THEN c1 ELSE c2 FI]。 如果 [b1] 被简化为 [BTrue] 或 [BFalse],那么会很容易:我们知道哪个分支 会被运行。如果 [b1] 不会被简化为常量,那么我们需要对两个分支部分地求值, 且最终的部分状态在两个分支上可能是不同的! @@ -466,9 +466,9 @@ Proof. intros st pe_st V n. apply functional_extensionality. intros V0. 下面的程序展示了这种困难: X ::= 3;; - IFB Y <= 4 THEN + TEST Y <= 4 THEN Y ::= 4;; - IFB X <= Y THEN Y ::= 999 ELSE SKIP FI + TEST X <= Y THEN Y ::= 999 ELSE SKIP FI ELSE SKIP FI 假设初始的部分状态为空状态。静态来说,我们不知道 [Y] 和 [4] 比较的结果, @@ -483,7 +483,7 @@ Proof. intros st pe_st V n. apply functional_extensionality. intros V0. [Y ::= 4]。因此,剩余程序为 SKIP;; - IFB Y <= 4 THEN + TEST Y <= 4 THEN SKIP;; SKIP;; Y ::= 4 @@ -646,12 +646,12 @@ Proof. intros pe_st ids st. apply functional_extensionality. intros V. Qed. Lemma ceval_extensionality: forall c st st1 st2, - c / st \\ st1 -> (forall V, st1 V = st2 V) -> c / st \\ st2. + st =[ c ]=> st1 -> (forall V, st1 V = st2 V) -> st =[ c ]=> st2. Proof. intros c st st1 st2 H Heq. apply functional_extensionality in Heq. rewrite <- Heq. apply H. Qed. Theorem eval_assign: forall pe_st ids st, - assign pe_st ids / st \\ assigned pe_st ids st. + st =[ assign pe_st ids ]=> assigned pe_st ids st. Proof. intros pe_st ids st. induction ids as [| V ids]; simpl. - (* [] *) eapply ceval_extensionality. apply E_Skip. reflexivity. - (* V::ids *) @@ -696,18 +696,18 @@ Inductive pe_com : com -> pe_state -> com -> pe_state -> Prop := | PE_IfTrue : forall pe_st pe_st' b1 c1 c2 c1', pe_bexp pe_st b1 = BTrue -> c1 / pe_st \\ c1' / pe_st' -> - (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st' + (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st' | PE_IfFalse : forall pe_st pe_st' b1 c1 c2 c2', pe_bexp pe_st b1 = BFalse -> c2 / pe_st \\ c2' / pe_st' -> - (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st' + (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st' | PE_If : forall pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2', pe_bexp pe_st b1 <> BTrue -> pe_bexp pe_st b1 <> BFalse -> c1 / pe_st \\ c1' / pe_st1 -> c2 / pe_st \\ c2' / pe_st2 -> - (IFB b1 THEN c1 ELSE c2 FI) / pe_st - \\ (IFB pe_bexp pe_st b1 + (TEST b1 THEN c1 ELSE c2 FI) / pe_st + \\ (TEST pe_bexp pe_st b1 THEN c1' ;; assign pe_st1 (pe_compare pe_st1 pe_st2) ELSE c2' ;; assign pe_st2 (pe_compare pe_st1 pe_st2) FI) / pe_removes pe_st1 (pe_compare pe_st1 pe_st2) @@ -725,28 +725,28 @@ Hint Constructors ceval. 但这里并不是必须的。 *) Example pe_example1: - (X ::= 3 ;; Y ::= Z * (X + X)) - / [] \\ (SKIP;; Y ::= Z * 6) / [(X,3)]. + (X ::= 3 ;; Y ::= Z * (X + X))%imp + / [] \\ (SKIP;; Y ::= Z * 6)%imp / [(X,3)]. Proof. eapply PE_Seq. eapply PE_AssStatic. reflexivity. eapply PE_AssDynamic. reflexivity. intros n H. inversion H. Qed. Example pe_example2: - (X ::= 3 ;; IFB X <= 4 THEN X ::= 4 ELSE SKIP FI) - / [] \\ (SKIP;; SKIP) / [(X,4)]. + (X ::= 3 ;; TEST X <= 4 THEN X ::= 4 ELSE SKIP FI)%imp + / [] \\ (SKIP;; SKIP)%imp / [(X,4)]. Proof. eapply PE_Seq. eapply PE_AssStatic. reflexivity. eapply PE_IfTrue. reflexivity. eapply PE_AssStatic. reflexivity. Qed. Example pe_example3: (X ::= 3;; - IFB Y <= 4 THEN + TEST Y <= 4 THEN Y ::= 4;; - IFB X = Y THEN Y ::= 999 ELSE SKIP FI - ELSE SKIP FI) / [] + TEST X = Y THEN Y ::= 999 ELSE SKIP FI + ELSE SKIP FI)%imp / [] \\ (SKIP;; - IFB Y <= 4 THEN + TEST Y <= 4 THEN (SKIP;; SKIP);; (SKIP;; Y ::= 4) - ELSE SKIP;; SKIP FI) + ELSE SKIP;; SKIP FI)%imp / [(X,3)]. Proof. erewrite f_equal2 with (f := fun c st => _ / _ \\ c / st). eapply PE_Seq. eapply PE_AssStatic. reflexivity. @@ -766,7 +766,7 @@ Reserved Notation "c' '/' pe_st' '/' st '\\' st''" Inductive pe_ceval (c':com) (pe_st':pe_state) (st:state) (st'':state) : Prop := | pe_ceval_intro : forall st', - c' / st \\ st' -> + st =[ c' ]=> st' -> pe_update st' pe_st' = st'' -> c' / pe_st' / st \\ st'' where "c' '/' pe_st' '/' st '\\' st''" := (pe_ceval c' pe_st' st st''). @@ -776,7 +776,7 @@ Hint Constructors pe_ceval. Theorem pe_com_complete: forall c pe_st pe_st' c', c / pe_st \\ c' / pe_st' -> forall st st'', - (c / pe_update st pe_st \\ st'') -> + (pe_update st pe_st =[ c ]=> st'') -> (c' / pe_st' / st \\ st''). Proof. intros c pe_st pe_st' c' Hpe. induction Hpe; intros st st'' Heval; @@ -810,7 +810,7 @@ Theorem pe_com_sound: forall c pe_st pe_st' c', c / pe_st \\ c' / pe_st' -> forall st st'', (c' / pe_st' / st \\ st'') -> - (c / pe_update st pe_st \\ st''). + (pe_update st pe_st =[ c ]=> st''). Proof. intros c pe_st pe_st' c' Hpe. induction Hpe; intros st st'' [st' Heval Heq]; @@ -841,7 +841,7 @@ Qed. Corollary pe_com_correct: forall c pe_st pe_st' c', c / pe_st \\ c' / pe_st' -> forall st st'', - (c / pe_update st pe_st \\ st'') <-> + (pe_update st pe_st =[ c ]=> st'') <-> (c' / pe_st' / st \\ st''). Proof. intros c pe_st pe_st' c' H st st''. split. - (* -> *) apply pe_com_complete. apply H. @@ -919,18 +919,18 @@ Inductive pe_com : com -> pe_state -> com -> pe_state -> com -> Prop := | PE_IfTrue : forall pe_st pe_st' b1 c1 c2 c1' c'', pe_bexp pe_st b1 = BTrue -> c1 / pe_st \\ c1' / pe_st' / c'' -> - (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st' / c'' + (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c1' / pe_st' / c'' | PE_IfFalse : forall pe_st pe_st' b1 c1 c2 c2' c'', pe_bexp pe_st b1 = BFalse -> c2 / pe_st \\ c2' / pe_st' / c'' -> - (IFB b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st' / c'' + (TEST b1 THEN c1 ELSE c2 FI) / pe_st \\ c2' / pe_st' / c'' | PE_If : forall pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2' c'', pe_bexp pe_st b1 <> BTrue -> pe_bexp pe_st b1 <> BFalse -> c1 / pe_st \\ c1' / pe_st1 / c'' -> c2 / pe_st \\ c2' / pe_st2 / c'' -> - (IFB b1 THEN c1 ELSE c2 FI) / pe_st - \\ (IFB pe_bexp pe_st b1 + (TEST b1 THEN c1 ELSE c2 FI) / pe_st + \\ (TEST pe_bexp pe_st b1 THEN c1' ;; assign pe_st1 (pe_compare pe_st1 pe_st2) ELSE c2' ;; assign pe_st2 (pe_compare pe_st1 pe_st2) FI) / pe_removes pe_st1 (pe_compare pe_st1 pe_st2) @@ -950,11 +950,11 @@ Inductive pe_com : com -> pe_state -> com -> pe_state -> com -> Prop := c1 / pe_st \\ c1' / pe_st' / SKIP -> (WHILE b1 DO c1 END) / pe_st' \\ c2' / pe_st'' / c2'' -> pe_compare pe_st pe_st'' <> [] -> - (c2'' = SKIP \/ c2'' = WHILE b1 DO c1 END) -> + (c2'' = SKIP%imp \/ c2'' = WHILE b1 DO c1 END%imp) -> (WHILE b1 DO c1 END) / pe_st - \\ (IFB pe_bexp pe_st b1 + \\ (TEST pe_bexp pe_st b1 THEN c1';; c2';; assign pe_st'' (pe_compare pe_st pe_st'') - ELSE assign pe_st (pe_compare pe_st pe_st'') FI) + ELSE assign pe_st (pe_compare pe_st pe_st'') FI)%imp / pe_removes pe_st (pe_compare pe_st pe_st'') / c2'' | PE_WhileFixedEnd : forall pe_st b1 c1, @@ -997,28 +997,28 @@ Ltac step i := | intuition eauto; solve_by_invert])). Definition square_loop: com := - WHILE 1 <= X DO + (WHILE 1 <= X DO Y ::= Y * Y;; X ::= X - 1 - END. + END)%imp. Example pe_loop_example1: square_loop / [] \\ (WHILE 1 <= X DO (Y ::= Y * Y;; X ::= X - 1);; SKIP - END) / [] / SKIP. + END)%imp / [] / SKIP. Proof. erewrite f_equal2 with (f := fun c st => _ / _ \\ c / st / SKIP). step PE_WhileFixed. step PE_WhileFixedEnd. reflexivity. reflexivity. reflexivity. Qed. Example pe_loop_example2: - (X ::= 3;; square_loop) / [] + (X ::= 3;; square_loop)%imp / [] \\ (SKIP;; (Y ::= Y * Y;; SKIP);; (Y ::= Y * Y;; SKIP);; (Y ::= Y * Y;; SKIP);; - SKIP) / [(X,0)] / SKIP. + SKIP)%imp / [(X,0)] / SKIP%imp. Proof. erewrite f_equal2 with (f := fun c st => _ / _ \\ c / st / SKIP). eapply PE_Seq. eapply PE_AssStatic. reflexivity. step PE_WhileTrue. @@ -1031,19 +1031,19 @@ Proof. erewrite f_equal2 with (f := fun c st => _ / _ \\ c / st / SKIP). Example pe_loop_example3: (Z ::= 3;; subtract_slowly) / [] \\ (SKIP;; - IFB !(X = 0) THEN + TEST ~(X = 0) THEN (SKIP;; X ::= X - 1);; - IFB !(X = 0) THEN + TEST ~(X = 0) THEN (SKIP;; X ::= X - 1);; - IFB !(X = 0) THEN + TEST ~(X = 0) THEN (SKIP;; X ::= X - 1);; - WHILE !(X = 0) DO + WHILE ~(X = 0) DO (SKIP;; X ::= X - 1);; SKIP END;; SKIP;; Z ::= 0 ELSE SKIP;; Z ::= 1 FI;; SKIP ELSE SKIP;; Z ::= 2 FI;; SKIP - ELSE SKIP;; Z ::= 3 FI) / [] / SKIP. + ELSE SKIP;; Z ::= 3 FI)%imp / [] / SKIP. Proof. erewrite f_equal2 with (f := fun c st => _ / _ \\ c / st / SKIP). eapply PE_Seq. eapply PE_AssStatic. reflexivity. step PE_While. @@ -1058,7 +1058,7 @@ Example pe_loop_example4: (X ::= 0;; WHILE X <= 2 DO X ::= 1 - X - END) / [] \\ (SKIP;; WHILE true DO SKIP END) / [(X,0)] / SKIP. + END)%imp / [] \\ (SKIP;; WHILE true DO SKIP END)%imp / [(X,0)] / SKIP. Proof. erewrite f_equal2 with (f := fun c st => _ / _ \\ c / st / SKIP). eapply PE_Seq. eapply PE_AssStatic. reflexivity. step PE_WhileFixedLoop. @@ -1088,11 +1088,11 @@ Inductive ceval_count : com -> state -> state -> nat -> Prop := | E'IfTrue : forall st st' b1 c1 c2 n, beval st b1 = true -> c1 / st \\ st' # n -> - (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' # n + (TEST b1 THEN c1 ELSE c2 FI) / st \\ st' # n | E'IfFalse : forall st st' b1 c1 c2 n, beval st b1 = false -> c2 / st \\ st' # n -> - (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' # n + (TEST b1 THEN c1 ELSE c2 FI) / st \\ st' # n | E'WhileFalse : forall b1 st c1, beval st b1 = false -> (WHILE b1 DO c1 END) / st \\ st # 0 @@ -1107,7 +1107,7 @@ Inductive ceval_count : com -> state -> state -> nat -> Prop := Hint Constructors ceval_count. Theorem ceval_count_complete: forall c st st', - c / st \\ st' -> exists n, c / st \\ st' # n. + st =[ c ]=> st' -> exists n, c / st \\ st' # n. Proof. intros c st st' Heval. induction Heval; try inversion IHHeval1; @@ -1116,7 +1116,7 @@ Proof. intros c st st' Heval. eauto. Qed. Theorem ceval_count_sound: forall c st st' n, - c / st \\ st' # n -> c / st \\ st'. + c / st \\ st' # n -> st =[ c ]=> st'. Proof. intros c st st' n Heval. induction Heval; eauto. Qed. Theorem pe_compare_nil_lookup: forall pe_st1 pe_st2, @@ -1139,12 +1139,10 @@ Reserved Notation "c' '/' pe_st' '/' c'' '/' st '\\' st'' '#' n" (at level 40, pe_st' at level 39, c'' at level 39, st at level 39, st'' at level 39). -Close Scope bexp_scope. - Inductive pe_ceval_count (c':com) (pe_st':pe_state) (c'':com) (st:state) (st'':state) (n:nat) : Prop := | pe_ceval_count_intro : forall st' n', - c' / st \\ st' -> + st =[ c' ]=> st' -> c'' / pe_update st' pe_st' \\ st'' # n' -> n' <= n -> c' / pe_st' / c'' / st \\ st'' # n @@ -1239,7 +1237,7 @@ Theorem pe_com_sound: forall c pe_st pe_st' c' c'', c / pe_st \\ c' / pe_st' / c'' -> forall st st'' n, (c' / pe_st' / c'' / st \\ st'' # n) -> - (c / pe_update st pe_st \\ st''). + (pe_update st pe_st =[ c ]=> st''). Proof. intros c pe_st pe_st' c' c'' Hpe. induction Hpe; intros st st'' n [st' n' Heval Heval' Hle]; @@ -1295,7 +1293,7 @@ Proof. intros c pe_st pe_st' c' c'' Hpe. apply loop_never_stops in Heval. inversion Heval. - (* PE_WhileFixed *) clear - H1 IHHpe1 IHHpe2 Heval. - remember (WHILE pe_bexp pe_st b1 DO c1';; c2' END) as c'. + remember (WHILE pe_bexp pe_st b1 DO c1';; c2' END)%imp as c'. induction Heval; inversion Heqc'; subst; clear Heqc'. + (* E_WhileFalse *) apply E_WhileFalse. @@ -1313,8 +1311,8 @@ Qed. Corollary pe_com_correct: forall c pe_st pe_st' c', c / pe_st \\ c' / pe_st' / SKIP -> forall st st'', - (c / pe_update st pe_st \\ st'') <-> - (exists st', c' / st \\ st' /\ pe_update st' pe_st' = st''). + (pe_update st pe_st =[ c ]=> st'') <-> + (exists st', st =[ c' ]=> st' /\ pe_update st' pe_st' = st''). Proof. intros c pe_st pe_st' c' H st st''. split. - (* -> *) intros Heval. apply ceval_count_complete in Heval. inversion Heval as [n Heval']. @@ -1382,8 +1380,8 @@ Fixpoint keval {L:Type} (st:state) (k : block L) : state * L := end. Example keval_example: - keval { --> 0 } parity_body - = ({ Y --> 0 ; X --> 1 }, loop). + keval empty_st parity_body + = ((X !-> 1 ; Y !-> 0), loop). Proof. reflexivity. Qed. (* ================================================================= *) @@ -1418,7 +1416,7 @@ Inductive peval {L:Type} (p : program L) peval p st' l' st'' l'' -> peval p st l st'' l''. -Example parity_eval: peval parity { --> 0 } entry { --> 0 } done. +Example parity_eval: peval parity empty_st entry empty_st done. Proof. erewrite f_equal with (f := fun st => peval _ _ _ st _). eapply E_Some. reflexivity. reflexivity. eapply E_Some. reflexivity. reflexivity. @@ -1530,4 +1528,5 @@ Proof. intros. eapply E_Some; eauto. apply pe_block_correct. apply Hkeval. Qed. -(** $Date$ *) + +(* Sat Jan 26 15:15:46 UTC 2019 *) diff --git a/plf-current/PETest.v b/plf-current/PETest.v index 27ff4c82..76157a4c 100644 --- a/plf-current/PETest.v +++ b/plf-current/PETest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:51 UTC 2019 *) diff --git a/plf-current/Postscript.html b/plf-current/Postscript.html index e3a5926e..ff3251bf 100644 --- a/plf-current/Postscript.html +++ b/plf-current/Postscript.html @@ -39,7 +39,7 @@

              Postscript后记

              恭喜,课程终于顺利结束了!
              -

              回顾一下

              +

              回顾一下

              @@ -187,7 +187,7 @@

              Postscript后记

              -

              环顾周围

              +

              环顾周围

              @@ -196,7 +196,7 @@

              Postscript后记

              和硬件系统使用形式化和机器检查验证技术的例子。
              -

              CompCert

              +

              CompCert

              CompCert 是一个经过了完全形式化验证的 ISO C90 / ANSI C 优化编译器, 可以为 x86,ARM 和 PowerPC 处理器生成代码。CompCert 完全使用 Gallina 编写,并使用 Coq 的提取机制生成高效的 OCaml 程序。 @@ -231,7 +231,7 @@

              Postscript后记

              http://compcert.inria.fr
              -

              seL4

              +

              seL4

              seL4 是一个完全形式化验证的微内核,被认为是世界上第一个对实现的正确性和 安全保证提供了端对端证明的操作系统内核。它使用 C 和 ARM 汇编实现,并使用 Isabelle 描述和验证规范。其实现开放了源代码。 @@ -248,7 +248,7 @@

              Postscript后记

              https://sel4.systems.
              -

              CertiKOS

              +

              CertiKOS

              CertiKOS 是一个设计清晰和完全形式化验证的虚拟机器监视器(Hypervisor), 使用 CompCert C 开发并经过 Coq 验证。 @@ -266,7 +266,7 @@

              Postscript后记

              http://flint.cs.yale.edu/certikos/
              -

              Ironclad

              +

              Ironclad

              Ironclad 应用 是一系列完全形式化验证的 Web 应用,包括一个用于安全地签署 声明的“公正人”程序,一个密码散列程序,一个多用户的可信计数器,以及一个差分隐私 数据库。 @@ -289,7 +289,7 @@

              Postscript后记

              https://github.com/Microsoft/Ironclad/tree/master/ironclad-apps
              -

              Verdi

              +

              Verdi

              Verdi 是一个用于形式化验证分布式系统的框架。
              @@ -306,7 +306,7 @@

              Postscript后记

              http://verdi.uwplse.org
              -

              DeepSpec

              +

              DeepSpec

              深度规范的科学(The Science of Deep Specification) 是一项 NSF 资助的“远征”研究项目(2016 至 2020 年),目标是为软硬件系统提供完整的功能 正确性规范和验证。项目同时赞助了讲习班和暑期学校。 @@ -331,7 +331,7 @@

              Postscript后记

              -

              REMS

              +

              REMS

              REMS 是一个欧洲项目,关注对主流系统使用严谨的工程方法(Rigorous Engineering of Mainstream Systems)。它为广泛使用的重要接口、协议和 API 提供了精细的形式化规格,这些系统包括 C 语言, ELF 链接器的格式, @@ -351,7 +351,7 @@

              Postscript后记

              http://www.cl.cam.ac.uk/~pes20/rems/
              -

              其他

              +

              其他

              @@ -388,7 +388,7 @@

              Postscript后记

              -

              继续前行

              +

              继续前行

              @@ -497,6 +497,10 @@

              Postscript后记

              +
              +
              + +(* Sat Jan 26 15:15:47 UTC 2019 *)
              diff --git a/plf-current/Postscript.v b/plf-current/Postscript.v index bf81748b..bd86af8a 100644 --- a/plf-current/Postscript.v +++ b/plf-current/Postscript.v @@ -19,7 +19,6 @@ --------- ~ ------------------ 软件工程 机械工程/土木工程 - - 归纳定义的集合和关系 - 归纳证明 - 证明对象 *) @@ -60,8 +59,9 @@ 和硬件系统使用形式化和机器检查验证技术的例子。*) (* ----------------------------------------------------------------- *) -(** *** CompCert *) -(** _'CompCert'_ 是一个经过了完全形式化验证的 ISO C90 / ANSI C 优化编译器, +(** *** CompCert + + _'CompCert'_ 是一个经过了完全形式化验证的 ISO C90 / ANSI C 优化编译器, 可以为 x86,ARM 和 PowerPC 处理器生成代码。CompCert 完全使用 Gallina 编写,并使用 Coq 的提取机制生成高效的 OCaml 程序。 @@ -83,8 +83,9 @@ http://compcert.inria.fr *) (* ----------------------------------------------------------------- *) -(** *** seL4 *) -(** _'seL4'_ 是一个完全形式化验证的微内核,被认为是世界上第一个对实现的正确性和 +(** *** seL4 + + _'seL4'_ 是一个完全形式化验证的微内核,被认为是世界上第一个对实现的正确性和 安全保证提供了端对端证明的操作系统内核。它使用 C 和 ARM 汇编实现,并使用 Isabelle 描述和验证规范。其实现开放了源代码。 @@ -96,8 +97,9 @@ https://sel4.systems. *) (* ----------------------------------------------------------------- *) -(** *** CertiKOS *) -(** _'CertiKOS'_ 是一个设计清晰和完全形式化验证的虚拟机器监视器(Hypervisor), +(** *** CertiKOS + + _'CertiKOS'_ 是一个设计清晰和完全形式化验证的虚拟机器监视器(Hypervisor), 使用 CompCert C 开发并经过 Coq 验证。 “CertiKOS 项目的目标是开发一个创新并实用的变成基础设施,用于构建大规模的带证明 @@ -110,8 +112,9 @@ http://flint.cs.yale.edu/certikos/ *) (* ----------------------------------------------------------------- *) -(** *** Ironclad *) -(** _'Ironclad 应用'_ 是一系列完全形式化验证的 Web 应用,包括一个用于安全地签署 +(** *** Ironclad + + _'Ironclad 应用'_ 是一系列完全形式化验证的 Web 应用,包括一个用于安全地签署 声明的“公正人”程序,一个密码散列程序,一个多用户的可信计数器,以及一个差分隐私 数据库。 @@ -127,8 +130,9 @@ https://github.com/Microsoft/Ironclad/tree/master/ironclad-apps *) (* ----------------------------------------------------------------- *) -(** *** Verdi *) -(** _'Verdi'_ 是一个用于形式化验证分布式系统的框架。 +(** *** Verdi + + _'Verdi'_ 是一个用于形式化验证分布式系统的框架。 “Verdi 支持了从现实化的到理想化的多种故障模型。Verdi 的验证系统变换器 (Verified System Transformers, VSTs)封装了常见的容错技术。 @@ -140,8 +144,9 @@ http://verdi.uwplse.org *) (* ----------------------------------------------------------------- *) -(** *** DeepSpec *) -(** _'深度规范的科学(The Science of Deep Specification)'_ 是一项 NSF +(** *** DeepSpec + + _'深度规范的科学(The Science of Deep Specification)'_ 是一项 NSF 资助的“远征”研究项目(2016 至 2020 年),目标是为软硬件系统提供完整的功能 正确性规范和验证。项目同时赞助了讲习班和暑期学校。 - 网站:http://deepspec.org/ @@ -150,8 +155,9 @@ - https://www.youtube.com/watch?v=IPNdsnRWBkk *) (* ----------------------------------------------------------------- *) -(** *** REMS *) -(** _'REMS'_ 是一个欧洲项目,关注对主流系统使用严谨的工程方法(Rigorous +(** *** REMS + + _'REMS'_ 是一个欧洲项目,关注对主流系统使用严谨的工程方法(Rigorous Engineering of Mainstream Systems)。它为广泛使用的重要接口、协议和 API 提供了精细的形式化规格,这些系统包括 C 语言, ELF 链接器的格式, ARM、Power、MIPS、CHERI 和 RISC-V 指令集,ARM 和 Power 处理器的弱内存模型, @@ -224,3 +230,4 @@ (** $Date$ *) +(* Sat Jan 26 15:15:47 UTC 2019 *) diff --git a/plf-current/PostscriptTest.v b/plf-current/PostscriptTest.v index 15ade061..c51110ad 100644 --- a/plf-current/PostscriptTest.v +++ b/plf-current/PostscriptTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:51 UTC 2019 *) diff --git a/plf-current/Preface.html b/plf-current/Preface.html index b22d3a38..e21a960c 100644 --- a/plf-current/Preface.html +++ b/plf-current/Preface.html @@ -230,9 +230,10 @@

              Preface

              supported, in part, by the National Science Foundation under the NSF Expeditions grant 1521523, _The Science of Deep Specification_. -
              +
              +
              - +(* Sat Jan 26 15:15:42 UTC 2019 *)
              diff --git a/plf-current/Preface.v b/plf-current/Preface.v index 149fbebd..b6a3f24d 100644 --- a/plf-current/Preface.v +++ b/plf-current/Preface.v @@ -33,7 +33,6 @@ Foundations_, there is plenty of additional material to fill most of a semester from this book alone. *) - (* ################################################################# *) (** * Overview *) @@ -155,4 +154,5 @@ NSF Expeditions grant 1521523, _The Science of Deep Specification_. *) -(** $Date$ *) + +(* Sat Jan 26 15:15:42 UTC 2019 *) diff --git a/plf-current/PrefaceTest.v b/plf-current/PrefaceTest.v index 80f509c3..5cdc8ad6 100644 --- a/plf-current/PrefaceTest.v +++ b/plf-current/PrefaceTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:15:50 UTC 2019 *) diff --git a/plf-current/RecordSub.html b/plf-current/RecordSub.html index 009cc12c..ea33f8b1 100644 --- a/plf-current/RecordSub.html +++ b/plf-current/RecordSub.html @@ -46,6 +46,7 @@

              RecordSubSubtyping with Records Set Warnings "-notation-overridden,-parsing".
              +From Coq Require Import Strings.String.
              From PLF Require Import Maps.
              From PLF Require Import Smallstep.
              From PLF Require Import MoreStlc.
              @@ -69,21 +70,21 @@

              RecordSubSubtyping with Records Inductive ty : Type :=
                (* proper types *)
              -  | TTop : ty
              -  | TBase : stringty
              -  | TArrow : tytyty
              +  | Top : ty
              +  | Base : stringty
              +  | Arrow : tytyty
                (* record types *)
              -  | TRNil : ty
              -  | TRCons : stringtytyty.

              +  | RNil : ty
              +  | RCons : stringtytyty.

              Inductive tm : Type :=
                (* proper terms *)
              -  | tvar : stringtm
              -  | tapp : tmtmtm
              -  | tabs : stringtytmtm
              -  | tproj : tmstringtm
              +  | var : stringtm
              +  | app : tmtmtm
              +  | abs : stringtytmtm
              +  | rproj : tmstringtm
                (* record terms *)
              -  | trnil : tm
              -  | trcons : stringtmtmtm.
              +  | rnil : tm
              +  | rcons : stringtmtmtm.

              @@ -113,30 +114,30 @@

              RecordSubSubtyping with RecordsInductive record_ty : tyProp :=
                | RTnil :
              -        record_ty TRNil
              -  | RTcons : i T1 T2,
              -        record_ty (TRCons i T1 T2).

              +        record_ty RNil
              +  | RTcons : i T1 T2,
              +        record_ty (RCons i T1 T2).

              Inductive record_tm : tmProp :=
                | rtnil :
              -        record_tm trnil
              -  | rtcons : i t1 t2,
              -        record_tm (trcons i t1 t2).

              +        record_tm rnil
              +  | rtcons : i t1 t2,
              +        record_tm (rcons i t1 t2).

              Inductive well_formed_ty : tyProp :=
              -  | wfTTop :
              -        well_formed_ty TTop
              -  | wfTBase : i,
              -        well_formed_ty (TBase i)
              -  | wfTArrow : T1 T2,
              +  | wfTop :
              +        well_formed_ty Top
              +  | wfBase : i,
              +        well_formed_ty (Base i)
              +  | wfArrow : T1 T2,
                      well_formed_ty T1
                      well_formed_ty T2
              -        well_formed_ty (TArrow T1 T2)
              -  | wfTRNil :
              -        well_formed_ty TRNil
              -  | wfTRCons : i T1 T2,
              +        well_formed_ty (Arrow T1 T2)
              +  | wfRNil :
              +        well_formed_ty RNil
              +  | wfRCons : i T1 T2,
                      well_formed_ty T1
                      well_formed_ty T2
                      record_ty T2
              -        well_formed_ty (TRCons i T1 T2).

              +        well_formed_ty (RCons i T1 T2).

              Hint Constructors record_ty record_tm well_formed_ty.

              @@ -151,13 +152,13 @@

              RecordSubSubtyping with RecordsFixpoint subst (x:string) (s:tm) (t:tm) : tm :=
                match t with
              -  | tvar yif eqb_string x y then s else t
              -  | tabs y T t1tabs y T (if eqb_string x y then t1
              +  | var yif eqb_string x y then s else t
              +  | abs y T t1abs y T (if eqb_string x y then t1
                                           else (subst x s t1))
              -  | tapp t1 t2tapp (subst x s t1) (subst x s t2)
              -  | tproj t1 itproj (subst x s t1) i
              -  | trniltrnil
              -  | trcons i t1 tr2trcons i (subst x s t1) (subst x s tr2)
              +  | app t1 t2app (subst x s t1) (subst x s t2)
              +  | rproj t1 irproj (subst x s t1) i
              +  | rnilrnil
              +  | rcons i t1 tr2rcons i (subst x s t1) (subst x s tr2)
                end.

              Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).

              @@ -170,54 +171,54 @@

              RecordSubSubtyping with Records Inductive value : tmProp :=
              -  | v_abs : x T t,
              -      value (tabs x T t)
              -  | v_rnil : value trnil
              -  | v_rcons : i v vr,
              +  | v_abs : x T t,
              +      value (abs x T t)
              +  | v_rnil : value rnil
              +  | v_rcons : i v vr,
                    value v
                    value vr
              -      value (trcons i v vr).

              +      value (rcons i v vr).

              Hint Constructors value.

              Fixpoint Tlookup (i:string) (Tr:ty) : option ty :=
                match Tr with
              -  | TRCons i' T Tr'
              +  | RCons i' T Tr'
                    if eqb_string i i' then Some T else Tlookup i Tr'
                | _None
                end.

              Fixpoint tlookup (i:string) (tr:tm) : option tm :=
                match tr with
              -  | trcons i' t tr'
              +  | rcons i' t tr'
                    if eqb_string i i' then Some t else tlookup i tr'
                | _None
                end.

              -Reserved Notation "t1 '==>' t2" (at level 40).

              +Reserved Notation "t1 '-->' t2" (at level 40).

              Inductive step : tmtmProp :=
              -  | ST_AppAbs : x T t12 v2,
              +  | 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',
              +         (app (abs x T t12) v2) --> [x:=v2]t12
              +  | ST_App1 : t1 t1' t2,
              +         t1 --> t1'
              +         (app t1 t2) --> (app t1' t2)
              +  | ST_App2 : v1 t2 t2',
                       value v1
              -         t2 ==> t2'
              -         (tapp v1 t2) ==> (tapp v1 t2')
              -  | ST_Proj1 : tr tr' i,
              -        tr ==> tr'
              -        (tproj tr i) ==> (tproj tr' i)
              -  | ST_ProjRcd : tr i vi,
              +         t2 --> t2'
              +         (app v1 t2) --> (app v1 t2')
              +  | ST_Proj1 : tr tr' i,
              +        tr --> tr'
              +        (rproj tr i) --> (rproj tr' i)
              +  | ST_ProjRcd : tr i vi,
                      value tr
                      tlookup i tr = Some vi
              -       (tproj tr i) ==> vi
              -  | ST_Rcd_Head : i t1 t1' tr2,
              -        t1 ==> t1'
              -        (trcons i t1 tr2) ==> (trcons i t1' tr2)
              -  | ST_Rcd_Tail : i v1 tr2 tr2',
              +       (rproj tr i) --> vi
              +  | ST_Rcd_Head : i t1 t1' tr2,
              +        t1 --> t1'
              +        (rcons i t1 tr2) --> (rcons i t1' tr2)
              +  | ST_Rcd_Tail : i v1 tr2 tr2',
                      value v1
              -        tr2 ==> tr2'
              -        (trcons i v1 tr2) ==> (trcons i v1 tr2')
              +        tr2 --> tr2'
              +        (rcons i v1 tr2) --> (rcons i v1 tr2')

              -where "t1 '==>' t2" := (step t1 t2).

              +where "t1 '-->' t2" := (step t1 t2).

              Hint Constructors step.

              @@ -249,35 +250,35 @@

              RecordSubSubtyping with RecordsReserved Notation "T '<:' U" (at level 40).

              Inductive subtype : tytyProp :=
                (* Subtyping between proper types *)
              -  | S_Refl : T,
              +  | S_Refl : T,
                  well_formed_ty T
                  T <: T
              -  | S_Trans : S U T,
              +  | S_Trans : S U T,
                  S <: U
                  U <: T
                  S <: T
              -  | S_Top : S,
              +  | S_Top : S,
                  well_formed_ty S
              -    S <: TTop
              -  | S_Arrow : S1 S2 T1 T2,
              +    S <: Top
              +  | S_Arrow : S1 S2 T1 T2,
                  T1 <: S1
                  S2 <: T2
              -    TArrow S1 S2 <: TArrow T1 T2
              +    Arrow S1 S2 <: Arrow T1 T2
                (* Subtyping between record types *)
              -  | S_RcdWidth : i T1 T2,
              -    well_formed_ty (TRCons i T1 T2) →
              -    TRCons i T1 T2 <: TRNil
              -  | S_RcdDepth : i S1 T1 Sr2 Tr2,
              +  | S_RcdWidth : i T1 T2,
              +    well_formed_ty (RCons i T1 T2) →
              +    RCons i T1 T2 <: RNil
              +  | S_RcdDepth : i S1 T1 Sr2 Tr2,
                  S1 <: T1
                  Sr2 <: Tr2
                  record_ty Sr2
                  record_ty Tr2
              -    TRCons i S1 Sr2 <: TRCons i T1 Tr2
              -  | S_RcdPerm : i1 i2 T1 T2 Tr3,
              -    well_formed_ty (TRCons i1 T1 (TRCons i2 T2 Tr3)) →
              +    RCons i S1 Sr2 <: RCons i T1 Tr2
              +  | S_RcdPerm : i1 i2 T1 T2 Tr3,
              +    well_formed_ty (RCons i1 T1 (RCons i2 T2 Tr3)) →
                  i1i2
              -       TRCons i1 T1 (TRCons i2 T2 Tr3)
              -    <: TRCons i2 T2 (TRCons i1 T1 Tr3)
              +       RCons i1 T1 (RCons i2 T2 Tr3)
              +    <: RCons i2 T2 (RCons i1 T1 Tr3)

              where "T '<:' U" := (subtype T U).

              Hint Constructors subtype.
              @@ -298,17 +299,17 @@

              RecordSubSubtyping with RecordsNotation j := "j".
              Notation k := "k".
              Notation i := "i".
              -Notation A := (TBase "A").
              -Notation B := (TBase "B").
              -Notation C := (TBase "C").

              +Notation A := (Base "A").
              +Notation B := (Base "B").
              +Notation C := (Base "C").

              Definition TRcd_j :=
              -  (TRCons j (TArrow B B) TRNil). (* {j:B->B} *)
              +  (RCons j (Arrow B B) RNil). (* {j:B->B} *)
              Definition TRcd_kj :=
              -  TRCons k (TArrow A A) TRcd_j. (* {k:C->C,j:B->B} *)

              +  RCons k (Arrow A A) TRcd_j. (* {k:C->C,j:B->B} *)

              Example subtyping_example_0 :
              -  subtype (TArrow C TRcd_kj)
              -          (TArrow C TRNil).
              -(* C->{k:A->A,j:B->B} <: C->{} *)
              +  subtype (Arrow C TRcd_kj)
              +          (Arrow C RNil).
              +(* C->{k:A->A,j:B->B} <: C->{} *)
              Proof.
                apply S_Arrow.
                  apply S_Refl. auto.
              @@ -322,13 +323,13 @@

              RecordSubSubtyping with Records

              -

              练习:2 星 (subtyping_example_1)

              +

              练习:2 星, standard (subtyping_example_1)

              Example subtyping_example_1 :
                subtype TRcd_kj TRcd_j.
              -(* {k:A->A,j:B->B} <: {j:B->B} *)
              +(* {k:A->A,j:B->B} <: {j:B->B} *)
              Proof with eauto.
                (* 请在此处解答 *) Admitted.
              @@ -337,14 +338,14 @@

              RecordSubSubtyping with Records
              -

              练习:1 星 (subtyping_example_2)

              +

              练习:1 星, standard (subtyping_example_2)

              Example subtyping_example_2 :
              -  subtype (TArrow TTop TRcd_kj)
              -          (TArrow (TArrow C C) TRcd_j).
              -(* Top->{k:A->A,j:B->B} <: (C->C)->{j:B->B} *)
              +  subtype (Arrow Top TRcd_kj)
              +          (Arrow (Arrow C C) TRcd_j).
              +(* Top->{k:A->A,j:B->B} <: (C->C)->{j:B->B} *)
              Proof with eauto.
                (* 请在此处解答 *) Admitted.
              @@ -353,14 +354,14 @@

              RecordSubSubtyping with Records
              -

              练习:1 星 (subtyping_example_3)

              +

              练习:1 星, standard (subtyping_example_3)

              Example subtyping_example_3 :
              -  subtype (TArrow TRNil (TRCons j A TRNil))
              -          (TArrow (TRCons k B TRNil) TRNil).
              -(* {}->{j:A} <: {k:B}->{} *)
              +  subtype (Arrow RNil (RCons j A RNil))
              +          (Arrow (RCons k B RNil) RNil).
              +(* {}->{j:A} <: {k:B}->{} *)
              Proof with eauto.
                (* 请在此处解答 *) Admitted.
              @@ -369,13 +370,13 @@

              RecordSubSubtyping with Records
              -

              练习:2 星 (subtyping_example_4)

              +

              练习:2 星, standard (subtyping_example_4)

              Example subtyping_example_4 :
              -  subtype (TRCons x A (TRCons y B (TRCons z C TRNil)))
              -          (TRCons z C (TRCons y B (TRCons x A TRNil))).
              +  subtype (RCons x A (RCons y B (RCons z C RNil)))
              +          (RCons z C (RCons y B (RCons x A RNil))).
              (* {x:A,y:B,z:C} <: {z:C,y:B,x:A} *)
              Proof with eauto.
                (* 请在此处解答 *) Admitted.
              @@ -404,7 +405,7 @@

              RecordSubSubtyping with Records
              -Lemma subtype__wf : S T,
              +Lemma subtype__wf : S T,
                subtype S T
                well_formed_ty Twell_formed_ty S.
              @@ -418,7 +419,7 @@

              RecordSubSubtyping with Records
              -Lemma wf_rcd_lookup : i T Ti,
              +Lemma wf_rcd_lookup : i T Ti,
                well_formed_ty T
                Tlookup i T = Some Ti
                well_formed_ty Ti.
              @@ -427,7 +428,7 @@

              RecordSubSubtyping with RecordsProof with eauto.
                intros i T.
                induction T; intros; try solve_by_invert.
              -  - (* TRCons *)
              +  - (* RCons *)
                  inversion H. subst. unfold Tlookup in H0.
                  destruct (eqb_string i s)... inversion H0; subst... Qed.

              @@ -447,10 +448,10 @@

              RecordSubSubtyping with Records
              -Lemma rcd_types_match : S T i Ti,
              +Lemma rcd_types_match : S T i Ti,
                subtype S T
                Tlookup i T = Some Ti
              -   Si, Tlookup i S = Some Sisubtype Si Ti.
              +  Si, Tlookup i S = Some Sisubtype Si Ti.
              Proof with (eauto using wf_rcd_lookup).
              @@ -458,19 +459,19 @@

              RecordSubSubtyping with Recordsinduction Hsub; intros Ti Hget;
                  try solve_by_invert.
                - (* S_Refl *)
              -     Ti...
              +    Ti...
                - (* S_Trans *)
                  destruct (IHHsub2 Ti) as [Ui Hui]... destruct Hui.
                  destruct (IHHsub1 Ui) as [Si Hsi]... destruct Hsi.
              -     Si...
              +    Si...
                - (* S_RcdDepth *)
                  rename i0 into k.
                  unfold Tlookup. unfold Tlookup in Hget.
                  destruct (eqb_string i k)...
                  + (* i = k -- we're looking up the first field *)
              -      inversion Hget. subst. S1...
              +      inversion Hget. subst. S1...
                - (* S_RcdPerm *)
              -     Ti. split.
              +    Ti. split.
                  + (* lookup *)
                    unfold Tlookup. unfold Tlookup in Hget.
                    destruct (eqb_stringP i i1)...
              @@ -485,7 +486,7 @@

              RecordSubSubtyping with Records
              -

              练习:3 星 (rcd_types_match_informal)

              +

              练习:3 星, standard (rcd_types_match_informal)

              Write a careful informal proof of the rcd_types_match lemma.
              @@ -504,19 +505,19 @@

              RecordSubSubtyping with Records

              -

              练习:3 星, optional (sub_inversion_arrow)

              +

              练习:3 星, standard, optional (sub_inversion_arrow)

              -Lemma sub_inversion_arrow : U V1 V2,
              -     subtype U (TArrow V1 V2) →
              -      U1 U2,
              -       (U=(TArrow U1 U2)) ∧ (subtype V1 U1) ∧ (subtype U2 V2).
              +Lemma sub_inversion_arrow : U V1 V2,
              +     subtype U (Arrow V1 V2) →
              +     U1 U2,
              +       (U=(Arrow U1 U2)) ∧ (subtype V1 U1) ∧ (subtype U2 V2).
              Proof with eauto.
                intros U V1 V2 Hs.
              -  remember (TArrow V1 V2) as V.
              +  remember (Arrow V1 V2) as V.
                generalize dependent V2. generalize dependent V1.
                (* 请在此处解答 *) Admitted.
              @@ -534,40 +535,40 @@

              RecordSubSubtyping with Records Definition context := partial_map ty.

              -Reserved Notation "Gamma '|-' t '∈' T" (at level 40).

              +Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).

              Inductive has_type : contexttmtyProp :=
              -  | T_Var : Gamma x T,
              +  | T_Var : Gamma x T,
                    Gamma x = Some T
                    well_formed_ty T
              -      Gamma |- tvar xT
              -  | T_Abs : Gamma x T11 T12 t12,
              +      Gammavar xT
              +  | T_Abs : Gamma x T11 T12 t12,
                    well_formed_ty T11
              -      update Gamma x T11 |- t12T12
              -      Gamma |- tabs x T11 t12TArrow T11 T12
              -  | T_App : T1 T2 Gamma t1 t2,
              -      Gamma |- t1TArrow T1 T2
              -      Gamma |- t2T1
              -      Gamma |- tapp t1 t2T2
              -  | T_Proj : Gamma i t T Ti,
              -      Gamma |- tT
              +      update Gamma x T11t12T12
              +      Gammaabs x T11 t12Arrow T11 T12
              +  | T_App : T1 T2 Gamma t1 t2,
              +      Gammat1Arrow T1 T2
              +      Gammat2T1
              +      Gammaapp t1 t2T2
              +  | T_Proj : Gamma i t T Ti,
              +      GammatT
                    Tlookup i T = Some Ti
              -      Gamma |- tproj t iTi
              +      Gammarproj t iTi
                (* Subsumption *)
              -  | T_Sub : Gamma t S T,
              -      Gamma |- tS
              +  | T_Sub : Gamma t S T,
              +      GammatS
                    subtype S T
              -      Gamma |- tT
              +      GammatT
                (* Rules for record terms *)
              -  | T_RNil : Gamma,
              -      Gamma |- trnilTRNil
              -  | T_RCons : Gamma i t T tr Tr,
              -      Gamma |- tT
              -      Gamma |- trTr
              +  | T_RNil : Gamma,
              +      GammarnilRNil
              +  | T_RCons : Gamma i t T tr Tr,
              +      GammatT
              +      GammatrTr
                    record_ty Tr
                    record_tm tr
              -      Gamma |- trcons i t trTRCons i T Tr
              +      Gammarcons i t trRCons i T Tr

              -where "Gamma '|-' t '∈' T" := (has_type Gamma t T).

              +where "Gamma '⊢' t '∈' T" := (has_type Gamma t T).

              Hint Constructors has_type.

              @@ -583,21 +584,21 @@

              RecordSubSubtyping with Records
              -

              练习:1 星 (typing_example_0)

              +

              练习:1 星, standard (typing_example_0)

              Definition trcd_kj :=
              -  (trcons k (tabs z A (tvar z))
              -           (trcons j (tabs z B (tvar z))
              -                      trnil)).

              +  (rcons k (abs z A (var z))
              +           (rcons j (abs z B (var z))
              +                      rnil)).

              Example typing_example_0 :
                has_type empty
              -           (trcons k (tabs z A (tvar z))
              -                     (trcons j (tabs z B (tvar z))
              -                               trnil))
              +           (rcons k (abs z A (var z))
              +                     (rcons j (abs z B (var z))
              +                               rnil))
                         TRcd_kj.
              -(* empty |- {k=(\z:A.z), j=(\z:B.z)} : {k:A->A,j:B->B} *)
              +(* empty ⊢ {k=(\z:A.z), j=(\z:B.z)} : {k:A->A,j:B->B} *)
              Proof.
              @@ -610,18 +611,18 @@

              RecordSubSubtyping with Records
              -

              练习:2 星 (typing_example_1)

              +

              练习:2 星, standard (typing_example_1)

              Example typing_example_1 :
                has_type empty
              -           (tapp (tabs x TRcd_j (tproj (tvar x) j))
              +           (app (abs x TRcd_j (rproj (var x) j))
                                 (trcd_kj))
              -           (TArrow B B).
              -(* empty |- (\x:{k:A->A,j:B->B}. x.j)
              +           (Arrow B B).
              +(* empty ⊢ (\x:{k:A->A,j:B->B}. x.j)
                            {k=(\z:A.z), j=(\z:B.z)}
              -         : B->B *)

              +         : B->B *)

              Proof with eauto.
              @@ -634,21 +635,21 @@

              RecordSubSubtyping with Records
              -

              练习:2 星, optional (typing_example_2)

              +

              练习:2 星, standard, optional (typing_example_2)

              Example typing_example_2 :
                has_type empty
              -           (tapp (tabs z (TArrow (TArrow C C) TRcd_j)
              -                           (tproj (tapp (tvar z)
              -                                            (tabs x C (tvar x)))
              +           (app (abs z (Arrow (Arrow C C) TRcd_j)
              +                           (rproj (app (var z)
              +                                            (abs x C (var x)))
                                                  j))
              -                   (tabs z (TArrow C C) trcd_kj))
              -           (TArrow B B).
              -(* empty |- (\z:(C->C)->{j:B->B}. (z (\x:C.x)).j)
              -              (\z:C->C. {k=(\z:A.z), j=(\z:B.z)})
              -           : B->B *)

              +                   (abs z (Arrow C C) trcd_kj))
              +           (Arrow B B).
              +(* empty ⊢ (\z:(C->C)->{j:B->B}. (z (\x:C.x)).j)
              +              (\z:C->C. {k=(\z:A.z), j=(\z:B.z)})
              +           : B->B *)

              Proof with eauto.
              @@ -672,7 +673,7 @@

              RecordSubSubtyping with Records
              -Lemma has_type__wf : Gamma t T,
              +Lemma has_type__wf : Gamma t T,
                has_type Gamma t Twell_formed_ty T.
              @@ -690,9 +691,9 @@

              RecordSubSubtyping with Records
              -Lemma step_preserves_record_tm : tr tr',
              +Lemma step_preserves_record_tm : tr tr',
                record_tm tr
              -  tr ==> tr'
              +  tr --> tr'
                record_tm tr'.
              @@ -710,11 +711,11 @@

              RecordSubSubtyping with Records
              -Lemma lookup_field_in_value : v T i Ti,
              +Lemma lookup_field_in_value : v T i Ti,
                value v
                has_type empty v T
                Tlookup i T = Some Ti
              -   vi, tlookup i v = Some vihas_type empty vi Ti.
              +  vi, tlookup i v = Some vihas_type empty vi Ti.
              Proof with eauto.
              @@ -729,7 +730,7 @@

              RecordSubSubtyping with Recordssimpl in H0. simpl. simpl in H1.
                  destruct (eqb_string i i0).
                  + (* i is first *)
              -      inversion H1. subst. t...
              +      inversion H1. subst. t...
                  + (* i in tail *)
                    destruct (IHHtyp2 Ti) as [vi [get Htyvi]]...
                    inversion Hval... Qed.
              @@ -741,15 +742,15 @@

              RecordSubSubtyping with Records

              -

              练习:3 星 (canonical_forms_of_arrow_types)

              +

              练习:3 星, standard (canonical_forms_of_arrow_types)

              -Lemma canonical_forms_of_arrow_types : Gamma s T1 T2,
              -     has_type Gamma s (TArrow T1 T2) →
              +Lemma canonical_forms_of_arrow_types : Gamma s T1 T2,
              +     has_type Gamma s (Arrow T1 T2) →
                   value s
              -      x S1 s2,
              -        s = tabs x S1 s2.
              +     x S1 s2,
              +        s = abs x S1 s2.
              Proof with eauto.
              @@ -759,9 +760,9 @@

              RecordSubSubtyping with Records☐
              -Theorem progress : t T,
              +Theorem progress : t T,
                   has_type empty t T
              -     value t t', t ==> t'.
              +     value tt', t --> t'.
              Proof with eauto.
              @@ -780,38 +781,38 @@

              RecordSubSubtyping with Records(* t2 is a value *)
                      destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
                        as [x [S1 [t12 Heqt1]]]...
              -        subst. ([x:=t2]t12)...
              +        subst. ([x:=t2]t12)...
                    * (* t2 steps *)
              -        destruct H0 as [t2' Hstp]. (tapp t1 t2')...
              +        destruct H0 as [t2' Hstp]. (app t1 t2')...
                  + (* t1 steps *)
              -      destruct H as [t1' Hstp]. (tapp t1' t2)...
              +      destruct H as [t1' Hstp]. (app t1' t2)...
                - (* T_Proj *)
                  right. destruct IHHt...
                  + (* rcd is value *)
                    destruct (lookup_field_in_value t T i Ti)
                      as [t' [Hget Ht']]...
                  + (* rcd_steps *)
              -      destruct H0 as [t' Hstp]. (tproj t' i)...
              +      destruct H0 as [t' Hstp]. (rproj t' i)...
                - (* T_RCons *)
                  destruct IHHt1...
                  + (* head is a value *)
                    destruct IHHt2...
                    * (* tail steps *)
                      right. destruct H2 as [tr' Hstp].
              -         (trcons i t tr')...
              +        (rcons i t tr')...
                  + (* head steps *)
                    right. destruct H1 as [t' Hstp].
              -       (trcons i t' tr)... Qed.
              +      (rcons i t' tr)... Qed.

              -Theorem_ : For any term t and type T, if empty |- t : T - then t is a value or t ==> t' for some term t'. +Theorem_ : 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 such that empty |- t : T. We + _Proof_: Let t and T be given such that empty t : T. We proceed by induction on the given typing derivation.
              @@ -828,7 +829,7 @@

              RecordSubSubtyping with Records
            • If the last step in the typing derivation is by T_App, then there are terms t1 t2 and types T1 T2 such that t = - t1 t2, T = T2, empty |- t1 : T1 T2 and empty |- t2 : + t1 t2, T = T2, empty t1 : T1 T2 and empty t2 : T1.
              @@ -840,7 +841,7 @@

              RecordSubSubtyping with Records

              • -
              • Suppose t1 ==> t1' for some term t1'. Then t1 t2 ==> +
              • Suppose t1 --> t1' for some term t1'. Then t1 t2 --> t1' t2 by ST_App1.
                @@ -852,7 +853,7 @@

                RecordSubSubtyping with Records

                -
              • Suppose t2 ==> t2' for some term t2'. Then t1 t2 ==> +
              • Suppose t2 --> t2' for some term t2'. Then t1 t2 --> t1 t2' by rule ST_App2 because t1 is a value.
                @@ -861,7 +862,7 @@

                RecordSubSubtyping with Records
              • Otherwise, t2 is a value. By Lemma canonical_forms_for_arrow_types, t1 = \x:S1.s2 for - some x, S1, and s2. But then (\x:S1.s2) t2 ==> + some x, S1, and s2. But then (\x:S1.s2) t2 --> [x:=t2]s2 by ST_AppAbs, since t2 is a value.
                @@ -876,26 +877,26 @@

                RecordSubSubtyping with Records
              • If the last step of the derivation is by T_Proj, then there are a term tr, a type Tr, and a label i such that t = - tr.i, empty |- tr : Tr, and Tlookup i Tr = Some T. + tr.i, empty tr : Tr, and Tlookup i Tr = Some T.
                - By the IH, either tr is a value or it steps. If tr ==> - tr' for some term tr', then tr.i ==> tr'.i by rule + By the IH, either tr is a value or it steps. If tr --> + tr' for some term tr', then tr.i --> tr'.i by rule ST_Proj1.
                If tr is a value, then Lemma lookup_field_in_value yields that there is a term ti such that tlookup i tr = Some ti. - It follows that tr.i ==> ti by rule ST_ProjRcd. + It follows that tr.i --> ti by rule ST_ProjRcd.
              • 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 + is a type S such that S <: T and empty t : S. The desired result is exactly the induction hypothesis for the typing subderivation. @@ -906,7 +907,7 @@

                RecordSubSubtyping with Records If the final step of the derivation is by T_RCons, then there exist some terms t1 tr, types T1 Tr and a label t such that t = {i=t1, tr}, T = {i:T1, Tr}, record_ty - tr, record_tm Tr, empty |- t1 : T1 and empty |- tr : + tr, record_tm Tr, empty t1 : T1 and empty tr : Tr.
                @@ -918,8 +919,8 @@

                RecordSubSubtyping with Records

                -
              • Suppose t1 ==> t1' for some term t1'. Then {i=t1, tr} - ==> {i=t1', tr} by rule ST_Rcd_Head. +
              • Suppose t1 --> t1' for some term t1'. Then {i=t1, tr} + --> {i=t1', tr} by rule ST_Rcd_Head.
                @@ -930,8 +931,8 @@

                RecordSubSubtyping with Records

                -
              • Suppose tr ==> tr' for some term tr'. Then {i=t1, - tr} ==> {i=t1, tr'} by rule ST_Rcd_Tail, since t1 is +
              • Suppose tr --> tr' for some term tr'. Then {i=t1, + tr} --> {i=t1, tr'} by rule ST_Rcd_Tail, since t1 is a value.
                @@ -958,74 +959,74 @@

                RecordSubSubtyping with Records
                -Lemma typing_inversion_var : Gamma x T,
                -  has_type Gamma (tvar x) T
                -   S,
                +Lemma typing_inversion_var : Gamma x T,
                +  has_type Gamma (var x) T
                +  S,
                    Gamma x = Some Ssubtype S T.
                Proof with eauto.
                  intros Gamma x T Hty.
                -  remember (tvar x) as t.
                +  remember (var x) as t.
                  induction Hty; intros;
                    inversion Heqt; subst; try solve_by_invert.
                  - (* T_Var *)
                -     T...
                +    T...
                  - (* T_Sub *)
                    destruct IHHty as [U [Hctx HsubU]]... Qed.

                -Lemma typing_inversion_app : Gamma t1 t2 T2,
                -  has_type Gamma (tapp t1 t2) T2
                -   T1,
                -    has_type Gamma t1 (TArrow T1 T2) ∧
                +Lemma typing_inversion_app : Gamma t1 t2 T2,
                +  has_type Gamma (app t1 t2) T2
                +  T1,
                +    has_type Gamma t1 (Arrow T1 T2) ∧
                    has_type Gamma t2 T1.
                Proof with eauto.
                  intros Gamma t1 t2 T2 Hty.
                -  remember (tapp t1 t2) as t.
                +  remember (app t1 t2) as t.
                  induction Hty; intros;
                    inversion Heqt; subst; try solve_by_invert.
                  - (* T_App *)
                -     T1...
                +    T1...
                  - (* T_Sub *)
                    destruct IHHty as [U1 [Hty1 Hty2]]...
                    assert (Hwf := has_type__wf _ _ _ Hty2).
                -     U1... Qed.
                +    U1... Qed.

                -Lemma typing_inversion_abs : Gamma x S1 t2 T,
                -     has_type Gamma (tabs x S1 t2) T
                -     ( S2, subtype (TArrow S1 S2) T
                +Lemma typing_inversion_abs : Gamma x S1 t2 T,
                +     has_type Gamma (abs x S1 t2) T
                +     (S2, subtype (Arrow S1 S2) T
                              ∧ has_type (update Gamma x S1) t2 S2).
                Proof with eauto.
                  intros Gamma x S1 t2 T H.
                -  remember (tabs x S1 t2) as t.
                +  remember (abs x S1 t2) as t.
                  induction H;
                    inversion Heqt; subst; intros; try solve_by_invert.
                  - (* T_Abs *)
                    assert (Hwf := has_type__wf _ _ _ H0).
                -     T12...
                +    T12...
                  - (* T_Sub *)
                    destruct IHhas_type as [S2 [Hsub Hty]]...
                    Qed.

                -Lemma typing_inversion_proj : Gamma i t1 Ti,
                -  has_type Gamma (tproj t1 i) Ti
                -   T Si,
                +Lemma typing_inversion_proj : Gamma i t1 Ti,
                +  has_type Gamma (rproj t1 i) Ti
                +  T Si,
                    Tlookup i T = Some Sisubtype Si Tihas_type Gamma t1 T.
                Proof with eauto.
                  intros Gamma i t1 Ti H.
                -  remember (tproj t1 i) as t.
                +  remember (rproj t1 i) as t.
                  induction H;
                    inversion Heqt; subst; intros; try solve_by_invert.
                  - (* T_Proj *)
                @@ -1033,40 +1034,40 @@

                RecordSubSubtyping with Records(* pf of assertion *)
                      apply (wf_rcd_lookup i T Ti)...
                      apply has_type__wf in H... }
                -     T. Ti...
                +    T, Ti...
                  - (* T_Sub *)
                    destruct IHhas_type as [U [Ui [Hget [Hsub Hty]]]]...
                -     U. Ui... Qed.
                +    U, Ui... Qed.


                -Lemma typing_inversion_rcons : Gamma i ti tr T,
                -  has_type Gamma (trcons i ti tr) T
                -   Si Sr,
                -    subtype (TRCons i Si Sr) Thas_type Gamma ti Si
                +Lemma typing_inversion_rcons : Gamma i ti tr T,
                +  has_type Gamma (rcons i ti tr) T
                +  Si Sr,
                +    subtype (RCons i Si Sr) Thas_type Gamma ti Si
                    record_tm trhas_type Gamma tr Sr.
                Proof with eauto.
                  intros Gamma i ti tr T Hty.
                -  remember (trcons i ti tr) as t.
                +  remember (rcons i ti tr) as t.
                  induction Hty;
                    inversion Heqt; subst...
                  - (* T_Sub *)
                    apply IHHty in H0.
                    destruct H0 as [Ri [Rr [HsubRS [HtypRi HtypRr]]]].
                -     Ri. Rr...
                +    Ri, Rr...
                  - (* T_RCons *)
                -    assert (well_formed_ty (TRCons i T Tr)) as Hwf.
                +    assert (well_formed_ty (RCons i T Tr)) as Hwf.
                    { (* pf of assertion *)
                      apply has_type__wf in Hty1.
                      apply has_type__wf in Hty2... }
                -     T. Tr... Qed.
                +    T, Tr... Qed.

                -Lemma abs_arrow : x S1 s2 T1 T2,
                -  has_type empty (tabs x S1 s2) (TArrow T1 T2) →
                +Lemma abs_arrow : x S1 s2 T1 T2,
                +  has_type empty (abs x S1 s2) (Arrow T1 T2) →
                     subtype T1 S1
                  ∧ has_type (update empty x S1) s2 T2.
                @@ -1089,29 +1090,29 @@

                RecordSubSubtyping with Records Inductive appears_free_in : stringtmProp :=
                -  | afi_var : x,
                -      appears_free_in x (tvar x)
                -  | afi_app1 : x t1 t2,
                -      appears_free_in x t1appears_free_in x (tapp t1 t2)
                -  | afi_app2 : x t1 t2,
                -      appears_free_in x t2appears_free_in x (tapp t1 t2)
                -  | afi_abs : x y T11 t12,
                +  | afi_var : x,
                +      appears_free_in x (var x)
                +  | afi_app1 : x t1 t2,
                +      appears_free_in x t1appears_free_in x (app t1 t2)
                +  | afi_app2 : x t1 t2,
                +      appears_free_in x t2appears_free_in x (app t1 t2)
                +  | afi_abs : x y T11 t12,
                        yx
                        appears_free_in x t12
                -        appears_free_in x (tabs y T11 t12)
                -  | afi_proj : x t i,
                +        appears_free_in x (abs y T11 t12)
                +  | afi_proj : x t i,
                      appears_free_in x t
                -      appears_free_in x (tproj t i)
                -  | afi_rhead : x i t tr,
                +      appears_free_in x (rproj t i)
                +  | afi_rhead : x i t tr,
                      appears_free_in x t
                -      appears_free_in x (trcons i t tr)
                -  | afi_rtail : x i t tr,
                +      appears_free_in x (rcons i t tr)
                +  | afi_rtail : x i t tr,
                      appears_free_in x tr
                -      appears_free_in x (trcons i t tr).

                +      appears_free_in x (rcons i t tr).

                Hint Constructors appears_free_in.

                -Lemma context_invariance : Gamma Gamma' t S,
                +Lemma context_invariance : Gamma Gamma' t S,
                     has_type Gamma t S
                -     ( x, appears_free_in x tGamma x = Gamma' x) →
                +     (x, appears_free_in x tGamma x = Gamma' x) →
                     has_type Gamma' t S.
                @@ -1131,17 +1132,17 @@

                RecordSubSubtyping with Records
                -Lemma free_in_context : x t T Gamma,
                +Lemma free_in_context : x t T Gamma,
                   appears_free_in x t
                   has_type Gamma t T
                -    T', Gamma x = Some T'.
                +   T', Gamma x = Some T'.
                Proof with eauto.
                  intros x t T Gamma Hafi Htyp.
                  induction Htyp; subst; inversion Hafi; subst...
                  - (* T_Abs *)
                -    destruct (IHHtyp H5) as [T Hctx]. T.
                +    destruct (IHHtyp H5) as [T Hctx]. T.
                    unfold update, t_update in Hctx.
                    rewrite false_eqb_string in Hctx... Qed.
                @@ -1154,7 +1155,7 @@

                RecordSubSubtyping with Records
                -Lemma substitution_preserves_typing : Gamma x U v t S,
                +Lemma substitution_preserves_typing : Gamma x U v t S,
                     has_type (update Gamma x U) t S
                     has_type empty v U
                     has_type Gamma ([x:=v]t) S.
                @@ -1164,7 +1165,7 @@

                RecordSubSubtyping with Recordsintros Gamma x U v t S Htypt Htypv.
                  generalize dependent S. generalize dependent Gamma.
                  induction t; intros; simpl.
                -  - (* tvar *)
                +  - (* var *)
                    rename s into y.
                    destruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub]].
                    unfold update, t_update in Hctx.
                @@ -1178,17 +1179,17 @@

                RecordSubSubtyping with Recordsinversion HT'.
                    + (* x<>y *)
                      destruct (subtype__wf _ _ Hsub)...
                -  - (* tapp *)
                +  - (* app *)
                    destruct (typing_inversion_app _ _ _ _ Htypt)
                      as [T1 [Htypt1 Htypt2]].
                    eapply T_App...
                -  - (* tabs *)
                +  - (* abs *)
                    rename s into y. rename t into T1.
                    destruct (typing_inversion_abs _ _ _ _ _ Htypt)
                      as [T2 [Hsub Htypt2]].
                    destruct (subtype__wf _ _ Hsub) as [Hwf1 Hwf2].
                    inversion Hwf2. subst.
                -    apply T_Sub with (TArrow T1 T2)... apply T_Abs...
                +    apply T_Sub with (Arrow T1 T2)... apply T_Abs...
                    destruct (eqb_stringP x y).
                    + (* x=y *)
                      eapply context_invariance...
                @@ -1200,16 +1201,16 @@

                RecordSubSubtyping with Recordsintros z Hafi. unfold update, t_update.
                      destruct (eqb_stringP y z)...
                      subst. rewrite false_eqb_string...
                -  - (* tproj *)
                +  - (* rproj *)
                    destruct (typing_inversion_proj _ _ _ _ Htypt)
                      as [T [Ti [Hget [Hsub Htypt1]]]]...
                -  - (* trnil *)
                +  - (* rnil *)
                    eapply context_invariance...
                    intros y Hcontra. inversion Hcontra.
                -  - (* trcons *)
                +  - (* rcons *)
                    destruct (typing_inversion_rcons _ _ _ _ _ Htypt) as
                      [Ti [Tr [Hsub [HtypTi [Hrcdt2 HtypTr]]]]].
                -    apply T_Sub with (TRCons s Ti Tr)...
                +    apply T_Sub with (RCons s Ti Tr)...
                    apply T_RCons...
                    + (* record_ty Tr *)
                      apply subtype__wf in Hsub. destruct Hsub. inversion H0...
                @@ -1218,9 +1219,9 @@

                RecordSubSubtyping with Records
                -Theorem preservation : t t' T,
                +Theorem preservation : t t' T,
                     has_type empty t T
                -     t ==> t'
                +     t --> t'
                     has_type empty t' T.
                @@ -1246,11 +1247,11 @@

                RecordSubSubtyping with Records Theorem_: If t, t' are terms and T is a type such that - empty |- t : T and t ==> t', then empty |- t' : T. + empty t : T and t --> t', then empty t' : T.
                - _Proof_: Let t and T be given such that empty |- t : T. We go + _Proof_: Let t and T be given such that empty t : T. We go by induction on the structure of this typing derivation, leaving t' general. Cases T_Abs and T_RNil are vacuous because abstractions and {} don't step. Case T_Var is vacuous as well, @@ -1261,7 +1262,7 @@

                RecordSubSubtyping with Records
              • If the final step of the derivation is by T_App, then there are terms t1 t2 and types T1 T2 such that t = t1 t2, - T = T2, empty |- t1 : T1 T2 and empty |- t2 : T1. + T = T2, empty t1 : T1 T2 and empty t2 : T1.
                @@ -1278,9 +1279,9 @@

                RecordSubSubtyping with Records

              • - By Lemma abs_arrow, we have T1 <: S and x:S1 |- s2 : T2. + By Lemma abs_arrow, we have T1 <: S and x:S1 s2 : T2. It then follows by lemma substitution_preserves_typing that - empty |- [x:=t2] t12 : T2 as desired. + empty [x:=t2] t12 : T2 as desired.
                @@ -1288,12 +1289,12 @@

                RecordSubSubtyping with Records
              • If the final step of the derivation is by T_Proj, then there is a term tr, type Tr and label i such that t = tr.i, - empty |- tr : Tr, and Tlookup i Tr = Some T. + empty tr : Tr, and Tlookup i Tr = Some T.
                The IH for the typing derivation gives us that, for any term - tr', if tr ==> tr' then empty |- tr' Tr. Inspection of + tr', if tr --> tr' then empty tr' Tr. Inspection of the definition of the step relation reveals that there are two ways a projection can step. Case ST_Proj1 follows immediately by the IH. @@ -1303,14 +1304,14 @@

                RecordSubSubtyping with Recordstr.i steps by ST_ProjRcd. Then tr is a value and there is some term vi such that tlookup i tr = Some vi and t' = vi. But by lemma - lookup_field_in_value, empty |- vi : Ti as desired. + lookup_field_in_value, empty vi : Ti as desired.

              • 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 + 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. @@ -1321,7 +1322,7 @@

                RecordSubSubtyping with Records If the final step of the derivation is by T_RCons, then there exist some terms t1 tr, types T1 Tr and a label t such that t = {i=t1, tr}, T = {i:T1, Tr}, record_ty tr, - record_tm Tr, empty |- t1 : T1 and empty |- tr : Tr. + record_tm Tr, empty t1 : T1 and empty tr : Tr.
                @@ -1334,9 +1335,10 @@

                RecordSubSubtyping with Records

              -
              +
              +
              - +(* Sat Jan 26 15:15:45 UTC 2019 *)

              diff --git a/plf-current/RecordSub.v b/plf-current/RecordSub.v index eacfe9d2..0e8a957d 100644 --- a/plf-current/RecordSub.v +++ b/plf-current/RecordSub.v @@ -8,6 +8,7 @@ are nonstandard. *) Set Warnings "-notation-overridden,-parsing". +From Coq Require Import Strings.String. From PLF Require Import Maps. From PLF Require Import Smallstep. From PLF Require Import MoreStlc. @@ -20,22 +21,22 @@ From PLF Require Import MoreStlc. Inductive ty : Type := (* proper types *) - | TTop : ty - | TBase : string -> ty - | TArrow : ty -> ty -> ty + | Top : ty + | Base : string -> ty + | Arrow : ty -> ty -> ty (* record types *) - | TRNil : ty - | TRCons : string -> ty -> ty -> ty. + | RNil : ty + | RCons : string -> ty -> ty -> ty. Inductive tm : Type := (* proper terms *) - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm - | tproj : tm -> string -> tm + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm + | rproj : tm -> string -> tm (* record terms *) - | trnil : tm - | trcons : string -> tm -> tm -> tm. + | rnil : tm + | rcons : string -> tm -> tm -> tm. (* ----------------------------------------------------------------- *) (** *** Well-Formedness *) @@ -58,32 +59,32 @@ Inductive tm : Type := Inductive record_ty : ty -> Prop := | RTnil : - record_ty TRNil + record_ty RNil | RTcons : forall i T1 T2, - record_ty (TRCons i T1 T2). + record_ty (RCons i T1 T2). Inductive record_tm : tm -> Prop := | rtnil : - record_tm trnil + record_tm rnil | rtcons : forall i t1 t2, - record_tm (trcons i t1 t2). + record_tm (rcons i t1 t2). Inductive well_formed_ty : ty -> Prop := - | wfTTop : - well_formed_ty TTop - | wfTBase : forall i, - well_formed_ty (TBase i) - | wfTArrow : forall T1 T2, + | wfTop : + well_formed_ty Top + | wfBase : forall i, + well_formed_ty (Base i) + | wfArrow : forall T1 T2, well_formed_ty T1 -> well_formed_ty T2 -> - well_formed_ty (TArrow T1 T2) - | wfTRNil : - well_formed_ty TRNil - | wfTRCons : forall i T1 T2, + well_formed_ty (Arrow T1 T2) + | wfRNil : + well_formed_ty RNil + | wfRCons : forall i T1 T2, well_formed_ty T1 -> well_formed_ty T2 -> record_ty T2 -> - well_formed_ty (TRCons i T1 T2). + well_formed_ty (RCons i T1 T2). Hint Constructors record_ty record_tm well_formed_ty. @@ -94,13 +95,13 @@ Hint Constructors record_ty record_tm well_formed_ty. Fixpoint subst (x:string) (s:tm) (t:tm) : tm := match t with - | tvar y => if eqb_string x y then s else t - | tabs y T t1 => tabs y T (if eqb_string x y then t1 + | var y => if eqb_string x y then s else t + | abs y T t1 => abs y T (if eqb_string x y then t1 else (subst x s t1)) - | tapp t1 t2 => tapp (subst x s t1) (subst x s t2) - | tproj t1 i => tproj (subst x s t1) i - | trnil => trnil - | trcons i t1 tr2 => trcons i (subst x s t1) (subst x s tr2) + | app t1 t2 => app (subst x s t1) (subst x s t2) + | rproj t1 i => rproj (subst x s t1) i + | rnil => rnil + | rcons i t1 tr2 => rcons i (subst x s t1) (subst x s tr2) end. Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). @@ -110,58 +111,58 @@ Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). Inductive value : tm -> Prop := | v_abs : forall x T t, - value (tabs x T t) - | v_rnil : value trnil + value (abs x T t) + | v_rnil : value rnil | v_rcons : forall i v vr, value v -> value vr -> - value (trcons i v vr). + value (rcons i v vr). Hint Constructors value. Fixpoint Tlookup (i:string) (Tr:ty) : option ty := match Tr with - | TRCons i' T Tr' => + | RCons i' T Tr' => if eqb_string i i' then Some T else Tlookup i Tr' | _ => None end. Fixpoint tlookup (i:string) (tr:tm) : option tm := match tr with - | trcons i' t tr' => + | rcons i' t tr' => if eqb_string i i' then Some t else tlookup i tr' | _ => None end. -Reserved Notation "t1 '==>' t2" (at level 40). +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 + (app (abs x T t12) v2) --> [x:=v2]t12 | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) + t1 --> t1' -> + (app t1 t2) --> (app t1' t2) | ST_App2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - (tapp v1 t2) ==> (tapp v1 t2') + t2 --> t2' -> + (app v1 t2) --> (app v1 t2') | ST_Proj1 : forall tr tr' i, - tr ==> tr' -> - (tproj tr i) ==> (tproj tr' i) + tr --> tr' -> + (rproj tr i) --> (rproj tr' i) | ST_ProjRcd : forall tr i vi, value tr -> tlookup i tr = Some vi -> - (tproj tr i) ==> vi + (rproj tr i) --> vi | ST_Rcd_Head : forall i t1 t1' tr2, - t1 ==> t1' -> - (trcons i t1 tr2) ==> (trcons i t1' tr2) + t1 --> t1' -> + (rcons i t1 tr2) --> (rcons i t1' tr2) | ST_Rcd_Tail : forall i v1 tr2 tr2', value v1 -> - tr2 ==> tr2' -> - (trcons i v1 tr2) ==> (trcons i v1 tr2') + tr2 --> tr2' -> + (rcons i v1 tr2) --> (rcons i v1 tr2') -where "t1 '==>' t2" := (step t1 t2). +where "t1 '-->' t2" := (step t1 t2). Hint Constructors step. @@ -196,26 +197,26 @@ Inductive subtype : ty -> ty -> Prop := S <: T | S_Top : forall S, well_formed_ty S -> - S <: TTop + S <: Top | S_Arrow : forall S1 S2 T1 T2, T1 <: S1 -> S2 <: T2 -> - TArrow S1 S2 <: TArrow T1 T2 + Arrow S1 S2 <: Arrow T1 T2 (* Subtyping between record types *) | S_RcdWidth : forall i T1 T2, - well_formed_ty (TRCons i T1 T2) -> - TRCons i T1 T2 <: TRNil + well_formed_ty (RCons i T1 T2) -> + RCons i T1 T2 <: RNil | S_RcdDepth : forall i S1 T1 Sr2 Tr2, S1 <: T1 -> Sr2 <: Tr2 -> record_ty Sr2 -> record_ty Tr2 -> - TRCons i S1 Sr2 <: TRCons i T1 Tr2 + RCons i S1 Sr2 <: RCons i T1 Tr2 | S_RcdPerm : forall i1 i2 T1 T2 Tr3, - well_formed_ty (TRCons i1 T1 (TRCons i2 T2 Tr3)) -> + well_formed_ty (RCons i1 T1 (RCons i2 T2 Tr3)) -> i1 <> i2 -> - TRCons i1 T1 (TRCons i2 T2 Tr3) - <: TRCons i2 T2 (TRCons i1 T1 Tr3) + RCons i1 T1 (RCons i2 T2 Tr3) + <: RCons i2 T2 (RCons i1 T1 Tr3) where "T '<:' U" := (subtype T U). @@ -233,18 +234,18 @@ Notation z := "z". Notation j := "j". Notation k := "k". Notation i := "i". -Notation A := (TBase "A"). -Notation B := (TBase "B"). -Notation C := (TBase "C"). +Notation A := (Base "A"). +Notation B := (Base "B"). +Notation C := (Base "C"). Definition TRcd_j := - (TRCons j (TArrow B B) TRNil). (* {j:B->B} *) + (RCons j (Arrow B B) RNil). (* {j:B->B} *) Definition TRcd_kj := - TRCons k (TArrow A A) TRcd_j. (* {k:C->C,j:B->B} *) + RCons k (Arrow A A) TRcd_j. (* {k:C->C,j:B->B} *) Example subtyping_example_0 : - subtype (TArrow C TRcd_kj) - (TArrow C TRNil). + subtype (Arrow C TRcd_kj) + (Arrow C RNil). (* C->{k:A->A,j:B->B} <: C->{} *) Proof. apply S_Arrow. @@ -256,7 +257,7 @@ Qed. benefit, make sure you also understand how to prove them on paper! *) -(** **** 练习:2 星 (subtyping_example_1) *) +(** **** 练习:2 星, standard (subtyping_example_1) *) Example subtyping_example_1 : subtype TRcd_kj TRcd_j. (* {k:A->A,j:B->B} <: {j:B->B} *) @@ -264,28 +265,28 @@ Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (subtyping_example_2) *) +(** **** 练习:1 星, standard (subtyping_example_2) *) Example subtyping_example_2 : - subtype (TArrow TTop TRcd_kj) - (TArrow (TArrow C C) TRcd_j). + subtype (Arrow Top TRcd_kj) + (Arrow (Arrow C C) TRcd_j). (* Top->{k:A->A,j:B->B} <: (C->C)->{j:B->B} *) Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (subtyping_example_3) *) +(** **** 练习:1 星, standard (subtyping_example_3) *) Example subtyping_example_3 : - subtype (TArrow TRNil (TRCons j A TRNil)) - (TArrow (TRCons k B TRNil) TRNil). + subtype (Arrow RNil (RCons j A RNil)) + (Arrow (RCons k B RNil) RNil). (* {}->{j:A} <: {k:B}->{} *) Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (subtyping_example_4) *) +(** **** 练习:2 星, standard (subtyping_example_4) *) Example subtyping_example_4 : - subtype (TRCons x A (TRCons y B (TRCons z C TRNil))) - (TRCons z C (TRCons y B (TRCons x A TRNil))). + subtype (RCons x A (RCons y B (RCons z C RNil))) + (RCons z C (RCons y B (RCons x A RNil))). (* {x:A,y:B,z:C} <: {z:C,y:B,x:A} *) Proof with eauto. (* 请在此处解答 *) Admitted. @@ -322,7 +323,7 @@ Lemma wf_rcd_lookup : forall i T Ti, Proof with eauto. intros i T. induction T; intros; try solve_by_invert. - - (* TRCons *) + - (* RCons *) inversion H. subst. unfold Tlookup in H0. destruct (eqb_string i s)... inversion H0; subst... Qed. @@ -369,8 +370,9 @@ Proof with (eauto using wf_rcd_lookup). + (* subtype *) inversion H. subst. inversion H5. subst... Qed. -(** **** 练习:3 星 (rcd_types_match_informal) *) -(** Write a careful informal proof of the [rcd_types_match] +(** **** 练习:3 星, standard (rcd_types_match_informal) + + Write a careful informal proof of the [rcd_types_match] lemma. *) (* 请在此处解答 *) @@ -382,14 +384,14 @@ Definition manual_grade_for_rcd_types_match_informal : option (nat*string) := No (* ----------------------------------------------------------------- *) (** *** Inversion Lemmas *) -(** **** 练习:3 星, optional (sub_inversion_arrow) *) +(** **** 练习:3 星, standard, optional (sub_inversion_arrow) *) Lemma sub_inversion_arrow : forall U V1 V2, - subtype U (TArrow V1 V2) -> + subtype U (Arrow V1 V2) -> exists U1 U2, - (U=(TArrow U1 U2)) /\ (subtype V1 U1) /\ (subtype U2 V2). + (U=(Arrow U1 U2)) /\ (subtype V1 U1) /\ (subtype U2 V2). Proof with eauto. intros U V1 V2 Hs. - remember (TArrow V1 V2) as V. + remember (Arrow V1 V2) as V. generalize dependent V2. generalize dependent V1. (* 请在此处解答 *) Admitted. (** [] *) @@ -405,19 +407,19 @@ Inductive has_type : context -> tm -> ty -> Prop := | T_Var : forall Gamma x T, Gamma x = Some T -> well_formed_ty T -> - Gamma |- tvar x \in T + Gamma |- var x \in T | T_Abs : forall Gamma x T11 T12 t12, well_formed_ty T11 -> update Gamma x T11 |- t12 \in T12 -> - Gamma |- tabs x T11 t12 \in TArrow T11 T12 + Gamma |- abs x T11 t12 \in Arrow T11 T12 | T_App : forall T1 T2 Gamma t1 t2, - Gamma |- t1 \in TArrow T1 T2 -> + Gamma |- t1 \in Arrow T1 T2 -> Gamma |- t2 \in T1 -> - Gamma |- tapp t1 t2 \in T2 + Gamma |- app t1 t2 \in T2 | T_Proj : forall Gamma i t T Ti, Gamma |- t \in T -> Tlookup i T = Some Ti -> - Gamma |- tproj t i \in Ti + Gamma |- rproj t i \in Ti (* Subsumption *) | T_Sub : forall Gamma t S T, Gamma |- t \in S -> @@ -425,13 +427,13 @@ Inductive has_type : context -> tm -> ty -> Prop := Gamma |- t \in T (* Rules for record terms *) | T_RNil : forall Gamma, - Gamma |- trnil \in TRNil + Gamma |- rnil \in RNil | T_RCons : forall Gamma i t T tr Tr, Gamma |- t \in T -> Gamma |- tr \in Tr -> record_ty Tr -> record_tm tr -> - Gamma |- trcons i t tr \in TRCons i T Tr + Gamma |- rcons i t tr \in RCons i T Tr where "Gamma '|-' t '\in' T" := (has_type Gamma t T). @@ -443,29 +445,29 @@ Hint Constructors has_type. Module Examples2. Import Examples. -(** **** 练习:1 星 (typing_example_0) *) +(** **** 练习:1 星, standard (typing_example_0) *) Definition trcd_kj := - (trcons k (tabs z A (tvar z)) - (trcons j (tabs z B (tvar z)) - trnil)). + (rcons k (abs z A (var z)) + (rcons j (abs z B (var z)) + rnil)). Example typing_example_0 : has_type empty - (trcons k (tabs z A (tvar z)) - (trcons j (tabs z B (tvar z)) - trnil)) + (rcons k (abs z A (var z)) + (rcons j (abs z B (var z)) + rnil)) TRcd_kj. (* empty |- {k=(\z:A.z), j=(\z:B.z)} : {k:A->A,j:B->B} *) Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (typing_example_1) *) +(** **** 练习:2 星, standard (typing_example_1) *) Example typing_example_1 : has_type empty - (tapp (tabs x TRcd_j (tproj (tvar x) j)) + (app (abs x TRcd_j (rproj (var x) j)) (trcd_kj)) - (TArrow B B). + (Arrow B B). (* empty |- (\x:{k:A->A,j:B->B}. x.j) {k=(\z:A.z), j=(\z:B.z)} : B->B *) @@ -473,15 +475,15 @@ Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (typing_example_2) *) +(** **** 练习:2 星, standard, optional (typing_example_2) *) Example typing_example_2 : has_type empty - (tapp (tabs z (TArrow (TArrow C C) TRcd_j) - (tproj (tapp (tvar z) - (tabs x C (tvar x))) + (app (abs z (Arrow (Arrow C C) TRcd_j) + (rproj (app (var z) + (abs x C (var x))) j)) - (tabs z (TArrow C C) trcd_kj)) - (TArrow B B). + (abs z (Arrow C C) trcd_kj)) + (Arrow B B). (* empty |- (\z:(C->C)->{j:B->B}. (z (\x:C.x)).j) (\z:C->C. {k=(\z:A.z), j=(\z:B.z)}) : B->B *) @@ -513,7 +515,7 @@ Qed. Lemma step_preserves_record_tm : forall tr tr', record_tm tr -> - tr ==> tr' -> + tr --> tr' -> record_tm tr'. Proof. intros tr tr' Hrt Hstp. @@ -548,19 +550,19 @@ Proof with eauto. (* ----------------------------------------------------------------- *) (** *** Progress *) -(** **** 练习:3 星 (canonical_forms_of_arrow_types) *) +(** **** 练习:3 星, standard (canonical_forms_of_arrow_types) *) Lemma canonical_forms_of_arrow_types : forall Gamma s T1 T2, - has_type Gamma s (TArrow T1 T2) -> + has_type Gamma s (Arrow T1 T2) -> value s -> exists x S1 s2, - s = tabs x S1 s2. + s = abs x S1 s2. Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) Theorem progress : forall t T, has_type empty t T -> - value t \/ exists t', t ==> t'. + value t \/ exists t', t --> t'. Proof with eauto. intros t T Ht. remember empty as Gamma. @@ -579,29 +581,29 @@ Proof with eauto. as [x [S1 [t12 Heqt1]]]... subst. exists ([x:=t2]t12)... * (* t2 steps *) - destruct H0 as [t2' Hstp]. exists (tapp t1 t2')... + destruct H0 as [t2' Hstp]. exists (app t1 t2')... + (* t1 steps *) - destruct H as [t1' Hstp]. exists (tapp t1' t2)... + destruct H as [t1' Hstp]. exists (app t1' t2)... - (* T_Proj *) right. destruct IHHt... + (* rcd is value *) destruct (lookup_field_in_value t T i Ti) as [t' [Hget Ht']]... + (* rcd_steps *) - destruct H0 as [t' Hstp]. exists (tproj t' i)... + destruct H0 as [t' Hstp]. exists (rproj t' i)... - (* T_RCons *) destruct IHHt1... + (* head is a value *) destruct IHHt2... * (* tail steps *) right. destruct H2 as [tr' Hstp]. - exists (trcons i t tr')... + exists (rcons i t tr')... + (* head steps *) right. destruct H1 as [t' Hstp]. - exists (trcons i t' tr)... Qed. + exists (rcons i t' tr)... Qed. (** _Theorem_ : For any term [t] and type [T], if [empty |- t : T] - then [t] is a value or [t ==> t'] for some term [t']. + then [t] is a value or [t --> t'] for some term [t']. _Proof_: Let [t] and [T] be given such that [empty |- t : T]. We proceed by induction on the given typing derivation. @@ -620,30 +622,30 @@ Proof with eauto. that [t1] is a value or steps, and that [t2] is a value or steps. - - Suppose [t1 ==> t1'] for some term [t1']. Then [t1 t2 ==> + - Suppose [t1 --> t1'] for some term [t1']. Then [t1 t2 --> t1' t2] by [ST_App1]. - Otherwise [t1] is a value. - - Suppose [t2 ==> t2'] for some term [t2']. Then [t1 t2 ==> + - Suppose [t2 --> t2'] for some term [t2']. Then [t1 t2 --> t1 t2'] by rule [ST_App2] because [t1] is a value. - Otherwise, [t2] is a value. By Lemma [canonical_forms_for_arrow_types], [t1 = \x:S1.s2] for - some [x], [S1], and [s2]. But then [(\x:S1.s2) t2 ==> + some [x], [S1], and [s2]. But then [(\x:S1.s2) t2 --> [x:=t2]s2] by [ST_AppAbs], since [t2] is a value. - If the last step of the derivation is by [T_Proj], then there are a term [tr], a type [Tr], and a label [i] such that [t = tr.i], [empty |- tr : Tr], and [Tlookup i Tr = Some T]. - By the IH, either [tr] is a value or it steps. If [tr ==> - tr'] for some term [tr'], then [tr.i ==> tr'.i] by rule + By the IH, either [tr] is a value or it steps. If [tr --> + tr'] for some term [tr'], then [tr.i --> tr'.i] by rule [ST_Proj1]. If [tr] is a value, then Lemma [lookup_field_in_value] yields that there is a term [ti] such that [tlookup i tr = Some ti]. - It follows that [tr.i ==> ti] by rule [ST_ProjRcd]. + It follows that [tr.i --> ti] by rule [ST_ProjRcd]. - 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 @@ -660,13 +662,13 @@ Proof with eauto. that [t1] is a value or steps, and that [tr] is a value or steps. We consider each case: - - Suppose [t1 ==> t1'] for some term [t1']. Then [{i=t1, tr} - ==> {i=t1', tr}] by rule [ST_Rcd_Head]. + - Suppose [t1 --> t1'] for some term [t1']. Then [{i=t1, tr} + --> {i=t1', tr}] by rule [ST_Rcd_Head]. - Otherwise [t1] is a value. - - Suppose [tr ==> tr'] for some term [tr']. Then [{i=t1, - tr} ==> {i=t1, tr'}] by rule [ST_Rcd_Tail], since [t1] is + - Suppose [tr --> tr'] for some term [tr']. Then [{i=t1, + tr} --> {i=t1, tr'}] by rule [ST_Rcd_Tail], since [t1] is a value. - Otherwise, [tr] is also a value. So, [{i=t1, tr}] is a @@ -676,12 +678,12 @@ Proof with eauto. (** *** Inversion Lemmas *) Lemma typing_inversion_var : forall Gamma x T, - has_type Gamma (tvar x) T -> + has_type Gamma (var x) T -> exists S, Gamma x = Some S /\ subtype S T. Proof with eauto. intros Gamma x T Hty. - remember (tvar x) as t. + remember (var x) as t. induction Hty; intros; inversion Heqt; subst; try solve_by_invert. - (* T_Var *) @@ -690,13 +692,13 @@ Proof with eauto. destruct IHHty as [U [Hctx HsubU]]... Qed. Lemma typing_inversion_app : forall Gamma t1 t2 T2, - has_type Gamma (tapp t1 t2) T2 -> + has_type Gamma (app t1 t2) T2 -> exists T1, - has_type Gamma t1 (TArrow T1 T2) /\ + has_type Gamma t1 (Arrow T1 T2) /\ has_type Gamma t2 T1. Proof with eauto. intros Gamma t1 t2 T2 Hty. - remember (tapp t1 t2) as t. + remember (app t1 t2) as t. induction Hty; intros; inversion Heqt; subst; try solve_by_invert. - (* T_App *) @@ -707,12 +709,12 @@ Proof with eauto. exists U1... Qed. Lemma typing_inversion_abs : forall Gamma x S1 t2 T, - has_type Gamma (tabs x S1 t2) T -> - (exists S2, subtype (TArrow S1 S2) T + has_type Gamma (abs x S1 t2) T -> + (exists S2, subtype (Arrow S1 S2) T /\ has_type (update Gamma x S1) t2 S2). Proof with eauto. intros Gamma x S1 t2 T H. - remember (tabs x S1 t2) as t. + remember (abs x S1 t2) as t. induction H; inversion Heqt; subst; intros; try solve_by_invert. - (* T_Abs *) @@ -723,12 +725,12 @@ Proof with eauto. Qed. Lemma typing_inversion_proj : forall Gamma i t1 Ti, - has_type Gamma (tproj t1 i) Ti -> + has_type Gamma (rproj t1 i) Ti -> exists T Si, Tlookup i T = Some Si /\ subtype Si Ti /\ has_type Gamma t1 T. Proof with eauto. intros Gamma i t1 Ti H. - remember (tproj t1 i) as t. + remember (rproj t1 i) as t. induction H; inversion Heqt; subst; intros; try solve_by_invert. - (* T_Proj *) @@ -736,34 +738,34 @@ Proof with eauto. { (* pf of assertion *) apply (wf_rcd_lookup i T Ti)... apply has_type__wf in H... } - exists T. exists Ti... + exists T, Ti... - (* T_Sub *) destruct IHhas_type as [U [Ui [Hget [Hsub Hty]]]]... - exists U. exists Ui... Qed. + exists U, Ui... Qed. Lemma typing_inversion_rcons : forall Gamma i ti tr T, - has_type Gamma (trcons i ti tr) T -> + has_type Gamma (rcons i ti tr) T -> exists Si Sr, - subtype (TRCons i Si Sr) T /\ has_type Gamma ti Si /\ + subtype (RCons i Si Sr) T /\ has_type Gamma ti Si /\ record_tm tr /\ has_type Gamma tr Sr. Proof with eauto. intros Gamma i ti tr T Hty. - remember (trcons i ti tr) as t. + remember (rcons i ti tr) as t. induction Hty; inversion Heqt; subst... - (* T_Sub *) apply IHHty in H0. destruct H0 as [Ri [Rr [HsubRS [HtypRi HtypRr]]]]. - exists Ri. exists Rr... + exists Ri, Rr... - (* T_RCons *) - assert (well_formed_ty (TRCons i T Tr)) as Hwf. + assert (well_formed_ty (RCons i T Tr)) as Hwf. { (* pf of assertion *) apply has_type__wf in Hty1. apply has_type__wf in Hty2... } - exists T. exists Tr... Qed. + exists T, Tr... Qed. Lemma abs_arrow : forall x S1 s2 T1 T2, - has_type empty (tabs x S1 s2) (TArrow T1 T2) -> + has_type empty (abs x S1 s2) (Arrow T1 T2) -> subtype T1 S1 /\ has_type (update empty x S1) s2 T2. Proof with eauto. @@ -779,24 +781,24 @@ Proof with eauto. Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) + appears_free_in x t1 -> appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) + appears_free_in x t2 -> appears_free_in x (app t1 t2) | afi_abs : forall x y T11 t12, y <> x -> appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) + appears_free_in x (abs y T11 t12) | afi_proj : forall x t i, appears_free_in x t -> - appears_free_in x (tproj t i) + appears_free_in x (rproj t i) | afi_rhead : forall x i t tr, appears_free_in x t -> - appears_free_in x (trcons i t tr) + appears_free_in x (rcons i t tr) | afi_rtail : forall x i t tr, appears_free_in x tr -> - appears_free_in x (trcons i t tr). + appears_free_in x (rcons i t tr). Hint Constructors appears_free_in. @@ -841,7 +843,7 @@ Proof with eauto. intros Gamma x U v t S Htypt Htypv. generalize dependent S. generalize dependent Gamma. induction t; intros; simpl. - - (* tvar *) + - (* var *) rename s into y. destruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub]]. unfold update, t_update in Hctx. @@ -855,17 +857,17 @@ Proof with eauto. inversion HT'. + (* x<>y *) destruct (subtype__wf _ _ Hsub)... - - (* tapp *) + - (* app *) destruct (typing_inversion_app _ _ _ _ Htypt) as [T1 [Htypt1 Htypt2]]. eapply T_App... - - (* tabs *) + - (* abs *) rename s into y. rename t into T1. destruct (typing_inversion_abs _ _ _ _ _ Htypt) as [T2 [Hsub Htypt2]]. destruct (subtype__wf _ _ Hsub) as [Hwf1 Hwf2]. inversion Hwf2. subst. - apply T_Sub with (TArrow T1 T2)... apply T_Abs... + apply T_Sub with (Arrow T1 T2)... apply T_Abs... destruct (eqb_stringP x y). + (* x=y *) eapply context_invariance... @@ -877,16 +879,16 @@ Proof with eauto. intros z Hafi. unfold update, t_update. destruct (eqb_stringP y z)... subst. rewrite false_eqb_string... - - (* tproj *) + - (* rproj *) destruct (typing_inversion_proj _ _ _ _ Htypt) as [T [Ti [Hget [Hsub Htypt1]]]]... - - (* trnil *) + - (* rnil *) eapply context_invariance... intros y Hcontra. inversion Hcontra. - - (* trcons *) + - (* rcons *) destruct (typing_inversion_rcons _ _ _ _ _ Htypt) as [Ti [Tr [Hsub [HtypTi [Hrcdt2 HtypTr]]]]]. - apply T_Sub with (TRCons s Ti Tr)... + apply T_Sub with (RCons s Ti Tr)... apply T_RCons... + (* record_ty Tr *) apply subtype__wf in Hsub. destruct Hsub. inversion H0... @@ -895,7 +897,7 @@ Proof with eauto. Theorem preservation : forall t t' T, has_type empty t T -> - t ==> t' -> + t --> t' -> has_type empty t' T. Proof with eauto. intros t t' T HT. @@ -916,7 +918,7 @@ Proof with eauto. eauto using step_preserves_record_tm. Qed. (** _Theorem_: If [t], [t'] are terms and [T] is a type such that - [empty |- t : T] and [t ==> t'], then [empty |- t' : T]. + [empty |- t : T] and [t --> t'], then [empty |- t' : T]. _Proof_: Let [t] and [T] be given such that [empty |- t : T]. We go by induction on the structure of this typing derivation, leaving @@ -946,7 +948,7 @@ Proof with eauto. [empty |- tr : Tr], and [Tlookup i Tr = Some T]. The IH for the typing derivation gives us that, for any term - [tr'], if [tr ==> tr'] then [empty |- tr' Tr]. Inspection of + [tr'], if [tr --> tr'] then [empty |- tr' Tr]. Inspection of the definition of the step relation reveals that there are two ways a projection can step. Case [ST_Proj1] follows immediately by the IH. @@ -973,5 +975,4 @@ Proof with eauto. for [tr]'s typing derivation, [T_RCons], and a use of the [step_preserves_record_tm] lemma. *) -(** $Date$ *) - +(* Sat Jan 26 15:15:45 UTC 2019 *) diff --git a/plf-current/RecordSubTest.v b/plf-current/RecordSubTest.v index 868c9645..e57a4b91 100644 --- a/plf-current/RecordSubTest.v +++ b/plf-current/RecordSubTest.v @@ -50,8 +50,8 @@ idtac " ". idtac "#> Examples.subtyping_example_2". idtac "Possible points: 1". check_type @Examples.subtyping_example_2 ( -(TArrow TTop Examples.TRcd_kj <: - TArrow (TArrow Examples.C Examples.C) Examples.TRcd_j)). +(Arrow Top Examples.TRcd_kj <: + Arrow (Arrow Examples.C Examples.C) Examples.TRcd_j)). idtac "Assumptions:". Abort. Print Assumptions Examples.subtyping_example_2. @@ -64,8 +64,8 @@ idtac " ". idtac "#> Examples.subtyping_example_3". idtac "Possible points: 1". check_type @Examples.subtyping_example_3 ( -(TArrow TRNil (TRCons "j" Examples.A TRNil) <: - TArrow (TRCons "k" Examples.B TRNil) TRNil)). +(Arrow RNil (RCons "j" Examples.A RNil) <: + Arrow (RCons "k" Examples.B RNil) RNil)). idtac "Assumptions:". Abort. Print Assumptions Examples.subtyping_example_3. @@ -78,8 +78,8 @@ idtac " ". idtac "#> Examples.subtyping_example_4". idtac "Possible points: 2". check_type @Examples.subtyping_example_4 ( -(TRCons "x" Examples.A (TRCons "y" Examples.B (TRCons "z" Examples.C TRNil)) <: - TRCons "z" Examples.C (TRCons "y" Examples.B (TRCons "x" Examples.A TRNil)))). +(RCons "x" Examples.A (RCons "y" Examples.B (RCons "z" Examples.C RNil)) <: + RCons "z" Examples.C (RCons "y" Examples.B (RCons "x" Examples.A RNil)))). idtac "Assumptions:". Abort. Print Assumptions Examples.subtyping_example_4. @@ -101,9 +101,8 @@ idtac "#> Examples2.typing_example_0". idtac "Possible points: 1". check_type @Examples2.typing_example_0 ( (@Maps.empty ty - |- trcons "k" (tabs "z" Examples.A (tvar "z")) - (trcons "j" (tabs "z" Examples.B (tvar "z")) trnil) \in - Examples.TRcd_kj)). + |- rcons "k" (abs "z" Examples.A (var "z")) + (rcons "j" (abs "z" Examples.B (var "z")) rnil) \in Examples.TRcd_kj)). idtac "Assumptions:". Abort. Print Assumptions Examples2.typing_example_0. @@ -117,8 +116,8 @@ idtac "#> Examples2.typing_example_1". idtac "Possible points: 2". check_type @Examples2.typing_example_1 ( (@Maps.empty ty - |- tapp (tabs "x" Examples.TRcd_j (tproj (tvar "x") "j")) Examples2.trcd_kj \in - TArrow Examples.B Examples.B)). + |- app (abs "x" Examples.TRcd_j (rproj (var "x") "j")) Examples2.trcd_kj \in + Arrow Examples.B Examples.B)). idtac "Assumptions:". Abort. Print Assumptions Examples2.typing_example_1. @@ -132,8 +131,8 @@ idtac "#> canonical_forms_of_arrow_types". idtac "Possible points: 3". check_type @canonical_forms_of_arrow_types ( (forall (Gamma : context) (s : tm) (T1 T2 : ty), - Gamma |- s \in TArrow T1 T2 -> - value s -> exists (x : String.string) (S1 : ty) (s2 : tm), s = tabs x S1 s2)). + Gamma |- s \in Arrow T1 T2 -> + value s -> exists (x : String.string) (S1 : ty) (s2 : tm), s = abs x S1 s2)). idtac "Assumptions:". Abort. Print Assumptions canonical_forms_of_arrow_types. @@ -167,3 +166,5 @@ Print Assumptions canonical_forms_of_arrow_types. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:35 UTC 2019 *) diff --git a/plf-current/Records.html b/plf-current/Records.html index 0dfa09ff..f8550236 100644 --- a/plf-current/Records.html +++ b/plf-current/Records.html @@ -35,6 +35,7 @@

              RecordsAdding Records to STLC
              Set Warnings "-notation-overridden,-parsing".
              +From Coq Require Import Strings.String.
              From PLF Require Import Maps.
              From PLF Require Import Imp.
              From PLF Require Import Smallstep.
              @@ -121,7 +122,7 @@

              RecordsAdding Records to STLC Typing:
              - + @@ -129,12 +130,12 @@

              RecordsAdding Records to STLC

              - +
              Gamma |- t1 : T1     ...     Gamma |- tn : TnGamma ⊢ t1 : T1     ...     Gamma ⊢ tn : Tn (T_Rcd)  

              Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}Gamma ⊢ {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}
              - + @@ -142,7 +143,7 @@

              RecordsAdding Records to STLC

              - +
              Gamma |- t : {..., i:Ti, ...}Gamma ⊢ t : {..., i:Ti, ...} (T_Proj)  

              Gamma |- t.i : TiGamma ⊢ t.i : Ti
              @@ -171,8 +172,8 @@

              RecordsAdding Records to STLC Module FirstTry.

              Definition alist (X : Type) := list (string * X).

              Inductive ty : Type :=
              -  | TBase : stringty
              -  | TArrow : tytyty
              +  | Base : stringty
              +  | Arrow : tytyty
                | TRcd : (alist ty) → ty.

              @@ -188,11 +189,11 @@

              RecordsAdding Records to STLC (* Check ty_ind.
                 ====>
                  ty_ind :
              -      forall P : ty -> Prop,
              -        (forall i : id, P (TBase i)) ->
              -        (forall t : ty, P t -> forall t0 : ty, P t0 
              -                            -> P (TArrow t t0)) ->
              -        (forall a : alist ty, P (TRcd a)) ->    (* ??? *)
              +      forall P : ty -> Prop,
              +        (forall i : id, P (Base i)) ->
              +        (forall t : ty, P t -> forall t0 : ty, P t0 
              +                            -> P (Arrow t t0)) ->
              +        (forall a : alist ty, P (TRcd a)) ->    (* ??? *)
                      forall t : ty, P t
              *)


              End FirstTry.
              @@ -214,27 +215,27 @@

              RecordsAdding Records to STLC
              Inductive ty : Type :=
              -  | TBase : stringty
              -  | TArrow : tytyty
              -  | TRNil : ty
              -  | TRCons : stringtytyty.
              +  | Base : stringty
              +  | Arrow : tytyty
              +  | RNil : ty
              +  | RCons : stringtytyty.
              Similarly, at the level of terms, we have constructors trnil, - for the empty record, and trcons, which adds a single field to + for the empty record, and rcons, which adds a single field to the front of a list of fields.
              Inductive tm : Type :=
              -  | tvar : stringtm
              -  | tapp : tmtmtm
              -  | tabs : stringtytmtm
              +  | var : stringtm
              +  | app : tmtmtm
              +  | abs : stringtytmtm
                (* records *)
              -  | tproj : tmstringtm
              +  | rproj : tmstringtm
                | trnil : tm
              -  | trcons : stringtmtmtm.
              +  | rcons : stringtmtmtm.
              @@ -246,8 +247,8 @@

              RecordsAdding Records to STLC Notation f := "f".
              Notation g := "g".
              Notation l := "l".
              -Notation A := (TBase "A").
              -Notation B := (TBase "B").
              +Notation A := (Base "A").
              +Notation B := (Base "B").
              Notation k := "k".
              Notation i1 := "i1".
              Notation i2 := "i2".
              @@ -258,7 +259,7 @@

              RecordsAdding Records to STLC

              -(* Check (TRCons i1 A TRNil). *)
              +(* Check (RCons i1 A RNil). *)
              @@ -266,8 +267,8 @@

              RecordsAdding Records to STLC

              -(* Check (TRCons i1 (TArrow A B)
              -           (TRCons i2 A TRNil)). *)

              +(* Check (RCons i1 (Arrow A B)
              +           (RCons i2 A RNil)). *)

              @@ -281,7 +282,7 @@

              RecordsAdding Records to STLC

              -Definition weird_type := TRCons X A B.
              +Definition weird_type := RCons X A B.
              @@ -295,16 +296,16 @@

              RecordsAdding Records to STLC ill-formed types.
              - First, a type is a record type if it is built with just TRNil - and TRCons at the outermost level. + First, a type is a record type if it is built with just RNil + and RCons at the outermost level.

              Inductive record_ty : tyProp :=
                | RTnil :
              -        record_ty TRNil
              -  | RTcons : i T1 T2,
              -        record_ty (TRCons i T1 T2).
              +        record_ty RNil
              +  | RTcons : i T1 T2,
              +        record_ty (RCons i T1 T2).
              @@ -313,19 +314,19 @@

              RecordsAdding Records to STLC
              Inductive well_formed_ty : tyProp :=
              -  | wfTBase : i,
              -        well_formed_ty (TBase i)
              -  | wfTArrow : T1 T2,
              +  | wfBase : i,
              +        well_formed_ty (Base i)
              +  | wfArrow : T1 T2,
                      well_formed_ty T1
                      well_formed_ty T2
              -        well_formed_ty (TArrow T1 T2)
              -  | wfTRNil :
              -        well_formed_ty TRNil
              -  | wfTRCons : i T1 T2,
              +        well_formed_ty (Arrow T1 T2)
              +  | wfRNil :
              +        well_formed_ty RNil
              +  | wfRCons : i T1 T2,
                      well_formed_ty T1
                      well_formed_ty T2
                      record_ty T2
              -        well_formed_ty (TRCons i T1 T2).

              +        well_formed_ty (RCons i T1 T2).

              Hint Constructors record_ty well_formed_ty.
              @@ -334,24 +335,24 @@

              RecordsAdding Records to STLC outermost constructor. The well_formed_ty property, on the other hand, verifies that the whole type is well formed in the sense that the tail of every record (the second argument to - TRCons) is a record. + RCons) is a record.
              Of course, we should also be concerned about ill-formed terms, not - just types; but typechecking can rules those out without the help + just types; but typechecking can rule those out without the help of an extra well_formed_tm definition because it already examines the structure of terms. All we need is an analog of record_ty saying that a term is a record term if it is built - with trnil and trcons. + with trnil and rcons.

              Inductive record_tm : tmProp :=
                | rtnil :
                      record_tm trnil
              -  | rtcons : i t1 t2,
              -        record_tm (trcons i t1 t2).

              +  | rtcons : i t1 t2,
              +        record_tm (rcons i t1 t2).

              Hint Constructors record_tm.
              @@ -366,13 +367,13 @@

              RecordsAdding Records to STLC Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
                match t with
              -  | tvar yif eqb_string x y then s else t
              -  | tabs y T t1tabs y T
              +  | var yif eqb_string x y then s else t
              +  | abs y T t1abs y T
                                   (if eqb_string x y then t1 else (subst x s t1))
              -  | tapp t1 t2tapp (subst x s t1) (subst x s t2)
              -  | tproj t1 itproj (subst x s t1) i
              +  | app t1 t2app (subst x s t1) (subst x s t2)
              +  | rproj t1 irproj (subst x s t1) i
                | trniltrnil
              -  | trcons i t1 tr1trcons i (subst x s t1) (subst x s tr1)
              +  | rcons i t1 tr1rcons i (subst x s t1) (subst x s tr1)
                end.

              Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).

              @@ -387,13 +388,13 @@

              RecordsAdding Records to STLC
              Inductive value : tmProp :=
              -  | v_abs : x T11 t12,
              -      value (tabs x T11 t12)
              +  | v_abs : x T11 t12,
              +      value (abs x T11 t12)
                | v_rnil : value trnil
              -  | v_rcons : i v1 vr,
              +  | v_rcons : i v1 vr,
                    value v1
                    value vr
              -      value (trcons i v1 vr).

              +      value (rcons i v1 vr).

              Hint Constructors value.
              @@ -405,7 +406,7 @@

              RecordsAdding Records to STLC Fixpoint tlookup (i:string) (tr:tm) : option tm :=
                match tr with
              -  | trcons i' t tr'if eqb_string i i' then Some t else tlookup i tr'
              +  | rcons i' t tr'if eqb_string i i' then Some t else tlookup i tr'
                | _None
                end.

              @@ -416,36 +417,36 @@

              RecordsAdding Records to STLC

              -Reserved Notation "t1 '==>' t2" (at level 40).

              +Reserved Notation "t1 '-->' t2" (at level 40).

              Inductive step : tmtmProp :=
              -  | ST_AppAbs : x T11 t12 v2,
              +  | 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',
              +         (app (abs x T11 t12) v2) --> ([x:=v2]t12)
              +  | ST_App1 : t1 t1' t2,
              +         t1 --> t1'
              +         (app t1 t2) --> (app t1' t2)
              +  | ST_App2 : v1 t2 t2',
                       value v1
              -         t2 ==> t2'
              -         (tapp v1 t2) ==> (tapp v1 t2')
              -  | ST_Proj1 : t1 t1' i,
              -        t1 ==> t1'
              -        (tproj t1 i) ==> (tproj t1' i)
              -  | ST_ProjRcd : tr i vi,
              +         t2 --> t2'
              +         (app v1 t2) --> (app v1 t2')
              +  | ST_Proj1 : t1 t1' i,
              +        t1 --> t1'
              +        (rproj t1 i) --> (rproj t1' i)
              +  | ST_ProjRcd : tr i vi,
                      value tr
                      tlookup i tr = Some vi
              -        (tproj tr i) ==> vi
              -  | ST_Rcd_Head : i t1 t1' tr2,
              -        t1 ==> t1'
              -        (trcons i t1 tr2) ==> (trcons i t1' tr2)
              -  | ST_Rcd_Tail : i v1 tr2 tr2',
              +        (rproj tr i) --> vi
              +  | ST_Rcd_Head : i t1 t1' tr2,
              +        t1 --> t1'
              +        (rcons i t1 tr2) --> (rcons i t1' tr2)
              +  | ST_Rcd_Tail : i v1 tr2 tr2',
                      value v1
              -        tr2 ==> tr2'
              -        (trcons i v1 tr2) ==> (trcons i v1 tr2')
              +        tr2 --> tr2'
              +        (rcons i v1 tr2) --> (rcons i v1 tr2')

              -where "t1 '==>' t2" := (step t1 t2).

              +where "t1 '-->' t2" := (step t1 t2).

              Notation multistep := (multi step).
              -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40).

              +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).

              Hint Constructors step.
              @@ -481,40 +482,40 @@

              RecordsAdding Records to STLC Fixpoint Tlookup (i:string) (Tr:ty) : option ty :=
                match Tr with
              -  | TRCons i' T Tr'
              +  | RCons i' T Tr'
                    if eqb_string i i' then Some T else Tlookup i Tr'
                | _None
                end.

              Definition context := partial_map ty.

              -Reserved Notation "Gamma '|-' t '∈' T" (at level 40).

              +Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).

              Inductive has_type : contexttmtyProp :=
              -  | T_Var : Gamma x T,
              +  | T_Var : Gamma x T,
                    Gamma x = Some T
                    well_formed_ty T
              -      Gamma |- (tvar x) ∈ T
              -  | T_Abs : Gamma x T11 T12 t12,
              +      Gamma ⊢ (var x) ∈ T
              +  | T_Abs : Gamma x T11 T12 t12,
                    well_formed_ty T11
              -      (update Gamma x T11) |- t12T12
              -      Gamma |- (tabs x T11 t12) ∈ (TArrow T11 T12)
              -  | T_App : T1 T2 Gamma t1 t2,
              -      Gamma |- t1 ∈ (TArrow T1 T2) →
              -      Gamma |- t2T1
              -      Gamma |- (tapp t1 t2) ∈ T2
              +      (update Gamma x T11) ⊢ t12T12
              +      Gamma ⊢ (abs x T11 t12) ∈ (Arrow T11 T12)
              +  | T_App : T1 T2 Gamma t1 t2,
              +      Gammat1 ∈ (Arrow T1 T2) →
              +      Gammat2T1
              +      Gamma ⊢ (app t1 t2) ∈ T2
                (* records: *)
              -  | T_Proj : Gamma i t Ti Tr,
              -      Gamma |- tTr
              +  | T_Proj : Gamma i t Ti Tr,
              +      GammatTr
                    Tlookup i Tr = Some Ti
              -      Gamma |- (tproj t i) ∈ Ti
              -  | T_RNil : Gamma,
              -      Gamma |- trnilTRNil
              -  | T_RCons : Gamma i t T tr Tr,
              -      Gamma |- tT
              -      Gamma |- trTr
              +      Gamma ⊢ (rproj t i) ∈ Ti
              +  | T_RNil : Gamma,
              +      GammatrnilRNil
              +  | T_RCons : Gamma i t T tr Tr,
              +      GammatT
              +      GammatrTr
                    record_ty Tr
                    record_tm tr
              -      Gamma |- (trcons i t tr) ∈ (TRCons i T Tr)
              +      Gamma ⊢ (rcons i t tr) ∈ (RCons i T Tr)

              -where "Gamma '|-' t '∈' T" := (has_type Gamma t T).

              +where "Gamma '⊢' t '∈' T" := (has_type Gamma t T).

              Hint Constructors has_type.

              @@ -523,43 +524,43 @@

              RecordsAdding Records to STLC
              -

              练习:2 星 (examples)

              +

              练习:2 星, standard (examples)

              Finish the proofs below. Feel free to use Coq's automation features in this proof. However, if you are not confident about how the type system works, you may want to carry out the proofs first using the basic features (apply instead of eapply, in particular) and then perhaps compress it using automation. Before starting to prove anything, make sure you understand what it is - saying. + saying.
              Lemma typing_example_2 :
              -  empty |-
              -    (tapp (tabs a (TRCons i1 (TArrow A A)
              -                      (TRCons i2 (TArrow B B)
              -                       TRNil))
              -              (tproj (tvar a) i2))
              -            (trcons i1 (tabs a A (tvar a))
              -            (trcons i2 (tabs a B (tvar a))
              +  empty
              +    (app (abs a (RCons i1 (Arrow A A)
              +                      (RCons i2 (Arrow B B)
              +                       RNil))
              +              (rproj (var a) i2))
              +            (rcons i1 (abs a A (var a))
              +            (rcons i2 (abs a B (var a))
                           trnil))) ∈
              -    (TArrow B B).
              +    (Arrow B B).
              Proof.
                (* 请在此处解答 *) Admitted.

              Example typing_nonexample :
              -  ¬ T,
              -      (update empty a (TRCons i2 (TArrow A A)
              -                                TRNil)) |-
              -               (trcons i1 (tabs a B (tvar a)) (tvar a)) ∈
              +  ¬T,
              +      (update empty a (RCons i2 (Arrow A A)
              +                                RNil)) ⊢
              +               (rcons i1 (abs a B (var a)) (var a)) ∈
                             T.
              Proof.
                (* 请在此处解答 *) Admitted.

              -Example typing_nonexample_2 : y,
              -  ¬ T,
              -    (update empty y A) |-
              -           (tapp (tabs a (TRCons i1 A TRNil)
              -                     (tproj (tvar a) i1))
              -                   (trcons i1 (tvar y) (trcons i2 (tvar y) trnil))) ∈
              +Example typing_nonexample_2 : y,
              +  ¬T,
              +    (update empty y A) ⊢
              +           (app (abs a (RCons i1 A RNil)
              +                     (rproj (var a) i1))
              +                   (rcons i1 (var y) (rcons i2 (var y) trnil))) ∈
                         T.
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -582,7 +583,7 @@

              RecordsAdding Records to STLC

              -Lemma wf_rcd_lookup : i T Ti,
              +Lemma wf_rcd_lookup : i T Ti,
                well_formed_ty T
                Tlookup i T = Some Ti
                well_formed_ty Ti.
              @@ -591,16 +592,16 @@

              RecordsAdding Records to STLC Proof with eauto.
                intros i T.
                induction T; intros; try solve_by_invert.
              -  - (* TRCons *)
              +  - (* RCons *)
                  inversion H. subst. unfold Tlookup in H0.
                  destruct (eqb_string i s)...
                  inversion H0. subst... Qed.


              -Lemma step_preserves_record_tm : tr tr',
              +Lemma step_preserves_record_tm : tr tr',
                record_tm tr
              -  tr ==> tr'
              +  tr --> tr'
                record_tm tr'.
              @@ -611,8 +612,8 @@

              RecordsAdding Records to STLC


              -Lemma has_type__wf : Gamma t T,
              -  Gamma |- tTwell_formed_ty T.
              +Lemma has_type__wf : Gamma t T,
              +  GammatTwell_formed_ty T.
              Proof with eauto.
              @@ -631,9 +632,9 @@

              RecordsAdding Records to STLC
              - Lemma: If empty |- v : T and Tlookup i T returns Some Ti, + Lemma: If empty v : T and Tlookup i T returns Some Ti, then tlookup i v returns Some ti for some term ti such - that empty |- ti Ti. + that empty ti Ti.
              @@ -645,7 +646,7 @@

              RecordsAdding Records to STLC
              If the last step in the typing derivation is by T_RCons, then - t = trcons i0 t tr and T = TRCons i0 T Tr for some i0, + t = rcons i0 t tr and T = RCons i0 T Tr for some i0, t, tr, T and Tr.
              @@ -656,7 +657,7 @@

              RecordsAdding Records to STLC
                -
              • If i = i0, then since Tlookup i (TRCons i0 T Tr) = Some +
              • If i = i0, then since Tlookup i (RCons i0 T Tr) = Some Ti we have T = Ti. It follows that t itself satisfies the theorem. @@ -694,11 +695,11 @@

                RecordsAdding Records to STLC

              -Lemma lookup_field_in_value : v T i Ti,
              +Lemma lookup_field_in_value : v T i Ti,
                value v
              -  empty |- vT
              +  emptyvT
                Tlookup i T = Some Ti
              -   ti, tlookup i v = Some tiempty |- tiTi.
              +  ti, tlookup i v = Some tiemptytiTi.
              Proof with eauto.
              @@ -709,7 +710,7 @@

              RecordsAdding Records to STLC     simpl in Hget. simpl. destruct (eqb_string i i0).
                  + (* i is first *)
                    simpl. inversion Hget. subst.
              -       t...
              +      t...
                  + (* get tail *)
                    destruct IHHtyp2 as [vi [Hgeti Htypi]]...
                    inversion Hval... Qed.
              @@ -723,15 +724,15 @@

              RecordsAdding Records to STLC

              -Theorem progress : t T,
              -     empty |- tT
              -     value t t', t ==> t'.
              +Theorem progress : t T,
              +     emptytT
              +     value tt', t --> t'.
              Proof with eauto.
              -  (* Theorem: Suppose empty |- t : T.  Then either
              +  (* Theorem: Suppose empty ⊢ t : T.  Then either
                     1. t is a value, or
              -       2. t ==> t' for some t'.
              +       2. t --> t' for some t'.
                   Proof: By induction on the given typing derivation. *)

                intros t T Ht.
                remember (@empty ty) as Gamma.
              @@ -740,17 +741,17 @@

              RecordsAdding Records to STLC   - (* 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). *)

              +       empty x : T (since the context is empty). *)
                  inversion H.
                - (* T_Abs *)
                  (* If the T_Abs rule was the last used, then 
              -       t = tabs x T11 t12, which is a value. *)

              +       t = abs x T11 t12, which is a value. *)
                  left...
                - (* 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
              +         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.
              @@ -759,66 +760,66 @@

              RecordsAdding Records to STLC       destruct IHHt2; subst...
                    * (* 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 
              +         t1 = abs 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. *)

              +         (abs x T11 t12) t2 --> [x:=t2]t12 by ST_AppAbs. *)
                      inversion H; subst; try solve_by_invert.
              -         ([x:=t2]t12)...
              +        ([x:=t2]t12)...
                    * (* t2 steps *)
              -        (* If t1 is a value and t2 ==> t2', then 
              -           t1 t2 ==> t1 t2' by ST_App2. *)

              -        destruct H0 as [t2' Hstp]. (tapp t1 t2')...
              +        (* If t1 is a value and t2 --> t2', then
              +           t1 t2 --> t1 t2' by ST_App2. *)

              +        destruct H0 as [t2' Hstp]. (app t1 t2')...
                  + (* t1 steps *)
              -      (* Finally, If t1 ==> t1', then t1 t2 ==> t1' t2 
              +      (* Finally, If t1 --> t1', then t1 t2 --> t1' t2
                       by ST_App1. *)

              -      destruct H as [t1' Hstp]. (tapp t1' t2)...
              +      destruct H as [t1' Hstp]. (app t1' t2)...
                - (* T_Proj *)
                  (* If the last rule in the given derivation is T_Proj, then
              -       t = tproj t i and
              -           empty |- t : (TRcd Tr)
              +       t = rproj t i and
              +           empty t : (TRcd Tr)
                     By the IH, t either is a value or takes a step. *)

                  right. destruct IHHt...
                  + (* rcd is value *)
                    (* If t is a value, then we may use lemma
                       lookup_field_in_value to show tlookup i t = Some ti 
              -         for some ti which gives us tproj i t ==> ti by 
              +         for some ti which gives us rproj i t --> ti by
                       ST_ProjRcd. *)

                    destruct (lookup_field_in_value _ _ _ _ H0 Ht H)
                      as [ti [Hlkup _]].
              -       ti...
              +      ti...
                  + (* rcd_steps *)
              -      (* On the other hand, if t ==> t', then 
              -         tproj t i ==> tproj t' i by ST_Proj1. *)

              -      destruct H0 as [t' Hstp]. (tproj t' i)...
              +      (* On the other hand, if t --> t', then
              +         rproj t i --> rproj t' i by ST_Proj1. *)

              +      destruct H0 as [t' Hstp]. (rproj t' i)...
                - (* T_RNil *)
                  (* If the last rule in the given derivation is T_RNil
                     then t = trnil, which is a value. *)

                  left...
                - (* T_RCons *)
              -    (* If the last rule is T_RCons, then t = trcons i t tr and
              -         empty |- t : T
              -         empty |- tr : Tr
              +    (* If the last rule is T_RCons, then t = rcons i t tr and
              +         empty t : T
              +         empty tr : Tr
                     By the IH, each of t and tr either is a value or can 
                     take a step. *)

                  destruct IHHt1...
                  + (* head is a value *)
                    destruct IHHt2; try reflexivity.
                    * (* tail is a value *)
              -      (* If t and tr are both values, then trcons i t tr
              +      (* If t and tr are both values, then rcons i t tr
                       is a value as well. *)

                      left...
                    * (* tail steps *)
              -        (* If t is a value and tr ==> tr', then
              -           trcons i t tr ==> trcons i t tr' by
              +        (* If t is a value and tr --> tr', then
              +           rcons i t tr --> rcons i t tr' by
                         ST_Rcd_Tail. *)

                      right. destruct H2 as [tr' Hstp].
              -         (trcons i t tr')...
              +        (rcons i t tr')...
                  + (* head steps *)
              -      (* If t ==> t', then
              -         trcons i t tr ==> trcons i t' tr
              +      (* If t --> t', then
              +         rcons i t tr --> rcons i t' tr
                       by ST_Rcd_Head. *)

                    right. destruct H1 as [t' Hstp].
              -       (trcons i t' tr)... Qed.
              +      (rcons i t' tr)... Qed.

              @@ -830,30 +831,30 @@

              RecordsAdding Records to STLC
              Inductive appears_free_in : stringtmProp :=
              -  | afi_var : x,
              -      appears_free_in x (tvar x)
              -  | afi_app1 : x t1 t2,
              -      appears_free_in x t1appears_free_in x (tapp t1 t2)
              -  | afi_app2 : x t1 t2,
              -      appears_free_in x t2appears_free_in x (tapp t1 t2)
              -  | afi_abs : x y T11 t12,
              +  | afi_var : x,
              +      appears_free_in x (var x)
              +  | afi_app1 : x t1 t2,
              +      appears_free_in x t1appears_free_in x (app t1 t2)
              +  | afi_app2 : x t1 t2,
              +      appears_free_in x t2appears_free_in x (app t1 t2)
              +  | afi_abs : x y T11 t12,
                      yx
                      appears_free_in x t12
              -        appears_free_in x (tabs y T11 t12)
              -  | afi_proj : x t i,
              +        appears_free_in x (abs y T11 t12)
              +  | afi_proj : x t i,
                   appears_free_in x t
              -     appears_free_in x (tproj t i)
              -  | afi_rhead : x i ti tr,
              +     appears_free_in x (rproj t i)
              +  | afi_rhead : x i ti tr,
                    appears_free_in x ti
              -      appears_free_in x (trcons i ti tr)
              -  | afi_rtail : x i ti tr,
              +      appears_free_in x (rcons i ti tr)
              +  | afi_rtail : x i ti tr,
                    appears_free_in x tr
              -      appears_free_in x (trcons i ti tr).

              +      appears_free_in x (rcons i ti tr).

              Hint Constructors appears_free_in.

              -Lemma context_invariance : Gamma Gamma' t S,
              -     Gamma |- tS
              -     ( x, appears_free_in x tGamma x = Gamma' x) →
              -     Gamma' |- tS.
              +Lemma context_invariance : Gamma Gamma' t S,
              +     GammatS
              +     (x, appears_free_in x tGamma x = Gamma' x) →
              +     Gamma'tS.
              Proof with eauto.
              @@ -872,17 +873,17 @@

              RecordsAdding Records to STLC


              -Lemma free_in_context : x t T Gamma,
              +Lemma free_in_context : x t T Gamma,
                 appears_free_in x t
              -   Gamma |- tT
              -    T', Gamma x = Some T'.
              +   GammatT
              +   T', Gamma x = Some T'.
              Proof with eauto.
                intros x t T Gamma Hafi Htyp.
                induction Htyp; inversion Hafi; subst...
                - (* T_Abs *)
              -    destruct IHHtyp as [T' Hctx]... T'.
              +    destruct IHHtyp as [T' Hctx]... T'.
                  unfold update, t_update in Hctx.
                  rewrite false_eqb_string in Hctx...
              Qed.
              @@ -896,31 +897,31 @@

              RecordsAdding Records to STLC

              -Lemma substitution_preserves_typing : Gamma x U v t S,
              -     (update Gamma x U) |- tS
              -     empty |- vU
              -     Gamma |- ([x:=v]t) ∈ S.
              +Lemma substitution_preserves_typing : Gamma x U v t S,
              +     (update Gamma x U) ⊢ tS
              +     emptyvU
              +     Gamma ⊢ ([x:=v]t) ∈ S.
              Proof with eauto.
              -  (* Theorem: If Gamma,x:U |- t : S and empty |- v : U, then
              -     Gamma |- (x:=vt) S. *)

              +  (* Theorem: If x>U;Gamma ⊢ t : S and empty ⊢ v : U, then
              +     Gamma ⊢ (x:=vt) 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, 
              -     tabs, trcons. The former aren't automatic because we 
              +     directly from the IH, with the exception of var, 
              +     abs, rcons. The former aren't automatic because we 
                   must reason about how the variables interact. In the 
              -     case of trcons, we must do a little extra work to show 
              +     case of rcons, we must do a little extra work to show 
                   that substituting into a term doesn't change whether 
                   it is a record term. *)

                induction t;
                  intros S Gamma Htypt; simpl; inversion Htypt; subst...
              -  - (* tvar *)
              +  - (* var *)
                  simpl. rename s into y.
                  (* If t = y, we know that
              -         empty |- v : U and
              -         Gamma,x:U |- y : S
              +         empty v : U and
              +         x>U; Gamma y : S
                     and, by inversion, update Gamma x U y = Some S.  
              -       We want to show that Gamma |- [x:=v]y : S.
              +       We want to show that Gamma [x:=v]y : S.

                     There are two cases to consider: either x=y or xy. *)

                  unfold update, t_update in H0.
              @@ -928,7 +929,7 @@

              RecordsAdding Records to STLC     + (* 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
              +       if empty v : U then Gamma v : U.  We have
                      already proven a more general version of this theorem, 
                      called context invariance! *)

                    subst.
              @@ -940,29 +941,29 @@

              RecordsAdding Records to STLC       inversion HT'.
                  + (* x<>y *)
                  (* If x y, then Gamma y = Some S and the substitution
              -       has no effect.  We can show that Gamma |- y : S by 
              +       has no effect.  We can show that Gamma y : S by 
                     T_Var. *)

                    apply T_Var...
              -  - (* tabs *)
              +  - (* abs *)
                  rename s into y. rename t into T11.
              -    (* If t = tabs y T11 t0, then we know that
              -         Gamma,x:U |- tabs y T11 t0 : T11T12
              -         Gamma,x:U,y:T11 |- t0 : T12
              -         empty |- v : U
              +    (* If t = abs y T11 t0, then we know that
              +         x>U; Gamma abs y T11 t0 : T11T12
              +         x>U; y>T11; Gamma t0 : T12
              +         empty v : U
                     As our IH, we know that forall S Gamma,
              -         Gamma,x:U |- t0 : S Gamma |- [x:=v]t0 S.
              +         x>U; Gamma t0 : S Gamma [x:=v]t0 S.

                     We can calculate that
              -        [x:=v]t = tabs y T11 (if eqb_string x y then t0 else [x:=v]t0) ,
              -       and we must show that Gamma |- [x:=v]t : T11T12.  We know
              +        [x:=v]t = abs y T11 (if eqb_string x y then t0 else [x:=v]t0) ,
              +       and we must show that Gamma [x:=v]t : T11T12.  We know
                     we will do so using T_Abs, so it remains to be shown that:
              -         Gamma,y:T11 |- if eqb_string x y then t0 else [x:=v]t0 : T12
              +         y>T11; Gamma if eqb_string x y then t0 else [x:=v]t0 : T12
                     We consider two cases: x = y and x y. *)

                  apply T_Abs...
                  destruct (eqb_stringP x y) as [Hxy|Hxy].
                  + (* 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
              +         invariance shows that y:U,y:T11 and Gamma,y:T11 are
                       equivalent.  Since t0 : T12 under the former context, 
                       this is also the case under the latter. *)

                    eapply context_invariance...
              @@ -972,24 +973,24 @@

              RecordsAdding Records to STLC     + (* 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 *)

              +           x>U; y>T11; Gamma t0 : T12       =>
              +           y>T11; x>U; Gamma t0 : T12       =>
              +           y>T11; Gamma [x:=v]t0 : T12 *)
                    apply IHt. eapply context_invariance...
                    intros z Hafi. unfold update, t_update.
                    destruct (eqb_stringP y z)...
                    subst. rewrite false_eqb_string...
              -  - (* trcons *)
              +  - (* rcons *)
                  apply T_RCons... inversion H7; subst; simpl...
              Qed.

              -Theorem preservation : t t' T,
              -     empty |- tT
              -     t ==> t'
              -     empty |- t'T.
              +Theorem preservation : t t' T,
              +     emptytT
              +     t --> t'
              +     emptyt'T.
              Proof with eauto.
                intros t t' T HT.
              -  (* Theorem: If empty |- t : T and t ==> t', then 
              -     empty |- t' : T. *)

              +  (* 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.  
              @@ -1000,32 +1001,32 @@

              RecordsAdding Records to STLC     intros t' HeqGamma HE; subst; inversion HE; subst...
                - (* 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'
              +       and three rules could have been used to show t --> t':
                     ST_App1ST_App2, and ST_AppAbs. In the first two 
                     cases, the result follows directly from the IH. *)

                  inversion HE; subst...
                  + (* ST_AppAbs *)
                    (* For the third case, suppose
              -           t1 = tabs x T11 t12
              +           t1 = abs x T11 t12
                       and
              -           t2 = v2.  We must show that empty |- [x:=v2]t12 : T2.
              +           t2 = v2.  We must show that empty [x:=v2]t12 : T2.
                       We know by assumption that
              -             empty |- tabs x T11 t12 : T1T2
              +             empty abs x T11 t12 : T1T2
                       and by inversion
              -             x:T1 |- t12 : T2
              +             x:T1 t12 : T2
                       We have already proven that substitution_preserves_typing and
              -             empty |- v2 : T1
              +             empty v2 : T1
                       by assumption, so we are done. *)

                    apply substitution_preserves_typing with T1...
                    inversion HT1...
                - (* T_Proj *)
              -    (* If the last rule was T_Proj, then t = tproj t1 i.  
              -       Two rules could have caused t ==> t'T_Proj1 and 
              +    (* If the last rule was T_Proj, then t = rproj t1 i.  
              +       Two rules could have caused t --> t'T_Proj1 and
                     T_ProjRcd.  The typing of t' follows from the IH 
                     in the former case, so we only consider T_ProjRcd.

                     Here we have that t is a record value.  Since rule 
              -       T_Proj was used, we know empty |- t Tr and 
              +       T_Proj was used, we know empty t Tr and 
                     Tlookup i Tr = Some Ti for some i and Tr.  
                     We may therefore apply lemma lookup_field_in_value 
                     to find the record element this projection steps to. *)

              @@ -1033,10 +1034,10 @@

              RecordsAdding Records to STLC       as [vi [Hget Htyp]].
                  rewrite H4 in Hget. inversion Hget. subst...
                - (* T_RCons *)
              -    (* If the last rule was T_RCons, then t = trcons i t tr 
              +    (* If the last rule was T_RCons, then t = rcons i t tr 
                     for some it and tr such that record_tm tr.  If 
                     the step is by ST_Rcd_Head, the result is immediate by 
              -       the IH.  If the step is by ST_Rcd_Tailtr ==> tr2' 
              +       the IH.  If the step is by ST_Rcd_Tailtr --> tr2'
                     for some tr2' and we must also use lemma step_preserves_record_tm 
                     to show record_tm tr2'. *)

                  apply T_RCons... eapply step_preserves_record_tm...
              @@ -1046,9 +1047,9 @@

              RecordsAdding Records to STLC
              -End STLCExtendedRecords.
              +End STLCExtendedRecords.

              +(* Sat Jan 26 15:15:45 UTC 2019 *)
              -

              diff --git a/plf-current/Records.v b/plf-current/Records.v index dc77f733..fd38142c 100644 --- a/plf-current/Records.v +++ b/plf-current/Records.v @@ -1,6 +1,7 @@ (** * Records: Adding Records to STLC *) Set Warnings "-notation-overridden,-parsing". +From Coq Require Import Strings.String. From PLF Require Import Maps. From PLF Require Import Imp. From PLF Require Import Smallstep. @@ -76,8 +77,8 @@ Module FirstTry. Definition alist (X : Type) := list (string * X). Inductive ty : Type := - | TBase : string -> ty - | TArrow : ty -> ty -> ty + | Base : string -> ty + | Arrow : ty -> ty -> ty | TRcd : (alist ty) -> ty. (** Unfortunately, we encounter here a limitation in Coq: this type @@ -90,9 +91,9 @@ Inductive ty : Type := ====> ty_ind : forall P : ty -> Prop, - (forall i : id, P (TBase i)) -> + (forall i : id, P (Base i)) -> (forall t : ty, P t -> forall t0 : ty, P t0 - -> P (TArrow t t0)) -> + -> P (Arrow t t0)) -> (forall a : alist ty, P (TRcd a)) -> (* ??? *) forall t : ty, P t *) @@ -110,23 +111,23 @@ End FirstTry. constructors ("nil" and "cons") in the syntax of our types. *) Inductive ty : Type := - | TBase : string -> ty - | TArrow : ty -> ty -> ty - | TRNil : ty - | TRCons : string -> ty -> ty -> ty. + | Base : string -> ty + | Arrow : ty -> ty -> ty + | RNil : ty + | RCons : string -> ty -> ty -> ty. (** Similarly, at the level of terms, we have constructors [trnil], - for the empty record, and [trcons], which adds a single field to + for the empty record, and [rcons], which adds a single field to the front of a list of fields. *) Inductive tm : Type := - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm (* records *) - | tproj : tm -> string -> tm + | rproj : tm -> string -> tm | trnil : tm - | trcons : string -> tm -> tm -> tm. + | rcons : string -> tm -> tm -> tm. (** Some examples... *) Open Scope string_scope. @@ -135,20 +136,20 @@ Notation a := "a". Notation f := "f". Notation g := "g". Notation l := "l". -Notation A := (TBase "A"). -Notation B := (TBase "B"). +Notation A := (Base "A"). +Notation B := (Base "B"). Notation k := "k". Notation i1 := "i1". Notation i2 := "i2". (** [{ i1:A }] *) -(* Check (TRCons i1 A TRNil). *) +(* Check (RCons i1 A RNil). *) (** [{ i1:A->B, i2:A }] *) -(* Check (TRCons i1 (TArrow A B) - (TRCons i2 A TRNil)). *) +(* Check (RCons i1 (Arrow A B) + (RCons i2 A RNil)). *) (* ----------------------------------------------------------------- *) (** *** Well-Formedness *) @@ -157,7 +158,7 @@ Notation i2 := "i2". lists to the nil/cons presentation is that it introduces the possibility of writing strange types like this... *) -Definition weird_type := TRCons X A B. +Definition weird_type := RCons X A B. (** where the "tail" of a record type is not actually a record type! *) @@ -167,31 +168,31 @@ Definition weird_type := TRCons X A B. record types and terms, and [well_formed_ty] which rules out the ill-formed types. *) -(** First, a type is a record type if it is built with just [TRNil] - and [TRCons] at the outermost level. *) +(** First, a type is a record type if it is built with just [RNil] + and [RCons] at the outermost level. *) Inductive record_ty : ty -> Prop := | RTnil : - record_ty TRNil + record_ty RNil | RTcons : forall i T1 T2, - record_ty (TRCons i T1 T2). + record_ty (RCons i T1 T2). (** With this, we can define well-formed types. *) Inductive well_formed_ty : ty -> Prop := - | wfTBase : forall i, - well_formed_ty (TBase i) - | wfTArrow : forall T1 T2, + | wfBase : forall i, + well_formed_ty (Base i) + | wfArrow : forall T1 T2, well_formed_ty T1 -> well_formed_ty T2 -> - well_formed_ty (TArrow T1 T2) - | wfTRNil : - well_formed_ty TRNil - | wfTRCons : forall i T1 T2, + well_formed_ty (Arrow T1 T2) + | wfRNil : + well_formed_ty RNil + | wfRCons : forall i T1 T2, well_formed_ty T1 -> well_formed_ty T2 -> record_ty T2 -> - well_formed_ty (TRCons i T1 T2). + well_formed_ty (RCons i T1 T2). Hint Constructors record_ty well_formed_ty. @@ -199,20 +200,20 @@ Hint Constructors record_ty well_formed_ty. outermost constructor. The [well_formed_ty] property, on the other hand, verifies that the whole type is well formed in the sense that the tail of every record (the second argument to - [TRCons]) is a record. + [RCons]) is a record. Of course, we should also be concerned about ill-formed terms, not - just types; but typechecking can rules those out without the help + just types; but typechecking can rule those out without the help of an extra [well_formed_tm] definition because it already examines the structure of terms. All we need is an analog of [record_ty] saying that a term is a record term if it is built - with [trnil] and [trcons]. *) + with [trnil] and [rcons]. *) Inductive record_tm : tm -> Prop := | rtnil : record_tm trnil | rtcons : forall i t1 t2, - record_tm (trcons i t1 t2). + record_tm (rcons i t1 t2). Hint Constructors record_tm. @@ -223,13 +224,13 @@ Hint Constructors record_tm. Fixpoint subst (x:string) (s:tm) (t:tm) : tm := match t with - | tvar y => if eqb_string x y then s else t - | tabs y T t1 => tabs y T + | var y => if eqb_string x y then s else t + | abs y T t1 => abs y T (if eqb_string x y then t1 else (subst x s t1)) - | tapp t1 t2 => tapp (subst x s t1) (subst x s t2) - | tproj t1 i => tproj (subst x s t1) i + | app t1 t2 => app (subst x s t1) (subst x s t2) + | rproj t1 i => rproj (subst x s t1) i | trnil => trnil - | trcons i t1 tr1 => trcons i (subst x s t1) (subst x s tr1) + | rcons i t1 tr1 => rcons i (subst x s t1) (subst x s tr1) end. Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). @@ -241,12 +242,12 @@ Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). Inductive value : tm -> Prop := | v_abs : forall x T11 t12, - value (tabs x T11 t12) + value (abs x T11 t12) | v_rnil : value trnil | v_rcons : forall i v1 vr, value v1 -> value vr -> - value (trcons i v1 vr). + value (rcons i v1 vr). Hint Constructors value. @@ -255,45 +256,45 @@ Hint Constructors value. Fixpoint tlookup (i:string) (tr:tm) : option tm := match tr with - | trcons i' t tr' => if eqb_string i i' then Some t else tlookup i tr' + | rcons i' t tr' => if eqb_string i i' then Some t else tlookup i tr' | _ => None end. (** The [step] function uses this term-level lookup function in the projection rule. *) -Reserved Notation "t1 '==>' t2" (at level 40). +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) + (app (abs x T11 t12) v2) --> ([x:=v2]t12) | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) + t1 --> t1' -> + (app t1 t2) --> (app t1' t2) | ST_App2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - (tapp v1 t2) ==> (tapp v1 t2') + t2 --> t2' -> + (app v1 t2) --> (app v1 t2') | ST_Proj1 : forall t1 t1' i, - t1 ==> t1' -> - (tproj t1 i) ==> (tproj t1' i) + t1 --> t1' -> + (rproj t1 i) --> (rproj t1' i) | ST_ProjRcd : forall tr i vi, value tr -> tlookup i tr = Some vi -> - (tproj tr i) ==> vi + (rproj tr i) --> vi | ST_Rcd_Head : forall i t1 t1' tr2, - t1 ==> t1' -> - (trcons i t1 tr2) ==> (trcons i t1' tr2) + t1 --> t1' -> + (rcons i t1 tr2) --> (rcons i t1' tr2) | ST_Rcd_Tail : forall i v1 tr2 tr2', value v1 -> - tr2 ==> tr2' -> - (trcons i v1 tr2) ==> (trcons i v1 tr2') + tr2 --> tr2' -> + (rcons i v1 tr2) --> (rcons i v1 tr2') -where "t1 '==>' t2" := (step t1 t2). +where "t1 '-->' t2" := (step t1 t2). Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40). Hint Constructors step. @@ -323,7 +324,7 @@ Hint Constructors step. Fixpoint Tlookup (i:string) (Tr:ty) : option ty := match Tr with - | TRCons i' T Tr' => + | RCons i' T Tr' => if eqb_string i i' then Some T else Tlookup i Tr' | _ => None end. @@ -336,28 +337,28 @@ Inductive has_type : context -> tm -> ty -> Prop := | T_Var : forall Gamma x T, Gamma x = Some T -> well_formed_ty T -> - Gamma |- (tvar x) \in T + Gamma |- (var x) \in T | T_Abs : forall Gamma x T11 T12 t12, well_formed_ty T11 -> (update Gamma x T11) |- t12 \in T12 -> - Gamma |- (tabs x T11 t12) \in (TArrow T11 T12) + Gamma |- (abs x T11 t12) \in (Arrow T11 T12) | T_App : forall T1 T2 Gamma t1 t2, - Gamma |- t1 \in (TArrow T1 T2) -> + Gamma |- t1 \in (Arrow T1 T2) -> Gamma |- t2 \in T1 -> - Gamma |- (tapp t1 t2) \in T2 + Gamma |- (app t1 t2) \in T2 (* records: *) | T_Proj : forall Gamma i t Ti Tr, Gamma |- t \in Tr -> Tlookup i Tr = Some Ti -> - Gamma |- (tproj t i) \in Ti + Gamma |- (rproj t i) \in Ti | T_RNil : forall Gamma, - Gamma |- trnil \in TRNil + Gamma |- trnil \in RNil | T_RCons : forall Gamma i t T tr Tr, Gamma |- t \in T -> Gamma |- tr \in Tr -> record_ty Tr -> record_tm tr -> - Gamma |- (trcons i t tr) \in (TRCons i T Tr) + Gamma |- (rcons i t tr) \in (RCons i T Tr) where "Gamma '|-' t '\in' T" := (has_type Gamma t T). @@ -366,33 +367,34 @@ Hint Constructors has_type. (* ================================================================= *) (** ** Examples *) -(** **** 练习:2 星 (examples) *) -(** Finish the proofs below. Feel free to use Coq's automation +(** **** 练习:2 星, standard (examples) + + Finish the proofs below. Feel free to use Coq's automation features in this proof. However, if you are not confident about how the type system works, you may want to carry out the proofs first using the basic features ([apply] instead of [eapply], in particular) and then perhaps compress it using automation. Before starting to prove anything, make sure you understand what it is - saying.*) + saying. *) Lemma typing_example_2 : empty |- - (tapp (tabs a (TRCons i1 (TArrow A A) - (TRCons i2 (TArrow B B) - TRNil)) - (tproj (tvar a) i2)) - (trcons i1 (tabs a A (tvar a)) - (trcons i2 (tabs a B (tvar a)) + (app (abs a (RCons i1 (Arrow A A) + (RCons i2 (Arrow B B) + RNil)) + (rproj (var a) i2)) + (rcons i1 (abs a A (var a)) + (rcons i2 (abs a B (var a)) trnil))) \in - (TArrow B B). + (Arrow B B). Proof. (* 请在此处解答 *) Admitted. Example typing_nonexample : ~ exists T, - (update empty a (TRCons i2 (TArrow A A) - TRNil)) |- - (trcons i1 (tabs a B (tvar a)) (tvar a)) \in + (update empty a (RCons i2 (Arrow A A) + RNil)) |- + (rcons i1 (abs a B (var a)) (var a)) \in T. Proof. (* 请在此处解答 *) Admitted. @@ -400,9 +402,9 @@ Proof. Example typing_nonexample_2 : forall y, ~ exists T, (update empty y A) |- - (tapp (tabs a (TRCons i1 A TRNil) - (tproj (tvar a) i1)) - (trcons i1 (tvar y) (trcons i2 (tvar y) trnil))) \in + (app (abs a (RCons i1 A RNil) + (rproj (var a) i1)) + (rcons i1 (var y) (rcons i2 (var y) trnil))) \in T. Proof. (* 请在此处解答 *) Admitted. @@ -424,14 +426,14 @@ Lemma wf_rcd_lookup : forall i T Ti, Proof with eauto. intros i T. induction T; intros; try solve_by_invert. - - (* TRCons *) + - (* RCons *) inversion H. subst. unfold Tlookup in H0. destruct (eqb_string i s)... inversion H0. subst... Qed. Lemma step_preserves_record_tm : forall tr tr', record_tm tr -> - tr ==> tr' -> + tr --> tr' -> record_tm tr'. Proof. intros tr tr' Hrt Hstp. @@ -462,13 +464,13 @@ Qed. leaving only the [T_RCons] case. If the last step in the typing derivation is by [T_RCons], then - [t = trcons i0 t tr] and [T = TRCons i0 T Tr] for some [i0], + [t = rcons i0 t tr] and [T = RCons i0 T Tr] for some [i0], [t], [tr], [T] and [Tr]. This leaves two possiblities to consider - either [i0 = i] or not. - - If [i = i0], then since [Tlookup i (TRCons i0 T Tr) = Some + - If [i = i0], then since [Tlookup i (RCons i0 T Tr) = Some Ti] we have [T = Ti]. It follows that [t] itself satisfies the theorem. @@ -508,11 +510,11 @@ Proof with eauto. Theorem progress : forall t T, empty |- t \in T -> - value t \/ exists t', t ==> 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'. + 2. t --> t' for some t'. Proof: By induction on the given typing derivation. *) intros t T Ht. remember (@empty ty) as Gamma. @@ -525,7 +527,7 @@ Proof with eauto. inversion H. - (* T_Abs *) (* If the [T_Abs] rule was the last used, then - [t = tabs x T11 t12], which is a value. *) + [t = abs x T11 t12], which is a value. *) left... - (* T_App *) (* If the last rule applied was T_App, then [t = t1 t2], @@ -540,43 +542,43 @@ Proof with eauto. destruct IHHt2; subst... * (* 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 + [t1 = abs 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]. *) + [(abs x T11 t12) t2 --> [x:=t2]t12] by [ST_AppAbs]. *) inversion H; subst; try solve_by_invert. exists ([x:=t2]t12)... * (* t2 steps *) - (* If [t1] is a value and [t2 ==> t2'], then - [t1 t2 ==> t1 t2'] by [ST_App2]. *) - destruct H0 as [t2' Hstp]. exists (tapp t1 t2')... + (* If [t1] is a value and [t2 --> t2'], then + [t1 t2 --> t1 t2'] by [ST_App2]. *) + destruct H0 as [t2' Hstp]. exists (app t1 t2')... + (* t1 steps *) - (* Finally, If [t1 ==> t1'], then [t1 t2 ==> t1' t2] + (* Finally, If [t1 --> t1'], then [t1 t2 --> t1' t2] by [ST_App1]. *) - destruct H as [t1' Hstp]. exists (tapp t1' t2)... + destruct H as [t1' Hstp]. exists (app t1' t2)... - (* T_Proj *) (* If the last rule in the given derivation is [T_Proj], then - [t = tproj t i] and + [t = rproj t i] and [empty |- t : (TRcd Tr)] By the IH, [t] either is a value or takes a step. *) right. destruct IHHt... + (* rcd is value *) (* If [t] is a value, then we may use lemma [lookup_field_in_value] to show [tlookup i t = Some ti] - for some [ti] which gives us [tproj i t ==> ti] by + for some [ti] which gives us [rproj i t --> ti] by [ST_ProjRcd]. *) destruct (lookup_field_in_value _ _ _ _ H0 Ht H) as [ti [Hlkup _]]. exists ti... + (* rcd_steps *) - (* On the other hand, if [t ==> t'], then - [tproj t i ==> tproj t' i] by [ST_Proj1]. *) - destruct H0 as [t' Hstp]. exists (tproj t' i)... + (* On the other hand, if [t --> t'], then + [rproj t i --> rproj t' i] by [ST_Proj1]. *) + destruct H0 as [t' Hstp]. exists (rproj t' i)... - (* T_RNil *) (* If the last rule in the given derivation is [T_RNil], then [t = trnil], which is a value. *) left... - (* T_RCons *) - (* If the last rule is [T_RCons], then [t = trcons i t tr] and + (* If the last rule is [T_RCons], then [t = rcons i t tr] and [empty |- t : T] [empty |- tr : Tr] By the IH, each of [t] and [tr] either is a value or can @@ -585,45 +587,45 @@ Proof with eauto. + (* head is a value *) destruct IHHt2; try reflexivity. * (* tail is a value *) - (* If [t] and [tr] are both values, then [trcons i t tr] + (* If [t] and [tr] are both values, then [rcons i t tr] is a value as well. *) left... * (* tail steps *) - (* If [t] is a value and [tr ==> tr'], then - [trcons i t tr ==> trcons i t tr'] by + (* If [t] is a value and [tr --> tr'], then + [rcons i t tr --> rcons i t tr'] by [ST_Rcd_Tail]. *) right. destruct H2 as [tr' Hstp]. - exists (trcons i t tr')... + exists (rcons i t tr')... + (* head steps *) - (* If [t ==> t'], then - [trcons i t tr ==> trcons i t' tr] + (* If [t --> t'], then + [rcons i t tr --> rcons i t' tr] by [ST_Rcd_Head]. *) right. destruct H1 as [t' Hstp]. - exists (trcons i t' tr)... Qed. + exists (rcons i t' tr)... Qed. (* ----------------------------------------------------------------- *) (** *** Context Invariance *) Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) + appears_free_in x t1 -> appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) + appears_free_in x t2 -> appears_free_in x (app t1 t2) | afi_abs : forall x y T11 t12, y <> x -> appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) + appears_free_in x (abs y T11 t12) | afi_proj : forall x t i, appears_free_in x t -> - appears_free_in x (tproj t i) + appears_free_in x (rproj t i) | afi_rhead : forall x i ti tr, appears_free_in x ti -> - appears_free_in x (trcons i ti tr) + appears_free_in x (rcons i ti tr) | afi_rtail : forall x i ti tr, appears_free_in x tr -> - appears_free_in x (trcons i ti tr). + appears_free_in x (rcons i ti tr). Hint Constructors appears_free_in. @@ -666,24 +668,24 @@ Lemma substitution_preserves_typing : forall Gamma x U v t 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 + (* Theorem: If x|->U;Gamma |- 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, - tabs, trcons. The former aren't automatic because we + directly from the IH, with the exception of var, + abs, rcons. The former aren't automatic because we must reason about how the variables interact. In the - case of trcons, we must do a little extra work to show + case of rcons, we must do a little extra work to show that substituting into a term doesn't change whether it is a record term. *) induction t; intros S Gamma Htypt; simpl; inversion Htypt; subst... - - (* tvar *) + - (* var *) simpl. rename s into y. (* If t = y, we know that [empty |- v : U] and - [Gamma,x:U |- y : S] + [x|->U; Gamma |- y : S] and, by inversion, [update Gamma x U y = Some S]. We want to show that [Gamma |- [x:=v]y : S]. @@ -708,26 +710,26 @@ Proof with eauto. has no effect. We can show that [Gamma |- y : S] by [T_Var]. *) apply T_Var... - - (* tabs *) + - (* abs *) rename s 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] + (* If [t = abs y T11 t0], then we know that + [x|->U; Gamma |- abs y T11 t0 : T11->T12] + [x|->U; y|->T11; Gamma |- t0 : T12] [empty |- v : U] As our IH, we know that forall S Gamma, - [Gamma,x:U |- t0 : S -> Gamma |- [x:=v]t0 S]. + [x|->U; Gamma |- t0 : S -> Gamma |- [x:=v]t0 S]. We can calculate that - [ [x:=v]t = tabs y T11 (if eqb_string x y then t0 else [x:=v]t0) ], + [ [x:=v]t = abs y T11 (if eqb_string 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 eqb_string x y then t0 else [x:=v]t0 : T12] + [y|->T11; Gamma |- if eqb_string x y then t0 else [x:=v]t0 : T12] We consider two cases: [x = y] and [x <> y]. *) apply T_Abs... destruct (eqb_stringP x y) as [Hxy|Hxy]. + (* 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 + invariance shows that [y:U,y:T11] and [Gamma,y:T11] are equivalent. Since [t0 : T12] under the former context, this is also the case under the latter. *) eapply context_invariance... @@ -737,24 +739,24 @@ Proof with eauto. + (* 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] *) + [x|->U; y|->T11; Gamma |- t0 : T12] => + [y|->T11; x|->U; Gamma |- t0 : T12] => + [y|->T11; Gamma |- [x:=v]t0 : T12] *) apply IHt. eapply context_invariance... intros z Hafi. unfold update, t_update. destruct (eqb_stringP y z)... subst. rewrite false_eqb_string... - - (* trcons *) + - (* rcons *) apply T_RCons... inversion H7; subst; simpl... Qed. Theorem preservation : forall t t' T, empty |- t \in T -> - t ==> t' -> + t --> t' -> empty |- t' \in T. Proof with eauto. intros t t' T HT. - (* Theorem: If [empty |- t : T] and [t ==> t'], then + (* Theorem: If [empty |- t : T] and [t --> t'], then [empty |- t' : T]. *) remember (@empty ty) as Gamma. generalize dependent HeqGamma. generalize dependent t'. @@ -766,17 +768,17 @@ Proof with eauto. intros t' HeqGamma HE; subst; inversion HE; subst... - (* 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']: + 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... + (* ST_AppAbs *) (* For the third case, suppose - [t1 = tabs x T11 t12] + [t1 = abs 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] + [empty |- abs x T11 t12 : T1->T2] and by inversion [x:T1 |- t12 : T2] We have already proven that substitution_preserves_typing and @@ -785,8 +787,8 @@ Proof with eauto. apply substitution_preserves_typing with T1... inversion HT1... - (* T_Proj *) - (* If the last rule was [T_Proj], then [t = tproj t1 i]. - Two rules could have caused [t ==> t']: [T_Proj1] and + (* If the last rule was [T_Proj], then [t = rproj t1 i]. + Two rules could have caused [t --> t']: [T_Proj1] and [T_ProjRcd]. The typing of [t'] follows from the IH in the former case, so we only consider [T_ProjRcd]. @@ -799,10 +801,10 @@ Proof with eauto. as [vi [Hget Htyp]]. rewrite H4 in Hget. inversion Hget. subst... - (* T_RCons *) - (* If the last rule was [T_RCons], then [t = trcons i t tr] + (* If the last rule was [T_RCons], then [t = rcons i t tr] for some [i], [t] and [tr] such that [record_tm tr]. If the step is by [ST_Rcd_Head], the result is immediate by - the IH. If the step is by [ST_Rcd_Tail], [tr ==> tr2'] + the IH. If the step is by [ST_Rcd_Tail], [tr --> tr2'] for some [tr2'] and we must also use lemma [step_preserves_record_tm] to show [record_tm tr2']. *) apply T_RCons... eapply step_preserves_record_tm... @@ -811,5 +813,4 @@ Qed. End STLCExtendedRecords. -(** $Date$ *) - +(* Sat Jan 26 15:15:45 UTC 2019 *) diff --git a/plf-current/RecordsTest.v b/plf-current/RecordsTest.v index c5383b8a..bcfcf1c6 100644 --- a/plf-current/RecordsTest.v +++ b/plf-current/RecordsTest.v @@ -39,22 +39,22 @@ idtac "#> STLCExtendedRecords.typing_example_2". idtac "Possible points: 0.5". check_type @STLCExtendedRecords.typing_example_2 ( (STLCExtendedRecords.has_type (@Maps.empty STLCExtendedRecords.ty) - (STLCExtendedRecords.tapp - (STLCExtendedRecords.tabs "a" - (STLCExtendedRecords.TRCons "i1" - (STLCExtendedRecords.TArrow STLCExtendedRecords.A + (STLCExtendedRecords.app + (STLCExtendedRecords.abs "a" + (STLCExtendedRecords.RCons "i1" + (STLCExtendedRecords.Arrow STLCExtendedRecords.A STLCExtendedRecords.A) - (STLCExtendedRecords.TRCons "i2" - (STLCExtendedRecords.TArrow STLCExtendedRecords.B - STLCExtendedRecords.B) STLCExtendedRecords.TRNil)) - (STLCExtendedRecords.tproj (STLCExtendedRecords.tvar "a") "i2")) - (STLCExtendedRecords.trcons "i1" - (STLCExtendedRecords.tabs "a" STLCExtendedRecords.A - (STLCExtendedRecords.tvar "a")) - (STLCExtendedRecords.trcons "i2" - (STLCExtendedRecords.tabs "a" STLCExtendedRecords.B - (STLCExtendedRecords.tvar "a")) STLCExtendedRecords.trnil))) - (STLCExtendedRecords.TArrow STLCExtendedRecords.B STLCExtendedRecords.B))). + (STLCExtendedRecords.RCons "i2" + (STLCExtendedRecords.Arrow STLCExtendedRecords.B + STLCExtendedRecords.B) STLCExtendedRecords.RNil)) + (STLCExtendedRecords.rproj (STLCExtendedRecords.var "a") "i2")) + (STLCExtendedRecords.rcons "i1" + (STLCExtendedRecords.abs "a" STLCExtendedRecords.A + (STLCExtendedRecords.var "a")) + (STLCExtendedRecords.rcons "i2" + (STLCExtendedRecords.abs "a" STLCExtendedRecords.B + (STLCExtendedRecords.var "a")) STLCExtendedRecords.trnil))) + (STLCExtendedRecords.Arrow STLCExtendedRecords.B STLCExtendedRecords.B))). idtac "Assumptions:". Abort. Print Assumptions STLCExtendedRecords.typing_example_2. @@ -69,12 +69,12 @@ check_type @STLCExtendedRecords.typing_nonexample ( STLCExtendedRecords.has_type (@Maps.update STLCExtendedRecords.ty (@Maps.empty STLCExtendedRecords.ty) "a" - (STLCExtendedRecords.TRCons "i2" - (STLCExtendedRecords.TArrow STLCExtendedRecords.A - STLCExtendedRecords.A) STLCExtendedRecords.TRNil)) - (STLCExtendedRecords.trcons "i1" - (STLCExtendedRecords.tabs "a" STLCExtendedRecords.B - (STLCExtendedRecords.tvar "a")) (STLCExtendedRecords.tvar "a")) T))). + (STLCExtendedRecords.RCons "i2" + (STLCExtendedRecords.Arrow STLCExtendedRecords.A + STLCExtendedRecords.A) STLCExtendedRecords.RNil)) + (STLCExtendedRecords.rcons "i1" + (STLCExtendedRecords.abs "a" STLCExtendedRecords.B + (STLCExtendedRecords.var "a")) (STLCExtendedRecords.var "a")) T))). idtac "Assumptions:". Abort. Print Assumptions STLCExtendedRecords.typing_nonexample. @@ -90,13 +90,13 @@ check_type @STLCExtendedRecords.typing_nonexample_2 ( STLCExtendedRecords.has_type (@Maps.update STLCExtendedRecords.ty (@Maps.empty STLCExtendedRecords.ty) y STLCExtendedRecords.A) - (STLCExtendedRecords.tapp - (STLCExtendedRecords.tabs "a" - (STLCExtendedRecords.TRCons "i1" STLCExtendedRecords.A - STLCExtendedRecords.TRNil) - (STLCExtendedRecords.tproj (STLCExtendedRecords.tvar "a") "i1")) - (STLCExtendedRecords.trcons "i1" (STLCExtendedRecords.tvar y) - (STLCExtendedRecords.trcons "i2" (STLCExtendedRecords.tvar y) + (STLCExtendedRecords.app + (STLCExtendedRecords.abs "a" + (STLCExtendedRecords.RCons "i1" STLCExtendedRecords.A + STLCExtendedRecords.RNil) + (STLCExtendedRecords.rproj (STLCExtendedRecords.var "a") "i1")) + (STLCExtendedRecords.rcons "i1" (STLCExtendedRecords.var y) + (STLCExtendedRecords.rcons "i2" (STLCExtendedRecords.var y) STLCExtendedRecords.trnil))) T))). idtac "Assumptions:". Abort. @@ -121,3 +121,5 @@ Print Assumptions STLCExtendedRecords.typing_nonexample_2. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:26 UTC 2019 *) diff --git a/plf-current/References.html b/plf-current/References.html index d0086c9d..e059950f 100644 --- a/plf-current/References.html +++ b/plf-current/References.html @@ -72,11 +72,12 @@

              ReferencesTyping Mutable References<
              Set Warnings "-notation-overridden,-parsing".
              -Require Import Coq.Arith.Arith.
              -Require Import Coq.omega.Omega.
              +From Coq Require Import Strings.String.
              +From Coq Require Import Arith.Arith.
              +From Coq Require Import omega.Omega.
              From PLF Require Import Maps.
              From PLF Require Import Smallstep.
              -Require Import Coq.Lists.List.
              +From Coq Require Import Lists.List.
              Import ListNotations.
              @@ -198,10 +199,10 @@

              ReferencesTyping Mutable References<
              Inductive ty : Type :=
              -  | TNat : ty
              -  | TUnit : ty
              -  | TArrow : tytyty
              -  | TRef : tyty.
              +  | Nat : ty
              +  | Unit : ty
              +  | Arrow : tytyty
              +  | Ref : tyty.
              @@ -225,20 +226,20 @@

              ReferencesTyping Mutable References< Inductive tm : Type :=
                (* STLC with numbers: *)
              -  | tvar : stringtm
              -  | tapp : tmtmtm
              -  | tabs : stringtytmtm
              -  | tnat : nattm
              -  | tsucc : tmtm
              -  | tpred : tmtm
              -  | tmult : tmtmtm
              -  | tif0 : tmtmtmtm
              +  | var : stringtm
              +  | app : tmtmtm
              +  | abs : stringtytmtm
              +  | const : nattm
              +  | scc : tmtm
              +  | prd : tmtm
              +  | mlt : tmtmtm
              +  | test0 : tmtmtmtm
                (* New terms: *)
              -  | tunit : tm
              -  | tref : tmtm
              -  | tderef : tmtm
              -  | tassign : tmtmtm
              -  | tloc : nattm.
              +  | unit : tm
              +  | ref : tmtm
              +  | deref : tmtm
              +  | assign : tmtmtm
              +  | loc : nattm.

              @@ -247,7 +248,7 @@

              ReferencesTyping Mutable References<
                -
              • ref t (formally, tref t) allocates a new reference cell +
              • ref t (formally, ref t) allocates a new reference cell with the value t and reduces to the location of the newly allocated cell; @@ -255,21 +256,21 @@

                ReferencesTyping Mutable References<

              • -
              • !t (formally, tderef t) reduces to the contents of the +
              • !t (formally, deref t) reduces to the contents of the cell referenced by t;
              • -
              • t1 := t2 (formally, tassign t1 t2) assigns t2 to the +
              • t1 := t2 (formally, assign t1 t2) assigns t2 to the cell referenced by t1; and
              • -
              • l (formally, tloc l) is a reference to the cell at +
              • l (formally, loc l) is a reference to the cell at location l. We'll discuss locations later.
              @@ -292,7 +293,7 @@

              ReferencesTyping Mutable References< assignment will look like this:
              - + @@ -300,12 +301,12 @@

              ReferencesTyping Mutable References<

              - +
              Gamma |- t1 : T1Gamma ⊢ t1 : T1 (T_Ref)  

              Gamma |- ref t1 : Ref T1Gamma ⊢ ref t1 : Ref T1
              - + @@ -313,16 +314,16 @@

              ReferencesTyping Mutable References<

              - +
              Gamma |- t1 : Ref T11Gamma ⊢ t1 : Ref T11 (T_Deref)  

              Gamma |- !t1 : T11Gamma ⊢ !t1 : T11
              - + - + @@ -330,7 +331,7 @@

              ReferencesTyping Mutable References<

              - +
              Gamma |- t1 : Ref T11Gamma ⊢ t1 : Ref T11
              Gamma |- t2 : T11Gamma ⊢ t2 : T11 (T_Assign)  

              Gamma |- t1 := t2 : UnitGamma ⊢ t1 := t2 : Unit
              The rule for locations will require a bit more machinery, and this @@ -349,14 +350,14 @@

              ReferencesTyping Mutable References<
              Inductive value : tmProp :=
              -  | v_abs : x T t,
              -      value (tabs x T t)
              -  | v_nat : n,
              -      value (tnat n)
              +  | v_abs : x T t,
              +      value (abs x T t)
              +  | v_nat : n,
              +      value (const n)
                | v_unit :
              -      value tunit
              -  | v_loc : l,
              -      value (tloc l).

              +      value unit
              +  | v_loc : l,
              +      value (loc l).

              Hint Constructors value.
              @@ -368,31 +369,31 @@

              ReferencesTyping Mutable References< Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
                match t with
              -  | tvar x'
              +  | var x'
                    if eqb_string x x' then s else t
              -  | tapp t1 t2
              -      tapp (subst x s t1) (subst x s t2)
              -  | tabs x' T t1
              -      if eqb_string x x' then t else tabs x' T (subst x s t1)
              -  | tnat n
              +  | app t1 t2
              +      app (subst x s t1) (subst x s t2)
              +  | abs x' T t1
              +      if eqb_string x x' then t else abs x' T (subst x s t1)
              +  | const n
                    t
              -  | 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)
              -  | tunit
              +  | scc t1
              +      scc (subst x s t1)
              +  | prd t1
              +      prd (subst x s t1)
              +  | mlt t1 t2
              +      mlt (subst x s t1) (subst x s t2)
              +  | test0 t1 t2 t3
              +      test0 (subst x s t1) (subst x s t2) (subst x s t3)
              +  | unit
                    t
              -  | tref t1
              -      tref (subst x s t1)
              -  | tderef t1
              -      tderef (subst x s t1)
              -  | tassign t1 t2
              -      tassign (subst x s t1) (subst x s t2)
              -  | tloc _
              +  | ref t1
              +      ref (subst x s t1)
              +  | deref t1
              +      deref (subst x s t1)
              +  | assign t1 t2
              +      assign (subst x s t1) (subst x s t2)
              +  | loc _
                    t
                end.

              Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
              @@ -443,7 +444,7 @@

              ReferencesTyping Mutable References<
              Definition tseq t1 t2 :=
              -  tapp (tabs "x" TUnit t2) t1.
              +  app (abs "x" Unit t2) t1.
              @@ -566,7 +567,7 @@

              ReferencesTyping Mutable References<
              -

              练习:1 星, optional (store_draw)

              +

              练习:1 星, standard, optional (store_draw)

              Draw (on paper) the contents of the store at the point in execution where the first two lets have finished and the third one is about to begin. @@ -596,7 +597,7 @@

              ReferencesTyping Mutable References<
                     equal =
                       fix
              -          (\eq:Nat->Nat->Bool.
              +          (\eq:Nat->Nat->Bool.
                            \m:Nat. \n:Nat.
                              if m=0 then iszero n
                              else if n=0 then false
              @@ -628,7 +629,7 @@ 

              ReferencesTyping Mutable References< lists and trees.
              -

              练习:2 星, recommended (compact_update)

              +

              练习:2 星, standard, recommended (compact_update)

              If we defined update more compactly like this
                     update = \a:NatArray. \m:Nat. \v:Nat.
              @@ -706,7 +707,7 @@ 

              ReferencesTyping Mutable References< other with type Ref Bool.
              -

              练习:2 星 (type_safety_violation)

              +

              练习:2 星, standard (type_safety_violation)

              Show how this can lead to a violation of type safety.

              @@ -802,7 +803,7 @@

              ReferencesTyping Mutable References< before is that, in IMP, a program could modify any location at any time, so states had to be ready to map _any_ variable to a value. However, in the STLC with references, the only way to create a - reference cell is with tref t1, which puts the value of t1 + reference cell is with ref t1, which puts the value of t1 in a new reference cell and reduces to the location of the newly created reference cell. When reducing such an expression, we can just add a new reference cell to the end of the list representing @@ -823,7 +824,7 @@

              ReferencesTyping Mutable References<
              Definition store_lookup (n:nat) (st:store) :=
              -  nth n st tunit.
              +  nth n st unit.
              @@ -849,7 +850,7 @@

              ReferencesTyping Mutable References<

              -Lemma replace_nil : A n (x:A),
              +Lemma replace_nil : A n (x:A),
                replace n x nil = nil.
              @@ -859,7 +860,7 @@

              ReferencesTyping Mutable References<


              -Lemma length_replace : A n x (l:list A),
              +Lemma length_replace : A n x (l:list A),
                length (replace n x l) = length l.
              @@ -873,7 +874,7 @@

              ReferencesTyping Mutable References<


              -Lemma lookup_replace_eq : l t st,
              +Lemma lookup_replace_eq : l t st,
                l < length st
                store_lookup l (replace l t st) = t.
              @@ -892,7 +893,7 @@

              ReferencesTyping Mutable References<


              -Lemma lookup_replace_neq : l1 l2 t st,
              +Lemma lookup_replace_neq : l1 l2 t st,
                l1l2
                store_lookup l1 (replace l2 t st) = store_lookup l1 st.
              @@ -927,7 +928,7 @@

              ReferencesTyping Mutable References< term can cause side effects on the store, and these may affect the reduction of other terms in the future, the reduction rules need to return a new store. Thus, the shape of the single-step - reduction relation needs to change from t ==> t' to t / st ==> t' / + reduction relation needs to change from t --> t' to t / st --> t' / st', where st and st' are the starting and ending states of the store. @@ -945,12 +946,12 @@

              ReferencesTyping Mutable References<
              - (\x:T.t12) v2 / st ==> [x:=v2]t12 / st + (\x:T.t12) v2 / st --> [x:=v2]t12 / st
              - + @@ -958,12 +959,12 @@

              ReferencesTyping Mutable References<

              - +
              t1 / st ==> t1' / st't1 / st --> t1' / st' (ST_App1)  

              t1 t2 / st ==> t1' t2 / st't1 t2 / st --> t1' t2 / st'
              - + @@ -971,7 +972,7 @@

              ReferencesTyping Mutable References<

              - +
              value v1 t2 / st ==> t2' / st'value v1 t2 / st --> t2' / st' (ST_App2)  

              v1 t2 / st ==> v1 t2' / st'v1 t2 / st --> v1 t2' / st'
              Note that the first rule here returns the store unchanged, since @@ -1001,7 +1002,7 @@

              ReferencesTyping Mutable References< reduce t1 until it becomes a value:
              - + @@ -1009,7 +1010,7 @@

              ReferencesTyping Mutable References<

              - +
              t1 / st ==> t1' / st't1 / st --> t1' / st' (ST_Deref)  

              !t1 / st ==> !t1' / st'!t1 / st --> !t1' / st'
              Once t1 has finished reducing, we should have an expression of @@ -1030,7 +1031,7 @@

              ReferencesTyping Mutable References<
              - !(loc l) / st ==> lookup l st / st + !(loc l) / st --> lookup l st / st @@ -1041,7 +1042,7 @@

              ReferencesTyping Mutable References< reduce t2 until it becomes a value (of any sort):
              - + @@ -1049,12 +1050,12 @@

              ReferencesTyping Mutable References<

              - +
              t1 / st ==> t1' / st't1 / st --> t1' / st' (ST_Assign1)  

              t1 := t2 / st ==> t1' := t2 / st't1 := t2 / st --> t1' := t2 / st'
              - + @@ -1062,7 +1063,7 @@

              ReferencesTyping Mutable References<

              - +
              t2 / st ==> t2' / st't2 / st --> t2' / st' (ST_Assign2)  

              v1 := t2 / st ==> v1 := t2' / st'v1 := t2 / st --> v1 := t2' / st'
              Once we have finished with t1 and t2, we have an expression of @@ -1078,7 +1079,7 @@

              ReferencesTyping Mutable References<
              - loc l := v2 / st ==> unit / [l:=v2]st + loc l := v2 / st --> unit / [l:=v2]st The notation [l:=v2]st means "the store that maps l to v2 @@ -1092,7 +1093,7 @@

              ReferencesTyping Mutable References< reduce t1 until it becomes a value:
              - + @@ -1100,7 +1101,7 @@

              ReferencesTyping Mutable References<

              - +
              t1 / st ==> t1' / st't1 / st --> t1' / st' (ST_Ref)  

              ref t1 / st ==> ref t1' / st'ref t1 / st --> ref t1' / st'
              Then, to reduce the ref itself, we choose a fresh location at @@ -1116,7 +1117,7 @@

              ReferencesTyping Mutable References<
              - ref v1 / st ==> loc |st| / st,v1 + ref v1 / st --> loc |st| / st,v1 The value resulting from this step is the newly allocated location @@ -1142,71 +1143,71 @@

              ReferencesTyping Mutable References<

              -Reserved Notation "t1 '/' st1 '==>' t2 '/' st2"
              +Reserved Notation "t1 '/' st1 '-->' t2 '/' st2"
                (at level 40, st1 at level 39, t2 at level 39).

              Import ListNotations.

              Inductive step : tm * storetm * storeProp :=
              -  | ST_AppAbs : x T t12 v2 st,
              +  | ST_AppAbs : x T t12 v2 st,
                       value v2
              -         tapp (tabs x T t12) v2 / st ==> [x:=v2]t12 / st
              -  | ST_App1 : t1 t1' t2 st st',
              -         t1 / st ==> t1' / st'
              -         tapp t1 t2 / st ==> tapp t1' t2 / st'
              -  | ST_App2 : v1 t2 t2' st st',
              +         app (abs x T t12) v2 / st --> [x:=v2]t12 / st
              +  | ST_App1 : t1 t1' t2 st st',
              +         t1 / st --> t1' / st'
              +         app t1 t2 / st --> app t1' t2 / st'
              +  | ST_App2 : v1 t2 t2' st st',
                       value v1
              -         t2 / st ==> t2' / st'
              -         tapp v1 t2 / st ==> tapp v1 t2'/ st'
              -  | ST_SuccNat : n st,
              -         tsucc (tnat n) / st ==> tnat (S n) / st
              -  | ST_Succ : t1 t1' st st',
              -         t1 / st ==> t1' / st'
              -         tsucc t1 / st ==> tsucc t1' / st'
              -  | ST_PredNat : n st,
              -         tpred (tnat n) / st ==> tnat (pred n) / st
              -  | ST_Pred : t1 t1' st st',
              -         t1 / st ==> t1' / st'
              -         tpred t1 / st ==> tpred t1' / st'
              -  | ST_MultNats : n1 n2 st,
              -         tmult (tnat n1) (tnat n2) / st ==> tnat (mult n1 n2) / st
              -  | ST_Mult1 : t1 t2 t1' st st',
              -         t1 / st ==> t1' / st'
              -         tmult t1 t2 / st ==> tmult t1' t2 / st'
              -  | ST_Mult2 : v1 t2 t2' st st',
              +         t2 / st --> t2' / st'
              +         app v1 t2 / st --> app v1 t2'/ st'
              +  | ST_SuccNat : n st,
              +         scc (const n) / st --> const (S n) / st
              +  | ST_Succ : t1 t1' st st',
              +         t1 / st --> t1' / st'
              +         scc t1 / st --> scc t1' / st'
              +  | ST_PredNat : n st,
              +         prd (const n) / st --> const (pred n) / st
              +  | ST_Pred : t1 t1' st st',
              +         t1 / st --> t1' / st'
              +         prd t1 / st --> prd t1' / st'
              +  | ST_MultNats : n1 n2 st,
              +         mlt (const n1) (const n2) / st --> const (mult n1 n2) / st
              +  | ST_Mult1 : t1 t2 t1' st st',
              +         t1 / st --> t1' / st'
              +         mlt t1 t2 / st --> mlt t1' t2 / st'
              +  | ST_Mult2 : v1 t2 t2' st st',
                       value v1
              -         t2 / st ==> t2' / st'
              -         tmult v1 t2 / st ==> tmult v1 t2' / st'
              -  | ST_If0 : t1 t1' t2 t3 st st',
              -         t1 / st ==> t1' / st'
              -         tif0 t1 t2 t3 / st ==> tif0 t1' t2 t3 / st'
              -  | ST_If0_Zero : t2 t3 st,
              -         tif0 (tnat 0) t2 t3 / st ==> t2 / st
              -  | ST_If0_Nonzero : n t2 t3 st,
              -         tif0 (tnat (S n)) t2 t3 / st ==> t3 / st
              -  | ST_RefValue : v1 st,
              +         t2 / st --> t2' / st'
              +         mlt v1 t2 / st --> mlt v1 t2' / st'
              +  | ST_If0 : t1 t1' t2 t3 st st',
              +         t1 / st --> t1' / st'
              +         test0 t1 t2 t3 / st --> test0 t1' t2 t3 / st'
              +  | ST_If0_Zero : t2 t3 st,
              +         test0 (const 0) t2 t3 / st --> t2 / st
              +  | ST_If0_Nonzero : n t2 t3 st,
              +         test0 (const (S n)) t2 t3 / st --> t3 / st
              +  | ST_RefValue : v1 st,
                       value v1
              -         tref v1 / st ==> tloc (length st) / (st ++ v1::nil)
              -  | ST_Ref : t1 t1' st st',
              -         t1 / st ==> t1' / st'
              -         tref t1 / st ==> tref t1' / st'
              -  | ST_DerefLoc : st l,
              +         ref v1 / st --> loc (length st) / (st ++ v1::nil)
              +  | ST_Ref : t1 t1' st st',
              +         t1 / st --> t1' / st'
              +         ref t1 / st --> ref t1' / st'
              +  | ST_DerefLoc : st l,
                       l < length st
              -         tderef (tloc l) / st ==> store_lookup l st / st
              -  | ST_Deref : t1 t1' st st',
              -         t1 / st ==> t1' / st'
              -         tderef t1 / st ==> tderef t1' / st'
              -  | ST_Assign : v2 l st,
              +         deref (loc l) / st --> store_lookup l st / st
              +  | ST_Deref : t1 t1' st st',
              +         t1 / st --> t1' / st'
              +         deref t1 / st --> deref t1' / st'
              +  | ST_Assign : v2 l st,
                       value v2
                       l < length st
              -         tassign (tloc l) v2 / st ==> tunit / replace l v2 st
              -  | ST_Assign1 : t1 t1' t2 st st',
              -         t1 / st ==> t1' / st'
              -         tassign t1 t2 / st ==> tassign t1' t2 / st'
              -  | ST_Assign2 : v1 t2 t2' st st',
              +         assign (loc l) v2 / st --> unit / replace l v2 st
              +  | ST_Assign1 : t1 t1' t2 st st',
              +         t1 / st --> t1' / st'
              +         assign t1 t2 / st --> assign t1' t2 / st'
              +  | ST_Assign2 : v1 t2 t2' st st',
                       value v1
              -         t2 / st ==> t2' / st'
              -         tassign v1 t2 / st ==> tassign v1 t2' / st'
              +         t2 / st --> t2' / st'
              +         assign v1 t2 / st --> assign v1 t2' / st'

              -where "t1 '/' st1 '==>' t2 '/' st2" := (step (t1,st1) (t2,st2)).
              +where "t1 '/' st1 '-->' t2 '/' st2" := (step (t1,st1) (t2,st2)).
              @@ -1220,7 +1221,7 @@

              ReferencesTyping Mutable References< Hint Constructors step.

              Definition multistep := (multi step).
              -Notation "t1 '/' st '==>*' t2 '/' st'" :=
              +Notation "t1 '/' st '-->*' t2 '/' st'" :=
                             (multistep (t1,st) (t2,st'))
                             (at level 40, st at level 39, t2 at level 39).

              @@ -1274,7 +1275,7 @@

              ReferencesTyping Mutable References< first attempt at a typing rule for locations:
              - + @@ -1282,7 +1283,7 @@

              ReferencesTyping Mutable References<

              - +
              Gamma |- lookup  l st : T1Gamma ⊢ lookup  l st : T1  

              Gamma |- loc l : Ref T1Gamma ⊢ loc l : Ref T1
              That is, to find the type of a location l, we look up the @@ -1298,11 +1299,11 @@

              ReferencesTyping Mutable References< (between contexts, _stores_, terms, and types). Since the store is, intuitively, part of the context in which we calculate the type of a term, let's write this four-place relation with the store to the left - of the turnstile: Gamma; st |- t : T. Our rule for typing + of the turnstile: Gamma; st t : T. Our rule for typing references now has the form
              - + @@ -1310,7 +1311,7 @@

              ReferencesTyping Mutable References<

              - +
              Gamma; st |- lookup l st : T1Gamma; st ⊢ lookup l st : T1  

              Gamma; st |- loc l : Ref T1Gamma; st ⊢ loc l : Ref T1
              and all the rest of the typing rules in the system are extended @@ -1337,7 +1338,7 @@

              ReferencesTyping Mutable References<
              -

              练习:2 星 (cyclic_store)

              +

              练习:2 星, standard (cyclic_store)

              Can you find a term whose reduction will create this particular cyclic store?

              @@ -1391,7 +1392,7 @@

              ReferencesTyping Mutable References<
              Definition store_Tlookup (n:nat) (ST:store_ty) :=
              -  nth n ST TUnit.
              +  nth n ST Unit.
              @@ -1412,7 +1413,7 @@

              ReferencesTyping Mutable References<
              - Gamma; ST |- loc l : Ref (lookup l ST) + Gamma; ST ⊢ loc l : Ref (lookup l ST) @@ -1448,12 +1449,12 @@

              ReferencesTyping Mutable References<
              - Gamma; ST |- loc l : Ref (lookup l ST) + Gamma; ST ⊢ loc l : Ref (lookup l ST)
              - + @@ -1461,12 +1462,12 @@

              ReferencesTyping Mutable References<

              - +
              Gamma; ST |- t1 : T1Gamma; ST ⊢ t1 : T1 (T_Ref)  

              Gamma; ST |- ref t1 : Ref T1Gamma; ST ⊢ ref t1 : Ref T1
              - + @@ -1474,16 +1475,16 @@

              ReferencesTyping Mutable References<

              - +
              Gamma; ST |- t1 : Ref T11Gamma; ST ⊢ t1 : Ref T11 (T_Deref)  

              Gamma; ST |- !t1 : T11Gamma; ST ⊢ !t1 : T11
              - + - + @@ -1491,59 +1492,59 @@

              ReferencesTyping Mutable References<

              - +
              Gamma; ST |- t1 : Ref T11Gamma; ST ⊢ t1 : Ref T11
              Gamma; ST |- t2 : T11Gamma; ST ⊢ t2 : T11 (T_Assign)  

              Gamma; ST |- t1 := t2 : UnitGamma; ST ⊢ t1 := t2 : Unit

              -Reserved Notation "Gamma ';' ST '|-' t '∈' T" (at level 40).

              +Reserved Notation "Gamma ';' ST '⊢' t '∈' T" (at level 40).

              Inductive has_type : contextstore_tytmtyProp :=
              -  | T_Var : Gamma ST x T,
              +  | T_Var : Gamma ST x T,
                    Gamma x = Some T
              -      Gamma; ST |- (tvar x) ∈ T
              -  | T_Abs : Gamma ST x T11 T12 t12,
              -      (update Gamma x T11); ST |- t12T12
              -      Gamma; ST |- (tabs x T11 t12) ∈ (TArrow T11 T12)
              -  | T_App : T1 T2 Gamma ST t1 t2,
              -      Gamma; ST |- t1 ∈ (TArrow T1 T2) →
              -      Gamma; ST |- t2T1
              -      Gamma; ST |- (tapp t1 t2) ∈ T2
              -  | T_Nat : Gamma ST n,
              -      Gamma; ST |- (tnat n) ∈ TNat
              -  | T_Succ : Gamma ST t1,
              -      Gamma; ST |- t1TNat
              -      Gamma; ST |- (tsucc t1) ∈ TNat
              -  | T_Pred : Gamma ST t1,
              -      Gamma; ST |- t1TNat
              -      Gamma; ST |- (tpred t1) ∈ TNat
              -  | T_Mult : Gamma ST t1 t2,
              -      Gamma; ST |- t1TNat
              -      Gamma; ST |- t2TNat
              -      Gamma; ST |- (tmult t1 t2) ∈ TNat
              -  | T_If0 : Gamma ST t1 t2 t3 T,
              -      Gamma; ST |- t1TNat
              -      Gamma; ST |- t2T
              -      Gamma; ST |- t3T
              -      Gamma; ST |- (tif0 t1 t2 t3) ∈ T
              -  | T_Unit : Gamma ST,
              -      Gamma; ST |- tunitTUnit
              -  | T_Loc : Gamma ST l,
              +      Gamma; ST ⊢ (var x) ∈ T
              +  | T_Abs : Gamma ST x T11 T12 t12,
              +      (update Gamma x T11); STt12T12
              +      Gamma; ST ⊢ (abs x T11 t12) ∈ (Arrow T11 T12)
              +  | T_App : T1 T2 Gamma ST t1 t2,
              +      Gamma; STt1 ∈ (Arrow T1 T2) →
              +      Gamma; STt2T1
              +      Gamma; ST ⊢ (app t1 t2) ∈ T2
              +  | T_Nat : Gamma ST n,
              +      Gamma; ST ⊢ (const n) ∈ Nat
              +  | T_Succ : Gamma ST t1,
              +      Gamma; STt1Nat
              +      Gamma; ST ⊢ (scc t1) ∈ Nat
              +  | T_Pred : Gamma ST t1,
              +      Gamma; STt1Nat
              +      Gamma; ST ⊢ (prd t1) ∈ Nat
              +  | T_Mult : Gamma ST t1 t2,
              +      Gamma; STt1Nat
              +      Gamma; STt2Nat
              +      Gamma; ST ⊢ (mlt t1 t2) ∈ Nat
              +  | T_If0 : Gamma ST t1 t2 t3 T,
              +      Gamma; STt1Nat
              +      Gamma; STt2T
              +      Gamma; STt3T
              +      Gamma; ST ⊢ (test0 t1 t2 t3) ∈ T
              +  | T_Unit : Gamma ST,
              +      Gamma; STunitUnit
              +  | T_Loc : Gamma ST l,
                    l < length ST
              -      Gamma; ST |- (tloc l) ∈ (TRef (store_Tlookup l ST))
              -  | T_Ref : Gamma ST t1 T1,
              -      Gamma; ST |- t1T1
              -      Gamma; ST |- (tref t1) ∈ (TRef T1)
              -  | T_Deref : Gamma ST t1 T11,
              -      Gamma; ST |- t1 ∈ (TRef T11) →
              -      Gamma; ST |- (tderef t1) ∈ T11
              -  | T_Assign : Gamma ST t1 t2 T11,
              -      Gamma; ST |- t1 ∈ (TRef T11) →
              -      Gamma; ST |- t2T11
              -      Gamma; ST |- (tassign t1 t2) ∈ TUnit
              +      Gamma; ST ⊢ (loc l) ∈ (Ref (store_Tlookup l ST))
              +  | T_Ref : Gamma ST t1 T1,
              +      Gamma; STt1T1
              +      Gamma; ST ⊢ (ref t1) ∈ (Ref T1)
              +  | T_Deref : Gamma ST t1 T11,
              +      Gamma; STt1 ∈ (Ref T11) →
              +      Gamma; ST ⊢ (deref t1) ∈ T11
              +  | T_Assign : Gamma ST t1 t2 T11,
              +      Gamma; STt1 ∈ (Ref T11) →
              +      Gamma; STt2T11
              +      Gamma; ST ⊢ (assign t1 t2) ∈ Unit

              -where "Gamma ';' ST '|-' t '∈' T" := (has_type Gamma ST t T).

              +where "Gamma ';' ST '⊢' t '∈' T" := (has_type Gamma ST t T).

              Hint Constructors has_type.
              @@ -1553,7 +1554,7 @@

              ReferencesTyping Mutable References< actually conforms to the store typing that we assume for purposes of typechecking. This proviso exactly parallels the situation with free variables in the basic STLC: the substitution lemma - promises that, if Gamma |- t : T, then we can replace the free + promises that, if Gamma t : T, then we can replace the free variables in t with values of the types listed in Gamma to obtain a closed term of type T, which, by the type preservation theorem will reduce to a final result of type T if it yields @@ -1603,10 +1604,10 @@

              ReferencesTyping Mutable References<

              -Theorem preservation_wrong1 : ST T t st t' st',
              -  empty; ST |- tT
              -  t / st ==> t' / st'
              -  empty; ST |- t'T.
              +Theorem preservation_wrong1 : ST T t st t' st',
              +  empty; STtT
              +  t / st --> t' / st'
              +  empty; STt'T.
              Abort.
              @@ -1625,12 +1626,12 @@

              ReferencesTyping Mutable References< Definition store_well_typed (ST:store_ty) (st:store) :=
                length ST = length st
              -  ( l, l < length st
              -     empty; ST |- (store_lookup l st) ∈ (store_Tlookup l ST)).
              +  (l, l < length st
              +     empty; ST ⊢ (store_lookup l st) ∈ (store_Tlookup l ST)).

              -Informally, we will write ST |- st for store_well_typed ST st. +Informally, we will write ST st for store_well_typed ST st.
              Intuitively, a store st is consistent with a store typing @@ -1641,10 +1642,10 @@

              ReferencesTyping Mutable References< stores like the one we saw above.
              -

              练习:2 星 (store_not_unique)

              +

              练习:2 星, standard (store_not_unique)

              Can you find a store st, and two different store typings ST1 and ST2 such that both - ST1 |- st and ST2 |- st? + ST1 st and ST2 st?

              @@ -1662,11 +1663,11 @@

              ReferencesTyping Mutable References<

              -Theorem preservation_wrong2 : ST T t st t' st',
              -  empty; ST |- tT
              -  t / st ==> t' / st'
              +Theorem preservation_wrong2 : ST T t st t' st',
              +  empty; STtT
              +  t / st --> t' / st'
                store_well_typed ST st
              -  empty; ST |- t'T.
              +  empty; STt'T.
              Abort.
              @@ -1694,9 +1695,9 @@

              ReferencesTyping Mutable References<
              Inductive extends : store_tystore_tyProp :=
              -  | extends_nil : ST',
              +  | extends_nil : ST',
                    extends ST' nil
              -  | extends_cons : x ST' ST,
              +  | extends_cons : x ST' ST,
                    extends ST' ST
                    extends (x::ST') (x::ST).

              Hint Constructors extends.
              @@ -1712,7 +1713,7 @@

              ReferencesTyping Mutable References<

              -Lemma extends_lookup : l ST ST',
              +Lemma extends_lookup : l ST ST',
                l < length ST
                extends ST' ST
                store_Tlookup l ST' = store_Tlookup l ST.
              @@ -1742,7 +1743,7 @@

              ReferencesTyping Mutable References<

              -Lemma length_extends : l ST ST',
              +Lemma length_extends : l ST ST',
                l < length ST
                extends ST' ST
                l < length ST'.
              @@ -1763,7 +1764,7 @@

              ReferencesTyping Mutable References<

              -Lemma extends_app : ST T,
              +Lemma extends_app : ST T,
                extends (ST ++ T) ST.
              @@ -1774,7 +1775,7 @@

              ReferencesTyping Mutable References<


              -Lemma extends_refl : ST,
              +Lemma extends_refl : ST,
                extends ST ST.
              @@ -1794,13 +1795,13 @@

              ReferencesTyping Mutable References<

              -Definition preservation_theorem := ST t t' T st st',
              -  empty; ST |- tT
              +Definition preservation_theorem := ST t t' T st st',
              +  empty; STtT
                store_well_typed ST st
              -  t / st ==> t' / st'
              -   ST',
              +  t / st --> t' / st'
              +  ST',
                  (extends ST' ST
              -     empty; ST' |- t'T
              +     empty; ST't'T
                   store_well_typed ST' st').
              @@ -1838,50 +1839,50 @@

              ReferencesTyping Mutable References<
              Inductive appears_free_in : stringtmProp :=
              -  | afi_var : x,
              -      appears_free_in x (tvar x)
              -  | afi_app1 : x t1 t2,
              -      appears_free_in x t1appears_free_in x (tapp t1 t2)
              -  | afi_app2 : x t1 t2,
              -      appears_free_in x t2appears_free_in x (tapp t1 t2)
              -  | afi_abs : x y T11 t12,
              +  | afi_var : x,
              +      appears_free_in x (var x)
              +  | afi_app1 : x t1 t2,
              +      appears_free_in x t1appears_free_in x (app t1 t2)
              +  | afi_app2 : x t1 t2,
              +      appears_free_in x t2appears_free_in x (app t1 t2)
              +  | afi_abs : x y T11 t12,
                    yx
                    appears_free_in x t12
              -      appears_free_in x (tabs y T11 t12)
              -  | afi_succ : x t1,
              +      appears_free_in x (abs y T11 t12)
              +  | afi_succ : x t1,
                    appears_free_in x t1
              -      appears_free_in x (tsucc t1)
              -  | afi_pred : x t1,
              +      appears_free_in x (scc t1)
              +  | afi_pred : x t1,
                    appears_free_in x t1
              -      appears_free_in x (tpred t1)
              -  | afi_mult1 : x t1 t2,
              +      appears_free_in x (prd t1)
              +  | 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 (mlt t1 t2)
              +  | afi_mult2 : x t1 t2,
                    appears_free_in x t2
              -      appears_free_in x (tmult t1 t2)
              -  | afi_if0_1 : x t1 t2 t3,
              +      appears_free_in x (mlt t1 t2)
              +  | afi_if0_1 : x t1 t2 t3,
                    appears_free_in x t1
              -      appears_free_in x (tif0 t1 t2 t3)
              -  | afi_if0_2 : x t1 t2 t3,
              +      appears_free_in x (test0 t1 t2 t3)
              +  | afi_if0_2 : x t1 t2 t3,
                    appears_free_in x t2
              -      appears_free_in x (tif0 t1 t2 t3)
              -  | afi_if0_3 : x t1 t2 t3,
              +      appears_free_in x (test0 t1 t2 t3)
              +  | afi_if0_3 : x t1 t2 t3,
                    appears_free_in x t3
              -      appears_free_in x (tif0 t1 t2 t3)
              -  | afi_ref : x t1,
              -      appears_free_in x t1appears_free_in x (tref t1)
              -  | afi_deref : x t1,
              -      appears_free_in x t1appears_free_in x (tderef t1)
              -  | afi_assign1 : x t1 t2,
              -      appears_free_in x t1appears_free_in x (tassign t1 t2)
              -  | afi_assign2 : x t1 t2,
              -      appears_free_in x t2appears_free_in x (tassign t1 t2).

              +      appears_free_in x (test0 t1 t2 t3)
              +  | afi_ref : x t1,
              +      appears_free_in x t1appears_free_in x (ref t1)
              +  | afi_deref : x t1,
              +      appears_free_in x t1appears_free_in x (deref t1)
              +  | afi_assign1 : x t1 t2,
              +      appears_free_in x t1appears_free_in x (assign t1 t2)
              +  | afi_assign2 : x t1 t2,
              +      appears_free_in x t2appears_free_in x (assign t1 t2).

              Hint Constructors appears_free_in.

              -Lemma free_in_context : x t T Gamma ST,
              +Lemma free_in_context : x t T Gamma ST,
                 appears_free_in x t
              -   Gamma; ST |- tT
              -    T', Gamma x = Some T'.
              +   Gamma; STtT
              +   T', Gamma x = Some T'.
              Proof with eauto.
              @@ -1896,10 +1897,10 @@

              ReferencesTyping Mutable References<


              -Lemma context_invariance : Gamma Gamma' ST t T,
              -  Gamma; ST |- tT
              -  ( x, appears_free_in x tGamma x = Gamma' x) →
              -  Gamma'; ST |- tT.
              +Lemma context_invariance : Gamma Gamma' ST t T,
              +  Gamma; STtT
              +  (x, appears_free_in x tGamma x = Gamma' x) →
              +  Gamma'; STtT.
              Proof with eauto.
              @@ -1933,10 +1934,10 @@

              ReferencesTyping Mutable References<


              -Lemma substitution_preserves_typing : Gamma ST x s S t T,
              -  empty; ST |- sS
              -  (update Gamma x S); ST |- tT
              -  Gamma; ST |- ([x:=s]t) ∈ T.
              +Lemma substitution_preserves_typing : Gamma ST x s S t T,
              +  empty; STsS
              +  (update Gamma x S); STtT
              +  Gamma; ST ⊢ ([x:=s]t) ∈ T.
              Proof with eauto.
              @@ -1944,7 +1945,7 @@

              ReferencesTyping Mutable References<   generalize dependent Gamma. generalize dependent T.
                induction t; intros T Gamma H;
                  inversion H; subst; simpl...
              -  - (* tvar *)
              +  - (* var *)
                  rename s0 into y.
                  destruct (eqb_stringP x y).
                  + (* x = y *)
              @@ -1959,7 +1960,7 @@

              ReferencesTyping Mutable References<     + (* x <> y *)
                    apply T_Var.
                    rewrite update_neq in H3...
              -  - (* tabs *) subst.
              +  - (* abs *) subst.
                  rename s0 into y.
                  destruct (eqb_stringP x y).
                  + (* x = y *)
              @@ -1989,10 +1990,10 @@

              ReferencesTyping Mutable References<

              -Lemma assign_pres_store_typing : ST st l t,
              +Lemma assign_pres_store_typing : ST st l t,
                l < length st
                store_well_typed ST st
              -  empty; ST |- t ∈ (store_Tlookup l ST) →
              +  empty; STt ∈ (store_Tlookup l ST) →
                store_well_typed ST (replace l t st).
              @@ -2033,10 +2034,10 @@

              ReferencesTyping Mutable References<

              -Lemma store_weakening : Gamma ST ST' t T,
              +Lemma store_weakening : Gamma ST ST' t T,
                extends ST' ST
              -  Gamma; ST |- tT
              -  Gamma; ST' |- tT.
              +  Gamma; STtT
              +  Gamma; ST'tT.
              Proof with eauto.
              @@ -2057,9 +2058,9 @@

              ReferencesTyping Mutable References<

              -Lemma store_well_typed_app : ST st t1 T1,
              +Lemma store_well_typed_app : ST st t1 T1,
                store_well_typed ST st
              -  empty; ST |- t1T1
              +  empty; STt1T1
                store_well_typed (ST ++ T1::nil) (st ++ t1::nil).
              @@ -2106,7 +2107,7 @@

              ReferencesTyping Mutable References<

              -Lemma nth_eq_last : A (l:list A) x d,
              +Lemma nth_eq_last : A (l:list A) x d,
                nth (length l) (l ++ x::nil) d = x.
              @@ -2121,13 +2122,13 @@

              ReferencesTyping Mutable References<

              -Theorem preservation : ST t t' T st st',
              -  empty; ST |- tT
              +Theorem preservation : ST t t' T st st',
              +  empty; STtT
                store_well_typed ST st
              -  t / st ==> t' / st'
              -   ST',
              +  t / st --> t' / st'
              +  ST',
                  (extends ST' ST
              -     empty; ST' |- t'T
              +     empty; ST't'T
                   store_well_typed ST' st').
              @@ -2139,50 +2140,50 @@

              ReferencesTyping Mutable References<     subst; try solve_by_invert; inversion Hstep; subst;
                  try (eauto using store_weakening, extends_refl).
                (* T_App *)
              -  - (* ST_AppAbs *) ST.
              +  - (* ST_AppAbs *) ST.
                  inversion Ht1; subst.
                  split; try split... eapply substitution_preserves_typing...
                - (* ST_App1 *)
                  eapply IHHt1 in H0...
                  inversion H0 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                - (* ST_App2 *)
                  eapply IHHt2 in H5...
                  inversion H5 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                - (* T_Succ *)
                  + (* ST_Succ *)
                    eapply IHHt in H0...
                    inversion H0 as [ST' [Hext [Hty Hsty]]].
              -       ST'...
              +      ST'...
                - (* T_Pred *)
                  + (* ST_Pred *)
                    eapply IHHt in H0...
                    inversion H0 as [ST' [Hext [Hty Hsty]]].
              -       ST'...
              +      ST'...
                (* T_Mult *)
                - (* ST_Mult1 *)
                  eapply IHHt1 in H0...
                  inversion H0 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                - (* ST_Mult2 *)
                  eapply IHHt2 in H5...
                  inversion H5 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                - (* T_If0 *)
                  + (* ST_If0_1 *)
                    eapply IHHt1 in H0...
                    inversion H0 as [ST' [Hext [Hty Hsty]]].
              -       ST'... split...
              +      ST'... split...
                (* T_Ref *)
                - (* ST_RefValue *)
              -     (ST ++ T1::nil).
              +    (ST ++ T1::nil).
                  inversion HST; subst.
                  split.
                    apply extends_app.
                  split.
              -      replace (TRef T1)
              -        with (TRef (store_Tlookup (length st) (ST ++ T1::nil))).
              +      replace (Ref T1)
              +        with (Ref (store_Tlookup (length st) (ST ++ T1::nil))).
                    apply T_Loc.
                    rewrite <- H. rewrite app_length, plus_comm. simpl. omega.
                    unfold store_Tlookup. rewrite <- H. rewrite nth_eq_last.
              @@ -2191,10 +2192,10 @@

              ReferencesTyping Mutable References<   - (* ST_Ref *)
                  eapply IHHt in H0...
                  inversion H0 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                (* T_Deref *)
                - (* ST_DerefLoc *)
              -     ST. split; try split...
              +    ST. split; try split...
                  inversion HST as [_ Hsty].
                  replace T11 with (store_Tlookup l ST).
                  apply Hsty...
              @@ -2202,26 +2203,26 @@

              ReferencesTyping Mutable References<   - (* ST_Deref *)
                  eapply IHHt in H0...
                  inversion H0 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                (* T_Assign *)
                - (* ST_Assign *)
              -     ST. split; try split...
              +    ST. split; try split...
                  eapply assign_pres_store_typing...
                  inversion Ht1; subst...
                - (* ST_Assign1 *)
                  eapply IHHt1 in H0...
                  inversion H0 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
                - (* ST_Assign2 *)
                  eapply IHHt2 in H5...
                  inversion H5 as [ST' [Hext [Hty Hsty]]].
              -     ST'...
              +    ST'...
              Qed.

              -

              练习:3 星 (preservation_informal)

              +

              练习:3 星, standard (preservation_informal)

              Write a careful informal proof of the preservation theorem, concentrating on the T_App, T_Deref, T_Assign, and T_Ref cases. @@ -2250,10 +2251,10 @@

              ReferencesTyping Mutable References<

              -Theorem progress : ST t T st,
              -  empty; ST |- tT
              +Theorem progress : ST t T st,
              +  empty; STtT
                store_well_typed ST st
              -  (value t t', st', t / st ==> t' / st').
              +  (value tt' st', t / st --> t' / st').
              Proof with eauto.
              @@ -2266,28 +2267,28 @@

              ReferencesTyping Mutable References<       destruct IHHt2 as [Ht2p | Ht2p]...
                    * (* t2 steps *)
                      inversion Ht2p as [t2' [st' Hstep]].
              -         (tapp (tabs x T t) t2'). st'...
              +        (app (abs x T t) t2'), st'...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tapp t1' t2). st'...
              +      (app t1' t2), st'...
                - (* T_Succ *)
                  right. destruct IHHt as [Ht1p | Ht1p]...
                  + (* t1 is a value *)
                    inversion Ht1p; subst; try solve [ inversion Ht ].
              -      * (* t1 is a tnat *)
              -         (tnat (S n)). st...
              +      * (* t1 is a const *)
              +        (const (S n)), st...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tsucc t1'). st'...
              +      (scc t1'), st'...
                - (* T_Pred *)
                  right. destruct IHHt as [Ht1p | Ht1p]...
                  + (* t1 is a value *)
                    inversion Ht1p; subst; try solve [inversion Ht ].
              -      * (* t1 is a tnat *)
              -         (tnat (pred n)). st...
              +      * (* t1 is a const *)
              +        (const (pred n)), st...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tpred t1'). st'...
              +      (prd t1'), st'...
                - (* T_Mult *)
                  right. destruct IHHt1 as [Ht1p | Ht1p]...
                  + (* t1 is a value *)
              @@ -2295,28 +2296,28 @@

              ReferencesTyping Mutable References<       destruct IHHt2 as [Ht2p | Ht2p]...
                    * (* t2 is a value *)
                      inversion Ht2p; subst; try solve [inversion Ht2].
              -         (tnat (mult n n0)). st...
              +        (const (mult n n0)), st...
                    * (* t2 steps *)
                      inversion Ht2p as [t2' [st' Hstep]].
              -         (tmult (tnat n) t2'). st'...
              +        (mlt (const n) t2'), st'...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tmult t1' t2). st'...
              +      (mlt t1' t2), st'...
                - (* T_If0 *)
                  right. destruct IHHt1 as [Ht1p | Ht1p]...
                  + (* t1 is a value *)
                    inversion Ht1p; subst; try solve [inversion Ht1].
                    destruct n.
              -      * (* n = 0 *) t2. st...
              -      * (* n = S n' *) t3. st...
              +      * (* n = 0 *) t2, st...
              +      * (* n = S n' *) t3, st...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tif0 t1' t2 t3). st'...
              +      (test0 t1' t2 t3), st'...
                - (* T_Ref *)
                  right. destruct IHHt as [Ht1p | Ht1p]...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tref t1'). st'...
              +      (ref t1'), st'...
                - (* T_Deref *)
                  right. destruct IHHt as [Ht1p | Ht1p]...
                  + (* t1 is a value *)
              @@ -2326,7 +2327,7 @@

              ReferencesTyping Mutable References<       rewrite <- H...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tderef t1'). st'...
              +      (deref t1'), st'...
                - (* T_Assign *)
                  right. destruct IHHt1 as [Ht1p|Ht1p]...
                  + (* t1 is a value *)
              @@ -2338,10 +2339,10 @@

              ReferencesTyping Mutable References<         rewrite H in H5...
                    * (* t2 steps *)
                      inversion Ht2p as [t2' [st' Hstep]].
              -         (tassign t1 t2'). st'...
              +        (assign t1 t2'), st'...
                  + (* t1 steps *)
                    inversion Ht1p as [t1' [st' Hstep]].
              -       (tassign t1' t2). st'...
              +      (assign t1' t2), st'...
              Qed.

              @@ -2369,7 +2370,7 @@

              ReferencesTyping Mutable References< another function stored in a reference cell; the trick is that we then smuggle in a reference to itself!
              -   (\r:Ref (Unit -> Unit).
              +   (\r:Ref (Unit -> Unit).
                       r := (\x:Unit.(!r) unit); (!r) unit)
                  (ref (\x:Unit.unit))
               
              @@ -2398,13 +2399,13 @@

              ReferencesTyping Mutable References< Module RefsAndNontermination.
              Import ExampleVariables.

              Definition loop_fun :=
              -  tabs x TUnit (tapp (tderef (tvar r)) tunit).

              +  abs x Unit (app (deref (var r)) unit).

              Definition loop :=
              -  tapp
              -    (tabs r (TRef (TArrow TUnit TUnit))
              -      (tseq (tassign (tvar r) loop_fun)
              -              (tapp (tderef (tvar r)) tunit)))
              -    (tref (tabs x TUnit tunit)).
              +  app
              +    (abs r (Ref (Arrow Unit Unit))
              +      (tseq (assign (var r) loop_fun)
              +              (app (deref (var r)) unit)))
              +    (ref (abs x Unit unit)).

              @@ -2412,7 +2413,7 @@

              ReferencesTyping Mutable References<

              -Lemma loop_typeable : T, empty; nil |- loopT.
              +Lemma loop_typeable : T, empty; nilloopT.
              Proof with eauto.
              @@ -2434,22 +2435,22 @@

              ReferencesTyping Mutable References<
              To show formally that the term diverges, we first define the step_closure of the single-step reduction relation, written - ==>+. This is just like the reflexive step closure of - single-step reduction (which we're been writing ==>*), except - that it is not reflexive: t ==>+ t' means that t can reach + -->+. This is just like the reflexive step closure of + single-step reduction (which we're been writing -->*), except + that it is not reflexive: t -->+ t' means that t can reach t' by _one or more_ steps of reduction.
              Inductive step_closure {X:Type} (R: relation X) : XXProp :=
              -  | sc_one : (x y : X),
              +  | sc_one : (x y : X),
                              R x ystep_closure R x y
              -  | sc_step : (x y z : X),
              +  | sc_step : (x y z : X),
                              R x y
                              step_closure R y z
                              step_closure R x z.

              Definition multistep1 := (step_closure step).
              -Notation "t1 '/' st '==>+' t2 '/' st'" :=
              +Notation "t1 '/' st '-->+' t2 '/' st'" :=
                      (multistep1 (t1,st) (t2,st'))
                      (at level 40, st at level 39, t2 at level 39).
              @@ -2469,7 +2470,7 @@

              ReferencesTyping Mutable References<

              -Ltac print_goal := match goal with |- ?xidtac x end.
              +Ltac print_goal := match goal with ⊢ ?xidtac x end.
              Ltac reduce :=
                  repeat (print_goal; eapply multi_step ;
                          [ (eauto 10; fail) | (instantiate; compute)];
              @@ -2483,8 +2484,8 @@

              ReferencesTyping Mutable References<
              Lemma loop_steps_to_loop_fun :
              -  loop / nil ==>*
              -  tapp (tderef (tloc 0)) tunit / cons ([r:=tloc 0]loop_fun) nil.
              +  loop / nil -->*
              +  app (deref (loc 0)) unit / cons ([r:=loc 0]loop_fun) nil.
              Proof.
                unfold loop.
                reduce.
              @@ -2498,8 +2499,8 @@

              ReferencesTyping Mutable References<
              Lemma loop_fun_step_self :
              -  tapp (tderef (tloc 0)) tunit / cons ([r:=tloc 0]loop_fun) nil ==>+
              -  tapp (tderef (tloc 0)) tunit / cons ([r:=tloc 0]loop_fun) nil.
              +  app (deref (loc 0)) unit / cons ([r:=loc 0]loop_fun) nil -->+
              +  app (deref (loc 0)) unit / cons ([r:=loc 0]loop_fun) nil.
              Proof with eauto.
              @@ -2511,7 +2512,7 @@

              ReferencesTyping Mutable References<

              -

              练习:4 星 (factorial_ref)

              +

              练习:4 星, standard (factorial_ref)

              Use the above ideas to implement a factorial function in STLC with references. (There is no need to prove formally that it really behaves like the factorial. Just uncomment the example below to make @@ -2522,7 +2523,7 @@

              ReferencesTyping Mutable References< Definition factorial : tm
                (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

              -Lemma factorial_type : empty; nil |- factorial ∈ (TArrow TNat TNat).
              +Lemma factorial_type : empty; nilfactorial ∈ (Arrow Nat Nat).
              Proof with eauto.
                (* 请在此处解答 *) Admitted.

              @@ -2536,7 +2537,7 @@

              ReferencesTyping Mutable References< (* 
              Lemma factorial_4 : exists st,
              -  tapp factorial (tnat 4) / nil ==>* tnat 24 / st.
              +  app factorial (const 4) / nil -->* const 24 / st.
              Proof.
                eexists. unfold factorial. reduce.
              Qed.
              @@ -2550,7 +2551,7 @@

              ReferencesTyping Mutable References<
              -

              练习:5 星, optional (garabage_collector)

              +

              练习:5 星, standard, optional (garabage_collector)

              Challenge problem: modify our formalization to include an account of garbage collection, and prove that it satisfies whatever nice properties you can think to prove about it. @@ -2561,9 +2562,9 @@

              ReferencesTyping Mutable References<
              End RefsAndNontermination.
              -End STLCRef.
              +End STLCRef.

              +(* Sat Jan 26 15:15:45 UTC 2019 *)
              -

              diff --git a/plf-current/References.v b/plf-current/References.v index b44416a7..0bc59377 100644 --- a/plf-current/References.v +++ b/plf-current/References.v @@ -30,11 +30,12 @@ preservation theorem. *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Arith.Arith. -Require Import Coq.omega.Omega. +From Coq Require Import Strings.String. +From Coq Require Import Arith.Arith. +From Coq Require Import omega.Omega. From PLF Require Import Maps. From PLF Require Import Smallstep. -Require Import Coq.Lists.List. +From Coq Require Import Lists.List. Import ListNotations. (* ################################################################# *) @@ -114,10 +115,10 @@ Module STLCRef. *) Inductive ty : Type := - | TNat : ty - | TUnit : ty - | TArrow : ty -> ty -> ty - | TRef : ty -> ty. + | Nat : ty + | Unit : ty + | Arrow : ty -> ty -> ty + | Ref : ty -> ty. (* ----------------------------------------------------------------- *) (** *** Terms *) @@ -135,33 +136,33 @@ Inductive ty : Type := Inductive tm : Type := (* STLC with numbers: *) - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm - | tnat : nat -> tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tmult : tm -> tm -> tm - | tif0 : tm -> tm -> tm -> tm + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm + | const : nat -> tm + | scc : tm -> tm + | prd : tm -> tm + | mlt : tm -> tm -> tm + | test0 : tm -> tm -> tm -> tm (* New terms: *) - | tunit : tm - | tref : tm -> tm - | tderef : tm -> tm - | tassign : tm -> tm -> tm - | tloc : nat -> tm. + | unit : tm + | ref : tm -> tm + | deref : tm -> tm + | assign : tm -> tm -> tm + | loc : nat -> tm. (** Intuitively: - - [ref t] (formally, [tref t]) allocates a new reference cell + - [ref t] (formally, [ref t]) allocates a new reference cell with the value [t] and reduces to the location of the newly allocated cell; - - [!t] (formally, [tderef t]) reduces to the contents of the + - [!t] (formally, [deref t]) reduces to the contents of the cell referenced by [t]; - - [t1 := t2] (formally, [tassign t1 t2]) assigns [t2] to the + - [t1 := t2] (formally, [assign t1 t2]) assigns [t2] to the cell referenced by [t1]; and - - [l] (formally, [tloc l]) is a reference to the cell at + - [l] (formally, [loc l]) is a reference to the cell at location [l]. We'll discuss locations later. *) (** In informal examples, we'll also freely use the extensions @@ -201,13 +202,13 @@ Inductive tm : Type := Inductive value : tm -> Prop := | v_abs : forall x T t, - value (tabs x T t) + value (abs x T t) | v_nat : forall n, - value (tnat n) + value (const n) | v_unit : - value tunit + value unit | v_loc : forall l, - value (tloc l). + value (loc l). Hint Constructors value. @@ -216,31 +217,31 @@ Hint Constructors value. Fixpoint subst (x:string) (s:tm) (t:tm) : tm := match t with - | tvar x' => + | var x' => if eqb_string x x' then s else t - | tapp t1 t2 => - tapp (subst x s t1) (subst x s t2) - | tabs x' T t1 => - if eqb_string x x' then t else tabs x' T (subst x s t1) - | tnat n => + | app t1 t2 => + app (subst x s t1) (subst x s t2) + | abs x' T t1 => + if eqb_string x x' then t else abs x' T (subst x s t1) + | const n => t - | 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) - | tunit => + | scc t1 => + scc (subst x s t1) + | prd t1 => + prd (subst x s t1) + | mlt t1 t2 => + mlt (subst x s t1) (subst x s t2) + | test0 t1 t2 t3 => + test0 (subst x s t1) (subst x s t2) (subst x s t3) + | unit => t - | tref t1 => - tref (subst x s t1) - | tderef t1 => - tderef (subst x s t1) - | tassign t1 t2 => - tassign (subst x s t1) (subst x s t2) - | tloc _ => + | ref t1 => + ref (subst x s t1) + | deref t1 => + deref (subst x s t1) + | assign t1 t2 => + assign (subst x s t1) (subst x s t2) + | loc _ => t end. @@ -274,12 +275,12 @@ Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). assignments: r:=succ(!r); r:=succ(!r); r:=succ(!r); r:=succ(!r); !r -*) -(** Formally, we introduce sequencing as a _derived form_ + + Formally, we introduce sequencing as a _derived form_ [tseq] that expands into an abstraction and an application. *) Definition tseq t1 t2 := - tapp (tabs "x" TUnit t2) t1. + app (abs "x" Unit t2) t1. (* ================================================================= *) (** ** References and Aliasing *) @@ -379,13 +380,15 @@ Definition tseq t1 t2 := r2 // yields 1, not 2! *) -(** **** 练习:1 星, optional (store_draw) *) -(** Draw (on paper) the contents of the store at the point in +(** **** 练习:1 星, standard, optional (store_draw) + + Draw (on paper) the contents of the store at the point in execution where the first two [let]s have finished and the third one is about to begin. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** References to Compound Types *) @@ -432,8 +435,9 @@ Definition tseq t1 t2 := useful, allowing us to define data structures such as mutable lists and trees. *) -(** **** 练习:2 星, recommended (compact_update) *) -(** If we defined [update] more compactly like this +(** **** 练习:2 星, standard, recommended (compact_update) + + If we defined [update] more compactly like this update = \a:NatArray. \m:Nat. \v:Nat. a := (\n:Nat. if equal m n then v else (!a) n) @@ -493,8 +497,9 @@ Definition manual_grade_for_compact_update : option (nat*string) := None. names for the same storage cell -- one with type [Ref Nat] and the other with type [Ref Bool]. *) -(** **** 练习:2 星 (type_safety_violation) *) -(** Show how this can lead to a violation of type safety. *) +(** **** 练习:2 星, standard (type_safety_violation) + + Show how this can lead to a violation of type safety. *) (* 请在此处解答 *) @@ -565,7 +570,7 @@ Definition manual_grade_for_type_safety_violation : option (nat*string) := None. before is that, in IMP, a program could modify any location at any time, so states had to be ready to map _any_ variable to a value. However, in the STLC with references, the only way to create a - reference cell is with [tref t1], which puts the value of [t1] + reference cell is with [ref t1], which puts the value of [t1] in a new reference cell and reduces to the location of the newly created reference cell. When reducing such an expression, we can just add a new reference cell to the end of the list representing @@ -580,7 +585,7 @@ Definition store := list tm. that we don't will require a bit of work.) *) Definition store_lookup (n:nat) (st:store) := - nth n st tunit. + nth n st unit. (** To update the store, we use the [replace] function, which replaces the contents of a cell at a particular index. *) @@ -658,7 +663,7 @@ Qed. term can cause side effects on the store, and these may affect the reduction of other terms in the future, the reduction rules need to return a new store. Thus, the shape of the single-step - reduction relation needs to change from [t ==> t'] to [t / st ==> t' / + reduction relation needs to change from [t --> t'] to [t / st --> t' / st'], where [st] and [st'] are the starting and ending states of the store. @@ -667,15 +672,15 @@ Qed. value v2 -------------------------------------- (ST_AppAbs) - (\x:T.t12) v2 / st ==> [x:=v2]t12 / st + (\x:T.t12) v2 / st --> [x:=v2]t12 / st - t1 / st ==> t1' / st' + t1 / st --> t1' / st' --------------------------- (ST_App1) - t1 t2 / st ==> t1' t2 / st' + t1 t2 / st --> t1' t2 / st' - value v1 t2 / st ==> t2' / st' + value v1 t2 / st --> t2' / st' ---------------------------------- (ST_App2) - v1 t2 / st ==> v1 t2' / st' + v1 t2 / st --> v1 t2' / st' Note that the first rule here returns the store unchanged, since function application, in itself, has no side effects. The other @@ -699,9 +704,9 @@ Qed. First, to reduce a dereferencing expression [!t1], we must first reduce [t1] until it becomes a value: - t1 / st ==> t1' / st' + t1 / st --> t1' / st' ----------------------- (ST_Deref) - !t1 / st ==> !t1' / st' + !t1 / st --> !t1' / st' Once [t1] has finished reducing, we should have an expression of the form [!l], where [l] is some location. (A term that attempts @@ -714,20 +719,19 @@ Qed. l < |st| ---------------------------------- (ST_DerefLoc) - !(loc l) / st ==> lookup l st / st - + !(loc l) / st --> lookup l st / st Next, to reduce an assignment expression [t1:=t2], we must first reduce [t1] until it becomes a value (a location), and then reduce [t2] until it becomes a value (of any sort): - t1 / st ==> t1' / st' + t1 / st --> t1' / st' ----------------------------------- (ST_Assign1) - t1 := t2 / st ==> t1' := t2 / st' + t1 := t2 / st --> t1' := t2 / st' - t2 / st ==> t2' / st' + t2 / st --> t2' / st' --------------------------------- (ST_Assign2) - v1 := t2 / st ==> v1 := t2' / st' + v1 := t2 / st --> v1 := t2' / st' Once we have finished with [t1] and [t2], we have an expression of the form [l:=v2], which we execute by updating the store to make @@ -735,7 +739,7 @@ Qed. l < |st| ------------------------------------- (ST_Assign) - loc l := v2 / st ==> unit / [l:=v2]st + loc l := v2 / st --> unit / [l:=v2]st The notation [[l:=v2]st] means "the store that maps [l] to [v2] and maps all other locations to the same thing as [st.]" Note @@ -745,16 +749,16 @@ Qed. Finally, to reduct an expression of the form [ref t1], we first reduce [t1] until it becomes a value: - t1 / st ==> t1' / st' + t1 / st --> t1' / st' ----------------------------- (ST_Ref) - ref t1 / st ==> ref t1' / st' + ref t1 / st --> ref t1' / st' Then, to reduce the [ref] itself, we choose a fresh location at the end of the current store -- i.e., location [|st|] -- and yield a new store that extends [st] with the new value [v1]. -------------------------------- (ST_RefValue) - ref v1 / st ==> loc |st| / st,v1 + ref v1 / st --> loc |st| / st,v1 The value resulting from this step is the newly allocated location itself. (Formally, [st,v1] means [st ++ v1::nil] -- i.e., to add @@ -773,7 +777,7 @@ Qed. Here are the rules again, formally: *) -Reserved Notation "t1 '/' st1 '==>' t2 '/' st2" +Reserved Notation "t1 '/' st1 '-->' t2 '/' st2" (at level 40, st1 at level 39, t2 at level 39). Import ListNotations. @@ -781,65 +785,65 @@ Import ListNotations. Inductive step : tm * store -> tm * store -> Prop := | ST_AppAbs : forall x T t12 v2 st, value v2 -> - tapp (tabs x T t12) v2 / st ==> [x:=v2]t12 / st + app (abs x T t12) v2 / st --> [x:=v2]t12 / st | ST_App1 : forall t1 t1' t2 st st', - t1 / st ==> t1' / st' -> - tapp t1 t2 / st ==> tapp t1' t2 / st' + t1 / st --> t1' / st' -> + app t1 t2 / st --> app t1' t2 / st' | ST_App2 : forall v1 t2 t2' st st', value v1 -> - t2 / st ==> t2' / st' -> - tapp v1 t2 / st ==> tapp v1 t2'/ st' + t2 / st --> t2' / st' -> + app v1 t2 / st --> app v1 t2'/ st' | ST_SuccNat : forall n st, - tsucc (tnat n) / st ==> tnat (S n) / st + scc (const n) / st --> const (S n) / st | ST_Succ : forall t1 t1' st st', - t1 / st ==> t1' / st' -> - tsucc t1 / st ==> tsucc t1' / st' + t1 / st --> t1' / st' -> + scc t1 / st --> scc t1' / st' | ST_PredNat : forall n st, - tpred (tnat n) / st ==> tnat (pred n) / st + prd (const n) / st --> const (pred n) / st | ST_Pred : forall t1 t1' st st', - t1 / st ==> t1' / st' -> - tpred t1 / st ==> tpred t1' / st' + t1 / st --> t1' / st' -> + prd t1 / st --> prd t1' / st' | ST_MultNats : forall n1 n2 st, - tmult (tnat n1) (tnat n2) / st ==> tnat (mult n1 n2) / st + mlt (const n1) (const n2) / st --> const (mult n1 n2) / st | ST_Mult1 : forall t1 t2 t1' st st', - t1 / st ==> t1' / st' -> - tmult t1 t2 / st ==> tmult t1' t2 / st' + t1 / st --> t1' / st' -> + mlt t1 t2 / st --> mlt t1' t2 / st' | ST_Mult2 : forall v1 t2 t2' st st', value v1 -> - t2 / st ==> t2' / st' -> - tmult v1 t2 / st ==> tmult v1 t2' / st' + t2 / st --> t2' / st' -> + mlt v1 t2 / st --> mlt v1 t2' / st' | ST_If0 : forall t1 t1' t2 t3 st st', - t1 / st ==> t1' / st' -> - tif0 t1 t2 t3 / st ==> tif0 t1' t2 t3 / st' + t1 / st --> t1' / st' -> + test0 t1 t2 t3 / st --> test0 t1' t2 t3 / st' | ST_If0_Zero : forall t2 t3 st, - tif0 (tnat 0) t2 t3 / st ==> t2 / st + test0 (const 0) t2 t3 / st --> t2 / st | ST_If0_Nonzero : forall n t2 t3 st, - tif0 (tnat (S n)) t2 t3 / st ==> t3 / st + test0 (const (S n)) t2 t3 / st --> t3 / st | ST_RefValue : forall v1 st, value v1 -> - tref v1 / st ==> tloc (length st) / (st ++ v1::nil) + ref v1 / st --> loc (length st) / (st ++ v1::nil) | ST_Ref : forall t1 t1' st st', - t1 / st ==> t1' / st' -> - tref t1 / st ==> tref t1' / st' + t1 / st --> t1' / st' -> + ref t1 / st --> ref t1' / st' | ST_DerefLoc : forall st l, l < length st -> - tderef (tloc l) / st ==> store_lookup l st / st + deref (loc l) / st --> store_lookup l st / st | ST_Deref : forall t1 t1' st st', - t1 / st ==> t1' / st' -> - tderef t1 / st ==> tderef t1' / st' + t1 / st --> t1' / st' -> + deref t1 / st --> deref t1' / st' | ST_Assign : forall v2 l st, value v2 -> l < length st -> - tassign (tloc l) v2 / st ==> tunit / replace l v2 st + assign (loc l) v2 / st --> unit / replace l v2 st | ST_Assign1 : forall t1 t1' t2 st st', - t1 / st ==> t1' / st' -> - tassign t1 t2 / st ==> tassign t1' t2 / st' + t1 / st --> t1' / st' -> + assign t1 t2 / st --> assign t1' t2 / st' | ST_Assign2 : forall v1 t2 t2' st st', value v1 -> - t2 / st ==> t2' / st' -> - tassign v1 t2 / st ==> tassign v1 t2' / st' + t2 / st --> t2' / st' -> + assign v1 t2 / st --> assign v1 t2' / st' -where "t1 '/' st1 '==>' t2 '/' st2" := (step (t1,st1) (t2,st2)). +where "t1 '/' st1 '-->' t2 '/' st2" := (step (t1,st1) (t2,st2)). (** One slightly ugly point should be noted here: In the [ST_RefValue] rule, we extend the state by writing [st ++ v1::nil] rather than @@ -850,7 +854,7 @@ where "t1 '/' st1 '==>' t2 '/' st2" := (step (t1,st1) (t2,st2)). Hint Constructors step. Definition multistep := (multi step). -Notation "t1 '/' st '==>*' t2 '/' st'" := +Notation "t1 '/' st '-->*' t2 '/' st'" := (multistep (t1,st) (t2,st')) (at level 40, st at level 39, t2 at level 39). @@ -862,7 +866,6 @@ Notation "t1 '/' st '==>*' t2 '/' st'" := Definition context := partial_map ty. - (* ================================================================= *) (** ** Store typings *) @@ -934,8 +937,9 @@ Definition context := partial_map ty. [\x:Nat. (!(loc 1)) x, \x:Nat. (!(loc 0)) x] *) -(** **** 练习:2 星 (cyclic_store) *) -(** Can you find a term whose reduction will create this particular +(** **** 练习:2 星, standard (cyclic_store) + + Can you find a term whose reduction will create this particular cyclic store? *) (* 请勿修改下面这一行: *) @@ -972,7 +976,7 @@ Definition store_ty := list ty. index. *) Definition store_Tlookup (n:nat) (ST:store_ty) := - nth n ST TUnit. + nth n ST Unit. (** Suppose we are given a store typing [ST] describing the store [st] in which some term [t] will be reduced. Then we can use @@ -986,7 +990,6 @@ Definition store_Tlookup (n:nat) (ST:store_ty) := ------------------------------------- Gamma; ST |- loc l : Ref (lookup l ST) - That is, as long as [l] is a valid location, we can compute the type of [l] just by looking it up in [ST]. Typing is again a four-place relation, but it is parameterized on a store _typing_ @@ -1025,46 +1028,46 @@ Reserved Notation "Gamma ';' ST '|-' t '\in' T" (at level 40). Inductive has_type : context -> store_ty -> tm -> ty -> Prop := | T_Var : forall Gamma ST x T, Gamma x = Some T -> - Gamma; ST |- (tvar x) \in T + Gamma; ST |- (var x) \in T | T_Abs : forall Gamma ST x T11 T12 t12, (update Gamma x T11); ST |- t12 \in T12 -> - Gamma; ST |- (tabs x T11 t12) \in (TArrow T11 T12) + Gamma; ST |- (abs x T11 t12) \in (Arrow T11 T12) | T_App : forall T1 T2 Gamma ST t1 t2, - Gamma; ST |- t1 \in (TArrow T1 T2) -> + Gamma; ST |- t1 \in (Arrow T1 T2) -> Gamma; ST |- t2 \in T1 -> - Gamma; ST |- (tapp t1 t2) \in T2 + Gamma; ST |- (app t1 t2) \in T2 | T_Nat : forall Gamma ST n, - Gamma; ST |- (tnat n) \in TNat + Gamma; ST |- (const n) \in Nat | T_Succ : forall Gamma ST t1, - Gamma; ST |- t1 \in TNat -> - Gamma; ST |- (tsucc t1) \in TNat + Gamma; ST |- t1 \in Nat -> + Gamma; ST |- (scc t1) \in Nat | T_Pred : forall Gamma ST t1, - Gamma; ST |- t1 \in TNat -> - Gamma; ST |- (tpred t1) \in TNat + Gamma; ST |- t1 \in Nat -> + Gamma; ST |- (prd t1) \in Nat | T_Mult : forall Gamma ST t1 t2, - Gamma; ST |- t1 \in TNat -> - Gamma; ST |- t2 \in TNat -> - Gamma; ST |- (tmult t1 t2) \in TNat + Gamma; ST |- t1 \in Nat -> + Gamma; ST |- t2 \in Nat -> + Gamma; ST |- (mlt t1 t2) \in Nat | T_If0 : forall Gamma ST t1 t2 t3 T, - Gamma; ST |- t1 \in TNat -> + Gamma; ST |- t1 \in Nat -> Gamma; ST |- t2 \in T -> Gamma; ST |- t3 \in T -> - Gamma; ST |- (tif0 t1 t2 t3) \in T + Gamma; ST |- (test0 t1 t2 t3) \in T | T_Unit : forall Gamma ST, - Gamma; ST |- tunit \in TUnit + Gamma; ST |- unit \in Unit | T_Loc : forall Gamma ST l, l < length ST -> - Gamma; ST |- (tloc l) \in (TRef (store_Tlookup l ST)) + Gamma; ST |- (loc l) \in (Ref (store_Tlookup l ST)) | T_Ref : forall Gamma ST t1 T1, Gamma; ST |- t1 \in T1 -> - Gamma; ST |- (tref t1) \in (TRef T1) + Gamma; ST |- (ref t1) \in (Ref T1) | T_Deref : forall Gamma ST t1 T11, - Gamma; ST |- t1 \in (TRef T11) -> - Gamma; ST |- (tderef t1) \in T11 + Gamma; ST |- t1 \in (Ref T11) -> + Gamma; ST |- (deref t1) \in T11 | T_Assign : forall Gamma ST t1 t2 T11, - Gamma; ST |- t1 \in (TRef T11) -> + Gamma; ST |- t1 \in (Ref T11) -> Gamma; ST |- t2 \in T11 -> - Gamma; ST |- (tassign t1 t2) \in TUnit + Gamma; ST |- (assign t1 t2) \in Unit where "Gamma ';' ST '|-' t '\in' T" := (has_type Gamma ST t T). @@ -1117,7 +1120,7 @@ Hint Constructors has_type. Theorem preservation_wrong1 : forall ST T t st t' st', empty; ST |- t \in T -> - t / st ==> t' / st' -> + t / st --> t' / st' -> empty; ST |- t' \in T. Abort. @@ -1145,8 +1148,9 @@ Definition store_well_typed (ST:store_ty) (st:store) := typing to the typing relation. This allows us to type circular stores like the one we saw above. *) -(** **** 练习:2 星 (store_not_unique) *) -(** Can you find a store [st], and two +(** **** 练习:2 星, standard (store_not_unique) + + Can you find a store [st], and two different store typings [ST1] and [ST2] such that both [ST1 |- st] and [ST2 |- st]? *) @@ -1161,7 +1165,7 @@ Definition manual_grade_for_store_not_unique : option (nat*string) := None. Theorem preservation_wrong2 : forall ST T t st t' st', empty; ST |- t \in T -> - t / st ==> t' / st' -> + t / st --> t' / st' -> store_well_typed ST st -> empty; ST |- t' \in T. Abort. @@ -1256,7 +1260,7 @@ Qed. Definition preservation_theorem := forall ST t t' T st st', empty; ST |- t \in T -> store_well_typed ST st -> - t / st ==> t' / st' -> + t / st --> t' / st' -> exists ST', (extends ST' ST /\ empty; ST' |- t' \in T /\ @@ -1289,44 +1293,44 @@ Definition preservation_theorem := forall ST t t' T st st', Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) + appears_free_in x t1 -> appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) + appears_free_in x t2 -> appears_free_in x (app t1 t2) | afi_abs : forall x y T11 t12, y <> x -> appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) + appears_free_in x (abs y T11 t12) | afi_succ : forall x t1, appears_free_in x t1 -> - appears_free_in x (tsucc t1) + appears_free_in x (scc t1) | afi_pred : forall x t1, appears_free_in x t1 -> - appears_free_in x (tpred t1) + appears_free_in x (prd t1) | afi_mult1 : forall x t1 t2, appears_free_in x t1 -> - appears_free_in x (tmult t1 t2) + appears_free_in x (mlt t1 t2) | afi_mult2 : forall x t1 t2, appears_free_in x t2 -> - appears_free_in x (tmult t1 t2) + appears_free_in x (mlt t1 t2) | afi_if0_1 : forall x t1 t2 t3, appears_free_in x t1 -> - appears_free_in x (tif0 t1 t2 t3) + appears_free_in x (test0 t1 t2 t3) | afi_if0_2 : forall x t1 t2 t3, appears_free_in x t2 -> - appears_free_in x (tif0 t1 t2 t3) + appears_free_in x (test0 t1 t2 t3) | afi_if0_3 : forall x t1 t2 t3, appears_free_in x t3 -> - appears_free_in x (tif0 t1 t2 t3) + appears_free_in x (test0 t1 t2 t3) | afi_ref : forall x t1, - appears_free_in x t1 -> appears_free_in x (tref t1) + appears_free_in x t1 -> appears_free_in x (ref t1) | afi_deref : forall x t1, - appears_free_in x t1 -> appears_free_in x (tderef t1) + appears_free_in x t1 -> appears_free_in x (deref t1) | afi_assign1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tassign t1 t2) + appears_free_in x t1 -> appears_free_in x (assign t1 t2) | afi_assign2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tassign t1 t2). + appears_free_in x t2 -> appears_free_in x (assign t1 t2). Hint Constructors appears_free_in. @@ -1386,7 +1390,7 @@ Proof with eauto. generalize dependent Gamma. generalize dependent T. induction t; intros T Gamma H; inversion H; subst; simpl... - - (* tvar *) + - (* var *) rename s0 into y. destruct (eqb_stringP x y). + (* x = y *) @@ -1401,7 +1405,7 @@ Proof with eauto. + (* x <> y *) apply T_Var. rewrite update_neq in H3... - - (* tabs *) subst. + - (* abs *) subst. rename s0 into y. destruct (eqb_stringP x y). + (* x = y *) @@ -1527,7 +1531,7 @@ Qed. Theorem preservation : forall ST t t' T st st', empty; ST |- t \in T -> store_well_typed ST st -> - t / st ==> t' / st' -> + t / st --> t' / st' -> exists ST', (extends ST' ST /\ empty; ST' |- t' \in T /\ @@ -1582,8 +1586,8 @@ Proof with eauto using store_weakening, extends_refl. split. apply extends_app. split. - replace (TRef T1) - with (TRef (store_Tlookup (length st) (ST ++ T1::nil))). + replace (Ref T1) + with (Ref (store_Tlookup (length st) (ST ++ T1::nil))). apply T_Loc. rewrite <- H. rewrite app_length, plus_comm. simpl. omega. unfold store_Tlookup. rewrite <- H. rewrite nth_eq_last. @@ -1619,8 +1623,9 @@ Proof with eauto using store_weakening, extends_refl. exists ST'... Qed. -(** **** 练习:3 星 (preservation_informal) *) -(** Write a careful informal proof of the preservation theorem, +(** **** 练习:3 星, standard (preservation_informal) + + Write a careful informal proof of the preservation theorem, concentrating on the [T_App], [T_Deref], [T_Assign], and [T_Ref] cases. @@ -1641,7 +1646,7 @@ Definition manual_grade_for_preservation_informal : option (nat*string) := None. Theorem progress : forall ST t T st, empty; ST |- t \in T -> store_well_typed ST st -> - (value t \/ exists t', exists st', t / st ==> t' / st'). + (value t \/ exists t' st', t / st --> t' / st'). Proof with eauto. intros ST t T st Ht HST. remember (@empty ty) as Gamma. induction Ht; subst; try solve_by_invert... @@ -1652,28 +1657,28 @@ Proof with eauto. destruct IHHt2 as [Ht2p | Ht2p]... * (* t2 steps *) inversion Ht2p as [t2' [st' Hstep]]. - exists (tapp (tabs x T t) t2'). exists st'... + exists (app (abs x T t) t2'), st'... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tapp t1' t2). exists st'... + exists (app t1' t2), st'... - (* T_Succ *) right. destruct IHHt as [Ht1p | Ht1p]... + (* t1 is a value *) inversion Ht1p; subst; try solve [ inversion Ht ]. - * (* t1 is a tnat *) - exists (tnat (S n)). exists st... + * (* t1 is a const *) + exists (const (S n)), st... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tsucc t1'). exists st'... + exists (scc t1'), st'... - (* T_Pred *) right. destruct IHHt as [Ht1p | Ht1p]... + (* t1 is a value *) inversion Ht1p; subst; try solve [inversion Ht ]. - * (* t1 is a tnat *) - exists (tnat (pred n)). exists st... + * (* t1 is a const *) + exists (const (pred n)), st... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tpred t1'). exists st'... + exists (prd t1'), st'... - (* T_Mult *) right. destruct IHHt1 as [Ht1p | Ht1p]... + (* t1 is a value *) @@ -1681,28 +1686,28 @@ Proof with eauto. destruct IHHt2 as [Ht2p | Ht2p]... * (* t2 is a value *) inversion Ht2p; subst; try solve [inversion Ht2]. - exists (tnat (mult n n0)). exists st... + exists (const (mult n n0)), st... * (* t2 steps *) inversion Ht2p as [t2' [st' Hstep]]. - exists (tmult (tnat n) t2'). exists st'... + exists (mlt (const n) t2'), st'... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tmult t1' t2). exists st'... + exists (mlt t1' t2), st'... - (* T_If0 *) right. destruct IHHt1 as [Ht1p | Ht1p]... + (* t1 is a value *) inversion Ht1p; subst; try solve [inversion Ht1]. destruct n. - * (* n = 0 *) exists t2. exists st... - * (* n = S n' *) exists t3. exists st... + * (* n = 0 *) exists t2, st... + * (* n = S n' *) exists t3, st... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tif0 t1' t2 t3). exists st'... + exists (test0 t1' t2 t3), st'... - (* T_Ref *) right. destruct IHHt as [Ht1p | Ht1p]... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tref t1'). exists st'... + exists (ref t1'), st'... - (* T_Deref *) right. destruct IHHt as [Ht1p | Ht1p]... + (* t1 is a value *) @@ -1712,7 +1717,7 @@ Proof with eauto. rewrite <- H... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tderef t1'). exists st'... + exists (deref t1'), st'... - (* T_Assign *) right. destruct IHHt1 as [Ht1p|Ht1p]... + (* t1 is a value *) @@ -1724,10 +1729,10 @@ Proof with eauto. rewrite H in H5... * (* t2 steps *) inversion Ht2p as [t2' [st' Hstep]]. - exists (tassign t1 t2'). exists st'... + exists (assign t1 t2'), st'... + (* t1 steps *) inversion Ht1p as [t1' [st' Hstep]]. - exists (tassign t1' t2). exists st'... + exists (assign t1' t2), st'... Qed. (* ################################################################# *) @@ -1777,14 +1782,14 @@ Module RefsAndNontermination. Import ExampleVariables. Definition loop_fun := - tabs x TUnit (tapp (tderef (tvar r)) tunit). + abs x Unit (app (deref (var r)) unit). Definition loop := - tapp - (tabs r (TRef (TArrow TUnit TUnit)) - (tseq (tassign (tvar r) loop_fun) - (tapp (tderef (tvar r)) tunit))) - (tref (tabs x TUnit tunit)). + app + (abs r (Ref (Arrow Unit Unit)) + (tseq (assign (var r) loop_fun) + (app (deref (var r)) unit))) + (ref (abs x Unit unit)). (** This term is well typed: *) @@ -1805,9 +1810,9 @@ Qed. (** To show formally that the term diverges, we first define the [step_closure] of the single-step reduction relation, written - [==>+]. This is just like the reflexive step closure of - single-step reduction (which we're been writing [==>*]), except - that it is not reflexive: [t ==>+ t'] means that [t] can reach + [-->+]. This is just like the reflexive step closure of + single-step reduction (which we're been writing [-->*]), except + that it is not reflexive: [t -->+ t'] means that [t] can reach [t'] by _one or more_ steps of reduction. *) Inductive step_closure {X:Type} (R: relation X) : X -> X -> Prop := @@ -1819,7 +1824,7 @@ Inductive step_closure {X:Type} (R: relation X) : X -> X -> Prop := step_closure R x z. Definition multistep1 := (step_closure step). -Notation "t1 '/' st '==>+' t2 '/' st'" := +Notation "t1 '/' st '-->+' t2 '/' st'" := (multistep1 (t1,st) (t2,st')) (at level 40, st at level 39, t2 at level 39). @@ -1844,8 +1849,8 @@ Ltac reduce := [!(loc 0) unit], starting from the empty store. *) Lemma loop_steps_to_loop_fun : - loop / nil ==>* - tapp (tderef (tloc 0)) tunit / cons ([r:=tloc 0]loop_fun) nil. + loop / nil -->* + app (deref (loc 0)) unit / cons ([r:=loc 0]loop_fun) nil. Proof. unfold loop. reduce. @@ -1855,16 +1860,17 @@ Qed. two steps to itself! *) Lemma loop_fun_step_self : - tapp (tderef (tloc 0)) tunit / cons ([r:=tloc 0]loop_fun) nil ==>+ - tapp (tderef (tloc 0)) tunit / cons ([r:=tloc 0]loop_fun) nil. + app (deref (loc 0)) unit / cons ([r:=loc 0]loop_fun) nil -->+ + app (deref (loc 0)) unit / cons ([r:=loc 0]loop_fun) nil. Proof with eauto. unfold loop_fun; simpl. eapply sc_step. apply ST_App1... eapply sc_one. compute. apply ST_AppAbs... Qed. -(** **** 练习:4 星 (factorial_ref) *) -(** Use the above ideas to implement a factorial function in STLC with +(** **** 练习:4 星, standard (factorial_ref) + + Use the above ideas to implement a factorial function in STLC with references. (There is no need to prove formally that it really behaves like the factorial. Just uncomment the example below to make sure it gives the correct result when applied to the argument @@ -1873,7 +1879,7 @@ Qed. Definition factorial : tm (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. -Lemma factorial_type : empty; nil |- factorial \in (TArrow TNat TNat). +Lemma factorial_type : empty; nil |- factorial \in (Arrow Nat Nat). Proof with eauto. (* 请在此处解答 *) Admitted. @@ -1883,18 +1889,19 @@ Proof with eauto. (* Lemma factorial_4 : exists st, - tapp factorial (tnat 4) / nil ==>* tnat 24 / st. + app factorial (const 4) / nil -->* const 24 / st. Proof. eexists. unfold factorial. reduce. Qed. -*) -(** [] *) + + [] *) (* ################################################################# *) (** * Additional Exercises *) -(** **** 练习:5 星, optional (garabage_collector) *) -(** Challenge problem: modify our formalization to include an account +(** **** 练习:5 星, standard, optional (garabage_collector) + + Challenge problem: modify our formalization to include an account of garbage collection, and prove that it satisfies whatever nice properties you can think to prove about it. *) @@ -1903,4 +1910,5 @@ Qed. End RefsAndNontermination. End STLCRef. -(** $Date$ *) + +(* Sat Jan 26 15:15:45 UTC 2019 *) diff --git a/plf-current/ReferencesTest.v b/plf-current/ReferencesTest.v index 9a54720e..c44145c9 100644 --- a/plf-current/ReferencesTest.v +++ b/plf-current/ReferencesTest.v @@ -89,7 +89,7 @@ idtac "Possible points: 2". check_type @STLCRef.RefsAndNontermination.factorial_type ( (STLCRef.has_type (@Maps.empty STLCRef.ty) (@nil STLCRef.ty) STLCRef.RefsAndNontermination.factorial - (STLCRef.TArrow STLCRef.TNat STLCRef.TNat))). + (STLCRef.Arrow STLCRef.Nat STLCRef.Nat))). idtac "Assumptions:". Abort. Print Assumptions STLCRef.RefsAndNontermination.factorial_type. @@ -121,3 +121,5 @@ Print Assumptions STLCRef.RefsAndNontermination.factorial_type. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:30 UTC 2019 *) diff --git a/plf-current/Smallstep.html b/plf-current/Smallstep.html index d93e1c73..ec6fb3ce 100644 --- a/plf-current/Smallstep.html +++ b/plf-current/Smallstep.html @@ -35,11 +35,11 @@

              Smallstep小步操作语义 Set Warnings "-notation-overridden,-parsing".
              -Require Import Coq.Arith.Arith.
              -Require Import Coq.Arith.EqNat.
              -Require Import Coq.Init.Nat.
              -Require Import Coq.omega.Omega.
              -Require Import Coq.Lists.List.
              +From Coq Require Import Arith.Arith.
              +From Coq Require Import Arith.EqNat.
              +From Coq Require Import Init.Nat.
              +From Coq Require Import omega.Omega.
              +From Coq Require Import Lists.List.
              Import ListNotations.
              From PLF Require Import Maps.
              From PLF Require Import Imp.
              @@ -95,7 +95,7 @@

              Smallstep小步操作语义
              -

              一个玩具语言

              +

              一个玩具语言

              @@ -124,8 +124,8 @@

              Smallstep小步操作语义
              -这是用同样风格描述的等价求值器,只是用归纳关系来定义。再一次提醒, - 我们使用记号 t \\ n 来表达“t 求值到 n”。 +这是用同样风格描述的等价求值器,只是用归纳关系来定义。 + 我们使用记号 t ==> n 来表达“t 求值到 n”。
              @@ -138,16 +138,16 @@

              Smallstep小步操作语义

              - +
              C n \\ nC n ==> n
              - + - + @@ -155,28 +155,22 @@

              Smallstep小步操作语义

              - +
              t1 \\ n1t1 ==> n1
              t2 \\ n2t2 ==> n2 (E_Plus)  
              P t1 t2 \\ n1 + n2P t1 t2 ==> n1 + n2
              -Reserved Notation " t '\\' n " (at level 50, left associativity).

              +Reserved Notation " t '==>' n " (at level 50, left associativity).

              Inductive eval : tmnatProp :=
              -
              -
              -  | 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).
              -
              - -
              +  | 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).

              Module SimpleArith1.
              @@ -191,12 +185,12 @@

              Smallstep小步操作语义
              - P (C n1) (C n2) ==> C (n1 + n2) + P (C n1) (C n2--> C (n1 + n2)
              - + @@ -204,12 +198,12 @@

              Smallstep小步操作语义

              - +
              t1 ==> t1't1 --> t1' (ST_Plus1)  
              P t1 t2 ==> P t1' t2P t1 t2 --> P t1' t2
              - + @@ -217,25 +211,25 @@

              Smallstep小步操作语义

              - +
              t2 ==> t2't2 --> t2' (ST_Plus2)  
              P (C n1) t2 ==> P (C n1) t2'P (C n1) t2 --> P (C n1) t2'

              -Reserved Notation " t '==>' t' " (at level 40).

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | 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'
              +  | 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').
              +  where " t '-->' t' " := (step t t').
              @@ -275,19 +269,19 @@

              Smallstep小步操作语义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.
              -

              练习:1 星 (test_step_2)

              +

              练习:1 星, standard (test_step_2)

              当求和操作的左侧表达式已经完成求值,其右侧表达式可向前一步: 如果 t2 可向前一步到 t2',那么 P (C n) t2 可向前一步到 P (C n) t2'
              @@ -299,7 +293,7 @@

              Smallstep小步操作语义P
                        (C 2)
                        (P (C 0) (C 3)))
              -      ==>
              +      -->
                    P
                      (C 0)
                      (P
              @@ -316,7 +310,7 @@

              Smallstep小步操作语义
              -

              关系

              +

              关系

              @@ -331,18 +325,21 @@

              Smallstep小步操作语义
              -Definition relation (X: Type) := XXProp.
              +Definition relation (X : Type) := XXProp.
              -本章中,我们主要的例子将会是单步归约关系,==>,以及它的多步版本, - ==>*(后面会定义),但是也有许多其他例子——比如,“等于”、“小于”、“小于等于” +本章中,我们主要的例子将会是单步规约关系,-->,以及它的多步版本, + -->*(后面会定义),但是也有许多其他例子——比如,“等于”、“小于”、“小于等于” 和数字上“平方数”关系,还有字符串和列表的“前缀”关系。
              - 和 Imp 的大步求值关系一样,==> 关系的一个简单性质是确定性(deterministic)。 + 和 Imp 的大步求值关系一样,--> 关系的一个简单性质是确定性(deterministic)。 + +
              + 定理:对于每个 t,最多有一个 t't 向前一步到 t' - (t ==> t' 是可证的)。这也就是说 ==> 是确定性的。 + (t --> t' 是可证的)。这也就是说 --> 是确定性的。
              证明草稿:我们通过对 step x y1 的导出式(derivation)进行归 @@ -386,37 +383,37 @@

              Smallstep小步操作语义
              -Definition deterministic {X: Type} (R: relation X) :=
              -   x y1 y2 : X, R x y1R x y2y1 = y2.

              +Definition deterministic {X : Type} (R : relation X) :=
              +  x y1 y2 : X, R x y1R x y2y1 = y2.

              Module SimpleArith2.
              Import SimpleArith1.

              Theorem step_deterministic:
                deterministic step.
              -
              -
              +
              +
              Proof.
                unfold deterministic. intros x y1 y2 Hy1 Hy2.
                generalize dependent y2.
                induction Hy1; intros y2 Hy2.
              -    - (* ST_PlusConstConst *) inversion Hy2.
              -      + (* ST_PlusConstConst *) reflexivity.
              -      + (* ST_Plus1 *) inversion H2.
              -      + (* ST_Plus2 *) inversion H2.
              -    - (* ST_Plus1 *) inversion Hy2.
              -      + (* ST_PlusConstConst *)
              -        rewrite <- H0 in Hy1. inversion Hy1.
              -      + (* ST_Plus1 *)
              -        rewrite <- (IHHy1 t1'0).
              -        reflexivity. assumption.
              -      + (* ST_Plus2 *)
              -        rewrite <- H in Hy1. inversion Hy1.
              -    - (* ST_Plus2 *) inversion Hy2.
              -      + (* ST_PlusConstConst *)
              -        rewrite <- H1 in Hy1. inversion Hy1.
              -      + (* ST_Plus1 *) inversion H2.
              -      + (* ST_Plus2 *)
              -        rewrite <- (IHHy1 t2'0).
              -        reflexivity. assumption.
              +  - (* ST_PlusConstConst *) inversion Hy2.
              +    + (* ST_PlusConstConst *) reflexivity.
              +    + (* ST_Plus1 *) inversion H2.
              +    + (* ST_Plus2 *) inversion H2.
              +  - (* ST_Plus1 *) inversion Hy2.
              +    + (* ST_PlusConstConst *)
              +      rewrite <- H0 in Hy1. inversion Hy1.
              +    + (* ST_Plus1 *)
              +      rewrite <- (IHHy1 t1'0).
              +      reflexivity. assumption.
              +    + (* ST_Plus2 *)
              +      rewrite <- H in Hy1. inversion Hy1.
              +  - (* ST_Plus2 *) inversion Hy2.
              +    + (* ST_PlusConstConst *)
              +      rewrite <- H1 in Hy1. inversion Hy1.
              +    + (* ST_Plus1 *) inversion H2.
              +    + (* ST_Plus2 *)
              +      rewrite <- (IHHy1 t2'0).
              +      reflexivity. assumption.
              Qed.
              @@ -438,7 +435,7 @@

              Smallstep小步操作语义 Ltac solve_by_inverts n :=
              -  match goal with | H : ?T |- _
              +  match goal with | H : ?T_
                match type of T with Prop
                  solve [
                    inversion H;
              @@ -487,14 +484,14 @@

              Smallstep小步操作语义
              -

              +

              下一步,我们会使用“值”的概念来稍微重新表述一下单步归约的定义。
              - 为了更好地理解 ==> 关系,我们定义一个抽象机(abstract machine): + 为了更好地理解 --> 关系,我们定义一个抽象机(abstract machine):
              @@ -528,7 +525,7 @@

              Smallstep小步操作语义 -
            • 重复使用 ==> 关系来找到一个以 t 开始的机器状态序列,序列中每个状态 +
            • 重复使用 --> 关系来找到一个以 t 开始的机器状态序列,序列中每个状态 会转移到下一个。
              @@ -547,11 +544,11 @@

              Smallstep小步操作语义 Inductive value : tmProp :=
              -  | v_const : n, value (C n).
              +  | v_const : n, value (C n).

            • -在引入了值的概念后,我们可以使用它来更简洁地定义 ==> +在引入了值的概念后,我们可以使用它来更简洁地定义 --> 关系中的 ST_Plus2 规则:
              @@ -565,12 +562,12 @@

              Smallstep小步操作语义
              - P (C n1) (C n2) ==> C (n1 + n2) + P (C n1) (C n2--> C (n1 + n2)
              - + @@ -578,7 +575,7 @@

              Smallstep小步操作语义

              - +
              t1 ==> t1't1 --> t1' (ST_Plus1)  
              P t1 t2 ==> P t1' t2P t1 t2 --> P t1' t2
              @@ -587,7 +584,7 @@

              Smallstep小步操作语义

              - + @@ -595,7 +592,7 @@

              Smallstep小步操作语义

              - +
              t2 ==> t2't2 --> t2' (ST_Plus2)  
              P v1 t2 ==> P v1 t2'P v1 t2 --> P v1 t2'
              再一次地,变量名在这里包含了重要的信息:按照惯例,v1 涉及到值, @@ -608,25 +605,26 @@

              Smallstep小步操作语义
              -Reserved Notation " t '==>' t' " (at level 40).

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | ST_PlusConstConst : n1 n2,
              +  | 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'
              +      --> 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').
              +  where " t '-->' t' " := (step t t').
              -

              练习:3 星, recommended (redo_determinism)

              +

              练习:3 星, standard, recommended (redo_determinism)

              作为这一改变的完备性检查,让我们重新验证一下确定性。 + 下面是它的非形式化证明:
              @@ -679,7 +677,7 @@

              Smallstep小步操作语义
              -

              强可进性和正规式

              +

              强可进性和正规式

              @@ -689,7 +687,7 @@

              Smallstep小步操作语义

              定理强可进性(Strong Progress)):如果 t 是一个项,那么 t - 要么是一个值,要么存在项 t' 使 t ==> t'。 + 要么是一个值,要么存在项 t' 使 t --> t'
              证明:对 t 进行归纳。 @@ -736,24 +734,25 @@

              Smallstep小步操作语义
              -Theorem strong_progress : t,
              -  value t ∨ ( t', t ==> t').
              -
              -
              +Theorem strong_progress : t,
              +  value t ∨ (t', t --> t').
              +
              +
              Proof.
                induction t.
              -    - (* C *) left. apply v_const.
              -    - (* P *) right. inversion IHt1.
              -      + (* l *) inversion IHt2.
              -        * (* l *) inversion H. inversion H0.
              -           (C (n + n0)).
              -          apply ST_PlusConstConst.
              -        * (* r *) inversion H0 as [t' H1].
              -           (P t1 t').
              -          apply ST_Plus2. apply H. apply H1.
              -      + (* r *) inversion H as [t' H0].
              -           (P t' t2).
              -          apply ST_Plus1. apply H0. Qed.
              +  - (* C *) left. apply v_const.
              +  - (* P *) right. destruct IHt1 as [IHt1 | [t1' Ht1]].
              +    + (* l *) destruct IHt2 as [IHt2 | [t2' Ht2]].
              +      * (* l *) inversion IHt1. inversion IHt2.
              +        (C (n + n0)).
              +        apply ST_PlusConstConst.
              +      * (* r *)
              +        (P t1 t2').
              +        apply ST_Plus2. apply IHt1. apply Ht2.
              +    + (* r *)
              +      (P t1' t2).
              +      apply ST_Plus1. apply Ht1.
              +Qed.
              @@ -773,8 +772,8 @@

              Smallstep小步操作语义
              -Definition normal_form {X:Type} (R:relation X) (t:X) : Prop :=
              -  ¬ t', R t t'.
              +Definition normal_form {X : Type} (R : relation X) (t : X) : Prop :=
              +  ¬t', R t t'.
              @@ -787,10 +786,10 @@

              Smallstep小步操作语义
              -Lemma value_is_nf : v,
              +Lemma value_is_nf : v,
                value vnormal_form step v.
              -
              -
              +
              +
              Proof.
                unfold normal_form. intros v H. inversion H.
                intros contra. inversion contra. inversion H1.
              @@ -798,26 +797,28 @@

              Smallstep小步操作语义
              -Lemma nf_is_value : t,
              +Lemma nf_is_value : t,
                normal_form step tvalue t.
              -
              -
              +
              +
              Proof. (* a corollary of strong_progress... *)
                unfold normal_form. intros t H.
              -  assert (G : value t t', t ==> t').
              -    { apply strong_progress. }
              -  inversion G.
              -    + (* l *) apply H0.
              -    + (* r *) exfalso. apply H. assumption. Qed.
              +  assert (G : value tt', t --> t').
              +  { apply strong_progress. }
              +  destruct G as [G | G].
              +  - (* l *) apply G.
              +  - (* r *) exfalso. apply H. assumption.
              +Qed.

              -Corollary nf_same_as_value : t,
              +Corollary nf_same_as_value : t,
                normal_form step tvalue t.
              -
              -
              +
              +
              Proof.
              -  split. apply nf_is_value. apply value_is_nf. Qed.
              +  split. apply nf_is_value. apply value_is_nf.
              +Qed.
              @@ -827,13 +828,17 @@

              Smallstep小步操作语义

              因为 value 是一个语法概念——它是由项的形式定义的——然而 normal_form 是一个 - 语义概念——它是由项如何前进定义的。并不显然这两个概念应当一致! + 语义概念——它是由项如何前进定义的。 +
              - 确实,容易写下使他们一致的定义。 + 并不显然这两个概念应当一致!
              -

              练习:3 星, optional (value_not_same_as_normal_form1)

              + 确实,容易错误地写下使它们一致的定义。 +
              + +

              练习:3 星, standard, optional (value_not_same_as_normal_form1)

              我们可能错误地定义了 value 使它包括了还没有完成归约的项。 (如果你不想亲自动手在 Coq 中完成这个和下一个练习, 也请思考一下,尝试找到一个这样的项。)
              @@ -841,24 +846,24 @@

              Smallstep小步操作语义Module Temp1.

              Inductive value : tmProp :=
              -| v_const : n, value (C n)
              -| v_funny : t1 n2, (* <---- *)
              -              value (P t1 (C n2)).

              -Reserved Notation " t '==>' t' " (at level 40).

              +  | v_const : n, value (C n)
              +  | v_funny : t1 n2,
              +                value (P t1 (C n2)). (* <--- *)

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | 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',
              +  | 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'
              +      t2 --> t2'
              +      P v1 t2 --> P v1 t2'

              -  where " t '==>' t' " := (step t t').

              +  where " t '-->' t' " := (step t t').

              Lemma value_not_same_as_normal_form :
              -   v, value v ∧ ¬ normal_form step v.
              +  v, value v ∧ ¬normal_form step v.
              Proof.
                (* 请在此处解答 *) Admitted.
              End Temp1.
              @@ -867,33 +872,33 @@

              Smallstep小步操作语义
              -

              练习:2 星, optional (value_not_same_as_normal_form2)

              +

              练习:2 星, standard, optional (value_not_same_as_normal_form2)

              或许,我们错误地定义了 step 使它允许继续归约一个值。
              Module Temp2.

              Inductive value : tmProp :=
              -| v_const : n, value (C n).

              -Reserved Notation " t '==>' t' " (at level 40).

              +  | v_const : n, value (C n). (* Original definition *)

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | 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',
              +  | ST_Funny : n,
              +      C n --> P (C n) (C 0) (* <--- NEW *)
              +  | 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'
              +      t2 --> t2'
              +      P v1 t2 --> P v1 t2'

              -  where " t '==>' t' " := (step t t').

              +  where " t '-->' t' " := (step t t').

              Lemma value_not_same_as_normal_form :
              -   v, value v ∧ ¬ normal_form step v.
              -
              -
              +  v, value v ∧ ¬normal_form step v.
              +
              +
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -904,7 +909,7 @@

              Smallstep小步操作语义
              -

              练习:3 星, optional (value_not_same_as_normal_form3)

              +

              练习:3 星, standard, optional (value_not_same_as_normal_form3)

              最后,我们还可能通过 valuestep 定义了某些不是值但已无法继续由 step 关系进行归约的项。这些项被称作卡住了(stuck)。在这种情况是由语义 中的错误导致的,但我们也会看到一些情况,即使是正确的语言定义中也会允许一些项卡住。 @@ -913,16 +918,16 @@

              Smallstep小步操作语义Module Temp3.

              Inductive value : tmProp :=
              -  | v_const : n, value (C n).

              -Reserved Notation " t '==>' t' " (at level 40).

              +  | v_const : n, value (C n).

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | 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_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').
              +  where " t '-->' t' " := (step t t').

              @@ -931,16 +936,21 @@

              Smallstep小步操作语义 Lemma value_not_same_as_normal_form :
              -   t, ¬ value tnormal_form step t.
              +  t, ¬value tnormal_form step t.
              +
              +
              Proof.
              -  (* 请在此处解答 *) Admitted.

              +  (* 请在此处解答 *) Admitted.
              +
              + +
              End Temp3.

              -

              额外练习

              +

              额外练习

              @@ -956,53 +966,53 @@

              Smallstep小步操作语义 Inductive tm : Type :=
              -  | ttrue : tm
              -  | tfalse : tm
              -  | tif : tmtmtmtm.

              +  | tru : tm
              +  | fls : tm
              +  | test : tmtmtmtm.

              Inductive value : tmProp :=
              -  | v_true : value ttrue
              -  | v_false : value tfalse.

              -Reserved Notation " t '==>' t' " (at level 40).

              +  | v_tru : value tru
              +  | v_fls : value fls.

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | 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_IfTrue : t1 t2,
              +      test tru t1 t2 --> t1
              +  | ST_IfFalse : t1 t2,
              +      test fls t1 t2 --> t2
              +  | ST_If : t1 t1' t2 t3,
              +      t1 --> t1'
              +      test t1 t2 t3 --> test t1' t2 t3

              -  where " t '==>' t' " := (step t t').
              +  where " t '-->' t' " := (step t t').

              -

              练习:1 星 (smallstep_bools)

              +

              练习:1 星, standard (smallstep_bools)

              下列哪些命题是可被证明的?(这只是一个思考练习,但如果你想挑战一下自己, 可以尝试在 Coq 中证明你的答案。)
              Definition bool_step_prop1 :=
              -  tfalse ==> tfalse.

              +  fls --> fls.

              (* 请在此处解答 *)

              Definition bool_step_prop2 :=
              -     tif
              -       ttrue
              -       (tif ttrue ttrue ttrue)
              -       (tif tfalse tfalse tfalse)
              -  ==>
              -     ttrue.

              +     test
              +       tru
              +       (test tru tru tru)
              +       (test fls fls fls)
              +  -->
              +     tru.

              (* 请在此处解答 *)

              Definition bool_step_prop3 :=
              -     tif
              -       (tif ttrue ttrue ttrue)
              -       (tif ttrue ttrue ttrue)
              -       tfalse
              -   ==>
              -     tif
              -       ttrue
              -       (tif ttrue ttrue ttrue)
              -       tfalse.

              +     test
              +       (test tru tru tru)
              +       (test tru tru tru)
              +       fls
              +   -->
              +     test
              +       tru
              +       (test tru tru tru)
              +       fls.

              (* 请在此处解答 *)

              (* 请勿修改下面这一行: *)
              Definition manual_grade_for_smallstep_bools : option (nat*string) := None.
              @@ -1012,13 +1022,13 @@

              Smallstep小步操作语义
              -

              练习:3 星, optional (progress_bool)

              +

              练习:3 星, standard, optional (progress_bool)

              我们之前对加法表达式证明了其可进性,我们也可以证明布尔表达式的可进性。
              -Theorem strong_progress : t,
              -  value t ∨ ( t', t ==> t').
              +Theorem strong_progress : t,
              +  value t ∨ (t', t --> t').
              Proof.
                (* 请在此处解答 *) Admitted.
              @@ -1027,7 +1037,7 @@

              Smallstep小步操作语义
              -

              练习:2 星, optional (step_deterministic)

              +

              练习:2 星, standard, optional (step_deterministic)

              @@ -1044,21 +1054,21 @@

              Smallstep小步操作语义
              -

              练习:2 星 (smallstep_bool_shortcut)

              +

              练习:2 星, standard (smallstep_bool_shortcut)

              假设我们想要为布尔表达式的单步归约关系添加“短路(short circuit)”, - 这样当条件语句的 thenelse 分支有相同的值时(ttruetfalse), + 这样当条件语句的 thenelse 分支有相同的值时(trufls), 便可以用一步化简整个条件表达式到值,尽管其条件还没有被归约到某个值。 比如,我们想要下面的命题可被证明:
              -         tif
              -            (tif ttrue ttrue ttrue)
              -            tfalse
              -            tfalse
              -     ==>
              -         tfalse. +         test
              +            (test tru tru tru)
              +            fls
              +            fls
              +     -->
              +         fls.
              @@ -1069,25 +1079,25 @@

              Smallstep小步操作语义
              -Reserved Notation " t '==>' t' " (at level 40).

              +Reserved Notation " t '-->' t' " (at level 40).

              Inductive step : tmtmProp :=
              -  | 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_IfTrue : t1 t2,
              +      test tru t1 t2 --> t1
              +  | ST_IfFalse : t1 t2,
              +      test fls t1 t2 --> t2
              +  | ST_If : t1 t1' t2 t3,
              +      t1 --> t1'
              +      test t1 t2 t3 --> test t1' t2 t3
                (* 请在此处解答 *)

              -  where " t '==>' t' " := (step t t').

              +  where " t '-->' t' " := (step t t').

              Definition bool_step_prop4 :=
              -         tif
              -            (tif ttrue ttrue ttrue)
              -            tfalse
              -            tfalse
              -     ==>
              -         tfalse.

              +         test
              +            (test tru tru tru)
              +            fls
              +            fls
              +     -->
              +         fls.

              Example bool_step_prop4_holds :
                bool_step_prop4.
              Proof.
              @@ -1098,7 +1108,7 @@

              Smallstep小步操作语义
              -

              练习:3 星, optional (properties_of_altered_step)

              +

              练习:3 星, standard, optional (properties_of_altered_step)

              课程中证明的确定性和强可进性定理对于我们刚刚定义的单步关系也是成立的。 在我们添加了 ST_ShortCircuit 以后…… @@ -1162,11 +1172,11 @@

              Smallstep小步操作语义
              -

              多步归约

              +

              多步归约

              - 目前为止,我们学习的是单步归约(single-step reduction)关系 ==>, + 目前为止,我们学习的是单步归约(single-step reduction)关系 -->, 它形式化了抽象机执行程序的每一步。
              @@ -1177,7 +1187,7 @@

              Smallstep小步操作语义
            • 首先,我们定义一个多步归约关系(multi-step reduction relation) - ==>*,如果项 t 可在任意多的单步(包括零步)内到达 t',那么它关联起 + -->*,如果项 t 可在任意多的单步(包括零步)内到达 t',那么它关联起 tt'
              @@ -1195,13 +1205,14 @@

              Smallstep小步操作语义

            • - 如下,给定关系 R,我们定义关系 multi RR多步闭包(multi-step closure)。 + 如下,给定关系 R(当前为 -->),我们定义关系 multi RR + 的多步闭包(multi-step closure)

              -Inductive multi {X:Type} (R: relation X) : relation X :=
              -  | multi_refl : (x : X), multi R x x
              -  | multi_step : (x y z : X),
              +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.
              @@ -1238,15 +1249,15 @@

              Smallstep小步操作语义

            - 因此,如果 R 刻画了单步计算,那么 z1...zn 则是 xy + 因此,如果 R 刻画了单步计算,那么 z1 ... zn 则是 xy 的中间计算步骤。
            - 我们为关系 multi step 使用记号 ==>*。 + 我们为关系 multi step 使用记号 -->*

            -Notation " t '==>*' t' " := (multi step t t') (at level 40).
            +Notation " t '-->*' t' " := (multi step t t') (at level 40).
            @@ -1254,24 +1265,24 @@

            Smallstep小步操作语义

            - 首先,显然它是自反的(reflexive)(即 x, multi R x x)。 - 就 ==>* 关系(即 multi step)而言,可以直观地理解为一个项可以执行零步 - 到它自己。 - + 首先,显然它是自反的(reflexive)(即 x, multi R x x)。 + 就 -->* 关系(即 multi step)而言,可以直观地理解为一个项可以执行零步 + 到它自己。
            - 第二,它包含了 R——也即,单步执行是多步执行的一个特殊情况。(这个事实解释了 + 第二,它包含了 R——也即,单步执行是多步执行的一个特殊情况。(这个事实解释了 “R 的多步闭包(multi-step closure)”中的“闭包(closure)”一词。)
            -Theorem multi_R : (X:Type) (R:relation X) (x y : X),
            -       R x y → (multi R) x y.
            +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.
            +  apply multi_step with y. apply H. apply multi_refl.
            +Qed.
            @@ -1281,7 +1292,7 @@

            Smallstep小步操作语义 Theorem multi_trans :
            -   (X:Type) (R: relation X) (x y z : X),
            +  (X : Type) (R : relation X) (x y z : X),
                  multi R x y
                  multi R y z
                  multi R x z.
            @@ -1293,17 +1304,18 @@

            Smallstep小步操作语义(* multi_refl *) assumption.
                - (* multi_step *)
                  apply multi_step with y. assumption.
            -      apply IHG. assumption. Qed.
            +      apply IHG. assumption.
            +Qed.

            -特别地,对于项的 multi step 关系可得,如果 t1==>*t2t2==>*t3, - 那么 t1==>*t3。 +特别地,对于项的 multi step 关系可得,如果 t1 -->* t2t2 -->* t3, + 那么 t1 -->* t3
            -

            例子

            +

            例子

            @@ -1315,7 +1327,7 @@

            Smallstep小步操作语义P
                    (P (C 0) (C 3))
                    (P (C 2) (C 4))
            -   ==>*
            +   -->*
                  C ((0 + 3) + (2 + 4)).
            @@ -1323,14 +1335,14 @@

            Smallstep小步操作语义apply multi_step with
                        (P (C (0 + 3))
                           (P (C 2) (C 4))).
            -  apply ST_Plus1. apply ST_PlusConstConst.
            +  { 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 ST_Plus2. apply v_const. apply ST_PlusConstConst. }
              apply multi_R.
            -  apply ST_PlusConstConst. Qed.
            +  { apply ST_PlusConstConst. }
            +Qed.

            @@ -1343,23 +1355,24 @@

            Smallstep小步操作语义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.
            +  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.

            -

            练习:1 星, optional (test_multistep_2)

            +

            练习:1 星, standard, optional (test_multistep_2)

            Lemma test_multistep_2:
            -  C 3 ==>* C 3.
            +  C 3 -->* C 3.
            Proof.
              (* 请在此处解答 *) Admitted.
            @@ -1368,13 +1381,13 @@

            Smallstep小步操作语义
            -

            练习:1 星, optional (test_multistep_3)

            +

            练习:1 星, standard, optional (test_multistep_3)

            Lemma test_multistep_3:
                  P (C 0) (C 3)
            -   ==>*
            +   -->*
                  P (C 0) (C 3).
            Proof.
              (* 请在此处解答 *) Admitted.
            @@ -1384,7 +1397,7 @@

            Smallstep小步操作语义
            -

            练习:2 星 (test_multistep_4)

            +

            练习:2 星, standard (test_multistep_4)

            @@ -1394,7 +1407,7 @@

            Smallstep小步操作语义P
                      (C 2)
                      (P (C 0) (C 3)))
            -  ==>*
            +  -->*
                  P
                    (C 0)
                    (C (2 + (0 + 3))).
            @@ -1405,7 +1418,7 @@

            Smallstep小步操作语义
            -

            再谈正规式

            +

            再谈正规式

            @@ -1416,7 +1429,7 @@

            Smallstep小步操作语义Definition step_normal_form := normal_form step.

            Definition normal_form_of (t t' : tm) :=
            -  (t ==>* t'step_normal_form t').
            +  (t -->* t'step_normal_form t').

            @@ -1425,7 +1438,7 @@

            Smallstep小步操作语义normal_form t t' 理解为“t' 就是 t 的正规式”。
            -

            练习:3 星, optional (normal_forms_unique)

            +

            练习:3 星, standard, optional (normal_forms_unique)

            @@ -1451,8 +1464,8 @@

            Smallstep小步操作语义
            -Definition normalizing {X:Type} (R:relation X) :=
            -   t, t',
            +Definition normalizing {X : Type} (R : relation X) :=
            +  t, t',
                (multi R) t t'normal_form R t'.
            @@ -1467,29 +1480,30 @@

            Smallstep小步操作语义
            -Lemma multistep_congr_1 : t1 t1' t2,
            -     t1 ==>* t1'
            -     P t1 t2 ==>* P t1' t2.
            +Lemma multistep_congr_1 : t1 t1' t2,
            +     t1 -->* t1'
            +     P t1 t2 -->* P t1' t2.
            Proof.
              intros t1 t1' t2 H. induction H.
            -    - (* multi_refl *) apply multi_refl.
            -    - (* multi_step *) apply multi_step with (P y t2).
            -        apply ST_Plus1. apply H.
            -        apply IHmulti. Qed.
            +  - (* multi_refl *) apply multi_refl.
            +  - (* multi_step *) apply multi_step with (P y t2).
            +    + apply ST_Plus1. apply H.
            +    + apply IHmulti.
            +Qed.
            -

            练习:2 星 (multistep_congr_2)

            +

            练习:2 星, standard (multistep_congr_2)

            -Lemma multistep_congr_2 : t1 t2 t2',
            +Lemma multistep_congr_2 : t1 t2 t2',
                 value t1
            -     t2 ==>* t2'
            -     P t1 t2 ==>* P t1 t2'.
            +     t2 -->* t2'
            +     P t1 t2 -->* P t1 t2'.
            Proof.
              (* 请在此处解答 *) Admitted.
            @@ -1524,7 +1538,7 @@

            Smallstep小步操作语义t1't2'。回忆一下正规式是值(由 nf_same_sa_value); 我们知道 t1' = C n1t2' = C n2 其中 n1n2 为项。 我们可以使用 multi_congr_1multi_congr_2 合并 t1t2 - 的 ==>* 导出式,以此证明 P t1 t2 在多步内归约到 C (n1 + n2)。 + 的 -->* 导出式,以此证明 P t1 t2 在多步内归约到 C (n1 + n2)
            @@ -1542,36 +1556,39 @@

            Smallstep小步操作语义Proof.
              unfold normalizing.
              induction t.
            -    - (* C *)
            -       (C n).
            -      split.
            -      + (* l *) apply multi_refl.
            -      + (* r *)
            +  - (* C *)
            +    (C n).
            +    split.
            +    + (* l *) apply multi_refl.
            +    + (* r *)
                    (* 除了等式,对于当且进当的命题,我们也可以使用 rewrite。 *)
            -        rewrite nf_same_as_value. apply v_const.
            -    - (* P *)
            -      destruct IHt1 as [t1' [H11 H12]].
            -      destruct IHt2 as [t2' [H21 H22]].
            -      rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22.
            -      inversion H12 as [n1 H]. inversion H22 as [n2 H'].
            -      rewrite <- H in H11.
            -      rewrite <- H' in H21.
            -       (C (n1 + n2)).
            -      split.
            -        + (* 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. }
            -        + (* r *)
            -          rewrite nf_same_as_value. apply v_const. Qed.
            +      rewrite nf_same_as_value. apply v_const.
            +  - (* P *)
            +    destruct IHt1 as [t1' [Hsteps1 Hnormal1]].
            +    destruct IHt2 as [t2' [Hsteps2 Hnormal2]].
            +    rewrite nf_same_as_value in Hnormal1.
            +    rewrite nf_same_as_value in Hnormal2.
            +    inversion Hnormal1 as [n1 H1].
            +    inversion Hnormal2 as [n2 H2].
            +    rewrite <- H1 in Hsteps1.
            +    rewrite <- H2 in Hsteps2.
            +    (C (n1 + n2)).
            +    split.
            +    + (* l *)
            +      apply multi_trans with (P (C n1) t2).
            +      * apply multistep_congr_1. apply Hsteps1.
            +      * apply multi_trans with
            +        (P (C n1) (C n2)).
            +        { apply multistep_congr_2. apply v_const. apply Hsteps2. }
            +        apply multi_R. { apply ST_PlusConstConst. }
            +    + (* r *)
            +      rewrite nf_same_as_value. apply v_const.
            +Qed.

            -

            大步语义和小步语义的等价关系

            +

            大步语义和小步语义的等价关系

            @@ -1580,12 +1597,12 @@

            Smallstep小步操作语义

            -

            练习:3 星 (eval__multistep)

            +

            练习:3 星, standard (eval__multistep)

            -Theorem eval__multistep : t n,
            -  t \\ nt ==>* C n.
            +Theorem eval__multistep : t n,
            +  t ==> nt -->* C n.
            @@ -1594,15 +1611,15 @@

            Smallstep小步操作语义

            -       P t1 t2 ==>            (by ST_Plus1)
            -       P t1' t2 ==>           (by ST_Plus1)
            -       P t1'' t2 ==>          (by ST_Plus1)
            +       P t1 t2 -->            (by ST_Plus1)
            +       P t1' t2 -->           (by ST_Plus1)
            +       P t1'' t2 -->          (by ST_Plus1)
                   ...
            -       P (C n1t2 ==>        (by ST_Plus2)
            -       P (C n1t2' ==>       (by ST_Plus2)
            -       P (C n1t2'' ==>      (by ST_Plus2)
            +       P (C n1t2 -->        (by ST_Plus2)
            +       P (C n1t2' -->       (by ST_Plus2)
            +       P (C n1t2'' -->      (by ST_Plus2)
                   ...
            -       P (C n1) (C n2) ==>    (by ST_PlusConstConst)
            +       P (C n1) (C n2-->    (by ST_PlusConstConst)
                   C (n1 + n2)
            @@ -1634,8 +1651,8 @@

            Smallstep小步操作语义

            为了形式化这个直觉的理解,我们需要使用之前的合同(congruence)引理 - (为了帮助后面的证明,你可能需要回顾一下他们),还有一些 ==>* 的基础性质: - 自反性,传递性,及其蕴含了 ==>。 + (为了帮助后面的证明,你可能需要回顾一下他们),还有一些 -->* 的基础性质: + 自反性,传递性,及其蕴含了 -->

            @@ -1647,7 +1664,7 @@

            Smallstep小步操作语义
            -

            练习:3 星, advanced (eval__multistep_inf)

            +

            练习:3 星, advanced (eval__multistep_inf)

            请为 eval__multi_step 写出详细的非形式化证明。
            @@ -1668,14 +1685,14 @@

            Smallstep小步操作语义

            -

            练习:3 星 (step__eval)

            +

            练习:3 星, standard (step__eval)

            -Lemma step__eval : t t' n,
            -     t ==> t'
            -     t' \\ n
            -     t \\ n.
            +Lemma step__eval : t t' n,
            +     t --> t'
            +     t' ==> n
            +     t ==> n.
            Proof.
              intros t t' n Hs. generalize dependent n.
              (* 请在此处解答 *) Admitted.
            @@ -1696,12 +1713,12 @@

            Smallstep小步操作语义

            -

            练习:3 星 (multistep__eval)

            +

            练习:3 星, standard (multistep__eval)

            -Theorem multistep__eval : t t',
            -  normal_form_of t t' n, t' = C nt \\ n.
            +Theorem multistep__eval : t t',
            +  normal_form_of t t'n, t' = C nt ==> n.
            Proof.
              (* 请在此处解答 *) Admitted.
            @@ -1709,19 +1726,19 @@

            Smallstep小步操作语义
            -

            额外练习

            +

            额外练习

            -

            练习:3 星, optional (interp_tm)

            +

            练习:3 星, standard, optional (interp_tm)

            请回忆一下我们还通过函数 evalF 定义了对项的大步求值。请证明它等价于其他语义。 (提示:我刚刚证明了 evalmultistep 是等价的,因此逻辑上讲你可以任意 选择证明哪个。尽管有一个要比另一个简单!)
            -Theorem evalF_eval : t n,
            -  evalF t = nt \\ n.
            +Theorem evalF_eval : t n,
            +  evalF t = nt ==> n.
            Proof.
              (* 请在此处解答 *) Admitted.
            @@ -1730,7 +1747,7 @@

            Smallstep小步操作语义
            -

            练习:4 星 (combined_properties)

            +

            练习:4 星, standard (combined_properties)

            我们分开考虑了算数和条件表达式,这个练习探索了他们之间如何交互。
          @@ -1739,33 +1756,33 @@

          Smallstep小步操作语义Inductive tm : Type :=
            | C : nattm
            | P : tmtmtm
          -  | ttrue : tm
          -  | tfalse : tm
          -  | tif : tmtmtmtm.

          +  | tru : tm
          +  | fls : tm
          +  | test : tmtmtmtm.

          Inductive value : tmProp :=
          -  | v_const : n, value (C n)
          -  | v_true : value ttrue
          -  | v_false : value tfalse.

          -Reserved Notation " t '==>' t' " (at level 40).

          +  | v_const : n, value (C n)
          +  | v_tru : value tru
          +  | v_fls : value fls.

          +Reserved Notation " t '-->' t' " (at level 40).

          Inductive step : tmtmProp :=
          -  | 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',
          +  | 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
          +      t2 --> t2'
          +      P v1 t2 --> P v1 t2'
          +  | ST_IfTrue : t1 t2,
          +      test tru t1 t2 --> t1
          +  | ST_IfFalse : t1 t2,
          +      test fls t1 t2 --> t2
          +  | ST_If : t1 t1' t2 t3,
          +      t1 --> t1'
          +      test t1 t2 t3 --> test t1' t2 t3

          -  where " t '==>' t' " := (step t t').
          +  where " t '-->' t' " := (step t t').

          @@ -1798,7 +1815,7 @@

          Smallstep小步操作语义
          -

          Imp 的小步语义

          +

          Imp 的小步语义

          @@ -1806,98 +1823,98 @@

          Smallstep小步操作语义

          目前为止,给这个小语言添加算数和布尔表达式的小步归约关系是很直接的扩展。 - 处于可读性的考虑,我们为他们分别添加记号 ==>a==>b。 + 处于可读性的考虑,我们为他们分别添加记号 -->a-->b

          Inductive aval : aexpProp :=
          -  | av_num : n, aval (ANum n).
          +  | av_num : n, aval (ANum n).
          -我们在此不会赘述布尔值的定义,因为 ==>b 的定义并不需要他们(为什么?), +我们在此不会赘述布尔值的定义,因为 -->b 的定义并不需要他们(为什么?), 尽管当语言规模更大一些时可能会需要到他们(为什么?)。
          -Reserved Notation " t '/' st '==>a' t' "
          +Reserved Notation " t '/' st '-->a' t' "
                            (at level 40, st at level 39).

          Inductive astep : stateaexpaexpProp :=
          -  | 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',
          +  | AS_Id : st i,
          +      AId i / st -->a ANum (st i)
          +  | 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',
          +      a2 / st -->a a2'
          +      (APlus v1 a2) / st -->a (APlus v1 a2')
          +  | AS_Plus : st n1 n2,
          +      APlus (ANum n1) (ANum n2) / st -->a ANum (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',
          +      a2 / st -->a a2'
          +      (AMinus v1 a2) / st -->a (AMinus v1 a2')
          +  | AS_Minus : st n1 n2,
          +      (AMinus (ANum n1) (ANum n2)) / st -->a (ANum (minus 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')
          +      a2 / st -->a a2'
          +      (AMult v1 a2) / st -->a (AMult v1 a2')
          +  | AS_Mult : st n1 n2,
          +      (AMult (ANum n1) (ANum n2)) / st -->a (ANum (mult n1 n2))

          -    where " t '/' st '==>a' t' " := (astep st t t').

          -Reserved Notation " t '/' st '==>b' t' "
          +    where " t '/' st '-->a' t' " := (astep st t t').

          +Reserved Notation " t '/' st '-->b' t' "
                            (at level 40, st at level 39).

          Inductive bstep : statebexpbexpProp :=
          -| BS_Eq : st n1 n2,
          -    (BEq (ANum n1) (ANum n2)) / st ==>b
          +| 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_Eq : st n1 n2,
          +    (BEq (ANum n1) (ANum n2)) / st -->b
              (if (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',
          +| 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'
          -    (BEq v1 a2) / st ==>b (BEq v1 a2')
          -| BS_LtEq : st n1 n2,
          -    (BLe (ANum n1) (ANum n2)) / st ==>b
          +    a2 / st -->a a2'
          +    (BLe v1 a2) / st -->b (BLe v1 a2')
          +| BS_LtEq : st n1 n2,
          +    (BLe (ANum n1) (ANum n2)) / st -->b
                       (if (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)
          +| BS_NotStep : st b1 b1',
          +    b1 / st -->b b1'
          +    (BNot b1) / st -->b (BNot b1')
          +| BS_NotTrue : st,
          +    (BNot BTrue) / st -->b BFalse
          +| BS_NotFalse : st,
          +    (BNot BFalse) / st -->b BTrue
          +| 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)
          +| 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

          -where " t '/' st '==>b' t' " := (bstep st t t').
          +where " t '/' st '-->b' t' " := (bstep st t t').
          @@ -1939,36 +1956,40 @@

          Smallstep小步操作语义
          -Reserved Notation " t '/' st '==>' t' '/' st' "
          +Reserved Notation " t '/' st '-->' t' '/' st' "
                            (at level 40, st at level 39, t' at level 39).

          +Open Scope imp_scope.
          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 / (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
          +  | 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 / (i !-> n ; st)
          +  | 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_IfStep : st b b' c1 c2,
          +      b / st -->b b'
          +      TEST b THEN c1 ELSE c2 FI / st
          +      -->
          +      (TEST b' THEN c1 ELSE c2 FI) / st
          +  | CS_IfTrue : st c1 c2,
          +      TEST BTrue THEN c1 ELSE c2 FI / st --> c1 / st
          +  | CS_IfFalse : st c1 c2,
          +      TEST BFalse THEN c1 ELSE c2 FI / st --> c2 / st
          +  | CS_While : st b c1,
          +      WHILE b DO c1 END / st
          +      -->
          +      (TEST b THEN c1;; WHILE b DO c1 END ELSE SKIP FI) / st

          -  where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')).
          +  where " t '/' st '-->' t' '/' st' " := (cstep (t,st) (t',st')).

          +Close Scope imp_scope.
          -

          并发 Imp

          +

          并发 Imp

          @@ -1985,8 +2006,7 @@

          Smallstep小步操作语义CSeq : comcomcom
            | CIf : bexpcomcomcom
            | CWhile : bexpcomcom
          -  (* New: *)
          -  | CPar : comcomcom.

          +  | CPar : comcomcom. (* <--- NEW *)

          Notation "'SKIP'" :=
            CSkip.
          Notation "x '::=' a" :=
          @@ -1995,45 +2015,45 @@

          Smallstep小步操作语义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'" :=
          +Notation "'TEST' 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 / 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,
          +  | 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 / (i !-> n ; st)
          +  | 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_IfStep : st b b' c1 c2,
          +      b /st -->b b'
          +          (TEST b THEN c1 ELSE c2 FI) / st
          +      --> (TEST b' THEN c1 ELSE c2 FI) / st
          +  | CS_IfTrue : st c1 c2,
          +      (TEST BTrue THEN c1 ELSE c2 FI) / st --> c1 / st
          +  | CS_IfFalse : st c1 c2,
          +      (TEST BFalse THEN c1 ELSE c2 FI) / st --> c2 / 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
          +      --> (TEST 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')).

          +  | 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' " :=
          +Notation " t '/' st '-->*' t' '/' st' " :=
             (multi cstep (t,st) (t',st'))
             (at level 40, st at level 39, t' at level 39).

          @@ -2059,8 +2079,8 @@

          Smallstep小步操作语义 Example par_loop_example_0:
          -   st',
          -       par_loop / { --> 0 } ==>* SKIP / st'
          +  st',
          +       par_loop / empty_st -->* SKIP / st'
              ∧ st' X = 0.
          @@ -2087,8 +2107,8 @@

          Smallstep小步操作语义 Example par_loop_example_2:
          -   st',
          -       par_loop / { --> 0 } ==>* SKIP / st'
          +  st',
          +       par_loop / empty_st -->* SKIP / st'
              ∧ st' X = 2.
          @@ -2137,13 +2157,13 @@

          Smallstep小步操作语义

          -

          练习:3 星, optional (par_body_n__Sn)

          +

          练习:3 星, standard, optional (par_body_n__Sn)

          -Lemma par_body_n__Sn : n st,
          +Lemma par_body_n__Sn : n st,
            st X = nst Y = 0 →
          -  par_loop / st ==>* par_loop / st & { X --> S n}.
          +  par_loop / st -->* par_loop / (X !-> S n ; st).
          Proof.
            (* 请在此处解答 *) Admitted.
          @@ -2152,14 +2172,14 @@

          Smallstep小步操作语义
          -

          练习:3 星, optional (par_body_n)

          +

          练习:3 星, standard, optional (par_body_n)

          -Lemma par_body_n : n st,
          +Lemma par_body_n : n st,
            st X = 0 ∧ st Y = 0 →
          -   st',
          -    par_loop / st ==>* par_loop / st'st' X = nst' Y = 0.
          +  st',
          +    par_loop / st -->* par_loop / st'st' X = nst' Y = 0.
          Proof.
            (* 请在此处解答 *) Admitted.
          @@ -2173,18 +2193,18 @@

          Smallstep小步操作语义 Theorem par_loop_any_X:
          -   n, st',
          -    par_loop / { --> 0 } ==>* SKIP / st'
          +  n, st',
          +    par_loop / empty_st -->* SKIP / st'
              ∧ st' X = n.
          Proof.
            intros n.
          -  destruct (par_body_n n { --> 0 }).
          +  destruct (par_body_n n empty_st).
              split; unfold t_update; reflexivity.

            rename x into st.
            inversion H as [H' [HX HY]]; clear H.
          -   (st & { Y --> 1 }). split.
          +  (Y !-> 1 ; st). 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.
          @@ -2204,7 +2224,7 @@

          Smallstep小步操作语义
          -

          小步堆栈机

          +

          小步堆栈机

          @@ -2215,17 +2235,17 @@

          Smallstep小步操作语义Definition stack := list nat.
          Definition prog := list sinstr.

          Inductive stack_step : stateprog * stackprog * stackProp :=
          -  | SS_Push : st stk n p',
          +  | SS_Push : st stk n p',
              stack_step st (SPush n :: p', stk) (p', n :: stk)
          -  | SS_Load : st stk i p',
          +  | SS_Load : st stk i p',
              stack_step st (SLoad i :: p', stk) (p', st i :: stk)
          -  | SS_Plus : st stk n m p',
          +  | 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',
          +  | 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',
          +  | SS_Mult : st stk n m p',
              stack_step st (SMult :: p', n::m::stk) (p', (m*n)::stk).

          -Theorem stack_step_deterministic : st,
          +Theorem stack_step_deterministic : st,
            deterministic (stack_step st).
          @@ -2240,9 +2260,9 @@

          Smallstep小步操作语义
          -

          练习:3 星, advanced (compiler_is_correct)

          +

          练习:3 星, advanced (compiler_is_correct)

          请回忆一下逻辑基础 Imp 一章中对 compileaexp 的定义。 - 我们现在想要证明堆栈机上 compile 函数的正确性。 + 我们现在想要证明堆栈机上 s_compile 函数的正确性。
          @@ -2257,11 +2277,135 @@

          Smallstep小步操作语义(* 请在此处解答 *) Admitted.

          + + +
          +

          Aside: A 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 quite tedious to do by hand. Consider, for + example, reducing an arithmetic expression using the small-step + relation astep. +
          +
          + +Example step_example1 :
          +  (P (C 3) (P (C 3) (C 4)))
          +  -->* (C 10).
          +Proof.
          +  apply multi_step with (P (C 3) (C 7)).
          +    apply ST_Plus2.
          +      apply v_const.
          +      apply ST_PlusConstConst.
          +  apply multi_step with (C 10).
          +    apply ST_PlusConstConst.
          +  apply multi_refl.
          +Qed.
          +
          + +
          +The proof repeatedly applies multi_step until the term reaches a + normal form. Fortunately The sub-proofs for the intermediate + steps are simple enough that auto, with appropriate hints, can + solve them. +
          +
          + +Hint Constructors step value.
          +Example step_example1' :
          +  (P (C 3) (P (C 3) (C 4)))
          +  -->* (C 10).
          +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 step, we print out the current + goal, so that we can follow how the term is being reduced. +
          +
          + +Tactic Notation "print_goal" :=
          +  match goal with ⊢ ?xidtac x end.

          +Tactic Notation "normalize" :=
          +  repeat (print_goal; eapply multi_step ;
          +            [ (eauto 10; fail) | (instantiate; simpl)]);
          +  apply multi_refl.

          +Example step_example1'' :
          +  (P (C 3) (P (C 3) (C 4)))
          +  -->* (C 10).
          +Proof.
          +  normalize.
          +  (* The print_goal in the normalize tactic shows
          +     a trace of how the expression reduced...
          +         (P (C 3) (P (C 3) (C 4)) -->* C 10)
          +         (P (C 3) (C 7) -->* C 10)
          +         (C 10 -->* C 10)
          +  *)

          +Qed.
          +
          + +
          +The normalize tactic also provides a simple way to calculate the + normal form of a term, by starting with a goal with an existentially + bound variable. +
          +
          + +Example step_example1''' : e',
          +  (P (C 3) (P (C 3) (C 4)))
          +  -->* e'.
          +Proof.
          +  eapply ex_intro. normalize.
          +(* This time, the trace is:
          +       (P (C 3) (P (C 3) (C 4)) -->* ?e')
          +       (P (C 3) (C 7) -->* ?e')
          +       (C 10 -->* ?e')
          +   where ?e' is the variable ``guessed'' by eapply. *)

          +Qed.
          +
          + +
          +

          练习:1 星, standard (normalize_ex)

          + +
          +
          +Theorem normalize_ex : e',
          +  (P (C 3) (P (C 2) (C 1)))
          +  -->* e'value e'.
          +Proof.
          +  (* 请在此处解答 *) Admitted.
          +
          +
          - +

          练习:1 星, standard, optional (normalize_ex')

          + For comparison, prove it using apply instead of eapply. +
          +
          + +Theorem normalize_ex' : e',
          +  (P (C 3) (P (C 2) (C 1)))
          +  -->* e'value e'.
          +Proof.
          +  (* 请在此处解答 *) Admitted.
          +
          + + +
          + +(* Sat Jan 26 15:15:44 UTC 2019 *)

          diff --git a/plf-current/Smallstep.v b/plf-current/Smallstep.v index 17cc8184..26d5995d 100644 --- a/plf-current/Smallstep.v +++ b/plf-current/Smallstep.v @@ -1,11 +1,11 @@ (** * Smallstep: 小步操作语义 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Arith.Arith. -Require Import Coq.Arith.EqNat. -Require Import Coq.Init.Nat. -Require Import Coq.omega.Omega. -Require Import Coq.Lists.List. +From Coq Require Import Arith.Arith. +From Coq Require Import Arith.EqNat. +From Coq Require Import Init.Nat. +From Coq Require Import omega.Omega. +From Coq Require Import Lists.List. Import ListNotations. From PLF Require Import Maps. From PLF Require Import Imp. @@ -65,60 +65,59 @@ Fixpoint evalF (t : tm) : nat := | P a1 a2 => evalF a1 + evalF a2 end. -(** 这是用同样风格描述的等价求值器,只是用归纳关系来定义。再一次提醒, - 我们使用记号 [t \\ n] 来表达“[t] 求值到 [n]”。 *) -(** +(** 这是用同样风格描述的等价求值器,只是用归纳关系来定义。 + 我们使用记号 [t ==> n] 来表达“[t] 求值到 [n]”。 - -------- (E_Const) - C n \\ n + --------- (E_Const) + C n ==> n - t1 \\ n1 - t2 \\ n2 - ------------------ (E_Plus) - P t1 t2 \\ n1 + n2 + t1 ==> n1 + t2 ==> n2 + ------------------- (E_Plus) + P t1 t2 ==> n1 + n2 *) -Reserved Notation " t '\\' n " (at level 50, left associativity). +Reserved Notation " t '==>' n " (at level 50, left associativity). Inductive eval : tm -> nat -> Prop := | E_Const : forall n, - C n \\ 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). + t1 ==> n1 -> + t2 ==> n2 -> + P t1 t2 ==> (n1 + n2) +where " t '==>' n " := (eval t n). Module SimpleArith1. -(** 现在,我们展示对应的_'小步'_求值关系。 *) -(** +(** 现在,我们展示对应的_'小步'_求值关系。 + + ------------------------------- (ST_PlusConstConst) - P (C n1) (C n2) ==> C (n1 + n2) + P (C n1) (C n2) --> C (n1 + n2) - t1 ==> t1' + t1 --> t1' -------------------- (ST_Plus1) - P t1 t2 ==> P t1' t2 + P t1 t2 --> P t1' t2 - t2 ==> t2' - --------------------------- (ST_Plus2) - P (C n1) t2 ==> P (C n1) t2' + t2 --> t2' + ---------------------------- (ST_Plus2) + P (C n1) t2 --> P (C n1) t2' *) -Reserved Notation " t '==>' t' " (at level 40). +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) + P (C n1) (C n2) --> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P 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' + t2 --> t2' -> + P (C n1) t2 --> P (C n1) t2' - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). (** 值得注意的几点: @@ -138,15 +137,16 @@ 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. -(** **** 练习:1 星 (test_step_2) *) -(** 当求和操作的左侧表达式已经完成求值,其右侧表达式可向前一步: +(** **** 练习:1 星, standard (test_step_2) + + 当求和操作的左侧表达式已经完成求值,其右侧表达式可向前一步: 如果 [t2] 可向前一步到 [t2'],那么 [P (C n) t2] 可向前一步到 [P (C n) t2']: *) Example test_step_2 : @@ -155,7 +155,7 @@ Example test_step_2 : (P (C 2) (P (C 0) (C 3))) - ==> + --> P (C 0) (P @@ -177,15 +177,16 @@ End SimpleArith1. 集合 [X] 上的_'二元关系(binary relation)'_是由 [X] 中的两个元素参数化的 命题——也即,一个 [X] 上序对的命题。 *) -Definition relation (X: Type) := X -> X -> Prop. +Definition relation (X : Type) := X -> X -> Prop. -(** 本章中,我们主要的例子将会是单步归约关系,[==>],以及它的多步版本, - [==>*](后面会定义),但是也有许多其他例子——比如,“等于”、“小于”、“小于等于” +(** 本章中,我们主要的例子将会是单步规约关系,[-->],以及它的多步版本, + [-->*](后面会定义),但是也有许多其他例子——比如,“等于”、“小于”、“小于等于” 和数字上“平方数”关系,还有字符串和列表的“前缀”关系。*) -(** 和 Imp 的大步求值关系一样,[==>] 关系的一个简单性质是_'确定性(deterministic)'_。 +(** 和 Imp 的大步求值关系一样,[-->] 关系的一个简单性质是_'确定性(deterministic)'_。 + _'定理'_:对于每个 [t],最多有一个 [t'] 且 [t] 向前一步到 [t'] - ([t ==> t'] 是可证的)。这也就是说 [==>] 是确定性的。*) + ([t --> t'] 是可证的)。这也就是说 [-->] 是确定性的。*) (** _'证明草稿'_:我们通过对 [step x y1] 的导出式(derivation)进行归 纳来证明如果 [x] 同时前进到 [y1] 和 [y2],那么 [y1] 和 [y2] 是相等的。 @@ -207,7 +208,7 @@ Definition relation (X: Type) := X -> X -> Prop. (** 形式化地来说: *) -Definition deterministic {X: Type} (R: relation X) := +Definition deterministic {X : Type} (R : relation X) := forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. Module SimpleArith2. @@ -219,25 +220,25 @@ Proof. unfold deterministic. intros x y1 y2 Hy1 Hy2. generalize dependent y2. induction Hy1; intros y2 Hy2. - - (* ST_PlusConstConst *) inversion Hy2. - + (* ST_PlusConstConst *) reflexivity. - + (* ST_Plus1 *) inversion H2. - + (* ST_Plus2 *) inversion H2. - - (* ST_Plus1 *) inversion Hy2. - + (* ST_PlusConstConst *) - rewrite <- H0 in Hy1. inversion Hy1. - + (* ST_Plus1 *) - rewrite <- (IHHy1 t1'0). - reflexivity. assumption. - + (* ST_Plus2 *) - rewrite <- H in Hy1. inversion Hy1. - - (* ST_Plus2 *) inversion Hy2. - + (* ST_PlusConstConst *) - rewrite <- H1 in Hy1. inversion Hy1. - + (* ST_Plus1 *) inversion H2. - + (* ST_Plus2 *) - rewrite <- (IHHy1 t2'0). - reflexivity. assumption. + - (* ST_PlusConstConst *) inversion Hy2. + + (* ST_PlusConstConst *) reflexivity. + + (* ST_Plus1 *) inversion H2. + + (* ST_Plus2 *) inversion H2. + - (* ST_Plus1 *) inversion Hy2. + + (* ST_PlusConstConst *) + rewrite <- H0 in Hy1. inversion Hy1. + + (* ST_Plus1 *) + rewrite <- (IHHy1 t1'0). + reflexivity. assumption. + + (* ST_Plus2 *) + rewrite <- H in Hy1. inversion Hy1. + - (* ST_Plus2 *) inversion Hy2. + + (* ST_PlusConstConst *) + rewrite <- H1 in Hy1. inversion Hy1. + + (* ST_Plus1 *) inversion H2. + + (* ST_Plus2 *) + rewrite <- (IHHy1 t2'0). + reflexivity. assumption. Qed. End SimpleArith2. @@ -295,7 +296,7 @@ End SimpleArith3. (** 下一步,我们会使用“值”的概念来稍微重新表述一下单步归约的定义。*) -(** 为了更好地理解 [==>] 关系,我们定义一个_'抽象机(abstract machine)'_: +(** 为了更好地理解 [-->] 关系,我们定义一个_'抽象机(abstract machine)'_: - 在任意时刻,机器的_'状态(state)'_是一个项(term)。 @@ -307,9 +308,9 @@ End SimpleArith3. - 以 [t] 作为机器的起始状态。 - - 重复使用 [==>] 关系来找到一个以 [t] 开始的机器状态序列,序列中每个状态 + - 重复使用 [-->] 关系来找到一个以 [t] 开始的机器状态序列,序列中每个状态 会转移到下一个。 - + - 当无法继续进行归约时,_'输出(read out)'_最终的机器状态作为执行的结果。 *) (** 直观地来说,可以看到机器的最终状态总是形如 [C n] 的项。 @@ -318,47 +319,49 @@ End SimpleArith3. Inductive value : tm -> Prop := | v_const : forall n, value (C n). -(** 在引入了值的概念后,我们可以使用它来更简洁地定义 [==>] +(** 在引入了值的概念后,我们可以使用它来更简洁地定义 [-->] 关系中的 [ST_Plus2] 规则: *) (** ------------------------------- (ST_PlusConstConst) - P (C n1) (C n2) ==> C (n1 + n2) + P (C n1) (C n2) --> C (n1 + n2) - t1 ==> t1' + t1 --> t1' -------------------- (ST_Plus1) - P t1 t2 ==> P t1' t2 + P t1 t2 --> P t1' t2 value v1 - t2 ==> t2' + t2 --> t2' -------------------- (ST_Plus2) - P v1 t2 ==> P v1 t2' -*) -(** 再一次地,变量名在这里包含了重要的信息:按照惯例,[v1] 涉及到值, + P v1 t2 --> P v1 t2' + + 再一次地,变量名在这里包含了重要的信息:按照惯例,[v1] 涉及到值, 而 [t1] 和 [t2] 涉及到任意的项。(在这种约定下,显式的 [value] 假设也 许是多余的。在这里仍然保留它,主要是为了在非形式化的和 Coq 的规则之间 建立起密切的对应关系,但为简单起见,后面的非形式化规则中我们便会省略掉它。) *) (** 这些是形式化的规则: *) -Reserved Notation " t '==>' t' " (at level 40). +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) + --> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P 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' + value v1 -> (* <--- n.b. *) + t2 --> t2' -> + P v1 t2 --> P v1 t2' + + where " t '-->' t' " := (step t t'). - where " t '==>' t' " := (step t t'). +(** **** 练习:3 星, standard, recommended (redo_determinism) -(** **** 练习:3 星, recommended (redo_determinism) *) -(** 作为这一改变的完备性检查,让我们重新验证一下确定性。 + 作为这一改变的完备性检查,让我们重新验证一下确定性。 + 下面是它的非形式化证明: _'证明草稿'_:我们必须证明如果 [x] 向前一步可同时到 [y1] 和 [y2], 那么 [y1] 和 [y2] 相等。考虑 [step x y1] 和 [step x y2] 生成式 @@ -393,7 +396,7 @@ Proof. 说明了我们没有犯这样的错误。 *) (** _'定理'_(_'强可进性'_(Strong Progress)):如果 [t] 是一个项,那么 [t] - 要么是一个值,要么存在项 [t'] 使 [t ==> t']。*) + 要么是一个值,要么存在项 [t'] 使 [t --> t']。*) (** _'证明'_:对 [t] 进行归纳。 @@ -412,21 +415,22 @@ Proof. 或者,形式化地说: *) Theorem strong_progress : forall t, - value t \/ (exists t', t ==> t'). + value t \/ (exists t', t --> t'). Proof. induction t. - - (* C *) left. apply v_const. - - (* P *) right. inversion IHt1. - + (* l *) inversion IHt2. - * (* l *) inversion H. inversion H0. - exists (C (n + n0)). - apply ST_PlusConstConst. - * (* r *) inversion H0 as [t' H1]. - exists (P t1 t'). - apply ST_Plus2. apply H. apply H1. - + (* r *) inversion H as [t' H0]. - exists (P t' t2). - apply ST_Plus1. apply H0. Qed. + - (* C *) left. apply v_const. + - (* P *) right. destruct IHt1 as [IHt1 | [t1' Ht1]]. + + (* l *) destruct IHt2 as [IHt2 | [t2' Ht2]]. + * (* l *) inversion IHt1. inversion IHt2. + exists (C (n + n0)). + apply ST_PlusConstConst. + * (* r *) + exists (P t1 t2'). + apply ST_Plus2. apply IHt1. apply Ht2. + + (* r *) + exists (P t1' t2). + apply ST_Plus1. apply Ht1. +Qed. (** 这个重要的定理叫做_'强可进性(strong progress)'_,因为每个项 要么是值,要么可“前进”到某个其他的项。(修饰语“强”区分另一个不同的版本, @@ -438,7 +442,7 @@ Proof. 为了形式化地表述这个观察,让我们给不能前进的项起个名字。我们把它叫做 _'正规式(normal forms)'_。 *) -Definition normal_form {X:Type} (R:relation X) (t:X) : Prop := +Definition normal_form {X : Type} (R : relation X) (t : X) : Prop := ~ exists t', R t t'. (** 请注意这个定义规范了对任意集合 [X] 上的任意关系 [R] 的正规式,而不仅仅是我们 @@ -458,50 +462,56 @@ 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'). - { apply strong_progress. } - inversion G. - + (* l *) apply H0. - + (* r *) exfalso. apply H. assumption. Qed. + assert (G : value t \/ exists t', t --> t'). + { apply strong_progress. } + destruct G as [G | G]. + - (* l *) apply G. + - (* r *) exfalso. 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. + split. apply nf_is_value. apply value_is_nf. +Qed. (** 这个为什么值得注意呢? 因为 [value] 是一个语法概念——它是由项的形式定义的——然而 [normal_form] 是一个 - 语义概念——它是由项如何前进定义的。并不显然这两个概念应当一致! *) + 语义概念——它是由项如何前进定义的。 -(** 确实,容易写下使他们_'不'_一致的定义。 *) + 并不显然这两个概念应当一致! *) -(** **** 练习:3 星, optional (value_not_same_as_normal_form1) *) -(** 我们可能错误地定义了 [value] 使它包括了还没有完成归约的项。 *) -(** (如果你不想亲自动手在 Coq 中完成这个和下一个练习, +(** 确实,容易错误地写下使它们_'不'_一致的定义。 *) + +(** **** 练习:3 星, standard, optional (value_not_same_as_normal_form1) + + 我们可能错误地定义了 [value] 使它包括了还没有完成归约的项。 + + (如果你不想亲自动手在 Coq 中完成这个和下一个练习, 也请思考一下,尝试找到一个这样的项。)*) Module Temp1. Inductive value : tm -> Prop := -| v_const : forall n, value (C n) -| v_funny : forall t1 n2, (* <---- *) - value (P t1 (C n2)). + | v_const : forall n, value (C n) + | v_funny : forall t1 n2, + value (P t1 (C n2)). (* <--- *) -Reserved Notation " t '==>' t' " (at level 40). +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) + P (C n1) (C n2) --> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P 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' + t2 --> t2' -> + P v1 t2 --> P v1 t2' - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). Lemma value_not_same_as_normal_form : exists v, value v /\ ~ normal_form step v. @@ -511,30 +521,31 @@ End Temp1. (** [] *) -(** **** 练习:2 星, optional (value_not_same_as_normal_form2) *) -(** 或许,我们错误地定义了 [step] 使它允许继续归约一个值。 *) +(** **** 练习:2 星, standard, optional (value_not_same_as_normal_form2) + + 或许,我们错误地定义了 [step] 使它允许继续归约一个值。 *) Module Temp2. Inductive value : tm -> Prop := -| v_const : forall n, value (C n). + | v_const : forall n, value (C n). (* Original definition *) -Reserved Notation " t '==>' t' " (at level 40). +Reserved Notation " t '-->' t' " (at level 40). Inductive step : tm -> tm -> Prop := - | ST_Funny : forall n, (* <---- *) - C n ==> P (C n) (C 0) + | ST_Funny : forall n, + C n --> P (C n) (C 0) (* <--- NEW *) | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) + P (C n1) (C n2) --> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P 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' + t2 --> t2' -> + P v1 t2 --> P v1 t2' - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). Lemma value_not_same_as_normal_form : exists v, value v /\ ~ normal_form step v. @@ -544,8 +555,9 @@ Proof. End Temp2. (** [] *) -(** **** 练习:3 星, optional (value_not_same_as_normal_form3) *) -(** 最后,我们还可能通过 [value] 和 [step] 定义了某些不是值但已无法继续由 +(** **** 练习:3 星, standard, optional (value_not_same_as_normal_form3) + + 最后,我们还可能通过 [value] 和 [step] 定义了某些不是值但已无法继续由 [step] 关系进行归约的项。这些项被称作_'卡住了(stuck)'_。在这种情况是由语义 中的错误导致的,但我们也会看到一些情况,即使是正确的语言定义中也会允许一些项卡住。 *) @@ -554,16 +566,16 @@ Module Temp3. Inductive value : tm -> Prop := | v_const : forall n, value (C n). -Reserved Notation " t '==>' t' " (at level 40). +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) + P (C n1) (C n2) --> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 + t1 --> t1' -> + P t1 t2 --> P t1' t2 - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). (** (请注意 [ST_Plus2] 是未定义的。) *) @@ -584,56 +596,57 @@ Module Temp4. 以及条件表达式…… *) Inductive tm : Type := - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. + | tru : tm + | fls : tm + | test : tm -> tm -> tm -> tm. Inductive value : tm -> Prop := - | v_true : value ttrue - | v_false : value tfalse. + | v_tru : value tru + | v_fls : value fls. -Reserved Notation " t '==>' t' " (at level 40). +Reserved Notation " t '-->' t' " (at level 40). Inductive step : tm -> tm -> Prop := | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 + test tru t1 t2 --> t1 | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 + test fls t1 t2 --> t2 | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 + t1 --> t1' -> + test t1 t2 t3 --> test t1' t2 t3 - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). -(** **** 练习:1 星 (smallstep_bools) *) -(** 下列哪些命题是可被证明的?(这只是一个思考练习,但如果你想挑战一下自己, +(** **** 练习:1 星, standard (smallstep_bools) + + 下列哪些命题是可被证明的?(这只是一个思考练习,但如果你想挑战一下自己, 可以尝试在 Coq 中证明你的答案。) *) Definition bool_step_prop1 := - tfalse ==> tfalse. + fls --> fls. (* 请在此处解答 *) Definition bool_step_prop2 := - tif - ttrue - (tif ttrue ttrue ttrue) - (tif tfalse tfalse tfalse) - ==> - ttrue. + test + tru + (test tru tru tru) + (test fls fls fls) + --> + tru. (* 请在此处解答 *) Definition bool_step_prop3 := - tif - (tif ttrue ttrue ttrue) - (tif ttrue ttrue ttrue) - tfalse - ==> - tif - ttrue - (tif ttrue ttrue ttrue) - tfalse. + test + (test tru tru tru) + (test tru tru tru) + fls + --> + test + tru + (test tru tru tru) + fls. (* 请在此处解答 *) @@ -641,16 +654,17 @@ Definition bool_step_prop3 := Definition manual_grade_for_smallstep_bools : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, optional (progress_bool) *) -(** 我们之前对加法表达式证明了其可进性,我们也可以证明布尔表达式的可进性。 *) +(** **** 练习:3 星, standard, optional (progress_bool) + + 我们之前对加法表达式证明了其可进性,我们也可以证明布尔表达式的可进性。 *) Theorem strong_progress : forall t, - value t \/ (exists t', t ==> t'). + value t \/ (exists t', t --> t'). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (step_deterministic) *) +(** **** 练习:2 星, standard, optional (step_deterministic) *) Theorem step_deterministic : deterministic step. Proof. @@ -659,43 +673,44 @@ Proof. Module Temp5. -(** **** 练习:2 星 (smallstep_bool_shortcut) *) -(** 假设我们想要为布尔表达式的单步归约关系添加“短路(short circuit)”, - 这样当条件语句的 [then] 和 [else] 分支有相同的值时([ttrue] 或 [tfalse]), +(** **** 练习:2 星, standard (smallstep_bool_shortcut) + + 假设我们想要为布尔表达式的单步归约关系添加“短路(short circuit)”, + 这样当条件语句的 [then] 和 [else] 分支有相同的值时([tru] 或 [fls]), 便可以用一步化简整个条件表达式到值,尽管其条件还没有被归约到某个值。 比如,我们想要下面的命题可被证明: - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse - ==> - tfalse. + test + (test tru tru tru) + fls + fls + --> + fls. *) (** 请为单步关系添加一个额外的语句来达到这个目的,并证明 [bool_step_prop4]。 *) -Reserved Notation " t '==>' t' " (at level 40). +Reserved Notation " t '-->' t' " (at level 40). Inductive step : tm -> tm -> Prop := | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 + test tru t1 t2 --> t1 | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 + test fls t1 t2 --> t2 | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 + t1 --> t1' -> + test t1 t2 t3 --> test t1' t2 t3 (* 请在此处解答 *) - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). Definition bool_step_prop4 := - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse - ==> - tfalse. + test + (test tru tru tru) + fls + fls + --> + fls. Example bool_step_prop4_holds : bool_step_prop4. @@ -703,29 +718,28 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (properties_of_altered_step) *) -(** 课程中证明的确定性和强可进性定理对于我们刚刚定义的单步关系也是成立的。 +(** **** 练习:3 星, standard, optional (properties_of_altered_step) + + 课程中证明的确定性和强可进性定理对于我们刚刚定义的单步关系也是成立的。 在我们添加了 [ST_ShortCircuit] 以后…… - [step] 关系是否仍然是确定的?请回答是或否,并简要解释(一句话即可)你的答案。 可选:在 Coq 中证明你的答案。*) -(* 请在此处解答 *) -(** +(* 请在此处解答 - 强可进性是否成立?请回答是或否,并简要解释(一句话即可)你的答案。 可选:在 Coq 中证明你的答案。 *) -(* 请在此处解答 *) -(** +(* 请在此处解答 - 一般来说,如果从原始的单步关系中拿掉一两个构造子,能否使强可进性不再成立? 请回答是或否,并简要解释(一句话即可)你的答案。 (* 请在此处解答 *) -*) -(** [] *) + + [] *) End Temp5. End Temp4. @@ -733,24 +747,24 @@ End Temp4. (* ################################################################# *) (** * 多步归约 *) -(** 目前为止,我们学习的是_'单步归约(single-step reduction)'_关系 [==>], +(** 目前为止,我们学习的是_'单步归约(single-step reduction)'_关系 [-->], 它形式化了抽象机执行程序的每一步。 我们可以使用同一个机器来归约程序直到结束——得到它最后的结果。我们这样形式化它: - 首先,我们定义一个_'多步归约关系(multi-step reduction relation)'_ - [==>*],如果项 [t] 可在任意多的单步(包括零步)内到达 [t'],那么它关联起 + [-->*],如果项 [t] 可在任意多的单步(包括零步)内到达 [t'],那么它关联起 [t] 和 [t']。 - 接着我们定义 [t] 的“结果(result)”是一个 [t] 可用多步达到的正规式。*) - (** 因为我们会反复使用多步归约这个概念,让我们花点功夫一般化地定义它。 - 如下,给定关系 [R],我们定义关系 [multi R] 是 [R] 的_'多步闭包(multi-step closure)'_。*) + 如下,给定关系 [R](当前为 [-->]),我们定义关系 [multi R] 是 [R] + 的_'多步闭包(multi-step closure)'_。*) -Inductive multi {X:Type} (R: relation X) : relation X := - | multi_refl : forall (x : X), multi R x x +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 -> @@ -770,32 +784,33 @@ Inductive multi {X:Type} (R: relation X) : relation X := ... R zn y. - 因此,如果 [R] 刻画了单步计算,那么 [z1]...[zn] 则是 [x] 和 [y] + 因此,如果 [R] 刻画了单步计算,那么 [z1] ... [zn] 则是 [x] 和 [y] 的中间计算步骤。 *) -(** 我们为关系 [multi step] 使用记号 [==>*]。*) +(** 我们为关系 [multi step] 使用记号 [-->*]。*) -Notation " t '==>*' t' " := (multi step t t') (at level 40). +Notation " t '-->*' t' " := (multi step t t') (at level 40). (** 关系 [multi R] 具有多个重要的性质。 首先,显然它是_'自反的(reflexive)'_(即 [forall x, multi R x x])。 - 就 [==>*] 关系(即 [multi step])而言,可以直观地理解为一个项可以执行零步 - 到它自己。 + 就 [-->*] 关系(即 [multi step])而言,可以直观地理解为一个项可以执行零步 + 到它自己。 *) - 第二,它包含了 [R]——也即,单步执行是多步执行的一个特殊情况。(这个事实解释了 +(** 第二,它包含了 [R]——也即,单步执行是多步执行的一个特殊情况。(这个事实解释了 “[R] 的多步闭包(multi-step closure)”中的“闭包(closure)”一词。) *) -Theorem multi_R : forall (X:Type) (R:relation X) (x y : X), - R x y -> (multi R) x y. +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. + apply multi_step with y. apply H. apply multi_refl. +Qed. (** 第三, [multi R] 是_'传递的(transitive)'_。 *) Theorem multi_trans : - forall (X:Type) (R: relation X) (x y z : X), + forall (X : Type) (R : relation X) (x y z : X), multi R x y -> multi R y z -> multi R x z. @@ -805,10 +820,11 @@ Proof. - (* multi_refl *) assumption. - (* multi_step *) apply multi_step with y. assumption. - apply IHG. assumption. Qed. + apply IHG. assumption. +Qed. -(** 特别地,对于项的 [multi step] 关系可得,如果 [t1==>*t2] 且 [t2==>*t3], - 那么 [t1==>*t3]。*) +(** 特别地,对于项的 [multi step] 关系可得,如果 [t1 -->* t2] 且 [t2 -->* t3], + 那么 [t1 -->* t3]。*) (* ================================================================= *) (** ** 例子 *) @@ -819,20 +835,20 @@ 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 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 ST_Plus2. apply v_const. apply ST_PlusConstConst. } apply multi_R. - apply ST_PlusConstConst. Qed. + { apply ST_PlusConstConst. } +Qed. (** 这是使用 [eapply] 的另一种证明方法,可以避免显式地构造所有的中间项。 *) @@ -840,39 +856,40 @@ 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. + 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. -(** **** 练习:1 星, optional (test_multistep_2) *) +(** **** 练习:1 星, standard, optional (test_multistep_2) *) Lemma test_multistep_2: - C 3 ==>* C 3. + C 3 -->* C 3. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星, optional (test_multistep_3) *) +(** **** 练习:1 星, standard, optional (test_multistep_3) *) Lemma test_multistep_3: P (C 0) (C 3) - ==>* + -->* P (C 0) (C 3). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (test_multistep_4) *) +(** **** 练习:2 星, standard (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))). @@ -889,13 +906,13 @@ Proof. Definition step_normal_form := normal_form step. Definition normal_form_of (t t' : tm) := - (t ==>* t' /\ step_normal_form t'). + (t -->* t' /\ step_normal_form t'). (** 我们已经看到,这这个语言中,单步归约是确定的——也即,给定的项最多只有一种方法 前进一步。从中可推论,如果 [t] 可以到到某个正规式,那么这个正规式唯一。换句话说, 我们实际上可以把 [normal_form t t'] 理解为“[t'] _'就是'_ [t] 的正规式”。*) -(** **** 练习:3 星, optional (normal_forms_unique) *) +(** **** 练习:3 星, standard, optional (normal_forms_unique) *) Theorem normal_forms_unique: deterministic normal_form_of. Proof. @@ -912,7 +929,7 @@ Proof. 任意项 [t] 最终都会到达一个正规式——即,[normal_form_of] 是一个全函数。 形式化地讲,我们说 [step] 关系是_'正规化(normalizing)'_的。 *) -Definition normalizing {X:Type} (R:relation X) := +Definition normalizing {X : Type} (R : relation X) := forall t, exists t', (multi R) t t' /\ normal_form R t'. @@ -923,20 +940,21 @@ Definition normalizing {X:Type} (R:relation X) := 的右子节点也适用。 *) Lemma multistep_congr_1 : forall t1 t1' t2, - t1 ==>* t1' -> - P t1 t2 ==>* P t1' t2. + t1 -->* t1' -> + P t1 t2 -->* P t1' t2. Proof. intros t1 t1' t2 H. induction H. - - (* multi_refl *) apply multi_refl. - - (* multi_step *) apply multi_step with (P y t2). - apply ST_Plus1. apply H. - apply IHmulti. Qed. + - (* multi_refl *) apply multi_refl. + - (* multi_step *) apply multi_step with (P y t2). + + apply ST_Plus1. apply H. + + apply IHmulti. +Qed. -(** **** 练习:2 星 (multistep_congr_2) *) +(** **** 练习:2 星, standard (multistep_congr_2) *) Lemma multistep_congr_2 : forall t1 t2 t2', value t1 -> - t2 ==>* t2' -> - P t1 t2 ==>* P t1 t2'. + t2 -->* t2' -> + P t1 t2 -->* P t1 t2'. Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -956,7 +974,7 @@ Proof. 分别有正规式 [t1'] 和 [t2']。回忆一下正规式是值(由 [nf_same_sa_value]); 我们知道 [t1' = C n1] 和 [t2' = C n2] 其中 [n1] 和 [n2] 为项。 我们可以使用 [multi_congr_1] 和 [multi_congr_2] 合并 [t1] 和 [t2] - 的 [==>*] 导出式,以此证明 [P t1 t2] 在多步内归约到 [C (n1 + n2)]。 + 的 [-->*] 导出式,以此证明 [P t1 t2] 在多步内归约到 [C (n1 + n2)]。 显然,我们的选择 [t' = C (n1 + n2)] 是一个值,也是一个正规式。[] *) @@ -965,31 +983,34 @@ Theorem step_normalizing : Proof. unfold normalizing. induction t. - - (* C *) - exists (C n). - split. - + (* l *) apply multi_refl. - + (* r *) + - (* C *) + exists (C n). + split. + + (* l *) apply multi_refl. + + (* r *) (* 除了等式,对于当且进当的命题,我们也可以使用 [rewrite]。 *) - rewrite nf_same_as_value. apply v_const. - - (* P *) - destruct IHt1 as [t1' [H11 H12]]. - destruct IHt2 as [t2' [H21 H22]]. - rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22. - inversion H12 as [n1 H]. inversion H22 as [n2 H']. - rewrite <- H in H11. - rewrite <- H' in H21. - exists (C (n1 + n2)). - split. - + (* 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. } - + (* r *) - rewrite nf_same_as_value. apply v_const. Qed. + rewrite nf_same_as_value. apply v_const. + - (* P *) + destruct IHt1 as [t1' [Hsteps1 Hnormal1]]. + destruct IHt2 as [t2' [Hsteps2 Hnormal2]]. + rewrite nf_same_as_value in Hnormal1. + rewrite nf_same_as_value in Hnormal2. + inversion Hnormal1 as [n1 H1]. + inversion Hnormal2 as [n2 H2]. + rewrite <- H1 in Hsteps1. + rewrite <- H2 in Hsteps2. + exists (C (n1 + n2)). + split. + + (* l *) + apply multi_trans with (P (C n1) t2). + * apply multistep_congr_1. apply Hsteps1. + * apply multi_trans with + (P (C n1) (C n2)). + { apply multistep_congr_2. apply v_const. apply Hsteps2. } + apply multi_R. { apply ST_PlusConstConst. } + + (* r *) + rewrite nf_same_as_value. apply v_const. +Qed. (* ================================================================= *) (** ** 大步语义和小步语义的等价关系 *) @@ -998,21 +1019,21 @@ Proof. 好奇这两种定义是否是等价的!他们确实是,尽管需要一点工作来证明它。 具体细节留做了练习。*) -(** **** 练习:3 星 (eval__multistep) *) +(** **** 练习:3 星, standard (eval__multistep) *) Theorem eval__multistep : forall t n, - t \\ n -> t ==>* C n. + t ==> n -> t -->* C n. (** 证明的核心想法以下面的方式展现: - P t1 t2 ==> (by ST_Plus1) - P t1' t2 ==> (by ST_Plus1) - P t1'' t2 ==> (by ST_Plus1) + 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) 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) + P (C n1) (C n2) --> (by ST_PlusConstConst) C (n1 + n2) 也即,一个形如 [P t1 t2] 的项的多步归约关系以如下三步的方式进行: @@ -1026,15 +1047,16 @@ Theorem eval__multistep : forall t n, [C (n1 + n2)]。*) (** 为了形式化这个直觉的理解,我们需要使用之前的合同(congruence)引理 - (为了帮助后面的证明,你可能需要回顾一下他们),还有一些 [==>*] 的基础性质: - 自反性,传递性,及其蕴含了 [==>]。 *) + (为了帮助后面的证明,你可能需要回顾一下他们),还有一些 [-->*] 的基础性质: + 自反性,传递性,及其蕴含了 [-->]。 *) Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced (eval__multistep_inf) *) -(** 请为 [eval__multi_step] 写出详细的非形式化证明。 +(** **** 练习:3 星, advanced (eval__multistep_inf) + + 请为 [eval__multi_step] 写出详细的非形式化证明。 (* 请在此处解答 *) *) @@ -1045,11 +1067,11 @@ Definition manual_grade_for_eval__multistep_inf : option (nat*string) := None. (** 对于另一个方向,我们需要一个引理来对单步归约和大步求值建立联系。*) -(** **** 练习:3 星 (step__eval) *) +(** **** 练习:3 星, standard (step__eval) *) Lemma step__eval : forall t t' n, - t ==> t' -> - t' \\ n -> - t \\ n. + t --> t' -> + t' ==> n -> + t ==> n. Proof. intros t t' n Hs. generalize dependent n. (* 请在此处解答 *) Admitted. @@ -1062,9 +1084,9 @@ Proof. (**请确保在开始证明前首先理解了命题。 *) -(** **** 练习:3 星 (multistep__eval) *) +(** **** 练习:3 星, standard (multistep__eval) *) Theorem multistep__eval : forall t t', - normal_form_of t t' -> exists n, t' = C n /\ t \\ n. + normal_form_of t t' -> exists n, t' = C n /\ t ==> n. Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -1072,55 +1094,57 @@ Proof. (* ================================================================= *) (** ** 额外练习 *) -(** **** 练习:3 星, optional (interp_tm) *) -(** 请回忆一下我们还通过函数 [evalF] 定义了对项的大步求值。请证明它等价于其他语义。 +(** **** 练习:3 星, standard, optional (interp_tm) + + 请回忆一下我们还通过函数 [evalF] 定义了对项的大步求值。请证明它等价于其他语义。 (提示:我刚刚证明了 [eval] 和 [multistep] 是等价的,因此逻辑上讲你可以任意 选择证明哪个。尽管有一个要比另一个简单!) *) Theorem evalF_eval : forall t n, - evalF t = n <-> t \\ n. + evalF t = n <-> t ==> n. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (combined_properties) *) -(** 我们分开考虑了算数和条件表达式,这个练习探索了他们之间如何交互。 *) +(** **** 练习:4 星, standard (combined_properties) + + 我们分开考虑了算数和条件表达式,这个练习探索了他们之间如何交互。 *) Module Combined. Inductive tm : Type := | C : nat -> tm | P : tm -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. + | tru : tm + | fls : tm + | test : tm -> tm -> tm -> tm. Inductive value : tm -> Prop := | v_const : forall n, value (C n) - | v_true : value ttrue - | v_false : value tfalse. + | v_tru : value tru + | v_fls : value fls. -Reserved Notation " t '==>' t' " (at level 40). +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) + P (C n1) (C n2) --> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P 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' + t2 --> t2' -> + P v1 t2 --> P v1 t2' | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 + test tru t1 t2 --> t1 | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 + test fls t1 t2 --> t2 | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 + t1 --> t1' -> + test t1 t2 t3 --> test t1' t2 t3 - where " t '==>' t' " := (step t t'). + where " t '-->' t' " := (step t t'). (** 之前,我们分开证明了加法和条件表达式的…… @@ -1145,95 +1169,95 @@ Definition manual_grade_for_combined_properties : option (nat*string) := None. (** 现在来看一个更严肃的例子:Imp 的小步操作语义。 *) (** 目前为止,给这个小语言添加算数和布尔表达式的小步归约关系是很直接的扩展。 - 处于可读性的考虑,我们为他们分别添加记号 [==>a] 和 [==>b]。 *) + 处于可读性的考虑,我们为他们分别添加记号 [-->a] 和 [-->b]。 *) Inductive aval : aexp -> Prop := | av_num : forall n, aval (ANum n). -(** 我们在此不会赘述布尔值的定义,因为 [==>b] 的定义并不需要他们(为什么?), +(** 我们在此不会赘述布尔值的定义,因为 [-->b] 的定义并不需要他们(为什么?), 尽管当语言规模更大一些时可能会需要到他们(为什么?)。*) -Reserved Notation " t '/' st '==>a' t' " +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) + AId i / st -->a ANum (st i) | AS_Plus1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (APlus a1 a2) / st ==>a (APlus 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)) + a2 / st -->a a2' -> + (APlus v1 a2) / st -->a (APlus v1 a2') + | AS_Plus : forall st n1 n2, + APlus (ANum n1) (ANum n2) / st -->a ANum (n1 + n2) | AS_Minus1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (AMinus a1 a2) / st ==>a (AMinus 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)) + a2 / st -->a a2' -> + (AMinus v1 a2) / st -->a (AMinus v1 a2') + | AS_Minus : forall st n1 n2, + (AMinus (ANum n1) (ANum n2)) / st -->a (ANum (minus n1 n2)) | AS_Mult1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (AMult a1 a2) / st ==>a (AMult 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') + a2 / st -->a a2' -> + (AMult v1 a2) / st -->a (AMult v1 a2') + | AS_Mult : forall st n1 n2, + (AMult (ANum n1) (ANum n2)) / st -->a (ANum (mult n1 n2)) - where " t '/' st '==>a' t' " := (astep st t t'). + where " t '/' st '-->a' t' " := (astep st t t'). -Reserved Notation " t '/' st '==>b' 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 (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) + 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 (n1 <=? n2) then BTrue else BFalse) + a2 / st -->a a2' -> + (BEq v1 a2) / st -->b (BEq v1 a2') +| BS_Eq : forall st n1 n2, + (BEq (ANum n1) (ANum n2)) / st -->b + (if (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) + 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') + a2 / st -->a a2' -> + (BLe v1 a2) / st -->b (BLe v1 a2') +| BS_LtEq : forall st n1 n2, + (BLe (ANum n1) (ANum n2)) / st -->b + (if (n1 <=? n2) then BTrue else BFalse) +| BS_NotStep : forall st b1 b1', + b1 / st -->b b1' -> + (BNot b1) / st -->b (BNot b1') | BS_NotTrue : forall st, - (BNot BTrue) / st ==>b BFalse + (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') + (BNot BFalse) / st -->b BTrue +| 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) | BS_AndTrueTrue : forall st, - (BAnd BTrue BTrue) / st ==>b BTrue + (BAnd BTrue BTrue) / st -->b BTrue | BS_AndTrueFalse : forall st, - (BAnd BTrue BFalse) / st ==>b BFalse + (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) + (BAnd BFalse b2) / st -->b BFalse -where " t '/' st '==>b' t' " := (bstep st t t'). +where " t '/' st '-->b' t' " := (bstep st t t'). (** 命令的语义是真正有趣的部分。我们需要两个小技巧来让们工作: @@ -1250,33 +1274,38 @@ where " t '/' st '==>b' t' " := (bstep st t t'). (** (也有一些其他的方式来达到后一个技巧同样的效果,但当对循环体进行归约时, 他们都需要将原始的 [WHILE] 命令保存在某处。)*) -Reserved Notation " t '/' st '==>' t' '/' st' " +Reserved Notation " t '/' st '-->' t' '/' st' " (at level 40, st at level 39, t' at level 39). +Open Scope imp_scope. Inductive cstep : (com * state) -> (com * state) -> Prop := | CS_AssStep : forall st i a a', - a / st ==>a a' -> - (i ::= a) / st ==> (i ::= a') / st + a / st -->a a' -> + (i ::= a) / st --> (i ::= a') / st | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ==> SKIP / (st & { i --> n }) + (i ::= (ANum n)) / st --> SKIP / (i !-> n ; st) | CS_SeqStep : forall st c1 c1' st' c2, - c1 / st ==> c1' / st' -> - (c1 ;; c2) / st ==> (c1' ;; c2) / st' + c1 / st --> c1' / st' -> + (c1 ;; c2) / st --> (c1' ;; c2) / st' | CS_SeqFinish : forall st c2, - (SKIP ;; c2) / st ==> c2 / st + (SKIP ;; c2) / st --> c2 / st + | CS_IfStep : forall st b b' c1 c2, + b / st -->b b' -> + TEST b THEN c1 ELSE c2 FI / st + --> + (TEST b' THEN c1 ELSE c2 FI) / st | CS_IfTrue : forall st c1 c2, - IFB BTrue THEN c1 ELSE c2 FI / st ==> c1 / st + TEST 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 + TEST BFalse THEN c1 ELSE c2 FI / st --> c2 / 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 + WHILE b DO c1 END / st + --> + (TEST b THEN c1;; WHILE b DO c1 END ELSE SKIP FI) / st + + where " t '/' st '-->' t' '/' st' " := (cstep (t,st) (t',st')). - where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). +Close Scope imp_scope. (* ################################################################# *) (** * 并发 Imp *) @@ -1293,8 +1322,7 @@ Inductive com : Type := | CSeq : com -> com -> com | CIf : bexp -> com -> com -> com | CWhile : bexp -> com -> com - (* New: *) - | CPar : com -> com -> com. + | CPar : com -> com -> com. (* <--- NEW *) Notation "'SKIP'" := CSkip. @@ -1304,7 +1332,7 @@ 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'" := +Notation "'TEST' 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). @@ -1312,40 +1340,40 @@ Notation "'PAR' c1 'WITH' c2 'END'" := 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 + a / st -->a a' -> + (i ::= a) / st --> (i ::= a') / st | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ==> SKIP / st & { i --> n } + (i ::= (ANum n)) / st --> SKIP / (i !-> n ; st) | CS_SeqStep : forall st c1 c1' st' c2, - c1 / st ==> c1' / st' -> - (c1 ;; c2) / st ==> (c1' ;; c2) / st' + c1 / st --> c1' / st' -> + (c1 ;; c2) / st --> (c1' ;; c2) / st' | CS_SeqFinish : forall st c2, - (SKIP ;; c2) / st ==> c2 / st + (SKIP ;; c2) / st --> c2 / st + | CS_IfStep : forall st b b' c1 c2, + b /st -->b b' -> + (TEST b THEN c1 ELSE c2 FI) / st + --> (TEST b' THEN c1 ELSE c2 FI) / st | CS_IfTrue : forall st c1 c2, - (IFB BTrue THEN c1 ELSE c2 FI) / st ==> c1 / st + (TEST 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 + (TEST BFalse THEN c1 ELSE c2 FI) / st --> c2 / 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 + --> (TEST 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' + 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' + 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')). + (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' " := +Notation " t '/' st '-->*' t' '/' st' " := (multi cstep (t,st) (t',st')) (at level 40, st at level 39, t' at level 39). @@ -1364,7 +1392,7 @@ Definition par_loop : com := Example par_loop_example_0: exists st', - par_loop / { --> 0 } ==>* SKIP / st' + par_loop / empty_st -->* SKIP / st' /\ st' X = 0. Proof. eapply ex_intro. split. @@ -1385,7 +1413,7 @@ Proof. Example par_loop_example_2: exists st', - par_loop / { --> 0 } ==>* SKIP / st' + par_loop / empty_st -->* SKIP / st' /\ st' X = 2. Proof. eapply ex_intro. split. @@ -1430,19 +1458,19 @@ Proof. (** 更一般地…… *) -(** **** 练习:3 星, optional (par_body_n__Sn) *) +(** **** 练习:3 星, standard, optional (par_body_n__Sn) *) Lemma par_body_n__Sn : forall n st, st X = n /\ st Y = 0 -> - par_loop / st ==>* par_loop / st & { X --> S n}. + par_loop / st -->* par_loop / (X !-> S n ; st). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (par_body_n) *) +(** **** 练习:3 星, standard, optional (par_body_n) *) 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. + par_loop / st -->* par_loop / st' /\ st' X = n /\ st' Y = 0. Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -1451,16 +1479,16 @@ Proof. Theorem par_loop_any_X: forall n, exists st', - par_loop / { --> 0 } ==>* SKIP / st' + par_loop / empty_st -->* SKIP / st' /\ st' X = n. Proof. intros n. - destruct (par_body_n n { --> 0 }). + destruct (par_body_n n empty_st). split; unfold t_update; reflexivity. rename x into st. inversion H as [H' [HX HY]]; clear H. - exists (st & { Y --> 1 }). split. + exists (Y !-> 1 ; st). 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. @@ -1506,9 +1534,10 @@ Qed. Definition stack_multistep st := multi (stack_step st). -(** **** 练习:3 星, advanced (compiler_is_correct) *) -(** 请回忆一下_'逻辑基础'_ [Imp] 一章中对 [compile] 和 [aexp] 的定义。 - 我们现在想要证明堆栈机上 [compile] 函数的正确性。 +(** **** 练习:3 星, advanced (compiler_is_correct) + + 请回忆一下_'逻辑基础'_ [Imp] 一章中对 [compile] 和 [aexp] 的定义。 + 我们现在想要证明堆栈机上 [s_compile] 函数的正确性。 请根据堆栈机的小步语义陈述编译器正确性的定义,并证明它。 *) @@ -1520,6 +1549,103 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) +(* ################################################################# *) +(** * Aside: A [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 quite tedious to do by hand. Consider, for + example, reducing an arithmetic expression using the small-step + relation [astep]. *) + +Example step_example1 : + (P (C 3) (P (C 3) (C 4))) + -->* (C 10). +Proof. + apply multi_step with (P (C 3) (C 7)). + apply ST_Plus2. + apply v_const. + apply ST_PlusConstConst. + apply multi_step with (C 10). + apply ST_PlusConstConst. + apply multi_refl. +Qed. + +(** The proof repeatedly applies [multi_step] until the term reaches a + normal form. Fortunately The sub-proofs for the intermediate + steps are simple enough that [auto], with appropriate hints, can + solve them. *) -(** $Date$ *) +Hint Constructors step value. +Example step_example1' : + (P (C 3) (P (C 3) (C 4))) + -->* (C 10). +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 step, we print out the current + goal, so that we can follow how the term is being reduced. *) + +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 step_example1'' : + (P (C 3) (P (C 3) (C 4))) + -->* (C 10). +Proof. + normalize. + (* The [print_goal] in the [normalize] tactic shows + a trace of how the expression reduced... + (P (C 3) (P (C 3) (C 4)) -->* C 10) + (P (C 3) (C 7) -->* C 10) + (C 10 -->* C 10) + *) +Qed. + +(** The [normalize] tactic also provides a simple way to calculate the + normal form of a term, by starting with a goal with an existentially + bound variable. *) + +Example step_example1''' : exists e', + (P (C 3) (P (C 3) (C 4))) + -->* e'. +Proof. + eapply ex_intro. normalize. +(* This time, the trace is: + (P (C 3) (P (C 3) (C 4)) -->* ?e') + (P (C 3) (C 7) -->* ?e') + (C 10 -->* ?e') + where ?e' is the variable ``guessed'' by eapply. *) +Qed. + +(** **** 练习:1 星, standard (normalize_ex) *) +Theorem normalize_ex : exists e', + (P (C 3) (P (C 2) (C 1))) + -->* e' /\ value e'. +Proof. + (* 请在此处解答 *) Admitted. +(** [] *) + +(** **** 练习:1 星, standard, optional (normalize_ex') + + For comparison, prove it using [apply] instead of [eapply]. *) + +Theorem normalize_ex' : exists e', + (P (C 3) (P (C 2) (C 1))) + -->* e' /\ value e'. +Proof. + (* 请在此处解答 *) Admitted. +(** [] *) +(* Sat Jan 26 15:15:44 UTC 2019 *) diff --git a/plf-current/SmallstepTest.v b/plf-current/SmallstepTest.v index bcc9ed0a..4c570d57 100644 --- a/plf-current/SmallstepTest.v +++ b/plf-current/SmallstepTest.v @@ -84,7 +84,7 @@ idtac " ". idtac "#> test_multistep_4". idtac "Possible points: 2". check_type @test_multistep_4 ( -(P (C 0) (P (C 2) (P (C 0) (C 3))) ==>* P (C 0) (C (2 + (0 + 3))))). +(P (C 0) (P (C 2) (P (C 0) (C 3))) -->* P (C 0) (C (2 + (0 + 3))))). idtac "Assumptions:". Abort. Print Assumptions test_multistep_4. @@ -97,7 +97,7 @@ idtac " ". idtac "#> multistep_congr_2". idtac "Possible points: 2". check_type @multistep_congr_2 ( -(forall t1 t2 t2' : tm, value t1 -> t2 ==>* t2' -> P t1 t2 ==>* P t1 t2')). +(forall t1 t2 t2' : tm, value t1 -> t2 -->* t2' -> P t1 t2 -->* P t1 t2')). idtac "Assumptions:". Abort. Print Assumptions multistep_congr_2. @@ -109,7 +109,7 @@ idtac " ". idtac "#> eval__multistep". idtac "Possible points: 3". -check_type @eval__multistep ((forall (t : tm) (n : nat), t \\ n -> t ==>* C n)). +check_type @eval__multistep ((forall (t : tm) (n : nat), t ==> n -> t -->* C n)). idtac "Assumptions:". Abort. Print Assumptions eval__multistep. @@ -130,7 +130,7 @@ idtac " ". idtac "#> step__eval". idtac "Possible points: 3". -check_type @step__eval ((forall (t t' : tm) (n : nat), t ==> t' -> t' \\ n -> t \\ n)). +check_type @step__eval ((forall (t t' : tm) (n : nat), t --> t' -> t' ==> n -> t ==> n)). idtac "Assumptions:". Abort. Print Assumptions step__eval. @@ -143,7 +143,7 @@ idtac " ". idtac "#> multistep__eval". idtac "Possible points: 3". check_type @multistep__eval ( -(forall t t' : tm, normal_form_of t t' -> exists n : nat, t' = C n /\ t \\ n)). +(forall t t' : tm, normal_form_of t t' -> exists n : nat, t' = C n /\ t ==> n)). idtac "Assumptions:". Abort. Print Assumptions multistep__eval. @@ -171,10 +171,22 @@ Print Assumptions compiler_is_correct. Goal True. idtac " ". +idtac "------------------- normalize_ex --------------------". idtac " ". -idtac "Max points - standard: 24". -idtac "Max points - advanced: 30". +idtac "#> normalize_ex". +idtac "Possible points: 1". +check_type @normalize_ex ((exists e' : tm, P (C 3) (P (C 2) (C 1)) -->* e' /\ value e')). +idtac "Assumptions:". +Abort. +Print Assumptions normalize_ex. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 25". +idtac "Max points - advanced: 31". idtac "". idtac "********** Summary **********". idtac "". @@ -199,6 +211,8 @@ idtac "---------- multistep__eval ---------". Print Assumptions multistep__eval. idtac "---------- combined_properties ---------". idtac "MANUAL". +idtac "---------- normalize_ex ---------". +Print Assumptions normalize_ex. idtac "". idtac "********** Advanced **********". idtac "---------- eval__multistep_inf ---------". @@ -206,3 +220,5 @@ idtac "MANUAL". idtac "---------- compiler_is_correct ---------". Print Assumptions compiler_is_correct. Abort. + +(* Sat Jan 26 15:16:03 UTC 2019 *) diff --git a/plf-current/Stlc.html b/plf-current/Stlc.html index d84cfb36..c9e3bfad 100644 --- a/plf-current/Stlc.html +++ b/plf-current/Stlc.html @@ -49,13 +49,13 @@

          Stlc简单类型 Lambda-演算 Set Warnings "-notation-overridden,-parsing".
          +From Coq Require Import Strings.String.
          From PLF Require Import Maps.
          From PLF Require Import Smallstep.
          -From PLF Require Import Types.

          -

          简介

          +

          简介

          @@ -93,21 +93,21 @@

          Stlc简单类型 Lambda-演算

          -       t ::= x                       variable
          -           | \x:T1.t2                abstraction
          -           | t1 t2                   application
          -           | true                    constant true
          -           | false                   constant false
          -           | if t1 then t2 else t3   conditional +       t ::= x                         variable
          +           | \x:T1.t2                  abstraction
          +           | t1 t2                     application
          +           | tru                       constant true
          +           | fls                       constant false
          +           | test t1 then t2 else t3   conditional
          - 函数抽象 \x:T1.t2 中的 \ 符号一般写作希腊字母“lambda”(本演算系统由此得名)。 - 变量 x 叫做函数的参数(parameter);项 t2函数体(body)。 - 记号 :T1 指明了函数可以被应用的参数类型。 + 函数抽象 \x:T.t 中的 \ 符号一般写作希腊字母“lambda”(本演算系统由此得名)。 + 变量 x 叫做函数的参数(parameter);项 t函数体(body)。 + 记号 :T 指明了函数可以被应用的参数类型。
          一些例子: @@ -125,17 +125,17 @@

          Stlc简单类型 Lambda-演算 -
        • (\x:Bool. x) true +
        • (\x:Bool. x) tru
          - 被应用于 true 的布尔值恒等函数。 + 被应用于 tru 的布尔值恒等函数。
        • -
        • \x:Bool. if x then false else true +
        • \x:Bool. test x then fls else tru
          @@ -145,11 +145,11 @@

          Stlc简单类型 Lambda-演算 -
        • \x:Bool. true +
        • \x:Bool. tru
          - 总是接受(布尔值)参数并返回 true 的常量函数。 + 总是接受(布尔值)参数并返回 tru 的常量函数。
        @@ -167,37 +167,38 @@

        Stlc简单类型 Lambda-演算 -
      • (\x:Bool. \y:Bool. x) false true +
      • (\x:Bool. \y:Bool. x) fls tru
        一个接受两个布尔值做参数,并返回第一个参数的函数,接着它被应用于两个布尔值参数 - falsetrue。 + flstru
        - 在 Coq 中,应用是左结合的——也即,这个表达式被解析为 ((\x:Bool. \y:Bool. x) false) true。 + 在 Coq 中,应用是左结合的——也即,这个表达式被解析为 + ((\x:Bool. \y:Bool. x) fls) tru
      • -
      • \f:BoolBool. f (f true) +
      • \f:BoolBool. f (f tru)
        一个高阶函数其接受一个函数 f(从布尔值到布尔值)作为参数,并应用 - f 于参数 true;其结果又被应用于 f。 + f 于参数 tru;其结果又被应用于 f
      • -
      • (\f:BoolBool. f (f true)) (\x:Bool. false) +
      • (\f:BoolBool. f (f tru)) (\x:Bool. fls)
        - 同一个高阶函数,被应用于返回 false 的常函数。 + 同一个高阶函数,被应用于返回 fls 的常函数。
      @@ -214,7 +215,7 @@

      Stlc简单类型 Lambda-演算

      - STLC 的类型(types)包括 Bool,其用于把 truefalse 这些常量 + STLC 的类型(types)包括 Bool,其用于把 trufls 这些常量 和其他产生布尔值的复杂计算归为一类;还有函数类型(arrow types),用于把函 数归为一类。
      @@ -224,7 +225,7 @@

      Stlc简单类型 Lambda-演算       T ::= Bool
      -          | T1 → T2 +          | T → T

      @@ -233,7 +234,7 @@

      Stlc简单类型 Lambda-演算

      -
    • \x:Bool. false 有类型 BoolBool +
    • \x:Bool. fls 有类型 BoolBool
      @@ -245,7 +246,7 @@

      Stlc简单类型 Lambda-演算 -
    • (\x:Bool. x) true 有类型 Bool +
    • (\x:Bool. x) tru 有类型 Bool
      @@ -258,20 +259,20 @@

      Stlc简单类型 Lambda-演算 -
    • (\x:Bool. \y:Bool. x) false 有类型 BoolBool +
    • (\x:Bool. \y:Bool. x) fls 有类型 BoolBool
    • -
    • (\x:Bool. \y:Bool. x) false true 有类型 Bool +
    • (\x:Bool. \y:Bool. x) fls tru 有类型 Bool

    -

    语法

    +

    语法

    @@ -283,48 +284,44 @@

    Stlc简单类型 Lambda-演算
    -

    类型

    +

    类型


    Inductive ty : Type :=
    -  | TBool : ty
    -  | TArrow : tytyty.
    +  | Bool : ty
    +  | Arrow : tytyty.
    -

    +


    Inductive tm : Type :=
    -  | tvar : stringtm
    -  | tapp : tmtmtm
    -  | tabs : stringtytmtm
    -  | ttrue : tm
    -  | tfalse : tm
    -  | tif : tmtmtmtm.
    +  | var : stringtm
    +  | app : tmtmtm
    +  | abs : stringtytmtm
    +  | tru : tm
    +  | fls : tm
    +  | test : tmtmtmtm.
    -请注意一个形如 \x:T.t 的抽象(形式化地讲是 tabs x T t)包含其参数 +请注意一个形如 \x:T.t 的抽象(形式化地讲是 abs x T t)包含其参数 T 的类型注释,相反在 Coq(以及其他函数式语言,比如 ML,Haskell等)中, 会使用类型推导来填补这些类型注释。我们在此不考虑类型推导。 -
    -
    - -Open Scope string_scope.
    -
    +
    -
    -一些例子…… + 一些例子……
    +Open Scope string_scope.

    Definition x := "x".
    Definition y := "y".
    Definition z := "z".

    @@ -339,7 +336,7 @@

    Stlc简单类型 Lambda-演算 Notation idB :=
    -  (tabs x TBool (tvar x)).
    +  (abs x Bool (var x)).

    @@ -348,7 +345,7 @@

    Stlc简单类型 Lambda-演算 Notation idBB :=
    -  (tabs x (TArrow TBool TBool) (tvar x)).
    +  (abs x (Arrow Bool Bool) (var x)).

    @@ -357,9 +354,9 @@

    Stlc简单类型 Lambda-演算 Notation idBBBB :=
    -  (tabs x (TArrow (TArrow TBool TBool)
    -                      (TArrow TBool TBool))
    -    (tvar x)).
    +  (abs x (Arrow (Arrow Bool Bool)
    +                      (Arrow Bool Bool))
    +    (var x)).

    @@ -367,15 +364,15 @@

    Stlc简单类型 Lambda-演算
    -Notation k := (tabs x TBool (tabs y TBool (tvar x))).
    +Notation k := (abs x Bool (abs y Bool (var x))).
    -notB = \x:Bool. if x then false else true +notB = \x:Bool. test x then fls else tru
    -Notation notB := (tabs x TBool (tif (tvar x) tfalse ttrue)).
    +Notation notB := (abs x Bool (test (var x) fls tru)).
    @@ -383,7 +380,7 @@

    Stlc简单类型 Lambda-演算
    -

    操作语义

    +

    操作语义

    @@ -393,7 +390,7 @@

    Stlc简单类型 Lambda-演算
    -

    +

    @@ -402,7 +399,7 @@

    Stlc简单类型 Lambda-演算

    首先,对于布尔值而言是显然的:truefalse 是仅有的值。 - 一个 if 表达式不是值。 + 一个 test 表达式不是值。
    其次,一个应用也不会是值:它表示一个函数正在某个参数上被调用,显然还可以继续归约。 @@ -413,14 +410,14 @@

    Stlc简单类型 Lambda-演算

      -
    • 我们可以说仅当 t1 是值时 \x:T. t1 是值——也即,仅当函数体已经被归约 +
    • 我们可以说仅当 t 是值时 \x:T. t 是值——也即,仅当函数体已经被归约 (在不知道被应用的参数是什么的情况下尽可能地归约)。
    • -
    • 或者,我们可以说不论 t1 是不是值,\x:T. t1 都是一个值——换句话说, +
    • 或者,我们可以说不论 t 是不是值,\x:T. t 都是一个值——换句话说, 归约止于抽象。
    • @@ -437,22 +434,27 @@

      Stlc简单类型 Lambda-演算

    - 会得到 fun x:bool 7。 + 会得到
    +
    +          fun x:bool ⇒ 7 +
    + +
    多数现实世界中的程序语言选择了第二种方式——函数体的归约仅发生在函数实际被应用 于某个参数时。在这里我们也选择第二种方式。

    Inductive value : tmProp :=
    -  | v_abs : x T t,
    -      value (tabs x T t)
    -  | v_true :
    -      value ttrue
    -  | v_false :
    -      value tfalse.

    +  | v_abs : x T t,
    +      value (abs x T t)
    +  | v_tru :
    +      value tru
    +  | v_fls :
    +      value fls.

    Hint Constructors value.
    @@ -467,16 +469,15 @@

    Stlc简单类型 Lambda-演算

    - (相反,含有自由变量的项一般被叫做开放项(open term)。) - + (相反,含有自由变量的项一般被叫做开放项(open term)。)
    - 由于我们决定不对抽象内的表达式进行归约,因此也不必担心变量是否是值这个问题。 + 由于我们决定不对抽象内的表达式进行归约,因此也不必担心变量是否是值这个问题。 因为我们总是“从外向内”地归约程序,这意味着 step 关系仅会处理闭合项。

    -

    替换

    +

    替换

    @@ -487,7 +488,7 @@

    Stlc简单类型 Lambda-演算

    -       (\x:Bool. if x then true else xfalse +       (\x:Bool. test x then tru else xfls
    @@ -496,16 +497,16 @@

    Stlc简单类型 Lambda-演算

    -       if false then true else false +       test fls then tru else fls
    - 这步归约将函数体中出现的参数 x 替换为 false。 + 这步归约将函数体中出现的参数 x 替换为 fls
    一般来说,我们可以用给定的项 s 替换的某另一个项 t 中出现个变量 x。 - 在非形式化的讨论中,这通常被写做 [x:=s]t ,并读做“替换 t 中的 x + 在非形式化的讨论中,这通常被写做 [x:=s]t ,并读做“替换 t 中的 xs”。
    @@ -514,65 +515,65 @@

    Stlc简单类型 Lambda-演算

      -
    • [x:=true] (if x then x else false) - 产生 if true then true else false +
    • [x:=tru] (test x then x else fls) + 产生 test tru then tru else fls
    • -
    • [x:=true] x 产生 true +
    • [x:=tru] x 产生 tru
    • -
    • [x:=true] (if x then x else y) 产生 if true then true else y +
    • [x:=tru] (test x then x else y) 产生 test tru then tru else y
    • -
    • [x:=true] y 产生 y +
    • [x:=tru] y 产生 y
    • -
    • [x:=true] false 产生 false (无意义的替换) +
    • [x:=tru] fls yields fls (vacuous substitution)
    • -
    • [x:=true] (\y:Bool. if y then x else false) - 产生 \y:Bool. if y then true else false +
    • [x:=tru] (\y:Bool. test y then x else fls) + 产生 \y:Bool. test y then tru else fls
    • -
    • [x:=true] (\y:Bool. x) 产生 \y:Bool. true +
    • [x:=tru] (\y:Bool. x) 产生 \y:Bool. tru
    • -
    • [x:=true] (\y:Bool. y) 产生 \y:Bool. y +
    • [x:=tru] (\y:Bool. y) 产生 \y:Bool. y
    • -
    • [x:=true] (\x:Bool. x) 产生 \x:Bool. x +
    • [x:=tru] (\x:Bool. x) 产生 \x:Bool. x
    - 最后一个例子非常重要:替换 \x:Bool. x 中的 xtrue 会产生 - \x:Bool. true!因为 \x:Bool. x 中的 x 是被这个抽象所绑定的(bound): + 最后一个例子非常重要:替换 \x:Bool. x 中的 xtru 会产生 + \x:Bool. tru!因为 \x:Bool. x 中的 x 是被这个抽象所绑定的(bound): 它是一个新的、局部的名字,只是恰巧写做了跟某个全局名字一样的 x
    @@ -582,14 +583,14 @@

    Stlc简单类型 Lambda-演算        [x:=s]x               = s
    -       [x:=s]y               = y                      if x ≠ y
    +       [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](\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 +       [x:=s]tru             = tru
    +       [x:=s]fls             = fls
    +       [x:=s](test t1 then t2 else t3) =
    +              test [x:=s]t1 then [x:=s]t2 else [x:=s]t3

    @@ -601,20 +602,20 @@

    Stlc简单类型 Lambda-演算 Reserved Notation "'[' x ':=' s ']' t" (at level 20).

    -Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
    +Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
      match t with
    -  | tvar x'
    +  | var x'
          if eqb_string x x' then s else t
    -  | tabs x' T t1
    -      tabs x' T (if eqb_string 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)
    +  | abs x' T t1
    +      abs x' T (if eqb_string x x' then t1 else ([x:=s] t1))
    +  | app t1 t2
    +      app ([x:=s] t1) ([x:=s] t2)
    +  | tru
    +      tru
    +  | fls
    +      fls
    +  | test t1 t2 t3
    +      test ([x:=s] t1) ([x:=s] t2) ([x:=s] t3)
      end

    where "'[' x ':=' s ']' t" := (subst x s t).
    @@ -622,7 +623,7 @@

    Stlc简单类型 Lambda-演算 '技术注解:如果我们考虑用于替换掉某个变量的项 s 其本身也含有自由变量, - 那么定义替换将会变得困难一点。由于我们仅对定义在闭合项(也即像 \x:Bool. x + 那么定义替换将会变得困难一点。由于我们仅对定义在闭合项(也即像 \x:Bool. x 这种绑定了内部全部变量的项)上的 step 关系有兴趣,我们可以规避这个额外的复杂性, 但是当形式化构造更丰富的语言时,我们必须考虑这一点。
    @@ -643,7 +644,7 @@

    Stlc简单类型 Lambda-演算[Aydemir 2008]
    -

    练习:3 星 (substi_correct)

    +

    练习:3 星, standard (substi_correct)

    上面我们使用了 Coq 的 Fixpoint 功能将替换定义为一个函数。 假设,现在我们想要将替换定义为一个归纳的关系 substi。作为开始,我们给出了 Inductive 定义的头部和其中一个构造子;你的任务是完成剩下的构造子,并证明 @@ -651,13 +652,13 @@

    Stlc简单类型 Lambda-演算
    -Inductive substi (s:tm) (x:string) : tmtmProp :=
    +Inductive substi (s : tm) (x : string) : tmtmProp :=
      | s_var1 :
    -      substi s x (tvar x) s
    +      substi s x (var x) s
      (* 请在此处解答 *)
    .

    Hint Constructors substi.

    -Theorem substi_correct : s x t t',
    +Theorem substi_correct : s x t t',
      [x:=s]t = t'substi s x t t'.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -666,7 +667,7 @@

    Stlc简单类型 Lambda-演算
    -

    归约

    +

    归约

    @@ -678,11 +679,11 @@

    Stlc简单类型 Lambda-演算

    -      (\x:T.t12v2 ==> [x:=v2]t12 +      (\x:T.t12v2 --> [x:=v2]t12
    - 传统上这也被称作“beta-归约(beta-reduction)” + 传统上这也被称作beta-归约(beta-reduction)
    @@ -695,12 +696,12 @@

    Stlc简单类型 Lambda-演算

    - +
    (\x:T.t12) v2 ==> [x:=v2]t12(\x:T.t12) v2 --> [x:=v2]t12
    - + @@ -708,7 +709,7 @@

    Stlc简单类型 Lambda-演算

    - +
    t1 ==> t1't1 --> t1' (ST_App1)  
    t1 t2 ==> t1' t2t1 t2 --> t1' t2
    @@ -717,7 +718,7 @@

    Stlc简单类型 Lambda-演算

    - + @@ -725,7 +726,7 @@

    Stlc简单类型 Lambda-演算

    - +
    t2 ==> t2't2 --> t2' (ST_App2)  
    v1 t2 ==> v1 t2'v1 t2 --> v1 t2'
    ……还有对条件语句的规则: @@ -733,39 +734,39 @@

    Stlc简单类型 Lambda-演算    - (ST_IfTrue)   + (ST_TestTru)  
    - (if true then t1 else t2) ==> t1 + (test tru then t1 else t2--> t1
    - +
       - (ST_IfFalse)   + (ST_TestFls)  

    (if false then t1 else t2) ==> t2(test fls then t1 else t2--> t2
    - + - +
    t1 ==> t1't1 --> t1' - (ST_If)   + (ST_Test)  

    (if t1 then t2 else t3) ==> (if t1' then t2 else t3)(test t1 then t2 else t3--> (test t1' then t2 else t3)
    @@ -775,34 +776,34 @@

    Stlc简单类型 Lambda-演算
    -Reserved Notation "t1 '==>' t2" (at level 40).

    +Reserved Notation "t1 '-->' t2" (at level 40).

    Inductive step : tmtmProp :=
    -  | ST_AppAbs : x T t12 v2,
    +  | 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',
    +         (app (abs x T t12) v2) --> [x:=v2]t12
    +  | ST_App1 : t1 t1' t2,
    +         t1 --> t1'
    +         app t1 t2 --> app 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)
    +         t2 --> t2'
    +         app v1 t2 --> app v1 t2'
    +  | ST_TestTru : t1 t2,
    +      (test tru t1 t2) --> t1
    +  | ST_TestFls : t1 t2,
    +      (test fls t1 t2) --> t2
    +  | ST_Test : t1 t1' t2 t3,
    +      t1 --> t1'
    +      (test t1 t2 t3) --> (test t1' t2 t3)

    -where "t1 '==>' t2" := (step t1 t2).

    +where "t1 '-->' t2" := (step t1 t2).

    Hint Constructors step.

    Notation multistep := (multi step).
    -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40).
    +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).
    -

    例子

    +

    例子

    @@ -811,7 +812,7 @@

    Stlc简单类型 Lambda-演算

    -      (\x:BoolBool. x) (\x:Bool. x) ==>* \x:Bool. x +      (\x:BoolBool. x) (\x:Bool. x-->* \x:Bool. x
    @@ -820,7 +821,7 @@

    Stlc简单类型 Lambda-演算

    -      idBB idB ==>* idB +      idBB idB -->* idB
    @@ -829,7 +830,7 @@

    Stlc简单类型 Lambda-演算 Lemma step_example1 :
    -  (tapp idBB idB) ==>* idB.
    +  (app idBB idB) -->* idB.
    Proof.
      eapply multi_step.
        apply ST_AppAbs.
    @@ -845,7 +846,7 @@

    Stlc简单类型 Lambda-演算       (\x:BoolBool. x) ((\x:BoolBool. x) (\x:Bool. x))
    -            ==>* \x:Bool. x +            -->* \x:Bool. x

    @@ -854,7 +855,7 @@

    Stlc简单类型 Lambda-演算

    -      (idBB (idBB idB)) ==>* idB. +      (idBB (idBB idB)) -->* idB.
    @@ -863,7 +864,7 @@

    Stlc简单类型 Lambda-演算 Lemma step_example2 :
    -  (tapp idBB (tapp idBB idB)) ==>* idB.
    +  (app idBB (app idBB idB)) -->* idB.
    Proof.
      eapply multi_step.
        apply ST_App2. auto.
    @@ -880,9 +881,9 @@

    Stlc简单类型 Lambda-演算       (\x:BoolBool. x)
    -         (\x:Bool. if x then false else true)
    -         true
    -            ==>* false +         (\x:Bool. test x then fls else tru)
    +         tru
    +            -->* fls

    @@ -891,7 +892,7 @@

    Stlc简单类型 Lambda-演算

    -       (idBB notBttrue ==>* tfalse. +       (idBB notBtru -->* fls.
    @@ -900,14 +901,14 @@

    Stlc简单类型 Lambda-演算 Lemma step_example3 :
    -  tapp (tapp idBB notB) ttrue ==>* tfalse.
    +  app (app idBB notB) tru -->* fls.
    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.
    +    apply ST_TestTru. apply multi_refl. Qed.

    @@ -917,8 +918,8 @@

    Stlc简单类型 Lambda-演算       (\x:Bool → Bool. x)
    -         ((\x:Bool. if x then false else truetrue)
    -            ==>* false +         ((\x:Bool. test x then fls else trutru)
    +            -->* fls

    @@ -927,7 +928,7 @@

    Stlc简单类型 Lambda-演算

    -      idBB (notB ttrue) ==>* tfalse. +      idBB (notB tru-->* fls.
    @@ -937,52 +938,52 @@

    Stlc简单类型 Lambda-演算 Lemma step_example4 :
    -  tapp idBB (tapp notB ttrue) ==>* tfalse.
    +  app idBB (app notB tru) -->* fls.
    Proof.
      eapply multi_step.
        apply ST_App2. auto.
        apply ST_AppAbs. auto. simpl.
      eapply multi_step.
        apply ST_App2. auto.
    -    apply ST_IfTrue.
    +    apply ST_TestTru.
      eapply multi_step.
        apply ST_AppAbs. auto. simpl.
      apply multi_refl. Qed.

    -我们可以使用 Types 一章中定义的 normalize 策略来简化这些证明。 +我们可以使用 Smallstep 一章中定义的 normalize 策略来简化这些证明。
    Lemma step_example1' :
    -  (tapp idBB idB) ==>* idB.
    +  app idBB idB -->* idB.
    Proof. normalize. Qed.

    Lemma step_example2' :
    -  (tapp idBB (tapp idBB idB)) ==>* idB.
    +  app idBB (app idBB idB) -->* idB.
    Proof. normalize. Qed.

    Lemma step_example3' :
    -  tapp (tapp idBB notB) ttrue ==>* tfalse.
    +  app (app idBB notB) tru -->* fls.
    Proof. normalize. Qed.

    Lemma step_example4' :
    -  tapp idBB (tapp notB ttrue) ==>* tfalse.
    +  app idBB (app notB tru) -->* fls.
    Proof. normalize. Qed.
    -

    练习:2 星 (step_example5)

    +

    练习:2 星, standard (step_example5)

    请分别使用和不使用 normalize 证明以下命题。
    Lemma step_example5 :
    -       tapp (tapp idBBBB idBB) idB
    -  ==>* idB.
    +       app (app idBBBB idBB) idB
    +  -->* idB.
    Proof.
      (* 请在此处解答 *) Admitted.

    Lemma step_example5_with_normalize :
    -       tapp (tapp idBBBB idBB) idB
    -  ==>* idB.
    +       app (app idBBBB idBB) idB
    +  -->* idB.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -990,7 +991,7 @@

    Stlc简单类型 Lambda-演算
    -

    定型

    +

    定型

    @@ -998,7 +999,7 @@

    Stlc简单类型 Lambda-演算
    -

    上下文

    +

    上下文

    @@ -1014,12 +1015,12 @@

    Stlc简单类型 Lambda-演算

    - 这把我们引向了一个三元类型断言(type judgement),非形式化地写做 Gamma |- t T, + 这把我们引向了一个三元类型断言(type judgement),非形式化地写做 Gamma t T, 其中 Gamma 是一个“类型上下文(typing context)”——一个变量到他们的 类型的映射。
    - 使用通常偏映射的记号,我们可以用 Gamma & {{x:T}} 来表示“更新偏函数 Gamma + 使用通常偏映射的记号,我们用 (X > T11, Gamma) 来表示“更新偏函数 Gamma 使其也将 x 映射到 T”。

    @@ -1028,7 +1029,7 @@

    Stlc简单类型 Lambda-演算
    -

    类型关系

    +

    类型关系

    @@ -1042,12 +1043,12 @@

    Stlc简单类型 Lambda-演算
    - Gamma |- x ∈ T + Gamma ⊢ x ∈ T
    - + @@ -1055,16 +1056,16 @@

    Stlc简单类型 Lambda-演算

    - +
    Gamma & {{ x --> T11 }} |- t12 ∈ T12(x > T11 ; Gamma) ⊢ t12 ∈ T12 (T_Abs)  
    Gamma |- \x:T11.t12 ∈ T11->T12Gamma ⊢ \x:T11.t12 ∈ T11->T12
    - + - + @@ -1072,91 +1073,91 @@

    Stlc简单类型 Lambda-演算

    - +
    Gamma |- t1 ∈ T11->T12Gamma ⊢ t1 ∈ T11->T12
    Gamma |- t2 ∈ T11Gamma ⊢ t2 ∈ T11 (T_App)  
    Gamma |- t1 t2 ∈ T12Gamma ⊢ t1 t2 ∈ T12
    - +
       - (T_True)   + (T_Tru)  

    Gamma |- true ∈ BoolGamma ⊢ tru ∈ Bool
    - +
       - (T_False)   + (T_Fls)  

    Gamma |- false ∈ BoolGamma ⊢ fls ∈ Bool
    - + - +
    Gamma |- t1 ∈ Bool    Gamma |- t2 ∈ T    Gamma |- t3 ∈ TGamma ⊢ t1 ∈ Bool    Gamma ⊢ t2 ∈ T    Gamma ⊢ t3 ∈ T - (T_If)   + (T_Test)  

    Gamma |- if t1 then t2 else t3 ∈ TGamma ⊢ test t1 then t2 else t3 ∈ T
    - 我们可以把形如 Gamma |- t T 的三元关系读做: + 我们可以把形如 Gamma t T 的三元关系读做: “在假设 Gamma 下,项 t 有类型 T。”

    -Reserved Notation "Gamma '|-' t '∈' T" (at level 40).

    +Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).

    Inductive has_type : contexttmtyProp :=
    -  | T_Var : Gamma x T,
    +  | T_Var : Gamma x T,
          Gamma x = Some T
    -      Gamma |- tvar xT
    -  | T_Abs : Gamma x T11 T12 t12,
    -      Gamma & {{x --> T11}} |- t12T12
    -      Gamma |- tabs x T11 t12TArrow T11 T12
    -  | T_App : T11 T12 Gamma t1 t2,
    -      Gamma |- t1TArrow T11 T12
    -      Gamma |- t2T11
    -      Gamma |- tapp t1 t2T12
    -  | T_True : Gamma,
    -       Gamma |- ttrueTBool
    -  | T_False : Gamma,
    -       Gamma |- tfalseTBool
    -  | T_If : t1 t2 t3 T Gamma,
    -       Gamma |- t1TBool
    -       Gamma |- t2T
    -       Gamma |- t3T
    -       Gamma |- tif t1 t2 t3T
    +      Gammavar xT
    +  | T_Abs : Gamma x T11 T12 t12,
    +      (x > T11 ; Gamma) ⊢ t12T12
    +      Gammaabs x T11 t12Arrow T11 T12
    +  | T_App : T11 T12 Gamma t1 t2,
    +      Gammat1Arrow T11 T12
    +      Gammat2T11
    +      Gammaapp t1 t2T12
    +  | T_Tru : Gamma,
    +       GammatruBool
    +  | T_Fls : Gamma,
    +       GammaflsBool
    +  | T_Test : t1 t2 t3 T Gamma,
    +       Gammat1Bool
    +       Gammat2T
    +       Gammat3T
    +       Gammatest t1 t2 t3T

    -where "Gamma '|-' t '∈' T" := (has_type Gamma t T).

    +where "Gamma '⊢' t '∈' T" := (has_type Gamma t T).

    Hint Constructors has_type.
    -

    例子

    +

    例子


    Example typing_example_1 :
    -  empty |- tabs x TBool (tvar x) ∈ TArrow TBool TBool.
    +  emptyabs x Bool (var x) ∈ Arrow Bool Bool.
    Proof.
      apply T_Abs. apply T_Var. reflexivity. Qed.
    @@ -1168,17 +1169,17 @@

    Stlc简单类型 Lambda-演算 Example typing_example_1' :
    -  empty |- tabs x TBool (tvar x) ∈ TArrow TBool TBool.
    +  emptyabs x Bool (var x) ∈ Arrow Bool Bool.
    Proof. auto. Qed.

    -另一个例子: +更多例子:
    -       empty |- \x:A. \y:AA. y (y x)
    +       empty ⊢ \x:A. \y:AA. y (y x)
                 ∈ A → (AA) → A.
    @@ -1191,11 +1192,11 @@

    Stlc简单类型 Lambda-演算 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)).
    +  empty
    +    (abs x Bool
    +       (abs y (Arrow Bool Bool)
    +          (app (var y) (app (var y) (var x))))) ∈
    +    (Arrow Bool (Arrow (Arrow Bool Bool) Bool)).
    Proof with auto using update_eq.
      apply T_Abs.
      apply T_Abs.
    @@ -1207,17 +1208,17 @@

    Stlc简单类型 Lambda-演算
    -

    练习:2 星, optional (typing_example_2_full)

    +

    练习:2 星, standard, optional (typing_example_2_full)

    请在不使用 autoeautoeapply(或者 ...)的情况下证明同一个命题:
    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)).
    +  empty
    +    (abs x Bool
    +       (abs y (Arrow Bool Bool)
    +          (app (var y) (app (var y) (var x))))) ∈
    +    (Arrow Bool (Arrow (Arrow Bool Bool) Bool)).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1226,12 +1227,12 @@

    Stlc简单类型 Lambda-演算
    -

    练习:2 星 (typing_example_3)

    +

    练习:2 星, standard (typing_example_3)

    请形式化地证明以下类型导出式成立:
    -       empty |- \x:BoolB. \y:BoolBool. \z:Bool.
    +       empty ⊢ \x:BoolB. \y:BoolBool. \z:Bool.
                       y (x z)
                 ∈ T.
    @@ -1242,12 +1243,12 @@

    Stlc简单类型 Lambda-演算 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,
    +    empty
    +      (abs x (Arrow Bool Bool)
    +         (abs y (Arrow Bool Bool)
    +            (abs z Bool
    +               (app (var y) (app (var x) (var z)))))) ∈
          T.
    Proof with auto.
      (* 请在此处解答 *) Admitted.
    @@ -1257,14 +1258,14 @@

    Stlc简单类型 Lambda-演算
    - 我们也可以证明一个项可定型。比如说,我们可以形式化地检查对于 + 我们也可以证明某些项可定型。比如说,我们可以形式化地检查对于 \x:Bool. \y:Bool, x y 来说没有类型导出式为其定型——也即,
    -    ¬  T,
    -        empty |- \x:Bool. \y:Boolx y ∈ T. +    ¬T,
    +        empty ⊢ \x:Bool. \y:Boolx y ∈ T.
    @@ -1276,11 +1277,11 @@

    Stlc简单类型 Lambda-演算 Example typing_nonexample_1 :
    -  ¬ T,
    -      empty |-
    -        (tabs x TBool
    -            (tabs y TBool
    -               (tapp (tvar x) (tvar y)))) ∈
    +  ¬T,
    +      empty
    +        (abs x Bool
    +            (abs y Bool
    +               (app (var x) (var y)))) ∈
            T.
    Proof.
      intros Hc. inversion Hc.
    @@ -1296,14 +1297,14 @@

    Stlc简单类型 Lambda-演算
    -

    练习:3 星, optional (typing_nonexample_3)

    +

    练习:3 星, standard, optional (typing_nonexample_3)

    另一个例子:
    -    ¬ ( S T,
    -          empty |- \x:S. x x ∈ T). +    ¬(S T,
    +          empty ⊢ \x:S. x x ∈ T).
    @@ -1312,10 +1313,10 @@

    Stlc简单类型 Lambda-演算 Example typing_nonexample_3 :
    -  ¬ ( S T,
    -        empty |-
    -          (tabs x S
    -             (tapp (tvar x) (tvar x))) ∈
    +  ¬(S T,
    +        empty
    +          (abs x S
    +             (app (var x) (var x))) ∈
              T).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -1324,9 +1325,9 @@

    Stlc简单类型 Lambda-演算
    -End STLC.
    +End STLC.

    +(* Sat Jan 26 15:15:44 UTC 2019 *)
    -

    diff --git a/plf-current/Stlc.v b/plf-current/Stlc.v index c0a75228..663b858c 100644 --- a/plf-current/Stlc.v +++ b/plf-current/Stlc.v @@ -9,9 +9,9 @@ 和_'替换(substitution)'_。我们将会费一些功夫来处理他们。*) Set Warnings "-notation-overridden,-parsing". +From Coq Require Import Strings.String. From PLF Require Import Maps. From PLF Require Import Smallstep. -From PLF Require Import Types. (* ################################################################# *) (** * 简介 *) @@ -26,22 +26,21 @@ From PLF Require Import Types. - 变量 - 函数抽象 - 应用 - + 这给了我们如下的抽象语法构造(先以非形式化的 BNF 记法写下——后面我们 - 会形式化它)。 *) -(** - - t ::= x variable - | \x:T1.t2 abstraction - | t1 t2 application - | true constant true - | false constant false - | if t1 then t2 else t3 conditional + 会形式化它)。 + + t ::= x variable + | \x:T1.t2 abstraction + | t1 t2 application + | tru constant true + | fls constant false + | test t1 then t2 else t3 conditional *) -(** 函数抽象 [\x:T1.t2] 中的 [\] 符号一般写作希腊字母“lambda”(本演算系统由此得名)。 - 变量 [x] 叫做函数的_'参数(parameter)'_;项 [t2] 是_'函数体(body)'_。 - 记号 [:T1] 指明了函数可以被应用的参数类型。*) +(** 函数抽象 [\x:T.t] 中的 [\] 符号一般写作希腊字母“lambda”(本演算系统由此得名)。 + 变量 [x] 叫做函数的_'参数(parameter)'_;项 [t] 是_'函数体(body)'_。 + 记号 [:T] 指明了函数可以被应用的参数类型。*) (** 一些例子: @@ -49,38 +48,38 @@ From PLF Require Import Types. 布尔值的恒等函数。 - - [(\x:Bool. x) true] + - [(\x:Bool. x) tru] - 被应用于 [true] 的布尔值恒等函数。 + 被应用于 [tru] 的布尔值恒等函数。 - - [\x:Bool. if x then false else true] + - [\x:Bool. test x then fls else tru] 布尔值的“否定”函数。 - - [\x:Bool. true] + - [\x:Bool. tru] - 总是接受(布尔值)参数并返回 [true] 的常量函数。*) -(** + 总是接受(布尔值)参数并返回 [tru] 的常量函数。 - [\x:Bool. \y:Bool. x] 接受两个布尔值做参数,并返回第一个参数的函数。(在 Coq 中,二元函数 其实就是一个一元函数,只是其函数体也是一元函数。) - - [(\x:Bool. \y:Bool. x) false true] + - [(\x:Bool. \y:Bool. x) fls tru] 一个接受两个布尔值做参数,并返回第一个参数的函数,接着它被应用于两个布尔值参数 - [false] 和 [true]。 + [fls] 和 [tru]。 - 在 Coq 中,应用是左结合的——也即,这个表达式被解析为 [((\x:Bool. \y:Bool. x) false) true]。 + 在 Coq 中,应用是左结合的——也即,这个表达式被解析为 + [((\x:Bool. \y:Bool. x) fls) tru]。 - - [\f:Bool->Bool. f (f true)] + - [\f:Bool->Bool. f (f tru)] 一个高阶函数其接受一个函数 [f](从布尔值到布尔值)作为参数,并应用 - [f] 于参数 [true];其结果又被应用于 [f]。 + [f] 于参数 [tru];其结果又被应用于 [f]。 - - [(\f:Bool->Bool. f (f true)) (\x:Bool. false)] + - [(\f:Bool->Bool. f (f tru)) (\x:Bool. fls)] - 同一个高阶函数,被应用于返回 [false] 的常函数。 *) + 同一个高阶函数,被应用于返回 [fls] 的常函数。 *) (** 正如最后几个例子中展示的那样,STLC是一个支持_'高阶(higher-order)'_ 函数的语言:我们可以写出接受其他函数作为参数,或返回其他函数作为结果的函数。 @@ -89,29 +88,27 @@ From PLF Require Import Types. 所有的函数都是“匿名的(anonymous)”。我们会在 [MoreStlc] 一章中看到添加有名 函数是十分简单的——确实,基本的命名和绑定机制其实是同一回事。 - STLC 的_'类型(types)'_包括 [Bool],其用于把 [true] 和 [false] 这些常量 + STLC 的_'类型(types)'_包括 [Bool],其用于把 [tru] 和 [fls] 这些常量 和其他产生布尔值的复杂计算归为一类;还有_'函数类型(arrow types)'_,用于把函 - 数归为一类。*) -(** + 数归为一类。 T ::= Bool - | T1 -> T2 + | T -> T 比如说: - - [\x:Bool. false] 有类型 [Bool->Bool] + - [\x:Bool. fls] 有类型 [Bool->Bool] - [\x:Bool. x] 有类型 [Bool->Bool] - - [(\x:Bool. x) true] 有类型 [Bool] + - [(\x:Bool. x) tru] 有类型 [Bool] - [\x:Bool. \y:Bool. x] 有类型 [Bool->Bool->Bool] (即 [Bool -> (Bool->Bool)]) - - [(\x:Bool. \y:Bool. x) false] 有类型 [Bool->Bool] - - - [(\x:Bool. \y:Bool. x) false true] 有类型 [Bool] *) + - [(\x:Bool. \y:Bool. x) fls] 有类型 [Bool->Bool] + - [(\x:Bool. \y:Bool. x) fls tru] 有类型 [Bool] *) (* ################################################################# *) (** * 语法 *) @@ -124,28 +121,28 @@ Module STLC. (** ** 类型 *) Inductive ty : Type := - | TBool : ty - | TArrow : ty -> ty -> ty. + | Bool : ty + | Arrow : ty -> ty -> ty. (* ================================================================= *) (** ** 项 *) Inductive tm : Type := - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. - -(** 请注意一个形如 [\x:T.t] 的抽象(形式化地讲是 [tabs x T t])包含其参数 + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm + | tru : tm + | fls : tm + | test : tm -> tm -> tm -> tm. + +(** 请注意一个形如 [\x:T.t] 的抽象(形式化地讲是 [abs x T t])包含其参数 [T] 的类型注释,相反在 Coq(以及其他函数式语言,比如 ML,Haskell等)中, 会使用类型推导来填补这些类型注释。我们在此不考虑类型推导。 *) -Open Scope string_scope. - (** 一些例子…… *) +Open Scope string_scope. + Definition x := "x". Definition y := "y". Definition z := "z". @@ -157,27 +154,27 @@ Hint Unfold z. (** [idB = \x:Bool. x] *) Notation idB := - (tabs x TBool (tvar x)). + (abs x Bool (var x)). (** [idBB = \x:Bool->Bool. x] *) Notation idBB := - (tabs x (TArrow TBool TBool) (tvar x)). + (abs x (Arrow Bool Bool) (var x)). (** [idBBBB = \x:(Bool->Bool) -> (Bool->Bool). x] *) Notation idBBBB := - (tabs x (TArrow (TArrow TBool TBool) - (TArrow TBool TBool)) - (tvar x)). + (abs x (Arrow (Arrow Bool Bool) + (Arrow Bool Bool)) + (var x)). (** [k = \x:Bool. \y:Bool. x] *) -Notation k := (tabs x TBool (tabs y TBool (tvar x))). +Notation k := (abs x Bool (abs y Bool (var x))). -(** [notB = \x:Bool. if x then false else true] *) +(** [notB = \x:Bool. test x then fls else tru] *) -Notation notB := (tabs x TBool (tif (tvar x) tfalse ttrue)). +Notation notB := (abs x Bool (test (var x) fls tru)). (** (我们使用 [Notation] 而非 [Definition] 使 [atuo] 更有效。)*) @@ -194,34 +191,36 @@ Notation notB := (tabs x TBool (tif (tvar x) tfalse ttrue)). (** 在定义 STLC 的值时,我们有几个情形需要考虑。 首先,对于布尔值而言是显然的:[true] 和 [false] 是仅有的值。 - 一个 [if] 表达式不是值。*) + 一个 [test] 表达式不是值。*) (** 其次,一个应用也不会是值:它表示一个函数正在某个参数上被调用,显然还可以继续归约。*) (** 第三,对于抽象,我们有几个选择: - - 我们可以说仅当 [t1] 是值时 [\x:T. t1] 是值——也即,仅当函数体已经被归约 + - 我们可以说仅当 [t] 是值时 [\x:T. t] 是值——也即,仅当函数体已经被归约 (在不知道被应用的参数是什么的情况下尽可能地归约)。 - - 或者,我们可以说不论 [t1] 是不是值,[\x:T. t1] 都是一个值——换句话说, + - 或者,我们可以说不论 [t] 是不是值,[\x:T. t] 都是一个值——换句话说, 归约止于抽象。 在 Coq 中表达式通常是以第一种方式求值的——比如说, Compute (fun x:bool => 3 + 4) - 会得到 [fun x:bool => 7]。 + 会得到 + + fun x:bool => 7 多数现实世界中的程序语言选择了第二种方式——函数体的归约仅发生在函数实际被应用 于某个参数时。在这里我们也选择第二种方式。*) Inductive value : tm -> Prop := | v_abs : forall x T t, - value (tabs x T t) - | v_true : - value ttrue - | v_false : - value tfalse. + value (abs x T t) + | v_tru : + value tru + | v_fls : + value fls. Hint Constructors value. @@ -231,9 +230,9 @@ Hint Constructors value. 项中的_'自由(free)'_变量。一个完整的程序是_'闭合的(closed)'_——也就是说, 它不含有自由变量。 - (相反,含有自由变量的项一般被叫做_'开放项(open term)'_。) + (相反,含有自由变量的项一般被叫做_'开放项(open term)'_。) *) - 由于我们决定不对抽象内的表达式进行归约,因此也不必担心变量是否是值这个问题。 +(** 由于我们决定不对抽象内的表达式进行归约,因此也不必担心变量是否是值这个问题。 因为我们总是“从外向内”地归约程序,这意味着 [step] 关系仅会处理闭合项。 *) (* ================================================================= *) @@ -243,81 +242,81 @@ Hint Constructors value. 定义函数应用的操作语义,其中我们会需要用一个参数项替换函数体中出现的形式参数。 比如说,我们会归约 - (\x:Bool. if x then true else x) false + (\x:Bool. test x then tru else x) fls 到 - if false then true else false + test fls then tru else fls - 这步归约将函数体中出现的参数 [x] 替换为 [false]。 + 这步归约将函数体中出现的参数 [x] 替换为 [fls]。 一般来说,我们可以用给定的项 [s] 替换的某另一个项 [t] 中出现个变量 [x]。 - 在非形式化的讨论中,这通常被写做 [ [x:=s]t ],并读做“替换 [t] 中的 [x] + 在非形式化的讨论中,这通常被写做 [ [x:=s]t ],并读做“替换 [t] 中的 [x] 为 [s]”。*) (** 这里有一些例子: - - [[x:=true] (if x then x else false)] - 产生 [if true then true else false] + - [[x:=tru] (test x then x else fls)] + 产生 [test tru then tru else fls] - - [[x:=true] x] 产生 [true] + - [[x:=tru] x] 产生 [tru] - - [[x:=true] (if x then x else y)] 产生 [if true then true else y] + - [[x:=tru] (test x then x else y)] 产生 [test tru then tru else y] - - [[x:=true] y] 产生 [y] + - [[x:=tru] y] 产生 [y] - - [[x:=true] false] 产生 [false] (无意义的替换) + - [[x:=tru] fls] yields [fls] (vacuous substitution) - - [[x:=true] (\y:Bool. if y then x else false)] - 产生 [\y:Bool. if y then true else false] + - [[x:=tru] (\y:Bool. test y then x else fls)] + 产生 [\y:Bool. test y then tru else fls] - - [[x:=true] (\y:Bool. x)] 产生 [\y:Bool. true] + - [[x:=tru] (\y:Bool. x)] 产生 [\y:Bool. tru] - - [[x:=true] (\y:Bool. y)] 产生 [\y:Bool. y] + - [[x:=tru] (\y:Bool. y)] 产生 [\y:Bool. y] - - [[x:=true] (\x:Bool. x)] 产生 [\x:Bool. x] + - [[x:=tru] (\x:Bool. x)] 产生 [\x:Bool. x] - 最后一个例子非常重要:替换 [\x:Bool. x] 中的 [x] 为 [true] _'不'_会产生 - [\x:Bool. true]!因为 [\x:Bool. x] 中的 [x] 是被这个抽象所_'绑定的(bound)'_: + 最后一个例子非常重要:替换 [\x:Bool. x] 中的 [x] 为 [tru] _'不'_会产生 + [\x:Bool. tru]!因为 [\x:Bool. x] 中的 [x] 是被这个抽象所_'绑定的(bound)'_: 它是一个新的、局部的名字,只是恰巧写做了跟某个全局名字一样的 [x]。*) (** 这是非形式化的定义…… [x:=s]x = s - [x:=s]y = y if x <> y + [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](\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 + [x:=s]tru = tru + [x:=s]fls = fls + [x:=s](test t1 then t2 else t3) = + test [x:=s]t1 then [x:=s]t2 else [x:=s]t3 *) (** ……以及形式化的: *) Reserved Notation "'[' x ':=' s ']' t" (at level 20). -Fixpoint subst (x:string) (s:tm) (t:tm) : tm := +Fixpoint subst (x : string) (s : tm) (t : tm) : tm := match t with - | tvar x' => + | var x' => if eqb_string x x' then s else t - | tabs x' T t1 => - tabs x' T (if eqb_string 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) + | abs x' T t1 => + abs x' T (if eqb_string x x' then t1 else ([x:=s] t1)) + | app t1 t2 => + app ([x:=s] t1) ([x:=s] t2) + | tru => + tru + | fls => + fls + | test t1 t2 t3 => + test ([x:=s] t1) ([x:=s] t2) ([x:=s] t3) end where "'[' x ':=' s ']' t" := (subst x s t). (** _'技术注解'_:如果我们考虑用于替换掉某个变量的项 [s] 其本身也含有自由变量, - 那么定义替换将会变得困难一点。由于我们仅对定义在_'闭合'_项(也即像 [\x:Bool. x] + 那么定义替换将会变得困难一点。由于我们仅对定义在_'闭合'_项(也即像 [\x:Bool. x] 这种绑定了内部全部变量的项)上的 [step] 关系有兴趣,我们可以规避这个额外的复杂性, 但是当形式化构造更丰富的语言时,我们必须考虑这一点。*) @@ -333,15 +332,16 @@ where "'[' x ':=' s ']' t" := (subst x s t). (** 对于这个问题,更详细的讨论可参考 [Aydemir 2008] (in Bib.v)。*) -(** **** 练习:3 星 (substi_correct) *) -(** 上面我们使用了 Coq 的 [Fixpoint] 功能将替换定义为一个_'函数'_。 +(** **** 练习:3 星, standard (substi_correct) + + 上面我们使用了 Coq 的 [Fixpoint] 功能将替换定义为一个_'函数'_。 假设,现在我们想要将替换定义为一个归纳的_'关系'_ [substi]。作为开始,我们给出了 [Inductive] 定义的头部和其中一个构造子;你的任务是完成剩下的构造子,并证明 你的定义同替换函数的定义相一致。 *) -Inductive substi (s:tm) (x:string) : tm -> tm -> Prop := +Inductive substi (s : tm) (x : string) : tm -> tm -> Prop := | s_var1 : - substi s x (tvar x) s + substi s x (var x) s (* 请在此处解答 *) . @@ -361,81 +361,81 @@ Proof. 接着归约其右手边的项(也即参数)直到其成为一个值;最后我们用参数替换函数 体内的绑定变量。最后一条规则可以非形式化地写做 - (\x:T.t12) v2 ==> [x:=v2]t12 + (\x:T.t12) v2 --> [x:=v2]t12 - 传统上这也被称作“beta-归约(beta-reduction)” *) + 传统上这也被称作_'beta-归约(beta-reduction)'_ *) (** value v2 ---------------------------- (ST_AppAbs) - (\x:T.t12) v2 ==> [x:=v2]t12 + (\x:T.t12) v2 --> [x:=v2]t12 - t1 ==> t1' + t1 --> t1' ---------------- (ST_App1) - t1 t2 ==> t1' t2 + t1 t2 --> t1' t2 value v1 - t2 ==> t2' + t2 --> t2' ---------------- (ST_App2) - v1 t2 ==> v1 t2' -*) -(** ……还有对条件语句的规则: + v1 t2 --> v1 t2' - -------------------------------- (ST_IfTrue) - (if true then t1 else t2) ==> t1 + ……还有对条件语句的规则: - --------------------------------- (ST_IfFalse) - (if false then t1 else t2) ==> t2 + -------------------------------- (ST_TestTru) + (test tru then t1 else t2) --> t1 - t1 ==> t1' - ---------------------------------------------------- (ST_If) - (if t1 then t2 else t3) ==> (if t1' then t2 else t3) + --------------------------------- (ST_TestFls) + (test fls then t1 else t2) --> t2 + + t1 --> t1' + -------------------------------------------------------- (ST_Test) + (test t1 then t2 else t3) --> (test t1' then t2 else t3) *) (** 形式化的: *) -Reserved Notation "t1 '==>' t2" (at level 40). +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 + (app (abs x T t12) v2) --> [x:=v2]t12 | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - tapp t1 t2 ==> tapp t1' t2 + t1 --> t1' -> + app t1 t2 --> app 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). + t2 --> t2' -> + app v1 t2 --> app v1 t2' + | ST_TestTru : forall t1 t2, + (test tru t1 t2) --> t1 + | ST_TestFls : forall t1 t2, + (test fls t1 t2) --> t2 + | ST_Test : forall t1 t1' t2 t3, + t1 --> t1' -> + (test t1 t2 t3) --> (test t1' t2 t3) + +where "t1 '-->' t2" := (step t1 t2). Hint Constructors step. Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40). (* ================================================================= *) (** ** 例子 *) (** 例子: - (\x:Bool->Bool. x) (\x:Bool. x) ==>* \x:Bool. x + (\x:Bool->Bool. x) (\x:Bool. x) -->* \x:Bool. x 即 - idBB idB ==>* idB + idBB idB -->* idB *) Lemma step_example1 : - (tapp idBB idB) ==>* idB. + (app idBB idB) -->* idB. Proof. eapply multi_step. apply ST_AppAbs. @@ -446,15 +446,15 @@ Proof. (** 例子: (\x:Bool->Bool. x) ((\x:Bool->Bool. x) (\x:Bool. x)) - ==>* \x:Bool. x + -->* \x:Bool. x 即 - (idBB (idBB idB)) ==>* idB. + (idBB (idBB idB)) -->* idB. *) Lemma step_example2 : - (tapp idBB (tapp idBB idB)) ==>* idB. + (app idBB (app idBB idB)) -->* idB. Proof. eapply multi_step. apply ST_App2. auto. @@ -466,81 +466,82 @@ Proof. (** 例子: (\x:Bool->Bool. x) - (\x:Bool. if x then false else true) - true - ==>* false + (\x:Bool. test x then fls else tru) + tru + -->* fls 即 - (idBB notB) ttrue ==>* tfalse. + (idBB notB) tru -->* fls. *) Lemma step_example3 : - tapp (tapp idBB notB) ttrue ==>* tfalse. + app (app idBB notB) tru -->* fls. 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. + apply ST_TestTru. apply multi_refl. Qed. (** 例子: (\x:Bool -> Bool. x) - ((\x:Bool. if x then false else true) true) - ==>* false + ((\x:Bool. test x then fls else tru) tru) + -->* fls 即 - idBB (notB ttrue) ==>* tfalse. + idBB (notB tru) -->* fls. (请注意,虽然这个项并不会通过类型检查,我们还是可以看看它是如何归约的。) *) Lemma step_example4 : - tapp idBB (tapp notB ttrue) ==>* tfalse. + app idBB (app notB tru) -->* fls. Proof. eapply multi_step. apply ST_App2. auto. apply ST_AppAbs. auto. simpl. eapply multi_step. apply ST_App2. auto. - apply ST_IfTrue. + apply ST_TestTru. eapply multi_step. apply ST_AppAbs. auto. simpl. apply multi_refl. Qed. -(** 我们可以使用 [Types] 一章中定义的 [normalize] 策略来简化这些证明。 *) +(** 我们可以使用 [Smallstep] 一章中定义的 [normalize] 策略来简化这些证明。 *) Lemma step_example1' : - (tapp idBB idB) ==>* idB. + app idBB idB -->* idB. Proof. normalize. Qed. Lemma step_example2' : - (tapp idBB (tapp idBB idB)) ==>* idB. + app idBB (app idBB idB) -->* idB. Proof. normalize. Qed. Lemma step_example3' : - tapp (tapp idBB notB) ttrue ==>* tfalse. + app (app idBB notB) tru -->* fls. Proof. normalize. Qed. Lemma step_example4' : - tapp idBB (tapp notB ttrue) ==>* tfalse. + app idBB (app notB tru) -->* fls. Proof. normalize. Qed. -(** **** 练习:2 星 (step_example5) *) -(** 请分别使用和不使用 [normalize] 证明以下命题。 *) +(** **** 练习:2 星, standard (step_example5) + + 请分别使用和不使用 [normalize] 证明以下命题。 *) Lemma step_example5 : - tapp (tapp idBBBB idBB) idB - ==>* idB. + app (app idBBBB idBB) idB + -->* idB. Proof. (* 请在此处解答 *) Admitted. Lemma step_example5_with_normalize : - tapp (tapp idBBBB idBB) idB - ==>* idB. + app (app idBBBB idBB) idB + -->* idB. Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -563,7 +564,7 @@ Proof. 其中 [Gamma] 是一个“类型上下文(typing context)”——一个变量到他们的 类型的映射。 *) -(** 使用通常偏映射的记号,我们可以用 [Gamma & {{x:T}}] 来表示“更新偏函数 [Gamma] +(** 使用通常偏映射的记号,我们用 [(X |-> T11, Gamma)] 来表示“更新偏函数 [Gamma] 使其也将 [x] 映射到 [T]”。*) Definition context := partial_map ty. @@ -572,29 +573,28 @@ Definition context := partial_map ty. (** ** 类型关系 *) (** - Gamma x = T - -------------- (T_Var) + Gamma x = T + ---------------- (T_Var) Gamma |- x \in T - Gamma & {{ x --> T11 }} |- t12 \in T12 - -------------------------------------- (T_Abs) - Gamma |- \x:T11.t12 \in T11->T12 + (x |-> T11 ; Gamma) |- t12 \in T12 + ---------------------------------- (T_Abs) + Gamma |- \x:T11.t12 \in T11->T12 Gamma |- t1 \in T11->T12 Gamma |- t2 \in T11 - ---------------------- (T_App) + ---------------------- (T_App) Gamma |- t1 t2 \in T12 - -------------------- (T_True) - Gamma |- true \in Bool + --------------------- (T_Tru) + Gamma |- tru \in Bool - --------------------- (T_False) - Gamma |- false \in Bool + --------------------- (T_Fls) + Gamma |- fls \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 - + -------------------------------------------------------------- (T_Test) + Gamma |- test t1 then t2 else t3 \in T 我们可以把形如 [Gamma |- t \in T] 的三元关系读做: “在假设 Gamma 下,项 [t] 有类型 [T]。” *) @@ -604,23 +604,23 @@ 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 + Gamma |- var x \in T | T_Abs : forall Gamma x T11 T12 t12, - Gamma & {{x --> T11}} |- t12 \in T12 -> - Gamma |- tabs x T11 t12 \in TArrow T11 T12 + (x |-> T11 ; Gamma) |- t12 \in T12 -> + Gamma |- abs x T11 t12 \in Arrow T11 T12 | T_App : forall T11 T12 Gamma t1 t2, - Gamma |- t1 \in TArrow T11 T12 -> + Gamma |- t1 \in Arrow 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 |- app t1 t2 \in T12 + | T_Tru : forall Gamma, + Gamma |- tru \in Bool + | T_Fls : forall Gamma, + Gamma |- fls \in Bool + | T_Test : forall t1 t2 t3 T Gamma, + Gamma |- t1 \in Bool -> Gamma |- t2 \in T -> Gamma |- t3 \in T -> - Gamma |- tif t1 t2 t3 \in T + Gamma |- test t1 t2 t3 \in T where "Gamma '|-' t '\in' T" := (has_type Gamma t T). @@ -630,7 +630,7 @@ Hint Constructors has_type. (** ** 例子 *) Example typing_example_1 : - empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. + empty |- abs x Bool (var x) \in Arrow Bool Bool. Proof. apply T_Abs. apply T_Var. reflexivity. Qed. @@ -638,10 +638,10 @@ Proof. 将可以直接解决这个证明。*) Example typing_example_1' : - empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. + empty |- abs x Bool (var x) \in Arrow Bool Bool. Proof. auto. Qed. -(** 另一个例子: +(** 更多例子: empty |- \x:A. \y:A->A. y (y x) \in A -> (A->A) -> A. @@ -649,10 +649,10 @@ Proof. auto. Qed. 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)). + (abs x Bool + (abs y (Arrow Bool Bool) + (app (var y) (app (var y) (var x))))) \in + (Arrow Bool (Arrow (Arrow Bool Bool) Bool)). Proof with auto using update_eq. apply T_Abs. apply T_Abs. @@ -661,22 +661,25 @@ Proof with auto using update_eq. apply T_Var... Qed. -(** **** 练习:2 星, optional (typing_example_2_full) *) -(** 请在不使用 [auto],[eauto],[eapply](或者 [...])的情况下证明同一个命题: *) +(** **** 练习:2 星, standard, optional (typing_example_2_full) + + 请在不使用 [auto],[eauto],[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)). + (abs x Bool + (abs y (Arrow Bool Bool) + (app (var y) (app (var y) (var x))))) \in + (Arrow Bool (Arrow (Arrow Bool Bool) Bool)). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (typing_example_3) *) -(** 请形式化地证明以下类型导出式成立:*) -(** +(** **** 练习:2 星, standard (typing_example_3) + + 请形式化地证明以下类型导出式成立: + + empty |- \x:Bool->B. \y:Bool->Bool. \z:Bool. y (x z) \in T. @@ -685,16 +688,16 @@ Proof. 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 + (abs x (Arrow Bool Bool) + (abs y (Arrow Bool Bool) + (abs z Bool + (app (var y) (app (var x) (var z)))))) \in T. Proof with auto. (* 请在此处解答 *) Admitted. (** [] *) -(** 我们也可以证明一个项_'不'_可定型。比如说,我们可以形式化地检查对于 +(** 我们也可以证明某些项_'不'_可定型。比如说,我们可以形式化地检查对于 [\x:Bool. \y:Bool, x y] 来说没有类型导出式为其定型——也即, ~ exists T, @@ -704,9 +707,9 @@ Proof with auto. Example typing_nonexample_1 : ~ exists T, empty |- - (tabs x TBool - (tabs y TBool - (tapp (tvar x) (tvar y)))) \in + (abs x Bool + (abs y Bool + (app (var x) (var y)))) \in T. Proof. intros Hc. inversion Hc. @@ -719,8 +722,9 @@ Proof. inversion H5. subst. clear H5. inversion H1. Qed. -(** **** 练习:3 星, optional (typing_nonexample_3) *) -(** 另一个例子: +(** **** 练习:3 星, standard, optional (typing_nonexample_3) + + 另一个例子: ~ (exists S T, empty |- \x:S. x x \in T). @@ -729,8 +733,8 @@ Proof. Example typing_nonexample_3 : ~ (exists S T, empty |- - (tabs x S - (tapp (tvar x) (tvar x))) \in + (abs x S + (app (var x) (var x))) \in T). Proof. (* 请在此处解答 *) Admitted. @@ -738,5 +742,4 @@ Proof. End STLC. -(** $Date$ *) - +(* Sat Jan 26 15:15:44 UTC 2019 *) diff --git a/plf-current/StlcProp.html b/plf-current/StlcProp.html index 65ff4e0d..99f8e33d 100644 --- a/plf-current/StlcProp.html +++ b/plf-current/StlcProp.html @@ -50,7 +50,7 @@

    StlcPropProperties of STLC
    -

    Canonical Forms

    +

    Canonical Forms

    @@ -58,15 +58,15 @@

    StlcPropProperties of STLCBool, these are the - boolean values ttrue and tfalse; for arrow types, they are + boolean values tru and fls; for arrow types, they are lambda-abstractions.

    -Lemma canonical_forms_bool : t,
    -  empty |- tTBool
    +Lemma canonical_forms_bool : t,
    +  emptytBool
      value t
    -  (t = ttrue) ∨ (t = tfalse).
    +  (t = tru) ∨ (t = fls).
    Proof.
    @@ -76,22 +76,22 @@

    StlcPropProperties of STLC
    -Lemma canonical_forms_fun : t T1 T2,
    -  empty |- t ∈ (TArrow T1 T2) →
    +Lemma canonical_forms_fun : t T1 T2,
    +  emptyt ∈ (Arrow T1 T2) →
      value t
    -   x u, t = tabs x T1 u.
    +  x u, t = abs x T1 u.
    Proof.
      intros t T1 T2 HT HVal.
      inversion HVal; intros; subst; try inversion HT; subst; auto.
    -   x0. t0. auto.
    +  x0, t0. auto.
    Qed.

    -

    Progress

    +

    Progress

    @@ -99,18 +99,18 @@

    StlcPropProperties of STLCTypes chapter. We'll give the proof in English first, then + Types chapter. We give the proof in English first, then the formal version.

    -Theorem progress : t T,
    -  empty |- tT
    -  value t t', t ==> t'.
    +Theorem progress : t T,
    +  emptytT
    +  value tt', t --> t'.
    -Proof_: By induction on the derivation of |- t T. +Proof_: By induction on the derivation of t T.
    @@ -122,7 +122,7 @@

    StlcPropProperties of STLC -
  • The T_True, T_False, and T_Abs cases are trivial, since in +
  • The T_Tru, T_Fls, and T_Abs cases are trivial, since in each of these cases we can see by inspecting the rule that t is a value. @@ -131,17 +131,17 @@

    StlcPropProperties of STLC
  • If the last rule of the derivation is T_App, then t has the - form t1 t2 for some t1 and t2, where |- t1 T2 T - and |- t2 T2 for some type T2. By the induction - hypothesis, either t1 is a value or it can take a reduction - step. + form t1 t2 for some t1 and t2, where t1 T2 T + and t2 T2 for some type T2. The induction hypothesis + for the first subderivation says that either t1 is a value or + else it can take a reduction step.
      -
    • If t1 is a value, then consider t2, which by the other - induction hypothesis must also either be a value or take a - step. +
    • If t1 is a value, then consider t2, which by the + induction hypothesis for the second subderivation must also + either be a value or take a step.
      @@ -173,23 +173,23 @@

      StlcPropProperties of STLC

    • -
    • If the last rule of the derivation is 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 the last rule of the derivation is T_Test, then t = test + t1 then t2 else t3, where t1 has type Bool. The first IH + says that 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. + either tru or fls. If it is tru, then t steps to + t2; otherwise it steps to t3.
      • Otherwise, t1 takes a step, and therefore so does t (by - ST_If). + ST_Test).
      @@ -215,34 +215,34 @@

      StlcPropProperties of STLC(* t1 is a value *)
            destruct IHHt2...
            * (* t2 is also a value *)
      -        assert ( x0 t0, t1 = tabs x0 T11 t0).
      +        assert (x0 t0, t1 = abs x0 T11 t0).
              eapply canonical_forms_fun; eauto.
              destruct H1 as [x0 [t0 Heq]]. subst.
      -         ([x0:=t2]t0)...

      +        ([x0:=t2]t0)...

            * (* t2 steps *)
      -        inversion H0 as [t2' Hstp]. (tapp t1 t2')...

      +        inversion H0 as [t2' Hstp]. (app t1 t2')...

          + (* t1 steps *)
      -      inversion H as [t1' Hstp]. (tapp t1' t2)...

      -  - (* T_If *)
      +      inversion H as [t1' Hstp]. (app t1' t2)...

      +  - (* T_Test *)
          right. destruct IHHt1...

          + (* t1 is a value *)
            destruct (canonical_forms_bool t1); subst; eauto.

          + (* t1 also steps *)
      -      inversion H as [t1' Hstp]. (tif t1' t2 t3)...
      +      inversion H as [t1' Hstp]. (test t1' t2 t3)...
      Qed.

  • -

    练习:3 星, advanced (progress_from_term_ind)

    +

    练习:3 星, advanced (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 |- tT
    -     value t t', t ==> t'.
    +Theorem progress' : t T,
    +     emptytT
    +     value tt', t --> t'.
    Proof.
      intros t.
      induction t; intros T Ht; auto.
    @@ -252,7 +252,7 @@

    StlcPropProperties of STLC
    -

    Preservation

    +

    Preservation

    @@ -304,7 +304,7 @@

    StlcPropProperties of STLC
  • the _free variables_ in a term — i.e., variables that are - used in the term and where these uses are _not_ in the scope of + used in the term in positions that are _not_ in the scope of an enclosing function abstraction binding a variable of the same name. @@ -313,12 +313,12 @@

    StlcPropProperties of STLC

  • - To make Coq happy, we need to formalize the story in the opposite - order... + To make Coq happy, of course, we need to formalize the story in the + opposite order...

    -

    Free Occurrences

    +

    Free Occurrences

    @@ -347,27 +347,27 @@

    StlcPropProperties of STLC Inductive appears_free_in : stringtmProp :=
    -  | afi_var : x,
    -      appears_free_in x (tvar x)
    -  | afi_app1 : x t1 t2,
    +  | afi_var : x,
    +      appears_free_in x (var 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 (app 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,
    +      appears_free_in x (app t1 t2)
    +  | afi_abs : x y T11 t12,
          yx
          appears_free_in x t12
    -      appears_free_in x (tabs y T11 t12)
    -  | afi_if1 : x t1 t2 t3,
    +      appears_free_in x (abs y T11 t12)
    +  | afi_test1 : 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 (test t1 t2 t3)
    +  | afi_test2 : 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 (test t1 t2 t3)
    +  | afi_test3 : x t1 t2 t3,
          appears_free_in x t3
    -      appears_free_in x (tif t1 t2 t3).

    +      appears_free_in x (test t1 t2 t3).

    Hint Constructors appears_free_in.

    @@ -379,16 +379,16 @@

    StlcPropProperties of STLC Definition closed (t:tm) :=
    -   x, ¬ appears_free_in x t.
    +  x, ¬appears_free_in x t.

    An _open_ term is one that may contain free variables. (I.e., every term is an open term; the closed terms are a subset of the open ones. - "Open" really means "possibly containing free variables.") + "Open" precisely means "possibly containing free variables.")
    -

    练习:1 星 (afi)

    +

    练习:1 星, standard (afi)

    In the space below, write out the rules of the appears_free_in relation in informal inference-rule notation. (Use whatever notational conventions you like — the point of the exercise is @@ -407,7 +407,7 @@

    StlcPropProperties of STLC
    -

    Substitution

    +

    Substitution

    @@ -419,10 +419,10 @@

    StlcPropProperties of STLC
    -Lemma free_in_context : x t T Gamma,
    +Lemma free_in_context : x t T Gamma,
       appears_free_in x t
    -   Gamma |- tT
    -    T', Gamma x = Some T'.
    +   GammatT
    +   T', Gamma x = Some T'.
    @@ -464,9 +464,9 @@

    StlcPropProperties of STLC\y:T11.t12 and x appears free in t12, and 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}}, + Gamma, its body t12 is well typed under (y>T11; Gamma, so the IH allows us to conclude that x is assigned some type - by the extended context (Gamma & {{y-->T11}}. To conclude that + by the extended context (y>T11; Gamma. To conclude that Gamma assigns a type to x, we appeal to lemma update_neq, noting that x and y are different variables. @@ -493,16 +493,17 @@

    StlcPropProperties of STLC
    -Next, we'll need the fact that any term t that is well typed in - the empty context is closed (it has no free variables). +From the free_in_context lemma, it immediately follows that any + term t that is well typed in the empty context is closed (it has + no free variables).
    -

    练习:2 星, optional (typable_empty__closed)

    +

    练习:2 星, standard, optional (typable_empty__closed)

    -Corollary typable_empty__closed : t T,
    -    empty |- tT
    +Corollary typable_empty__closed : t T,
    +    emptytT
        closed t.
    @@ -516,68 +517,68 @@

    StlcPropProperties of STLC
    -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. +Sometimes, when we have a proof of some typing relation + 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 : Gamma Gamma' t T,
    -     Gamma |- tT
    -     ( x, appears_free_in x tGamma x = Gamma' x) →
    -     Gamma' |- tT.
    +Lemma context_invariance : Gamma Gamma' t T,
    +     GammatT
    +     (x, appears_free_in x tGamma x = Gamma' x) →
    +     Gamma'tT.
    -Proof_: By induction on the derivation of Gamma |- t T. +Proof_: By induction on the derivation of Gamma t 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 T by T_Var. + hence Gamma' t 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 T12. The + = T11 T12 and y>T11; Gamma t12 T12. The induction hypothesis is that, for any context Gamma'', if - Gamma & {{y-->T11}} and Gamma'' assign the same types to + y>T11; Gamma 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' |- + Gamma on the free variables in t; we must show Gamma' \y:T11. t12 T11 T12.
      - By T_Abs, it suffices to show that Gamma' & {{y-->T11}} |- - t12 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 + By T_Abs, it suffices to show that y>T11; Gamma' + t12 T12. By the IH (setting Gamma'' = y>T11;Gamma'), + it suffices to show that y>T11;Gamma + and y>T11;Gamma' agree on all the variables that appear free in t12.
      Any variable occurring free in t12 must be either y or - some other variable. Gamma & {{y-->T11}} and Gamma' & - {{y-->T11}} clearly agree on y. Otherwise, note that any + some other variable. y>T11; Gamma and y>T11; Gamma' + clearly agree on y. Otherwise, note that any variable other than y that occurs free in t12 also occurs free in t = \y:T11. t12, and by assumption Gamma and - Gamma' agree on all such variables; hence so do Gamma & - {{y-->T11}} and Gamma' & {{y-->T11}}. + Gamma' agree on all such variables; hence so do y>T11; Gamma + and y>T11; Gamma'.
    • -
    • If the last rule was T_App, then t = t1 t2, with Gamma |- - t1 T2 T and Gamma |- t2 T2. One induction +
    • If the last rule was T_App, then t = t1 t2, with Gamma + t1 T2 T and Gamma t2 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 @@ -606,7 +607,7 @@

      StlcPropProperties of STLCapply T_Abs.
          apply IHhas_type. intros x1 Hafi.
          (* the only tricky step... the Gamma' we use to
      -       instantiate is Gamma & {{x-->T11}} *)

      +       instantiate is x>T11;Gamma *)
          unfold update. unfold t_update. destruct (eqb_string x0 x1) eqn: Hx0x1...
          rewrite eqb_string_false_iff in Hx0x1. auto.
        - (* T_App *)
      @@ -631,15 +632,15 @@

      StlcPropProperties of STLCT.
      - _Lemma_: If Gamma & {{x-->U}} |- t T and |- v U, - then Gamma |- [x:=v]t T. + _Lemma_: If x>U; Gamma t T and v U, + then Gamma [x:=v]t T.

    -Lemma substitution_preserves_typing : Gamma x U t v T,
    -  Gamma & {{x-->U}} |- tT
    -  empty |- vU
    -  Gamma |- [x:=v]tT.
    +Lemma substitution_preserves_typing : Gamma x U t v T,
    +  (x > U ; Gamma) ⊢ tT
    +  emptyvU
    +  Gamma ⊢ [x:=v]tT.
    @@ -647,7 +648,7 @@

    StlcPropProperties of STLCv has 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 U, which would be the other reasonable assumption + Gamma 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 @@ -655,8 +656,8 @@

    StlcPropProperties of STLC

    - The substitution lemma can be viewed as a kind of commutation - property. Intuitively, it says that substitution and typing can + 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 @@ -666,8 +667,8 @@

    StlcPropProperties of STLC

    _Proof_: We show, by induction on t, that for all T and - Gamma, if Gamma & {{x-->U}} |- t T and |- v U, then - Gamma |- [x:=v]t T. + Gamma, if x>U; Gamma t T and v U, then + Gamma [x:=v]t T.
    @@ -678,7 +679,7 @@

    StlcPropProperties of STLC

      -
    • If t = x, then from the fact that Gamma & {{x-->U}} |- +
    • If t = x, then from the fact that x>U; Gamma x 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 @@ -691,8 +692,8 @@

      StlcPropProperties of STLC
    • 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. + we need only note that y has the same type under + x>U; Gamma as under Gamma.
      @@ -702,8 +703,8 @@

      StlcPropProperties of STLC
    • If t is an abstraction \y:T11. t12, then the IH tells us, - for all Gamma' and T', that if Gamma' & {{x-->U} |- t12 - T' and |- v U, then Gamma' |- [x:=v]t12 T'. + for all Gamma' and T', that if x>U; Gamma' t12 + T' and v U, then Gamma' [x:=v]t12 T'.
      @@ -713,20 +714,20 @@

      StlcPropProperties of STLC

    First, suppose x = y. Then, by the definition of - substitution, [x:=v]t = t, so we just need to show Gamma |- - t T. But we know Gamma & {{x-->U}} |- t : T, and, + substitution, [x:=v]t = t, so we just need to show Gamma + t T. But we know x>U; Gamma t T, and, since y does not appear free in \y:T11. t12, the context - invariance lemma yields Gamma |- t T. + invariance lemma yields Gamma t T.
    - Second, suppose x y. We know Gamma & {{x-->U; y-->T11}} - |- t12 T12 by inversion of the typing relation, from - which Gamma & {{y-->T11; x-->U}} |- t12 T12 follows by + Second, suppose x y. We know x>U; y>T11; Gamma + t12 T12 by inversion of the typing relation, from + which y>T11; x>U; Gamma t12 T12 follows by the context invariance lemma, so the IH applies, giving us - Gamma & {{y-->T11}} |- [x:=v]t12 T12. By T_Abs, - Gamma |- \y:T11. [x:=v]t12 T11T12, and by the - definition of substitution (noting that x y), Gamma |- + y>T11; Gamma [x:=v]t12 T12. By T_Abs, + Gamma \y:T11. [x:=v]t12 T11T12, and by the + definition of substitution (noting that x y), Gamma \y:T11. [x:=v]t12 T11T12 as required.
    @@ -750,7 +751,7 @@

    StlcPropProperties of STLCGamma & {{x-->U}} |- t + The reason for this is that the assumption x>U; Gamma 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 @@ -769,7 +770,7 @@

    StlcPropProperties of STLCinduction t; intros T Gamma H;
        (* in each case, we'll want to get at the derivation of H *)
        inversion H; subst; simpl...
    -  - (* tvar *)
    +  - (* var *)
        rename s into y. destruct (eqb_stringP x y) as [Hxy|Hxy].
        + (* x=y *)
          subst.
    @@ -780,7 +781,7 @@

    StlcPropProperties of STLCintros. apply (Ht' x0) in H0. inversion H0.
        + (* x<>y *)
          apply T_Var. rewrite update_neq in H2...
    -  - (* tabs *)
    +  - (* abs *)
        rename s into y. rename t into T. apply T_Abs.
        destruct (eqb_stringP x y) as [Hxy | Hxy].
        + (* x=y *)
    @@ -796,7 +797,7 @@

    StlcPropProperties of STLC
    -

    Main Theorem

    +

    Main Theorem

    @@ -807,51 +808,55 @@

    StlcPropProperties of STLC
    -Theorem preservation : t t' T,
    -  empty |- tT
    -  t ==> t'
    -  empty |- t'T.
    +Theorem preservation : t t' T,
    +  emptytT
    +  t --> t'
    +  emptyt'T.
    -Proof_: By induction on the derivation of |- 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. +
    • We can immediately rule out T_Var, T_Abs, T_Tru, and + T_Fls as final rules in the derivation, since in each of these + cases t cannot take a step.
    • -
    • If the last rule in the derivation is T_App, then t = t1 - t2. There are three cases to consider, one for each rule that - could be used to show that t1 t2 takes a step to t'. +
    • If the last rule in the derivation is T_App, then t = t1 t2, + and there are subderivations showing that t1 T11T and + t2 T11 plus two induction hypotheses: (1) t1 --> t1' + implies t1' T11T and (2) t2 --> t2' implies t2' + T11. There are now three subcases to consider, one for + each rule that could be 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. + t1', then, by the first IH, t1' has the same type as + t1 ( t1 T11T), and hence by T_App t1' t2 has + type T.
      • -
      • The ST_App2 case is similar. +
      • The ST_App2 case is similar, using the second IH.
      • 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. + \x:T11.t12 and t1 t2 steps to [x:=t2]t12; the desired + result now follows from the substitution lemma.
        @@ -860,22 +865,31 @@

        StlcPropProperties of STLC

      • -
      • If the last rule in the derivation is T_If, then t = if t1 - then t2 else t3, and there are again three cases depending on - how t steps. +
      • If the last rule in the derivation is T_Test, then t = test + t1 then t2 else t3, with t1 Bool, t2 T, and + t3 T, and with three induction hypotheses: (1) t1 --> + t1' implies t1' Bool, (2) t2 --> t2' implies t2' + T, and (3) t3 --> t3' implies t3' T. + +
        + + There are again three subcases to consider, 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. +
        • If t steps to t2 or t3 by ST_TestTru or + ST_TestFalse, 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. +
        • Otherwise, t steps by ST_Test, and the desired + conclusion follows directly from the first induction + hypothesis.
        @@ -905,26 +919,23 @@

        StlcPropProperties of STLC
        -

        练习:2 星, recommended (subject_expansion_stlc)

        +

        练习:2 星, standard, recommended (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. + boolean expressions. This property did not hold for that language, + and it also fails for STLC. That is, it is not always the case that, + if t --> t' and has_type t' T, then empty t T. + Show this by giving a counter-example that does _not involve + conditionals_.
        - You can state your counterexample informally - in words, with a brief explanation. - -
        - -(* 请在此处解答 *)
        - + You can state your counterexample informally in words, with a brief + explanation.
        +(* 请在此处解答 *)

        (* 请勿修改下面这一行: *)
        Definition manual_grade_for_subject_expansion_stlc : option (nat*string) := None.
        @@ -932,21 +943,21 @@

        StlcPropProperties of STLC
        -

        Type Soundness

        +

        Type Soundness

        -

        练习:2 星, optional (type_soundness)

        +

        练习:2 星, standard, 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 |- tT
        -  t ==>* t'
        +  (normal_form step) t ∧ ¬value t.

        +Corollary soundness : t t' T,
        +  emptytT
        +  t -->* t'
          ~(stuck t').
        @@ -961,30 +972,32 @@

        StlcPropProperties of STLC
        -

        Uniqueness of Types

        +

        Uniqueness of Types

        -

        练习:3 星 (types_unique)

        +

        练习:3 星, standard (unique_types)

        Another nice property of the STLC is that types are unique: a - given term (in a given context) has at most one type. Formalize this statement as a theorem called - unique_types, and prove your theorem. + given term (in a given context) has at most one type.
        -(* 请在此处解答 *)

        -(* 请勿修改下面这一行: *)
        -Definition manual_grade_for_types_unique : option (nat*string) := None.
        +Theorem unique_types : Gamma e T T',
        +  GammaeT
        +  GammaeT'
        +  T = T'.
        +Proof.
        +  (* 请在此处解答 *) Admitted.
        -

        Additional Exercises

        +

        Additional Exercises

        -

        练习:1 星 (progress_preservation_statement)

        +

        练习:1 星, standard (progress_preservation_statement)

        Without peeking at their statements above, write down the progress and preservation theorems for the simply typed lambda-calculus (as Coq theorems). @@ -1000,7 +1013,7 @@

        StlcPropProperties of STLC
        -

        练习:2 星 (stlc_variation1)

        +

        练习:2 星, standard (stlc_variation1)

        Suppose we add a new term zap with the following reduction rule
        @@ -1012,7 +1025,7 @@

        StlcPropProperties of STLC

        - +
        t ==> zap--> zap
        and the following typing rule: @@ -1026,7 +1039,7 @@

        StlcPropProperties of STLC
        - Gamma |- zap : T + Gamma ⊢ zap ∈ T Which of the following properties of the STLC remain true in @@ -1072,7 +1085,7 @@

        StlcPropProperties of STLC
        -

        练习:2 星 (stlc_variation2)

        +

        练习:2 星, standard (stlc_variation2)

        Suppose instead that we add a new term foo with the following reduction rules:
        @@ -1085,7 +1098,7 @@

        StlcPropProperties of STLC

        - +
        (\x:A. x) ==> foo(\x:A. x) --> foo
        @@ -1098,7 +1111,7 @@

        StlcPropProperties of STLC

        - +
        foo ==> truefoo --> tru
        Which of the following properties of the STLC remain true in @@ -1144,7 +1157,7 @@

        StlcPropProperties of STLC
        -

        练习:2 星 (stlc_variation3)

        +

        练习:2 星, standard (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 @@ -1189,20 +1202,20 @@

        StlcPropProperties of STLC
        -

        练习:2 星, optional (stlc_variation4)

        +

        练习:2 星, standard, optional (stlc_variation4)

        Suppose instead that we add the following new rule to the reduction relation:
        - +
           - (ST_FunnyIfTrue)   + (ST_FunnyTestTru)  

        (if true then t1 else t2) ==> true(test tru then t1 else t2--> tru
        Which of the following properties of the STLC remain true in @@ -1239,16 +1252,16 @@

        StlcPropProperties of STLC
        -

        练习:2 星, optional (stlc_variation5)

        +

        练习:2 星, standard, optional (stlc_variation5)

        Suppose instead that we add the following new rule to the typing relation:
        - + - + @@ -1256,7 +1269,7 @@

        StlcPropProperties of STLC

        - +
        Gamma |- t1 ∈ Bool->Bool->BoolGamma ⊢ t1 ∈ Bool->Bool->Bool
        Gamma |- t2 ∈ BoolGamma ⊢ t2 ∈ Bool (T_FunnyApp)  
        Gamma |- t1 t2 ∈ BoolGamma ⊢ t1 t2 ∈ Bool
        Which of the following properties of the STLC remain true in @@ -1293,16 +1306,16 @@

        StlcPropProperties of STLC
        -

        练习:2 星, optional (stlc_variation6)

        +

        练习:2 星, standard, optional (stlc_variation6)

        Suppose instead that we add the following new rule to the typing relation:
        - + - + @@ -1310,7 +1323,7 @@

        StlcPropProperties of STLC

        - +
        Gamma |- t1 ∈ BoolGamma ⊢ t1 ∈ Bool
        Gamma |- t2 ∈ BoolGamma ⊢ t2 ∈ Bool (T_FunnyApp')  
        Gamma |- t1 t2 ∈ BoolGamma ⊢ t1 t2 ∈ Bool
        Which of the following properties of the STLC remain true in @@ -1347,7 +1360,7 @@

        StlcPropProperties of STLC
        -

        练习:2 星, optional (stlc_variation7)

        +

        练习:2 星, standard, optional (stlc_variation7)

        Suppose we add the following new rule to the typing relation of the STLC:
        @@ -1360,7 +1373,7 @@

        StlcPropProperties of STLC

        - +
        |- \x:Bool.t ∈ Bool⊢ \x:Bool.t ∈ Bool
        Which of the following properties of the STLC remain true in @@ -1402,7 +1415,7 @@

        StlcPropProperties of STLC
        -

        Exercise: STLC with Arithmetic

        +

        Exercise: STLC with Arithmetic

        @@ -1424,8 +1437,8 @@

        StlcPropProperties of STLC Inductive ty : Type :=
        -  | TArrow : tytyty
        -  | TNat : ty.
        +  | Arrow : tytyty
        +  | Nat : ty.

        @@ -1435,18 +1448,18 @@

        StlcPropProperties of STLC Inductive tm : Type :=
        -  | tvar : stringtm
        -  | tapp : tmtmtm
        -  | tabs : stringtytmtm
        -  | tnat : nattm
        -  | tsucc : tmtm
        -  | tpred : tmtm
        -  | tmult : tmtmtm
        -  | tif0 : tmtmtmtm.
        +  | var : stringtm
        +  | app : tmtmtm
        +  | abs : stringtytmtm
        +  | const : nattm
        +  | scc : tmtm
        +  | prd : tmtm
        +  | mlt : tmtmtm
        +  | test0 : tmtmtmtm.

        -

        练习:4 星 (stlc_arith)

        +

        练习:5 星, standard (stlc_arith)

        Finish formalizing the definition and properties of the STLC extended with arithmetic. This is a longer exercise. Specifically: @@ -1534,9 +1547,9 @@

        StlcPropProperties of STLC
        -End STLCArith.
        +End STLCArith.

        +(* Sat Jan 26 15:15:44 UTC 2019 *)
        -

        diff --git a/plf-current/StlcProp.v b/plf-current/StlcProp.v index 89b029ab..62e127f4 100644 --- a/plf-current/StlcProp.v +++ b/plf-current/StlcProp.v @@ -19,26 +19,26 @@ Import STLC. first step in establishing basic properties of reduction and types is to identify the possible _canonical forms_ (i.e., well-typed closed values) belonging to each type. For [Bool], these are the - boolean values [ttrue] and [tfalse]; for arrow types, they are + boolean values [tru] and [fls]; for arrow types, they are lambda-abstractions. *) Lemma canonical_forms_bool : forall t, - empty |- t \in TBool -> + empty |- t \in Bool -> value t -> - (t = ttrue) \/ (t = tfalse). + (t = tru) \/ (t = fls). 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) -> + empty |- t \in (Arrow T1 T2) -> value t -> - exists x u, t = tabs x T1 u. + exists x u, t = abs x T1 u. Proof. intros t T1 T2 HT HVal. inversion HVal; intros; subst; try inversion HT; subst; auto. - exists x0. exists t0. auto. + exists x0, t0. auto. Qed. (* ################################################################# *) @@ -48,31 +48,31 @@ Qed. terms are not stuck: either a well-typed term is a value, or it can take a reduction step. The proof is a relatively straightforward extension of the progress proof we saw in the - [Types] chapter. We'll give the proof in English first, then + [Types] chapter. We give the proof in English first, then the formal version. *) Theorem progress : forall t T, empty |- t \in T -> - value t \/ exists t', t ==> 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 + - The [T_Tru], [T_Fls], and [T_Abs] cases are trivial, since in each of these cases we can see by inspecting the rule that [t] is a value. - If the last rule of the derivation is [T_App], then [t] has the form [t1 t2] for some [t1] and [t2], where [|- t1 \in T2 -> T] - and [|- t2 \in T2] for some type [T2]. By the induction - hypothesis, either [t1] is a value or it can take a reduction - step. + and [|- t2 \in T2] for some type [T2]. The induction hypothesis + for the first subderivation says that either [t1] is a value or + else it can take a reduction step. - - If [t1] is a value, then consider [t2], which by the other - induction hypothesis must also either be a value or take a - step. + - If [t1] is a value, then consider [t2], which by the + induction hypothesis for the second subderivation must also + either be a value or take a step. - Suppose [t2] is a value. Since [t1] is a value with an arrow type, it must be a lambda abstraction; hence [t1 @@ -83,16 +83,16 @@ Theorem progress : forall t T, - If [t1] can take a step, then so can [t1 t2] by [ST_App1]. - - If the last rule of the derivation is [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 the last rule of the derivation is [T_Test], then [t = test + t1 then t2 else t3], where [t1] has type [Bool]. The first IH + says that [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]. + either [tru] or [fls]. If it is [tru], then [t] steps to + [t2]; otherwise it steps to [t3]. - Otherwise, [t1] takes a step, and therefore so does [t] (by - [ST_If]). *) + [ST_Test]). *) Proof with eauto. intros t T Ht. remember (@empty ty) as Gamma. @@ -109,34 +109,35 @@ Proof with eauto. + (* t1 is a value *) destruct IHHt2... * (* t2 is also a value *) - assert (exists x0 t0, t1 = tabs x0 T11 t0). + assert (exists x0 t0, t1 = abs x0 T11 t0). eapply canonical_forms_fun; eauto. destruct H1 as [x0 [t0 Heq]]. subst. exists ([x0:=t2]t0)... * (* t2 steps *) - inversion H0 as [t2' Hstp]. exists (tapp t1 t2')... + inversion H0 as [t2' Hstp]. exists (app t1 t2')... + (* t1 steps *) - inversion H as [t1' Hstp]. exists (tapp t1' t2)... + inversion H as [t1' Hstp]. exists (app t1' t2)... - - (* T_If *) + - (* T_Test *) right. destruct IHHt1... + (* t1 is a value *) destruct (canonical_forms_bool t1); subst; eauto. + (* t1 also steps *) - inversion H as [t1' Hstp]. exists (tif t1' t2 t3)... + inversion H as [t1' Hstp]. exists (test t1' t2 t3)... Qed. -(** **** 练习:3 星, advanced (progress_from_term_ind) *) -(** Show that progress can also be proved by induction on terms +(** **** 练习:3 星, advanced (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'. + value t \/ exists t', t --> t'. Proof. intros t. induction t; intros T Ht; auto. @@ -179,12 +180,12 @@ Proof. careful definition of... - the _free variables_ in a term -- i.e., variables that are - used in the term and where these uses are _not_ in the scope of + used in the term in positions that are _not_ in the scope of an enclosing function abstraction binding a variable of the same name. - To make Coq happy, we need to formalize the story in the opposite - order... *) + To make Coq happy, of course, we need to formalize the story in the + opposite order... *) (* ================================================================= *) (** ** Free Occurrences *) @@ -200,26 +201,26 @@ Proof. Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, appears_free_in x t1 -> - appears_free_in x (tapp t1 t2) + appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, appears_free_in x t2 -> - appears_free_in x (tapp t1 t2) + appears_free_in x (app 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 (abs y T11 t12) + | afi_test1 : 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 (test t1 t2 t3) + | afi_test2 : 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 (test t1 t2 t3) + | afi_test3 : forall x t1 t2 t3, appears_free_in x t3 -> - appears_free_in x (tif t1 t2 t3). + appears_free_in x (test t1 t2 t3). Hint Constructors appears_free_in. @@ -232,10 +233,11 @@ Definition closed (t:tm) := (** An _open_ term is one that may contain free variables. (I.e., every term is an open term; the closed terms are a subset of the open ones. - "Open" really means "possibly containing free variables.") *) + "Open" precisely means "possibly containing free variables.") *) + +(** **** 练习:1 星, standard (afi) -(** **** 练习:1 星 (afi) *) -(** In the space below, write out the rules of the [appears_free_in] + In the space below, write out the rules of the [appears_free_in] relation in informal inference-rule notation. (Use whatever notational conventions you like -- the point of the exercise is just for you to think a bit about the meaning of each rule.) @@ -286,9 +288,9 @@ Lemma free_in_context : forall x t T Gamma, \y:T11.t12] and [x] appears free in [t12], and 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}}], + [Gamma], its body [t12] is well typed under [(y|->T11; Gamma], so the IH allows us to conclude that [x] is assigned some type - by the extended context [(Gamma & {{y-->T11}}]. To conclude that + by the extended context [(y|->T11; Gamma]. To conclude that [Gamma] assigns a type to [x], we appeal to lemma [update_neq], noting that [x] and [y] are different variables. *) @@ -304,10 +306,11 @@ Proof. rewrite update_neq in H7; assumption. Qed. -(** Next, we'll need the fact that any term [t] that is well typed in - the empty context is closed (it has no free variables). *) +(** From the [free_in_context] lemma, it immediately follows that any + term [t] that is well typed in the empty context is closed (it has + no free variables). *) -(** **** 练习:2 星, optional (typable_empty__closed) *) +(** **** 练习:2 星, standard, optional (typable_empty__closed) *) Corollary typable_empty__closed : forall t T, empty |- t \in T -> closed t. @@ -315,12 +318,12 @@ Proof. (* 请在此处解答 *) 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. *) +(** Sometimes, when we have a proof of some typing relation + [Gamma |- t \in 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 -> @@ -334,27 +337,27 @@ Lemma context_invariance : forall Gamma Gamma' t T, 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 + = T11 -> T12] and [y|->T11; Gamma |- t12 \in T12]. The induction hypothesis is that, for any context [Gamma''], if - [Gamma & {{y-->T11}}] and [Gamma''] assign the same types to + [y|->T11; Gamma] 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 + By [T_Abs], it suffices to show that [y|->T11; Gamma' |- + t12 \in T12]. By the IH (setting [Gamma'' = y|->T11;Gamma']), + it suffices to show that [y|->T11;Gamma] + and [y|->T11;Gamma'] agree on all the variables that appear free in [t12]. Any variable occurring free in [t12] must be either [y] or - some other variable. [Gamma & {{y-->T11}}] and [Gamma' & - {{y-->T11}}] clearly agree on [y]. Otherwise, note that any + some other variable. [y|->T11; Gamma] and [y|->T11; Gamma'] + clearly agree on [y]. Otherwise, note that any variable other than [y] that occurs free in [t12] also occurs free in [t = \y:T11. t12], and by assumption [Gamma] and - [Gamma'] agree on all such variables; hence so do [Gamma & - {{y-->T11}}] and [Gamma' & {{y-->T11}}]. + [Gamma'] agree on all such variables; hence so do [y|->T11; Gamma] + and [y|->T11; Gamma']. - If the last rule was [T_App], then [t = t1 t2], with [Gamma |- t1 \in T2 -> T] and [Gamma |- t2 \in T2]. One induction @@ -379,7 +382,7 @@ Proof with eauto. apply T_Abs. apply IHhas_type. intros x1 Hafi. (* the only tricky step... the [Gamma'] we use to - instantiate is [Gamma & {{x-->T11}}] *) + instantiate is [x|->T11;Gamma] *) unfold update. unfold t_update. destruct (eqb_string x0 x1) eqn: Hx0x1... rewrite eqb_string_false_iff in Hx0x1. auto. - (* T_App *) @@ -399,11 +402,11 @@ Qed. 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], +(** _Lemma_: If [x|->U; Gamma |- 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, - Gamma & {{x-->U}} |- t \in T -> + (x |-> U ; Gamma) |- t \in T -> empty |- v \in U -> Gamma |- [x:=v]t \in T. @@ -417,8 +420,8 @@ Lemma substitution_preserves_typing : forall Gamma x U t v T, worry about free variables in [v] clashing with the variable being introduced into the context by [T_Abs]. - The substitution lemma can be viewed as a kind of commutation - property. Intuitively, it says that substitution and typing can + 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 @@ -426,13 +429,13 @@ Lemma substitution_preserves_typing : forall Gamma x U t v T, way. _Proof_: We show, by induction on [t], that for all [T] and - [Gamma], if [Gamma & {{x-->U}} |- t \in T] and [|- v \in U], then + [Gamma], if [x|->U; Gamma |- 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}} |- + - If [t = x], then from the fact that [x|->U; Gamma |- 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 @@ -441,11 +444,11 @@ Lemma substitution_preserves_typing : forall Gamma x U t v T, 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]. + we need only note that [y] has the same type under + [x|->U; Gamma] 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 + for all [Gamma'] and [T'], that if [x|->U; Gamma' |- t12 \in T'] and [|- v \in U], then [Gamma' |- [x:=v]t12 \in T']. The substitution in the conclusion behaves differently @@ -453,15 +456,15 @@ Lemma substitution_preserves_typing : forall Gamma x U t v T, 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, + t \in T]. But we know [x|->U; Gamma |- t \in T], and, since [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}} + Second, suppose [x <> y]. We know [x|->U; y|->T11; Gamma |- t12 \in T12] by inversion of the typing relation, from - which [Gamma & {{y-->T11; x-->U}} |- t12 \in T12] follows by + which [y|->T11; x|->U; Gamma |- t12 \in T12] follows by the context invariance lemma, so the IH applies, giving us - [Gamma & {{y-->T11}} |- [x:=v]t12 \in T12]. By [T_Abs], + [y|->T11; Gamma |- [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. @@ -474,7 +477,7 @@ Lemma substitution_preserves_typing : forall Gamma x U t v T, _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 [Gamma & {{x-->U}} |- t + The reason for this is that the assumption [x|->U; Gamma |- 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 @@ -489,7 +492,7 @@ Proof with eauto. induction t; intros T Gamma H; (* in each case, we'll want to get at the derivation of H *) inversion H; subst; simpl... - - (* tvar *) + - (* var *) rename s into y. destruct (eqb_stringP x y) as [Hxy|Hxy]. + (* x=y *) subst. @@ -500,7 +503,7 @@ Proof with eauto. intros. apply (Ht' x0) in H0. inversion H0. + (* x<>y *) apply T_Var. rewrite update_neq in H2... - - (* tabs *) + - (* abs *) rename s into y. rename t into T. apply T_Abs. destruct (eqb_stringP x y) as [Hxy | Hxy]. + (* x=y *) @@ -523,39 +526,50 @@ Qed. Theorem preservation : forall t t' T, empty |- t \in T -> - t ==> 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. + - We can immediately rule out [T_Var], [T_Abs], [T_Tru], and + [T_Fls] as final rules in the derivation, since in each of these + cases [t] cannot take a step. - - If the last rule in the derivation is [T_App], then [t = t1 - t2]. There are three cases to consider, one for each rule that - could be used to show that [t1 t2] takes a step to [t']. + - If the last rule in the derivation is [T_App], then [t = t1 t2], + and there are subderivations showing that [|- t1 \in T11->T] and + [|- t2 \in T11] plus two induction hypotheses: (1) [t1 --> t1'] + implies [|- t1' \in T11->T] and (2) [t2 --> t2'] implies [|- t2' + \in T11]. There are now three subcases to consider, one for + each rule that could be 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]. + [t1'], then, by the first IH, [t1'] has the same type as + [t1] ([|- t1 \in T11->T]), and hence by [T_App] [t1' t2] has + type [T]. - - The [ST_App2] case is similar. + - The [ST_App2] case is similar, using the second IH. - 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. + \x:T11.t12] and [t1 t2] steps to [[x:=t2]t12]; the desired + result now follows from the substitution lemma. - - If the last rule in the derivation is [T_If], then [t = if t1 - then t2 else t3], and there are again three cases depending on - how [t] steps. + - If the last rule in the derivation is [T_Test], then [t = test + t1 then t2 else t3], with [|- t1 \in Bool], [|- t2 \in T], and + [|- t3 \in T], and with three induction hypotheses: (1) [t1 --> + t1'] implies [|- t1' \in Bool], (2) [t2 --> t2'] implies [|- t2' + \in T], and (3) [t3 --> t3'] implies [|- t3' \in T]. - - If [t] steps to [t2] or [t3], the result is immediate, since - [t2] and [t3] have the same type as [t]. + There are again three subcases to consider, depending on how [t] + steps. - - Otherwise, [t] steps by [ST_If], and the desired conclusion - follows directly from the induction hypothesis. *) + - If [t] steps to [t2] or [t3] by [ST_TestTru] or + [ST_TestFalse], the result is immediate, since [t2] and [t3] + have the same type as [t]. + + - Otherwise, [t] steps by [ST_Test], and the desired + conclusion follows directly from the first induction + hypothesis. *) Proof with eauto. remember (@empty ty) as Gamma. @@ -572,19 +586,20 @@ Proof with eauto. inversion HT1... Qed. -(** **** 练习:2 星, recommended (subject_expansion_stlc) *) -(** An exercise in the [Types] chapter asked about the _subject +(** **** 练习:2 星, standard, recommended (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. + boolean expressions. This property did not hold for that language, + and it also fails for STLC. That is, it is not always the case that, + if [t --> t'] and [has_type t' T], then [empty |- t \in T]. + Show this by giving a counter-example that does _not involve + conditionals_. - You can state your counterexample informally - in words, with a brief explanation. + You can state your counterexample informally in words, with a brief + explanation. *) (* 请在此处解答 *) -*) (* 请勿修改下面这一行: *) Definition manual_grade_for_subject_expansion_stlc : option (nat*string) := None. @@ -593,8 +608,9 @@ Definition manual_grade_for_subject_expansion_stlc : option (nat*string) := None (* ################################################################# *) (** * Type Soundness *) -(** **** 练习:2 星, optional (type_soundness) *) -(** Put progress and preservation together and show that a well-typed +(** **** 练习:2 星, standard, 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 := @@ -602,7 +618,7 @@ Definition stuck (t:tm) : Prop := Corollary soundness : forall t t' T, empty |- t \in T -> - t ==>* t' -> + t -->* t' -> ~(stuck t'). Proof. intros t t' T Hhas_type Hmulti. unfold stuck. @@ -614,23 +630,25 @@ Proof. (* ################################################################# *) (** * Uniqueness of Types *) -(** **** 练习:3 星 (types_unique) *) -(** Another nice property of the STLC is that types are unique: a - given term (in a given context) has at most one type. *) -(** Formalize this statement as a theorem called - [unique_types], and prove your theorem. *) +(** **** 练习:3 星, standard (unique_types) -(* 请在此处解答 *) + Another nice property of the STLC is that types are unique: a + given term (in a given context) has at most one type. *) -(* 请勿修改下面这一行: *) -Definition manual_grade_for_types_unique : option (nat*string) := None. +Theorem unique_types : forall Gamma e T T', + Gamma |- e \in T -> + Gamma |- e \in T' -> + T = T'. +Proof. + (* 请在此处解答 *) Admitted. (** [] *) (* ################################################################# *) (** * Additional Exercises *) -(** **** 练习:1 星 (progress_preservation_statement) *) -(** Without peeking at their statements above, write down the progress +(** **** 练习:1 星, standard (progress_preservation_statement) + + Without peeking at their statements above, write down the progress and preservation theorems for the simply typed lambda-calculus (as Coq theorems). You can write [Admitted] for the proofs. *) @@ -640,16 +658,17 @@ Definition manual_grade_for_types_unique : option (nat*string) := None. Definition manual_grade_for_progress_preservation_statement : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (stlc_variation1) *) -(** Suppose we add a new term [zap] with the following reduction rule +(** **** 练习:2 星, standard (stlc_variation1) + + Suppose we add a new term [zap] with the following reduction rule --------- (ST_Zap) - t ==> zap + t --> zap and the following typing rule: - ---------------- (T_Zap) - Gamma |- zap : T + ------------------ (T_Zap) + Gamma |- zap \in T Which of the following properties of the STLC remain true in the presence of these rules? For each property, write either @@ -668,15 +687,16 @@ and the following typing rule: Definition manual_grade_for_stlc_variation1 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (stlc_variation2) *) -(** Suppose instead that we add a new term [foo] with the following +(** **** 练习:2 星, standard (stlc_variation2) + + Suppose instead that we add a new term [foo] with the following reduction rules: ----------------- (ST_Foo1) - (\x:A. x) ==> foo + (\x:A. x) --> foo ------------ (ST_Foo2) - foo ==> true + foo --> tru Which of the following properties of the STLC remain true in the presence of this rule? For each one, write either @@ -695,8 +715,9 @@ Definition manual_grade_for_stlc_variation1 : option (nat*string) := None. Definition manual_grade_for_stlc_variation2 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (stlc_variation3) *) -(** Suppose instead that we remove the rule [ST_App1] from the [step] +(** **** 练习:2 星, standard (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 @@ -714,12 +735,13 @@ Definition manual_grade_for_stlc_variation2 : option (nat*string) := None. Definition manual_grade_for_stlc_variation3 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, optional (stlc_variation4) *) -(** Suppose instead that we add the following new rule to the +(** **** 练习:2 星, standard, 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 + ---------------------------------- (ST_FunnyTestTru) + (test tru then t1 else t2) --> tru Which of the following properties of the STLC remain true in the presence of this rule? For each one, write either @@ -732,11 +754,12 @@ Definition manual_grade_for_stlc_variation3 : option (nat*string) := None. (* 请在此处解答 *) - Preservation (* 请在此处解答 *) -*) -(** [] *) -(** **** 练习:2 星, optional (stlc_variation5) *) -(** Suppose instead that we add the following new rule to the typing + [] *) + +(** **** 练习:2 星, standard, optional (stlc_variation5) + + Suppose instead that we add the following new rule to the typing relation: Gamma |- t1 \in Bool->Bool->Bool @@ -755,11 +778,12 @@ Definition manual_grade_for_stlc_variation3 : option (nat*string) := None. (* 请在此处解答 *) - Preservation (* 请在此处解答 *) -*) -(** [] *) -(** **** 练习:2 星, optional (stlc_variation6) *) -(** Suppose instead that we add the following new rule to the typing + [] *) + +(** **** 练习:2 星, standard, optional (stlc_variation6) + + Suppose instead that we add the following new rule to the typing relation: Gamma |- t1 \in Bool @@ -778,11 +802,12 @@ Definition manual_grade_for_stlc_variation3 : option (nat*string) := None. (* 请在此处解答 *) - Preservation (* 请在此处解答 *) -*) -(** [] *) -(** **** 练习:2 星, optional (stlc_variation7) *) -(** Suppose we add the following new rule to the typing relation + [] *) + +(** **** 练习:2 星, standard, optional (stlc_variation7) + + Suppose we add the following new rule to the typing relation of the STLC: ------------------- (T_FunnyAbs) @@ -799,8 +824,8 @@ Definition manual_grade_for_stlc_variation3 : option (nat*string) := None. (* 请在此处解答 *) - Preservation (* 请在此处解答 *) -*) -(** [] *) + + [] *) End STLCProp. @@ -819,24 +844,25 @@ Import STLC. booleans, for brevity). *) Inductive ty : Type := - | TArrow : ty -> ty -> ty - | TNat : ty. + | Arrow : ty -> ty -> ty + | Nat : ty. (** To terms, we add natural number constants, along with successor, predecessor, multiplication, and zero-testing. *) Inductive tm : Type := - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm - | tnat : nat -> tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tmult : tm -> tm -> tm - | tif0 : tm -> tm -> tm -> tm. - -(** **** 练习:4 星 (stlc_arith) *) -(** Finish formalizing the definition and properties of the STLC + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm + | const : nat -> tm + | scc : tm -> tm + | prd : tm -> tm + | mlt : tm -> tm -> tm + | test0 : tm -> tm -> tm -> tm. + +(** **** 练习:5 星, standard (stlc_arith) + + Finish formalizing the definition and properties of the STLC extended with arithmetic. This is a longer exercise. Specifically: 1. Copy the core definitions for STLC that we went through, @@ -879,4 +905,4 @@ Definition manual_grade_for_stlc_arith : option (nat*string) := None. End STLCArith. -(** $Date$ *) +(* Sat Jan 26 15:15:44 UTC 2019 *) diff --git a/plf-current/StlcPropTest.v b/plf-current/StlcPropTest.v index 5a2ec978..f145d515 100644 --- a/plf-current/StlcPropTest.v +++ b/plf-current/StlcPropTest.v @@ -64,12 +64,18 @@ idtac "Possible points: 2". print_manual_grade STLCProp.manual_grade_for_subject_expansion_stlc. idtac " ". -idtac "------------------- types_unique --------------------". +idtac "------------------- unique_types --------------------". idtac " ". -idtac "#> Manually graded: STLCProp.types_unique". +idtac "#> STLCProp.unique_types". idtac "Possible points: 3". -print_manual_grade STLCProp.manual_grade_for_types_unique. +check_type @STLCProp.unique_types ( +(forall (Gamma : Stlc.STLC.context) (e : Stlc.STLC.tm) (T T' : Stlc.STLC.ty), + Stlc.STLC.has_type Gamma e T -> Stlc.STLC.has_type Gamma e T' -> T = T')). +idtac "Assumptions:". +Abort. +Print Assumptions STLCProp.unique_types. +Goal True. idtac " ". idtac "------------------- progress_preservation_statement --------------------". @@ -108,14 +114,14 @@ idtac "------------------- stlc_arith --------------------". idtac " ". idtac "#> Manually graded: STLCArith.stlc_arith". -idtac "Possible points: 4". +idtac "Possible points: 5". print_manual_grade STLCArith.manual_grade_for_stlc_arith. idtac " ". idtac " ". -idtac "Max points - standard: 17". -idtac "Max points - advanced: 20". +idtac "Max points - standard: 18". +idtac "Max points - advanced: 21". idtac "". idtac "********** Summary **********". idtac "". @@ -124,8 +130,8 @@ idtac "---------- afi ---------". idtac "MANUAL". idtac "---------- subject_expansion_stlc ---------". idtac "MANUAL". -idtac "---------- types_unique ---------". -idtac "MANUAL". +idtac "---------- STLCProp.unique_types ---------". +Print Assumptions STLCProp.unique_types. idtac "---------- progress_preservation_statement ---------". idtac "MANUAL". idtac "---------- stlc_variation1 ---------". @@ -141,3 +147,5 @@ idtac "********** Advanced **********". idtac "---------- STLCProp.progress' ---------". Print Assumptions STLCProp.progress'. Abort. + +(* Sat Jan 26 15:16:10 UTC 2019 *) diff --git a/plf-current/StlcTest.v b/plf-current/StlcTest.v index 3bb94082..0206bb4f 100644 --- a/plf-current/StlcTest.v +++ b/plf-current/StlcTest.v @@ -52,8 +52,7 @@ idtac " ". idtac "#> STLC.step_example5". idtac "Possible points: 2". check_type @STLC.step_example5 ( -(STLC.multistep (STLC.tapp (STLC.tapp STLC.idBBBB STLC.idBB) STLC.idB) - STLC.idB)). +(STLC.multistep (STLC.app (STLC.app STLC.idBBBB STLC.idBB) STLC.idB) STLC.idB)). idtac "Assumptions:". Abort. Print Assumptions STLC.step_example5. @@ -68,11 +67,11 @@ idtac "Possible points: 2". check_type @STLC.typing_example_3 ( (exists T : STLC.ty, STLC.has_type (@Maps.empty STLC.ty) - (STLC.tabs STLC.x (STLC.TArrow STLC.TBool STLC.TBool) - (STLC.tabs STLC.y (STLC.TArrow STLC.TBool STLC.TBool) - (STLC.tabs STLC.z STLC.TBool - (STLC.tapp (STLC.tvar STLC.y) - (STLC.tapp (STLC.tvar STLC.x) (STLC.tvar STLC.z)))))) T)). + (STLC.abs STLC.x (STLC.Arrow STLC.Bool STLC.Bool) + (STLC.abs STLC.y (STLC.Arrow STLC.Bool STLC.Bool) + (STLC.abs STLC.z STLC.Bool + (STLC.app (STLC.var STLC.y) + (STLC.app (STLC.var STLC.x) (STLC.var STLC.z)))))) T)). idtac "Assumptions:". Abort. Print Assumptions STLC.typing_example_3. @@ -96,3 +95,5 @@ Print Assumptions STLC.typing_example_3. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:08 UTC 2019 *) diff --git a/plf-current/Sub.html b/plf-current/Sub.html index 09fe4682..cc9e6aab 100644 --- a/plf-current/Sub.html +++ b/plf-current/Sub.html @@ -35,13 +35,14 @@

        SubSubtyping

        Set Warnings "-notation-overridden,-parsing".
        +From Coq Require Import Strings.String.
        From PLF Require Import Maps.
        From PLF Require Import Types.
        From PLF Require Import Smallstep.
        -

        Concepts

        +

        Concepts

        @@ -50,7 +51,7 @@

        SubSubtyping

        -

        A Motivating Example

        +

        A Motivating Example

        @@ -102,7 +103,21 @@

        SubSubtyping

        pairs, etc.
        -

        Subtyping and Object-Oriented Languages

        + Safe substitution principle: + +
        + +
          +
        • S is a subtype of T, written S <: T, if a value of type + S can safely be used in any context where a value of type + T is expected. + +
        • +
        + +
        + +

        Subtyping and Object-Oriented Languages

        @@ -162,7 +177,7 @@

        SubSubtyping

        setting of the STLC.
        -

        The Subsumption Rule

        +

        The Subsumption Rule

        @@ -190,7 +205,7 @@

        SubSubtyping

        to the typing relation: the so-called _rule of subsumption_:
        - + @@ -198,7 +213,7 @@

        SubSubtyping

        - +
        Gamma |- t : S     S <: TGamma ⊢ t ∈ S     S <: T (T_Sub)  

        Gamma |- t : TGamma ⊢ t ∈ T
        This rule says, intuitively, that it is OK to "forget" some of @@ -211,7 +226,7 @@

        SubSubtyping

        function that requires just a single-field record.
        -

        The Subtype Relation

        +

        The Subtype Relation

        @@ -220,7 +235,7 @@

        SubSubtyping

        definition.
        -

        Structural Rules

        +

        Structural Rules

        @@ -260,7 +275,7 @@

        SubSubtyping

        -

        Products

        +

        Products

        @@ -283,7 +298,7 @@

        SubSubtyping

        -

        Arrows

        +

        Arrows

        @@ -382,7 +397,7 @@

        SubSubtyping

        viewed as having type T1T2.
        -

        Records

        +

        Records

        @@ -441,11 +456,11 @@

        SubSubtyping

        for records as follows:
        - + - + @@ -487,7 +502,7 @@

        SubSubtyping

         jk in j1..jn,jk in j1..jn,
         ip in i1..im, such thatip in i1..im, such that
        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}. + {age:Nat,name:String} <: {age:Nat}.
        Second, subtyping can be applied inside the components of a compound @@ -536,14 +551,6 @@

        SubSubtyping

          -
        • 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 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). @@ -554,13 +561,22 @@

          SubSubtyping

        • A class may implement multiple interfaces — so-called "multiple inheritance" of interfaces (i.e., permutation is allowed for - interfaces). + interfaces). + +
          + + +
        • +
        • In early versions of Java, a subclass could 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).
        -

        练习:2 星, recommended (arrow_sub_wrong)

        +

        练习:2 星, standard, recommended (arrow_sub_wrong)

        Suppose we had incorrectly defined subtyping as covariant on both the right and the left of arrow types:
        @@ -605,7 +621,7 @@

        SubSubtyping

        -

        Top

        +

        Top

        @@ -628,11 +644,11 @@

        SubSubtyping

        -
        S <: Top
        The Top type is an analog of the Object type in Java and C#. + The Top type is an analog of the Object type in Java and C#.
        -

        Summary

        +

        Summary

        @@ -651,7 +667,7 @@

        SubSubtyping

      • adding the rule of subsumption
        - + @@ -659,7 +675,7 @@

        SubSubtyping

        - +
        Gamma |- t : S     S <: TGamma ⊢ t ∈ S     S <: T (T_Sub)  

        Gamma |- t : TGamma ⊢ t ∈ T
        to the typing relation, and @@ -780,11 +796,11 @@

        SubSubtyping

      • -

        Exercises

        +

        Exercises

        -

        练习:1 星, optional (subtype_instances_tf_1)

        +

        练习:1 星, standard, 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. @@ -839,7 +855,7 @@

        SubSubtyping

        -

        练习:2 星 (subtype_order)

        +

        练习:2 星, standard (subtype_order)

        The following types happen to form a linear order with respect to subtyping:
        @@ -870,10 +886,7 @@

        SubSubtyping

        Where does the type TopTopStudent fit into this order? That is, state how Top (Top Student) compares with each -of the five types above. It may be unrelated to some of them. - -
        - +of the five types above. It may be unrelated to some of them.
        @@ -886,36 +899,36 @@

        SubSubtyping

        -

        练习:1 星 (subtype_instances_tf_2)

        +

        练习:1 星, standard (subtype_instances_tf_2)

        Which of the following statements are true? Write _true_ or _false_ after each one.
        -       S T,
        +      S T,
                  S <: T  →
                  SS   <:  TT

        -       S,
        +      S,
                   S <: AA →
        -            T,
        +           T,
                      S = TT  ∧  T <: A

        -       S T1 T2,
        +      S T1 T2,
                   (S <: T1 → T2) →
        -            S1 S2,
        +           S1 S2,
                      S = S1 → S2  ∧  T1 <: S1  ∧  S2 <: T2 

        -       S,
        +      S,
                   S <: SS 

        -       S,
        +      S,
                   SS <: S  

        -       S T1 T2,
        +      S T1 T2,
                   S <: T1*T2 →
        -            S1 S2,
        +           S1 S2,
                      S = S1*S2  ∧  S1 <: T1  ∧  S2 <: T2  
        @@ -932,7 +945,7 @@

        SubSubtyping

        -

        练习:1 星 (subtype_concepts_tf)

        +

        练习:1 星, standard (subtype_concepts_tf)

        Which of the following statements are true, and which are false?
        @@ -1009,18 +1022,18 @@

        SubSubtyping

        -

        练习:2 星 (proper_subtypes)

        +

        练习:2 星, standard (proper_subtypes)

        Is the following statement true or false? Briefly explain your - answer. (Here TBase n stands for a base type, where n is + answer. (Here Base n stands for a base type, where n is a string standing for the name of the base type. See the Syntax section below.)
        -     T,
        -         ~(T = TBool ∨  nT = TBase n) →
        -          S,
        +    T,
        +         ~(T = Bool ∨ nT = Base n) →
        +         S,
                    S <: T  ∧  S ≠ T
        @@ -1037,7 +1050,7 @@

        SubSubtyping

        -

        练习:2 星 (small_large_1)

        +

        练习:2 星, standard (small_large_1)

        @@ -1050,7 +1063,7 @@

        SubSubtyping

        -  empty |- (\p:T*Top. p.fst) ((\z:A.z), unit) : AA +  empty ⊢ (\p:T*Top. p.fst) ((\z:A.z), unit) ∈ AA
        @@ -1078,7 +1091,7 @@

        SubSubtyping

        -

        练习:2 星 (small_large_2)

        +

        练习:2 星, standard (small_large_2)

        @@ -1089,7 +1102,7 @@

        SubSubtyping

        -  empty |- (\p:(AA * BB). p) ((\z:A.z), (\z:B.z)) : T +  empty ⊢ (\p:(AA * BB). p) ((\z:A.z), (\z:B.z)) ∈ T
        @@ -1117,7 +1130,7 @@

        SubSubtyping

        -

        练习:2 星, optional (small_large_3)

        +

        练习:2 星, standard, optional (small_large_3)

        @@ -1128,7 +1141,7 @@

        SubSubtyping

        -  a:A |- (\p:(A*T). (p.snd) (p.fst)) (a , \z:A.z) : A +  a:A ⊢ (\p:(A*T). (p.snd) (p.fst)) (a, \z:A.z) ∈ A
        @@ -1147,7 +1160,7 @@

        SubSubtyping

        -

        练习:2 星 (small_large_4)

        +

        练习:2 星, standard (small_large_4)

        @@ -1158,8 +1171,8 @@

        SubSubtyping

        -   S,
        -    empty |- (\p:(A*T). (p.snd) (p.fst)) : S +  S,
        +    empty ⊢ (\p:(A*T). (p.snd) (p.fst)) ∈ S
        @@ -1188,15 +1201,15 @@

        SubSubtyping

        -

        练习:2 星 (smallest_1)

        +

        练习:2 星, standard (smallest_1)

        What is the _smallest_ type T that makes the following assertion true?
        -       S t,
        -        empty |- (\x:T. x xt : S +      S t,
        +        empty ⊢ (\x:T. x xt ∈ S
        @@ -1212,14 +1225,14 @@

        SubSubtyping

        -

        练习:2 星 (smallest_2)

        +

        练习:2 星, standard (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 +      empty ⊢ (\x:Top. x) ((\z:A.z) , (\z:B.z)) ∈ T
        @@ -1235,7 +1248,7 @@

        SubSubtyping

        -

        练习:3 星, optional (count_supertypes)

        +

        练习:3 星, standard, optional (count_supertypes)

        How many supertypes does the record type {x:A, y:CC} have? That is, how many different types T are there such that {x:A, y:CC} <: T? (We consider two types to be different if they are written @@ -1247,7 +1260,7 @@

        SubSubtyping

        -

        练习:2 星 (pair_permutation)

        +

        练习:2 星, standard (pair_permutation)

        The subtyping rule for product types
        @@ -1292,7 +1305,7 @@

        SubSubtyping

        -

        Formal Definitions

        +

        Formal Definitions

        @@ -1305,7 +1318,7 @@

        SubSubtyping

        -

        Core Definitions

        +

        Core Definitions

        @@ -1314,7 +1327,7 @@

        SubSubtyping

        -

        Syntax

        +

        Syntax

        @@ -1329,25 +1342,25 @@

        SubSubtyping

        Inductive ty : Type :=
        -  | TTop : ty
        -  | TBool : ty
        -  | TBase : stringty
        -  | TArrow : tytyty
        -  | TUnit : ty
        +  | Top : ty
        +  | Bool : ty
        +  | Base : stringty
        +  | Arrow : tytyty
        +  | Unit : ty
        .

        Inductive tm : Type :=
        -  | tvar : stringtm
        -  | tapp : tmtmtm
        -  | tabs : stringtytmtm
        -  | ttrue : tm
        -  | tfalse : tm
        -  | tif : tmtmtmtm
        -  | tunit : tm
        +  | var : stringtm
        +  | app : tmtmtm
        +  | abs : stringtytmtm
        +  | tru : tm
        +  | fls : tm
        +  | test : tmtmtmtm
        +  | unit : tm
        .
        -

        Substitution

        +

        Substitution

        @@ -1358,26 +1371,26 @@

        SubSubtyping

        Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
          match t with
        -  | tvar y
        +  | var y
              if eqb_string x y then s else t
        -  | tabs y T t1
        -      tabs y T (if eqb_string 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
        +  | abs y T t1
        +      abs y T (if eqb_string x y then t1 else (subst x s t1))
        +  | app t1 t2
        +      app (subst x s t1) (subst x s t2)
        +  | tru
        +      tru
        +  | fls
        +      fls
        +  | test t1 t2 t3
        +      test (subst x s t1) (subst x s t2) (subst x s t3)
        +  | unit
        +      unit
          end.

        Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
        -

        Reduction

        +

        Reduction

        @@ -1387,41 +1400,41 @@

        SubSubtyping

        Inductive value : tmProp :=
        -  | v_abs : x T t,
        -      value (tabs x T t)
        +  | v_abs : x T t,
        +      value (abs x T t)
          | v_true :
        -      value ttrue
        +      value tru
          | v_false :
        -      value tfalse
        +      value fls
          | v_unit :
        -      value tunit
        +      value unit
        .

        Hint Constructors value.

        -Reserved Notation "t1 '==>' t2" (at level 40).

        +Reserved Notation "t1 '-->' t2" (at level 40).

        Inductive step : tmtmProp :=
        -  | ST_AppAbs : x T t12 v2,
        +  | 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',
        +         (app (abs x T t12) v2) --> [x:=v2]t12
        +  | ST_App1 : t1 t1' t2,
        +         t1 --> t1'
        +         (app t1 t2) --> (app 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).

        +         t2 --> t2'
        +         (app v1 t2) --> (app v1 t2')
        +  | ST_TestTrue : t1 t2,
        +      (test tru t1 t2) --> t1
        +  | ST_TestFalse : t1 t2,
        +      (test fls t1 t2) --> t2
        +  | ST_Test : t1 t1' t2 t3,
        +      t1 --> t1'
        +      (test t1 t2 t3) --> (test t1' t2 t3)
        +where "t1 '-->' t2" := (step t1 t2).

        Hint Constructors step.
        -

        Subtyping

        +

        Subtyping

        @@ -1437,24 +1450,24 @@

        SubSubtyping

        Reserved Notation "T '<:' U" (at level 40).

        Inductive subtype : tytyProp :=
        -  | S_Refl : T,
        +  | S_Refl : T,
              T <: T
        -  | S_Trans : S U T,
        +  | S_Trans : S U T,
              S <: U
              U <: T
              S <: T
        -  | S_Top : S,
        -      S <: TTop
        -  | S_Arrow : S1 S2 T1 T2,
        +  | S_Top : S,
        +      S <: Top
        +  | S_Arrow : S1 S2 T1 T2,
              T1 <: S1
              S2 <: T2
        -      (TArrow S1 S2) <: (TArrow T1 T2)
        +      (Arrow S1 S2) <: (Arrow T1 T2)
        where "T '<:' U" := (subtype T U).
        -Note that we don't need any special rules for base types (TBool - and TBase): they are automatically subtypes of themselves (by +Note that we don't need any special rules for base types (Bool + and Base): they are automatically subtypes of themselves (by S_Refl) and Top (by S_Top), and that's all we want.
        @@ -1465,39 +1478,37 @@

        SubSubtyping

        Notation x := "x".
        Notation y := "y".
        Notation z := "z".

        -Notation A := (TBase "A").
        -Notation B := (TBase "B").
        -Notation C := (TBase "C").

        -Notation String := (TBase "String").
        -Notation Float := (TBase "Float").
        -Notation Integer := (TBase "Integer").

        +Notation A := (Base "A").
        +Notation B := (Base "B").
        +Notation C := (Base "C").

        +Notation String := (Base "String").
        +Notation Float := (Base "Float").
        +Notation Integer := (Base "Integer").

        Example subtyping_example_0 :
        -  (TArrow C TBool) <: (TArrow C TTop).
        -  (* C->Bool <: C->Top *)
        +  (Arrow C Bool) <: (Arrow C Top).
        +  (* C->Bool <: C->Top *)
        Proof. auto. Qed.
        -

        练习:2 星, optional (subtyping_judgements)

        - (Wait to do this exercise until after you have added product types to - the language — see exercise products — at least up to this point - in the file). +

        练习:2 星, standard, optional (subtyping_judgements)

        + (Leave this exercise Admitted until after you have finished adding product + types to the language — see exercise products — at least up to + this point in the file).
        - Recall that, in chapter MoreStlc, the optional section "Encoding - Records" describes how records can be encoded as pairs. + Recall that, in chapter MoreStlc, the optional section + "Encoding Records" describes how records can be encoded as pairs. Using this encoding, define pair types representing the following record types:
        -    Person   := { name : String }
        -    Student  := { name : String ;
        -                  gpa  : Float }
        -    Employee := { name : String ;
        -                  ssn  : Integer } +    Person := { name : String } 
        +    Student := { name : String ; gpa : Float } 
        +    Employee := { name : String ; ssn : Integer }
        @@ -1536,13 +1547,13 @@

        SubSubtyping

        understand how to prove them on paper!
        -

        练习:1 星, optional (subtyping_example_1)

        +

        练习:1 星, standard, optional (subtyping_example_1)

        Example subtyping_example_1 :
        -  (TArrow TTop Student) <: (TArrow (TArrow C C) Person).
        -  (* Top->Student <: (C->C)->Person *)
        +  (Arrow Top Student) <: (Arrow (Arrow C C) Person).
        +  (* Top->Student <: (C->C)->Person *)
        Proof with eauto.
          (* 请在此处解答 *) Admitted.
        @@ -1551,13 +1562,13 @@

        SubSubtyping

        -

        练习:1 星, optional (subtyping_example_2)

        +

        练习:1 星, standard, optional (subtyping_example_2)

        Example subtyping_example_2 :
        -  (TArrow TTop Person) <: (TArrow Person TTop).
        -  (* Top->Person <: Person->Top *)
        +  (Arrow Top Person) <: (Arrow Person Top).
        +  (* Top->Person <: Person->Top *)
        Proof with eauto.
          (* 请在此处解答 *) Admitted.
        @@ -1569,7 +1580,7 @@

        SubSubtyping

        -

        Typing

        +

        Typing

        @@ -1579,47 +1590,49 @@

        SubSubtyping

        Definition context := partial_map ty.

        -Reserved Notation "Gamma '|-' t '∈' T" (at level 40).

        +Reserved Notation "Gamma '⊢' t '∈' T" (at level 40).

        Inductive has_type : contexttmtyProp :=
          (* Same as before *)
        -  | T_Var : Gamma x T,
        +  | T_Var : Gamma x T,
              Gamma x = Some T
        -      Gamma |- tvar xT
        -  | T_Abs : Gamma x T11 T12 t12,
        -      Gamma & {{x-->T11}} |- t12T12
        -      Gamma |- tabs x T11 t12TArrow T11 T12
        -  | T_App : T1 T2 Gamma t1 t2,
        -      Gamma |- t1TArrow T1 T2
        -      Gamma |- t2T1
        -      Gamma |- tapp t1 t2T2
        -  | T_True : Gamma,
        -       Gamma |- ttrueTBool
        -  | T_False : Gamma,
        -       Gamma |- tfalseTBool
        -  | T_If : t1 t2 t3 T Gamma,
        -       Gamma |- t1TBool
        -       Gamma |- t2T
        -       Gamma |- t3T
        -       Gamma |- tif t1 t2 t3T
        -  | T_Unit : Gamma,
        -      Gamma |- tunitTUnit
        +      Gammavar xT
        +  | T_Abs : Gamma x T11 T12 t12,
        +      (x > T11 ; Gamma) ⊢ t12T12
        +      Gammaabs x T11 t12Arrow T11 T12
        +  | T_App : T1 T2 Gamma t1 t2,
        +      Gammat1Arrow T1 T2
        +      Gammat2T1
        +      Gammaapp t1 t2T2
        +  | T_True : Gamma,
        +       GammatruBool
        +  | T_False : Gamma,
        +       GammaflsBool
        +  | T_Test : t1 t2 t3 T Gamma,
        +       Gammat1Bool
        +       Gammat2T
        +       Gammat3T
        +       Gammatest t1 t2 t3T
        +  | T_Unit : Gamma,
        +      GammaunitUnit
          (* New rule of subsumption *)
        -  | T_Sub : Gamma t S T,
        -      Gamma |- tS
        +  | T_Sub : Gamma t S T,
        +      GammatS
              S <: T
        -      Gamma |- tT
        +      GammatT

        -where "Gamma '|-' t '∈' T" := (has_type Gamma t T).

        +where "Gamma '⊢' t '∈' T" := (has_type Gamma t T).

        Hint Constructors has_type.
        The following hints help auto and eauto construct typing - derivations. (See chapter UseAuto for more on hints.) + derivations. They are only used in a few places, but they give + a nice illustration of what auto can do with a bit more + programming. See chapter UseAuto for more on hints.
        -Hint Extern 2 (has_type _ (tapp _ _) _) ⇒
        +Hint Extern 2 (has_type _ (app _ _) _) ⇒
          eapply T_App; auto.
        Hint Extern 2 (_ = _) ⇒ compute; reflexivity.

        Module Examples2.
        @@ -1632,12 +1645,12 @@

        SubSubtyping

        formal statement in Coq and prove it.
        -

        练习:1 星, optional (typing_example_0)

        +

        练习:1 星, standard, optional (typing_example_0)

        -(* empty |- ((\z:A.z), (\z:B.z))
        -          : (A->A * B->B) *)

        +(* empty ⊢ ((\z:A.z), (\z:B.z))
        +         ∈ (A->A * B->B) *)

        (* 请在此处解答 *)
        @@ -1645,12 +1658,12 @@

        SubSubtyping

        -

        练习:2 星, optional (typing_example_1)

        +

        练习:2 星, standard, optional (typing_example_1)

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

        +(* empty ⊢ (\x:(Top * B->B). x.snd) ((\z:A.z), (\z:B.z))
        +         ∈ B->B *)

        (* 请在此处解答 *)
        @@ -1658,13 +1671,13 @@

        SubSubtyping

        -

        练习:2 星, optional (typing_example_2)

        +

        练习:2 星, standard, 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 *)

        +(* empty ⊢ (\z:(C->C)->(Top * B->B). (z (\x:C.x)).snd)
        +              (\z:C->C. ((\z:A.z), (\z:B.z)))
        +         ∈ B->B *)

        (* 请在此处解答 *)
        @@ -1675,7 +1688,7 @@

        SubSubtyping

        -

        Properties

        +

        Properties

        @@ -1688,7 +1701,7 @@

        SubSubtyping

        -

        Inversion Lemmas for Subtyping

        +

        Inversion Lemmas for Subtyping

        @@ -1717,18 +1730,18 @@

        SubSubtyping

        T and the existence of subtype relations between their parts.
        -

        练习:2 星, optional (sub_inversion_Bool)

        +

        练习:2 星, standard, optional (sub_inversion_Bool)

        -Lemma sub_inversion_Bool : U,
        -     U <: TBool
        -     U = TBool.
        +Lemma sub_inversion_Bool : U,
        +     U <: Bool
        +     U = Bool.
        Proof with auto.
          intros U Hs.
        -  remember TBool as V.
        +  remember Bool as V.
          (* 请在此处解答 *) Admitted.
        @@ -1738,19 +1751,19 @@

        SubSubtyping

        -

        练习:3 星 (sub_inversion_arrow)

        +

        练习:3 星, standard (sub_inversion_arrow)

        -Lemma sub_inversion_arrow : U V1 V2,
        -     U <: TArrow V1 V2
        -      U1 U2,
        -       U = TArrow U1 U2V1 <: U1U2 <: V2.
        +Lemma sub_inversion_arrow : U V1 V2,
        +     U <: Arrow V1 V2
        +     U1 U2,
        +     U = Arrow U1 U2V1 <: U1U2 <: V2.
        Proof with eauto.
          intros U V1 V2 Hs.
        -  remember (TArrow V1 V2) as V.
        +  remember (Arrow V1 V2) as V.
          generalize dependent V2. generalize dependent V1.
          (* 请在此处解答 *) Admitted.
        @@ -1759,7 +1772,7 @@

        SubSubtyping

        -

        Canonical Forms

        +

        Canonical Forms

        @@ -1781,7 +1794,7 @@

        SubSubtyping

        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 : T11T12 is subsumption, then there is some + t1 T11T12 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. @@ -1792,15 +1805,15 @@

        SubSubtyping

        type.
        -

        练习:3 星, optional (canonical_forms_of_arrow_types)

        +

        练习:3 星, standard, optional (canonical_forms_of_arrow_types)

        -Lemma canonical_forms_of_arrow_types : Gamma s T1 T2,
        -  Gamma |- sTArrow T1 T2
        +Lemma canonical_forms_of_arrow_types : Gamma s T1 T2,
        +  GammasArrow T1 T2
          value s
        -   x S1 s2,
        -     s = tabs x S1 s2.
        +  x S1 s2,
        +     s = abs x S1 s2.
        Proof with eauto.
        @@ -1813,19 +1826,19 @@

        SubSubtyping

        Similarly, the canonical forms of type Bool are the constants - true and false. + tru and fls.
        -Lemma canonical_forms_of_Bool : Gamma s,
        -  Gamma |- sTBool
        +Lemma canonical_forms_of_Bool : Gamma s,
        +  GammasBool
          value s
        -  s = ttrues = tfalse.
        +  s = trus = fls.
        Proof with eauto.
          intros Gamma s Hty Hv.
        -  remember TBool as T.
        +  remember Bool as T.
          induction Hty; try solve_by_invert...
          - (* T_Sub *)
            subst. apply sub_inversion_Bool in H. subst...
        @@ -1834,7 +1847,7 @@

        SubSubtyping

        -

        Progress

        +

        Progress

        @@ -1843,18 +1856,18 @@

        SubSubtyping

        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'. + _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 + _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 + immediate because abstractions, unit, tru, and fls are already values. The T_Var case is vacuous because variables cannot be typed in the empty context. The remaining cases are more interesting: @@ -1864,23 +1877,23 @@

        SubSubtyping

        • 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 + 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 +
          • 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 +
          • 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.
            @@ -1890,7 +1903,7 @@

            SubSubtyping

          • Finally, suppose t1 and t2 are both values. By the canonical forms lemma 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 + (\x:S1.s2) t2 --> [x:=t2]s2 by ST_AppAbs, since t2 is a value.
            @@ -1900,24 +1913,24 @@

            SubSubtyping

        • -
        • 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 the final step of the derivation uses rule T_Test, then there + are terms t1, t2, and t3 such that t = test 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. + booleans, either t1 = tru or t1 = fls. In either + case, t can step, using rule ST_TestTrue or ST_TestFalse.
          • -
          • If t1 can step, then so can t, by rule ST_If. +
          • If t1 can step, then so can t, by rule ST_Test.
            @@ -1927,7 +1940,7 @@

            SubSubtyping

          • 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 + a type S such that S <: T and empty t S. The desired result is exactly the induction hypothesis for the typing subderivation. @@ -1937,9 +1950,9 @@

            SubSubtyping

        -Theorem progress : t T,
        -     empty |- tT
        -     value t t', t ==> t'.
        +Theorem progress : t T,
        +     emptytT
        +     value tt', t --> t'.
        Proof with eauto.
        @@ -1958,16 +1971,16 @@

        SubSubtyping

              * (* t2 is a value *)
                destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
                  as [x [S1 [t12 Heqt1]]]...
        -        subst. ([x:=t2]t12)...
        +        subst. ([x:=t2]t12)...
              * (* t2 steps *)
        -        inversion H0 as [t2' Hstp]. (tapp t1 t2')...
        +        inversion H0 as [t2' Hstp]. (app t1 t2')...
            + (* t1 steps *)
        -      inversion H as [t1' Hstp]. (tapp t1' t2)...
        -  - (* T_If *)
        +      inversion H as [t1' Hstp]. (app t1' t2)...
        +  - (* T_Test *)
            right.
            destruct IHHt1.
            + (* t1 is a value *) eauto.
        -    + assert (t1 = ttruet1 = tfalse)
        +    + assert (t1 = trut1 = fls)
                by (eapply canonical_forms_of_Bool; eauto).
              inversion H0; subst...
            + inversion H. rename x into t1'. eauto.
        @@ -1976,7 +1989,7 @@

        SubSubtyping

        -

        Inversion Lemmas for Typing

        +

        Inversion Lemmas for Typing

        @@ -1992,13 +2005,13 @@

        SubSubtyping

        The following inversion lemma tells us that, if we have a - derivation of some typing statement Gamma |- \x:S1.t2 : T whose + 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. + _Lemma_: If Gamma \x:S1.t2 T, then there is a type S2 + such that x>S1; Gamma t2 S2 and S1 S2 <: T.
        @@ -2008,28 +2021,33 @@

        SubSubtyping

        _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 + 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 + there is a type T12 such that T = S1 T12 and x:S1; + Gamma 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. + there is a type S such that S <: T and Gamma \x:S1.t2 + S. The IH for the typing subderivation tells us that there + is some type S2 with S1 S2 <: S and x:S1; Gamma t2 + S2. Picking type S2 gives us what we need, since S1 + S2 <: T then follows by S_Trans.
        @@ -2040,20 +2058,20 @@

        SubSubtyping

        -Lemma typing_inversion_abs : Gamma x S1 t2 T,
        -     Gamma |- (tabs x S1 t2) ∈ T
        -      S2,
        -       TArrow S1 S2 <: T
        -       ∧ Gamma & {{x-->S1}} |- t2S2.
        +Lemma typing_inversion_abs : Gamma x S1 t2 T,
        +     Gamma ⊢ (abs x S1 t2) ∈ T
        +     S2,
        +       Arrow S1 S2 <: T
        +       ∧ (x > S1 ; Gamma) ⊢ t2S2.
        Proof with eauto.
          intros Gamma x S1 t2 T H.
        -  remember (tabs x S1 t2) as t.
        +  remember (abs x S1 t2) as t.
          induction H;
            inversion Heqt; subst; intros; try solve_by_invert.
          - (* T_Abs *)
        -     T12...
        +    T12...
          - (* T_Sub *)
            destruct IHhas_type as [S2 [Hsub Hty]]...
          Qed.
        @@ -2065,83 +2083,83 @@

        SubSubtyping

        -Lemma typing_inversion_var : Gamma x T,
        -  Gamma |- (tvar x) ∈ T
        -   S,
        +Lemma typing_inversion_var : Gamma x T,
        +  Gamma ⊢ (var x) ∈ T
        +  S,
            Gamma x = Some SS <: T.
        Proof with eauto.
          intros Gamma x T Hty.
        -  remember (tvar x) as t.
        +  remember (var x) as t.
          induction Hty; intros;
            inversion Heqt; subst; try solve_by_invert.
          - (* T_Var *)
        -     T...
        +    T...
          - (* T_Sub *)
            destruct IHHty as [U [Hctx HsubU]]... Qed.

        -Lemma typing_inversion_app : Gamma t1 t2 T2,
        -  Gamma |- (tapp t1 t2) ∈ T2
        -   T1,
        -    Gamma |- t1 ∈ (TArrow T1 T2) ∧
        -    Gamma |- t2T1.
        +Lemma typing_inversion_app : Gamma t1 t2 T2,
        +  Gamma ⊢ (app t1 t2) ∈ T2
        +  T1,
        +    Gammat1 ∈ (Arrow T1 T2) ∧
        +    Gammat2T1.
        Proof with eauto.
          intros Gamma t1 t2 T2 Hty.
        -  remember (tapp t1 t2) as t.
        +  remember (app t1 t2) as t.
          induction Hty; intros;
            inversion Heqt; subst; try solve_by_invert.
          - (* T_App *)
        -     T1...
        +    T1...
          - (* T_Sub *)
            destruct IHHty as [U1 [Hty1 Hty2]]...
        Qed.

        -Lemma typing_inversion_true : Gamma T,
        -  Gamma |- ttrueT
        -  TBool <: T.
        +Lemma typing_inversion_true : Gamma T,
        +  GammatruT
        +  Bool <: T.
        Proof with eauto.
        -  intros Gamma T Htyp. remember ttrue as tu.
        +  intros Gamma T Htyp. remember tru as tu.
          induction Htyp;
            inversion Heqtu; subst; intros...
        Qed.

        -Lemma typing_inversion_false : Gamma T,
        -  Gamma |- tfalseT
        -  TBool <: T.
        +Lemma typing_inversion_false : Gamma T,
        +  GammaflsT
        +  Bool <: T.
        Proof with eauto.
        -  intros Gamma T Htyp. remember tfalse as tu.
        +  intros Gamma T Htyp. remember fls as tu.
          induction Htyp;
            inversion Heqtu; subst; intros...
        Qed.

        -Lemma typing_inversion_if : Gamma t1 t2 t3 T,
        -  Gamma |- (tif t1 t2 t3) ∈ T
        -  Gamma |- t1TBool
        -  ∧ Gamma |- t2T
        -  ∧ Gamma |- t3T.
        +Lemma typing_inversion_if : Gamma t1 t2 t3 T,
        +  Gamma ⊢ (test t1 t2 t3) ∈ T
        +  Gammat1Bool
        +  ∧ Gammat2T
        +  ∧ Gammat3T.
        Proof with eauto.
          intros Gamma t1 t2 t3 T Hty.
        -  remember (tif t1 t2 t3) as t.
        +  remember (test t1 t2 t3) as t.
          induction Hty; intros;
            inversion Heqt; subst; try solve_by_invert.
        -  - (* T_If *)
        +  - (* T_Test *)
            auto.
          - (* T_Sub *)
            destruct (IHHty H0) as [H1 [H2 H3]]...
        @@ -2149,13 +2167,13 @@

        SubSubtyping


        -Lemma typing_inversion_unit : Gamma T,
        -  Gamma |- tunitT
        -    TUnit <: T.
        +Lemma typing_inversion_unit : Gamma T,
        +  GammaunitT
        +    Unit <: T.
        Proof with eauto.
        -  intros Gamma T Htyp. remember tunit as tu.
        +  intros Gamma T Htyp. remember unit as tu.
          induction Htyp;
            inversion Heqtu; subst; intros...
        Qed.
        @@ -2169,10 +2187,10 @@

        SubSubtyping

        -Lemma abs_arrow : x S1 s2 T1 T2,
        -  empty |- (tabs x S1 s2) ∈ (TArrow T1 T2) →
        +Lemma abs_arrow : x S1 s2 T1 T2,
        +  empty ⊢ (abs x S1 s2) ∈ (Arrow T1 T2) →
             T1 <: S1
        -  ∧ empty & {{x-->S1}} |- s2T2.
        +  ∧ (x > S1 ; empty) ⊢ s2T2.
        Proof with eauto.
        @@ -2186,7 +2204,7 @@

        SubSubtyping

        -

        Context Invariance

        +

        Context Invariance

        @@ -2196,31 +2214,31 @@

        SubSubtyping

        Inductive appears_free_in : stringtmProp :=
        -  | afi_var : x,
        -      appears_free_in x (tvar x)
        -  | afi_app1 : x t1 t2,
        -      appears_free_in x t1appears_free_in x (tapp t1 t2)
        -  | afi_app2 : x t1 t2,
        -      appears_free_in x t2appears_free_in x (tapp t1 t2)
        -  | afi_abs : x y T11 t12,
        +  | afi_var : x,
        +      appears_free_in x (var x)
        +  | afi_app1 : x t1 t2,
        +      appears_free_in x t1appears_free_in x (app t1 t2)
        +  | afi_app2 : x t1 t2,
        +      appears_free_in x t2appears_free_in x (app t1 t2)
        +  | afi_abs : x y T11 t12,
                yx
                appears_free_in x t12
        -        appears_free_in x (tabs y T11 t12)
        -  | afi_if1 : x t1 t2 t3,
        +        appears_free_in x (abs y T11 t12)
        +  | afi_test1 : 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 (test t1 t2 t3)
        +  | afi_test2 : 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 (test t1 t2 t3)
        +  | afi_test3 : x t1 t2 t3,
              appears_free_in x t3
        -      appears_free_in x (tif t1 t2 t3)
        +      appears_free_in x (test t1 t2 t3)
        .

        Hint Constructors appears_free_in.

        -Lemma context_invariance : Gamma Gamma' t S,
        -     Gamma |- tS
        -     ( x, appears_free_in x tGamma x = Gamma' x) →
        -     Gamma' |- tS.
        +Lemma context_invariance : Gamma Gamma' t S,
        +     GammatS
        +     (x, appears_free_in x tGamma x = Gamma' x) →
        +     Gamma'tS.
        Proof with eauto.
        @@ -2232,16 +2250,16 @@

        SubSubtyping

          - (* T_Abs *)
            apply T_Abs... apply IHhas_type. intros x0 Hafi.
            unfold update, t_update. destruct (eqb_stringP x x0)...
        -  - (* T_If *)
        -    apply T_If...
        +  - (* T_Test *)
        +    apply T_Test...
        Qed.

        -Lemma free_in_context : x t T Gamma,
        +Lemma free_in_context : x t T Gamma,
           appears_free_in x t
        -   Gamma |- tT
        -    T', Gamma x = Some T'.
        +   GammatT
        +   T', Gamma x = Some T'.
        Proof with eauto.
        @@ -2249,7 +2267,7 @@

        SubSubtyping

          induction Htyp;
              subst; inversion Hafi; subst...
          - (* T_Abs *)
        -    destruct (IHHtyp H4) as [T Hctx]. T.
        +    destruct (IHHtyp H4) as [T Hctx]. T.
            unfold update, t_update in Hctx.
            rewrite <- eqb_string_false_iff in H2.
            rewrite H2 in Hctx... Qed.
        @@ -2257,7 +2275,7 @@

        SubSubtyping

        -

        Substitution

        +

        Substitution

        @@ -2270,17 +2288,17 @@

        SubSubtyping

        -Lemma substitution_preserves_typing : Gamma x U v t S,
        -     Gamma & {{x-->U}} |- tS
        -     empty |- vU
        -     Gamma |- [x:=v]tS.
        +Lemma substitution_preserves_typing : Gamma x U v t S,
        +     (x > U ; Gamma) ⊢ tS
        +     emptyvU
        +     Gamma ⊢ [x:=v]tS.
        Proof with eauto.
          intros Gamma x U v t S Htypt Htypv.
          generalize dependent S. generalize dependent Gamma.
          induction t; intros; simpl.
        -  - (* tvar *)
        +  - (* var *)
            rename s into y.
            destruct (typing_inversion_var _ _ _ Htypt)
                as [T [Hctx Hsub]].
        @@ -2293,15 +2311,15 @@

        SubSubtyping

            destruct (free_in_context _ _ S empty Hcontra)
                as [T' HT']...
            inversion HT'.
        -  - (* tapp *)
        +  - (* app *)
            destruct (typing_inversion_app _ _ _ _ Htypt)
                as [T1 [Htypt1 Htypt2]].
            eapply T_App...
        -  - (* tabs *)
        +  - (* abs *)
            rename s 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...
        +    apply T_Sub with (Arrow T1 T2)... apply T_Abs...
            destruct (eqb_stringP x y) as [Hxy|Hxy].
            + (* x=y *)
              eapply context_invariance...
        @@ -2314,475 +2332,28 @@

        SubSubtyping

              destruct (eqb_stringP y z)...
              subst.
              rewrite <- eqb_string_false_iff in Hxy. rewrite Hxy...
        -  - (* ttrue *)
        -      assert (TBool <: S)
        +  - (* tru *)
        +      assert (Bool <: S)
                by apply (typing_inversion_true _ _ Htypt)...
        -  - (* tfalse *)
        -      assert (TBool <: S)
        +  - (* fls *)
        +      assert (Bool <: S)
                by apply (typing_inversion_false _ _ Htypt)...
        -  - (* tif *)
        -    assert (Gamma & {{x-->U}} |- t1TBool
        -         ∧ Gamma & {{x-->U}} |- t2S
        -         ∧ Gamma & {{x-->U}} |- t3S)
        +  - (* test *)
        +    assert ((x > U ; Gamma) ⊢ t1Bool
        +         ∧ (x > U ; Gamma) ⊢ t2S
        +         ∧ (x > U ; Gamma) ⊢ t3S)
              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.
        -  - (* tunit *)
        -    assert (TUnit <: S)
        +  - (* unit *)
        +    assert (Unit <: 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 |- tT
        -     t ==> t'
        -     empty |- t'T.
        -
        -
        -Proof with eauto.
        -  intros t t' T HT.
        -  remember empty as Gamma. generalize dependent HeqGamma.
        -  generalize dependent t'.
        -  induction HT;
        -    intros t' HeqGamma HE; subst; inversion HE; subst...
        -  - (* T_App *)
        -    inversion HE; subst...
        -    + (* 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 omits 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. -
        - -
        -

        Exercises

        - -
        - -

        练习:2 星 (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 reduction rule: -
        - - - - - - - - - - -
           - (ST_Funny5)   -

        (unit t) ==> (t unit)
        -
        - - -
      • -
      • Suppose we add the same reduction 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
        -
      • -
      - -
      - - -
    -
    - -(* 请勿修改下面这一行: *)
    -Definition manual_grade_for_variations : option (nat*string) := None.
    -
    - - - -
    -

    Exercise: Adding Products

    - -
    - -

    练习:4 星 (products)

    - Adding pairs, projections, and product types to the system we have - defined is a relatively straightforward matter. Carry out this - extension: - -
    - -
      -
    • Below, we've added constructors for pairs, first and second - projections, and product types to the definitions of ty and - tm. - -
      - - -
    • -
    • Copy the definitions of the substitution function and value - relation from above and extend them as in chapter - MoreSTLC to include products. - -
      - - -
    • -
    • Similarly, copy and extend the operational semantics with the - same reduction rules as in chapter MoreSTLC. - -
      - - -
    • -
    • (Copy and) 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 chapter MoreSTLC. - -
      - - -
    • -
    • Extend the proofs of progress, preservation, and all their - supporting lemmas to deal with the new constructs. (You'll also - need to add a couple of completely new lemmas.) -
    • -
    - -
    -
    -Module ProductExtension.

    -Inductive ty : Type :=
    -  | TTop : ty
    -  | TBool : ty
    -  | TBase : stringty
    -  | TArrow : tytyty
    -  | TUnit : ty
    -  | TProd : tytyty.

    -Inductive tm : Type :=
    -  | tvar : stringtm
    -  | tapp : tmtmtm
    -  | tabs : stringtytmtm
    -  | ttrue : tm
    -  | tfalse : tm
    -  | tif : tmtmtmtm
    -  | tunit : tm
    -  | tpair : tmtmtm
    -  | tfst : tmtm
    -  | tsnd : tmtm.
    -
    - -
    -Copy and extend and/or fill in required definitions and lemmas - here. -
    -
    - -Theorem progress : t T,
    -     empty |- tT
    -     value t t', t ==> t'.
    -Proof.
    -  (* 请在此处解答 *) Admitted.
    -Theorem preservation : t t' T,
    -     empty |- tT
    -     t ==> t'
    -     empty |- t'T.
    -Proof.
    -  (* 请在此处解答 *) Admitted.

    -End ProductExtension.
    -(* 请勿修改下面这一行: *)
    -Definition manual_grade_for_progress : option (nat*string) := None.
    -(* 请勿修改下面这一行: *)
    -Definition manual_grade_for_preservation : option (nat*string) := None.
    -
    - - -
    -
    - - +
    +(* Sat Jan 26 15:15:44 UTC 2019 *)

    diff --git a/plf-current/Sub.v b/plf-current/Sub.v index 41cd3fdc..e4a45751 100644 --- a/plf-current/Sub.v +++ b/plf-current/Sub.v @@ -1,6 +1,7 @@ (** * Sub: Subtyping *) Set Warnings "-notation-overridden,-parsing". +From Coq Require Import Strings.String. From PLF Require Import Maps. From PLF Require Import Types. From PLF Require Import Smallstep. @@ -53,6 +54,13 @@ From PLF Require Import Smallstep. to all of the type constructors in the language -- functions, pairs, etc. *) +(** Safe substitution principle: + + - [S] is a subtype of [T], written [S <: T], if a value of type + [S] can safely be used in any context where a value of type + [T] is expected. +*) + (* ================================================================= *) (** ** Subtyping and Object-Oriented Languages *) @@ -115,9 +123,9 @@ From PLF Require Import Smallstep. 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 + Gamma |- t \in S S <: T + --------------------------- (T_Sub) + Gamma |- t \in T This rule says, intuitively, that it is OK to "forget" some of what we know about a term. *) @@ -195,7 +203,6 @@ From PLF Require Import Smallstep. ---------------- (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: @@ -289,7 +296,7 @@ From PLF Require Import Smallstep. 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}]. *) + [{age:Nat,name:String} <: {age:Nat}]. *) (** Second, subtyping can be applied inside the components of a compound record type: @@ -315,20 +322,22 @@ From PLF Require Import Smallstep. (** 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 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). *) + interfaces). + + - In early versions of Java, a subclass could 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). *) + +(** **** 练习:2 星, standard, recommended (arrow_sub_wrong) -(** **** 练习:2 星, recommended (arrow_sub_wrong) *) -(** Suppose we had incorrectly defined subtyping as covariant on both + Suppose we had incorrectly defined subtyping as covariant on both the right and the left of arrow types: S1 <: T1 S2 <: T2 @@ -364,7 +373,7 @@ Definition manual_grade_for_arrow_sub_wrong : option (nat*string) := None. -------- (S_Top) S <: Top - The [Top] type is an analog of the [Object] type in Java and C[#]. *) + The [Top] type is an analog of the [Object] type in Java and C#. *) (* ----------------------------------------------------------------- *) (** *** Summary *) @@ -376,9 +385,9 @@ Definition manual_grade_for_arrow_sub_wrong : option (nat*string) := None. - adding the rule of subsumption - Gamma |- t : S S <: T - ------------------------- (T_Sub) - Gamma |- t : T + Gamma |- t \in S S <: T + --------------------------- (T_Sub) + Gamma |- t \in T to the typing relation, and @@ -418,8 +427,9 @@ Definition manual_grade_for_arrow_sub_wrong : option (nat*string) := None. (* ================================================================= *) (** ** Exercises *) -(** **** 练习:1 星, optional (subtype_instances_tf_1) *) -(** Suppose we have types [S], [T], [U], and [V] with [S <: T] +(** **** 练习:1 星, standard, 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 like [Bool], [Nat], etc.) @@ -438,11 +448,11 @@ Definition manual_grade_for_arrow_sub_wrong : option (nat*string) := None. - [S*V <: T*U] - [] *) -(** **** 练习:2 星 (subtype_order) *) -(** The following types happen to form a linear order with respect to subtyping: +(** **** 练习:2 星, standard (subtype_order) + + The following types happen to form a linear order with respect to subtyping: - [Top] - [Top -> Student] - [Student -> Person] @@ -453,16 +463,16 @@ Write these types in order from the most specific to the most general. Where does the type [Top->Top->Student] fit into this order? That is, state how [Top -> (Top -> Student)] compares with each -of the five types above. It may be unrelated to some of them. - +of the five types above. It may be unrelated to some of them. *) (* 请勿修改下面这一行: *) Definition manual_grade_for_subtype_order : option (nat*string) := None. (** [] *) -(** **** 练习:1 星 (subtype_instances_tf_2) *) -(** Which of the following statements are true? Write _true_ or +(** **** 练习:1 星, standard (subtype_instances_tf_2) + + Which of the following statements are true? Write _true_ or _false_ after each one. forall S T, @@ -495,8 +505,9 @@ Definition manual_grade_for_subtype_order : option (nat*string) := None. Definition manual_grade_for_subtype_instances_tf_2 : option (nat*string) := None. (** [] *) -(** **** 练习:1 星 (subtype_concepts_tf) *) -(** Which of the following statements are true, and which are false? +(** **** 练习:1 星, standard (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. @@ -529,14 +540,15 @@ Definition manual_grade_for_subtype_instances_tf_2 : option (nat*string) := None Definition manual_grade_for_subtype_concepts_tf : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (proper_subtypes) *) -(** Is the following statement true or false? Briefly explain your - answer. (Here [TBase n] stands for a base type, where [n] is +(** **** 练习:2 星, standard (proper_subtypes) + + Is the following statement true or false? Briefly explain your + answer. (Here [Base n] stands for a base type, where [n] is a string standing for the name of the base type. See the Syntax section below.) forall T, - ~(T = TBool \/ exists n, T = TBase n) -> + ~(T = Bool \/ exists n, T = Base n) -> exists S, S <: T /\ S <> T *) @@ -545,16 +557,13 @@ Definition manual_grade_for_subtype_concepts_tf : option (nat*string) := None. Definition manual_grade_for_proper_subtypes : option (nat*string) := None. (** [] *) - -(** **** 练习:2 星 (small_large_1) *) -(** +(** **** 练习:2 星, standard (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 - + empty |- (\p:T*Top. p.fst) ((\z:A.z), unit) \in A->A - What is the _largest_ type [T] that makes the same assertion true? @@ -564,13 +573,11 @@ Definition manual_grade_for_proper_subtypes : option (nat*string) := None. Definition manual_grade_for_small_large_1 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (small_large_2) *) -(** +(** **** 练习:2 星, standard (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 - + empty |- (\p:(A->A * B->B). p) ((\z:A.z), (\z:B.z)) \in T - What is the _largest_ type [T] that makes the same assertion true? @@ -580,27 +587,22 @@ Definition manual_grade_for_small_large_1 : option (nat*string) := None. Definition manual_grade_for_small_large_2 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, optional (small_large_3) *) -(** +(** **** 练习:2 星, standard, 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 - + a:A |- (\p:(A*T). (p.snd) (p.fst)) (a, \z:A.z) \in A - What is the _largest_ type [T] that makes the same assertion true? - [] *) -(** **** 练习:2 星 (small_large_4) *) -(** +(** **** 练习:2 星, standard (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 - + empty |- (\p:(A*T). (p.snd) (p.fst)) \in S - What is the _largest_ type [T] that makes the same assertion true? @@ -611,41 +613,44 @@ Definition manual_grade_for_small_large_2 : option (nat*string) := None. Definition manual_grade_for_small_large_4 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (smallest_1) *) -(** What is the _smallest_ type [T] that makes the following +(** **** 练习:2 星, standard (smallest_1) + + What is the _smallest_ type [T] that makes the following assertion true? exists S t, - empty |- (\x:T. x x) t : S + empty |- (\x:T. x x) t \in S *) (* 请勿修改下面这一行: *) Definition manual_grade_for_smallest_1 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (smallest_2) *) -(** What is the _smallest_ type [T] that makes the following +(** **** 练习:2 星, standard (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 + empty |- (\x:Top. x) ((\z:A.z) , (\z:B.z)) \in T *) (* 请勿修改下面这一行: *) Definition manual_grade_for_smallest_2 : option (nat*string) := None. (** [] *) -(** **** 练习:3 星, optional (count_supertypes) *) -(** How many supertypes does the record type [{x:A, y:C->C}] have? That is, +(** **** 练习:3 星, standard, 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.) - [] *) -(** **** 练习:2 星 (pair_permutation) *) -(** The subtyping rule for product types +(** **** 练习:2 星, standard (pair_permutation) + + The subtyping rule for product types S1 <: T1 S2 <: T2 -------------------- (S_Prod) @@ -690,21 +695,21 @@ Definition manual_grade_for_pair_permutation : option (nat*string) := None. we could easily do so.) *) Inductive ty : Type := - | TTop : ty - | TBool : ty - | TBase : string -> ty - | TArrow : ty -> ty -> ty - | TUnit : ty + | Top : ty + | Bool : ty + | Base : string -> ty + | Arrow : ty -> ty -> ty + | Unit : ty . Inductive tm : Type := - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm - | tunit : tm + | var : string -> tm + | app : tm -> tm -> tm + | abs : string -> ty -> tm -> tm + | tru : tm + | fls : tm + | test : tm -> tm -> tm -> tm + | unit : tm . (* ----------------------------------------------------------------- *) @@ -715,20 +720,20 @@ Inductive tm : Type := Fixpoint subst (x:string) (s:tm) (t:tm) : tm := match t with - | tvar y => + | var y => if eqb_string x y then s else t - | tabs y T t1 => - tabs y T (if eqb_string 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 + | abs y T t1 => + abs y T (if eqb_string x y then t1 else (subst x s t1)) + | app t1 t2 => + app (subst x s t1) (subst x s t2) + | tru => + tru + | fls => + fls + | test t1 t2 t3 => + test (subst x s t1) (subst x s t2) (subst x s t3) + | unit => + unit end. Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). @@ -741,38 +746,38 @@ Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20). Inductive value : tm -> Prop := | v_abs : forall x T t, - value (tabs x T t) + value (abs x T t) | v_true : - value ttrue + value tru | v_false : - value tfalse + value fls | v_unit : - value tunit + value unit . Hint Constructors value. -Reserved Notation "t1 '==>' t2" (at level 40). +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 + (app (abs x T t12) v2) --> [x:=v2]t12 | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - (tapp t1 t2) ==> (tapp t1' t2) + t1 --> t1' -> + (app t1 t2) --> (app 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). + t2 --> t2' -> + (app v1 t2) --> (app v1 t2') + | ST_TestTrue : forall t1 t2, + (test tru t1 t2) --> t1 + | ST_TestFalse : forall t1 t2, + (test fls t1 t2) --> t2 + | ST_Test : forall t1 t1' t2 t3, + t1 --> t1' -> + (test t1 t2 t3) --> (test t1' t2 t3) +where "t1 '-->' t2" := (step t1 t2). Hint Constructors step. @@ -796,15 +801,15 @@ Inductive subtype : ty -> ty -> Prop := U <: T -> S <: T | S_Top : forall S, - S <: TTop + S <: Top | S_Arrow : forall S1 S2 T1 T2, T1 <: S1 -> S2 <: T2 -> - (TArrow S1 S2) <: (TArrow T1 T2) + (Arrow S1 S2) <: (Arrow T1 T2) where "T '<:' U" := (subtype T U). -(** Note that we don't need any special rules for base types ([TBool] - and [TBase]): they are automatically subtypes of themselves (by +(** Note that we don't need any special rules for base types ([Bool] + and [Base]): they are automatically subtypes of themselves (by [S_Refl]) and [Top] (by [S_Top]), and that's all we want. *) Hint Constructors subtype. @@ -816,34 +821,33 @@ Notation x := "x". Notation y := "y". Notation z := "z". -Notation A := (TBase "A"). -Notation B := (TBase "B"). -Notation C := (TBase "C"). +Notation A := (Base "A"). +Notation B := (Base "B"). +Notation C := (Base "C"). -Notation String := (TBase "String"). -Notation Float := (TBase "Float"). -Notation Integer := (TBase "Integer"). +Notation String := (Base "String"). +Notation Float := (Base "Float"). +Notation Integer := (Base "Integer"). Example subtyping_example_0 : - (TArrow C TBool) <: (TArrow C TTop). + (Arrow C Bool) <: (Arrow C Top). (* C->Bool <: C->Top *) Proof. auto. Qed. -(** **** 练习:2 星, optional (subtyping_judgements) *) -(** (Wait to do this exercise until after you have added product types to - the language -- see exercise [products] -- at least up to this point - in the file). +(** **** 练习:2 星, standard, optional (subtyping_judgements) + + (Leave this exercise [Admitted] until after you have finished adding product + types to the language -- see exercise [products] -- at least up to + this point in the file). - Recall that, in chapter [MoreStlc], the optional section "Encoding - Records" describes how records can be encoded as pairs. + Recall that, in chapter [MoreStlc], the optional section + "Encoding Records" describes how records can be encoded as pairs. Using this encoding, define pair types representing the following record types: - Person := { name : String } - Student := { name : String ; - gpa : Float } - Employee := { name : String ; - ssn : Integer } + Person := { name : String } + Student := { name : String ; gpa : Float } + Employee := { name : String ; ssn : Integer } *) Definition Person : ty (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -869,17 +873,17 @@ Proof. full benefit from the exercises, make sure you also understand how to prove them on paper! *) -(** **** 练习:1 星, optional (subtyping_example_1) *) +(** **** 练习:1 星, standard, optional (subtyping_example_1) *) Example subtyping_example_1 : - (TArrow TTop Student) <: (TArrow (TArrow C C) Person). + (Arrow Top Student) <: (Arrow (Arrow C C) Person). (* Top->Student <: (C->C)->Person *) Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星, optional (subtyping_example_2) *) +(** **** 练习:1 星, standard, optional (subtyping_example_2) *) Example subtyping_example_2 : - (TArrow TTop Person) <: (TArrow Person TTop). + (Arrow Top Person) <: (Arrow Person Top). (* Top->Person <: Person->Top *) Proof with eauto. (* 请在此处解答 *) Admitted. @@ -901,25 +905,25 @@ 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 + Gamma |- var x \in T | T_Abs : forall Gamma x T11 T12 t12, - Gamma & {{x-->T11}} |- t12 \in T12 -> - Gamma |- tabs x T11 t12 \in TArrow T11 T12 + (x |-> T11 ; Gamma) |- t12 \in T12 -> + Gamma |- abs x T11 t12 \in Arrow T11 T12 | T_App : forall T1 T2 Gamma t1 t2, - Gamma |- t1 \in TArrow T1 T2 -> + Gamma |- t1 \in Arrow T1 T2 -> Gamma |- t2 \in T1 -> - Gamma |- tapp t1 t2 \in T2 + Gamma |- app t1 t2 \in T2 | T_True : forall Gamma, - Gamma |- ttrue \in TBool + Gamma |- tru \in Bool | T_False : forall Gamma, - Gamma |- tfalse \in TBool - | T_If : forall t1 t2 t3 T Gamma, - Gamma |- t1 \in TBool -> + Gamma |- fls \in Bool + | T_Test : forall t1 t2 t3 T Gamma, + Gamma |- t1 \in Bool -> Gamma |- t2 \in T -> Gamma |- t3 \in T -> - Gamma |- tif t1 t2 t3 \in T + Gamma |- test t1 t2 t3 \in T | T_Unit : forall Gamma, - Gamma |- tunit \in TUnit + Gamma |- unit \in Unit (* New rule of subsumption *) | T_Sub : forall Gamma t S T, Gamma |- t \in S -> @@ -931,9 +935,11 @@ where "Gamma '|-' t '\in' T" := (has_type Gamma t T). Hint Constructors has_type. (** The following hints help [auto] and [eauto] construct typing - derivations. (See chapter [UseAuto] for more on hints.) *) + derivations. They are only used in a few places, but they give + a nice illustration of what [auto] can do with a bit more + programming. See chapter [UseAuto] for more on hints. *) -Hint Extern 2 (has_type _ (tapp _ _) _) => +Hint Extern 2 (has_type _ (app _ _) _) => eapply T_App; auto. Hint Extern 2 (_ = _) => compute; reflexivity. @@ -944,24 +950,27 @@ Import Examples. the language. For each informal typing judgement, write it as a formal statement in Coq and prove it. *) -(** **** 练习:1 星, optional (typing_example_0) *) +(** **** 练习:1 星, standard, optional (typing_example_0) *) (* empty |- ((\z:A.z), (\z:B.z)) - : (A->A * B->B) *) -(* 请在此处解答 *) -(** [] *) + \in (A->A * B->B) *) +(* 请在此处解答 -(** **** 练习:2 星, optional (typing_example_1) *) + [] *) + +(** **** 练习:2 星, standard, optional (typing_example_1) *) (* empty |- (\x:(Top * B->B). x.snd) ((\z:A.z), (\z:B.z)) - : B->B *) -(* 请在此处解答 *) -(** [] *) + \in B->B *) +(* 请在此处解答 -(** **** 练习:2 星, optional (typing_example_2) *) + [] *) + +(** **** 练习:2 星, standard, 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 *) -(* 请在此处解答 *) -(** [] *) + \in B->B *) +(* 请在此处解答 + + [] *) End Examples2. @@ -992,24 +1001,24 @@ End Examples2. look like to tell us something further about the shapes of [S] and [T] and the existence of subtype relations between their parts. *) -(** **** 练习:2 星, optional (sub_inversion_Bool) *) +(** **** 练习:2 星, standard, optional (sub_inversion_Bool) *) Lemma sub_inversion_Bool : forall U, - U <: TBool -> - U = TBool. + U <: Bool -> + U = Bool. Proof with auto. intros U Hs. - remember TBool as V. + remember Bool as V. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (sub_inversion_arrow) *) +(** **** 练习:3 星, standard (sub_inversion_arrow) *) Lemma sub_inversion_arrow : forall U V1 V2, - U <: TArrow V1 V2 -> + U <: Arrow V1 V2 -> exists U1 U2, - U = TArrow U1 U2 /\ V1 <: U1 /\ U2 <: V2. + U = Arrow U1 U2 /\ V1 <: U1 /\ U2 <: V2. Proof with eauto. intros U V1 V2 Hs. - remember (TArrow V1 V2) as V. + remember (Arrow V1 V2) as V. generalize dependent V2. generalize dependent V1. (* 请在此处解答 *) Admitted. (** [] *) @@ -1033,7 +1042,7 @@ Proof with eauto. 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 + |- t1 \in 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]. @@ -1041,26 +1050,26 @@ Proof with eauto. tells us the possible "canonical forms" (i.e., values) of function type. *) -(** **** 练习:3 星, optional (canonical_forms_of_arrow_types) *) +(** **** 练习:3 星, standard, optional (canonical_forms_of_arrow_types) *) Lemma canonical_forms_of_arrow_types : forall Gamma s T1 T2, - Gamma |- s \in TArrow T1 T2 -> + Gamma |- s \in Arrow T1 T2 -> value s -> exists x S1 s2, - s = tabs x S1 s2. + s = abs x S1 s2. Proof with eauto. (* 请在此处解答 *) Admitted. (** [] *) (** Similarly, the canonical forms of type [Bool] are the constants - [true] and [false]. *) + [tru] and [fls]. *) Lemma canonical_forms_of_Bool : forall Gamma s, - Gamma |- s \in TBool -> + Gamma |- s \in Bool -> value s -> - s = ttrue \/ s = tfalse. + s = tru \/ s = fls. Proof with eauto. intros Gamma s Hty Hv. - remember TBool as T. + remember Bool as T. induction Hty; try solve_by_invert... - (* T_Sub *) subst. apply sub_inversion_Bool in H. subst... @@ -1074,51 +1083,51 @@ Qed. 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']. + t \in 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 + _Proof_: Let [t] and [T] be given, with [empty |- t \in 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 + immediate because abstractions, [unit], [tru], and [fls] 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 + [t = t1 t2], [T = T2], [empty |- t1 \in T1 -> T2], and [empty |- + t2 \in 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] + - 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 + - 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 the canonical forms lemma 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 + [(\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, + - If the final step of the derivation uses rule [T_Test], then there + are terms [t1], [t2], and [t3] such that [t = test t1 then t2 else + t3], with [empty |- t1 \in Bool] and with [empty |- t2 \in T] and + [empty |- t3 \in 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]. + booleans, either [t1 = tru] or [t1 = fls]. In either + case, [t] can step, using rule [ST_TestTrue] or [ST_TestFalse]. - - If [t1] can step, then so can [t], by rule [ST_If]. + - If [t1] can step, then so can [t], by rule [ST_Test]. - 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 + a type [S] such that [S <: T] and [empty |- t \in S]. The desired result is exactly the induction hypothesis for the typing subderivation. @@ -1126,7 +1135,7 @@ Qed. Theorem progress : forall t T, empty |- t \in T -> - value t \/ exists t', t ==> t'. + value t \/ exists t', t --> t'. Proof with eauto. intros t T Ht. remember empty as Gamma. @@ -1145,14 +1154,14 @@ Proof with eauto. as [x [S1 [t12 Heqt1]]]... subst. exists ([x:=t2]t12)... * (* t2 steps *) - inversion H0 as [t2' Hstp]. exists (tapp t1 t2')... + inversion H0 as [t2' Hstp]. exists (app t1 t2')... + (* t1 steps *) - inversion H as [t1' Hstp]. exists (tapp t1' t2)... - - (* T_If *) + inversion H as [t1' Hstp]. exists (app t1' t2)... + - (* T_Test *) right. destruct IHHt1. + (* t1 is a value *) eauto. - + assert (t1 = ttrue \/ t1 = tfalse) + + assert (t1 = tru \/ t1 = fls) by (eapply canonical_forms_of_Bool; eauto). inversion H0; subst... + inversion H. rename x into t1'. eauto. @@ -1171,43 +1180,43 @@ Qed. 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 + derivation of some typing statement [Gamma |- \x:S1.t2 \in 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]. +(** _Lemma_: If [Gamma |- \x:S1.t2 \in T], then there is a type [S2] + such that [x|->S1; Gamma |- t2 \in 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 + \x:S1.t2 \in 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 + there is a type [T12] such that [T = S1 -> T12] and [x:S1; + Gamma |- t2 \in 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]. + there is a type [S] such that [S <: T] and [Gamma |- \x:S1.t2 + \in S]. The IH for the typing subderivation tells us that there + is some type [S2] with [S1 -> S2 <: S] and [x:S1; Gamma |- t2 + \in S2]. Picking type [S2] gives us what we need, since [S1 -> + S2 <: T] then follows by [S_Trans]. Formally: *) Lemma typing_inversion_abs : forall Gamma x S1 t2 T, - Gamma |- (tabs x S1 t2) \in T -> + Gamma |- (abs x S1 t2) \in T -> exists S2, - TArrow S1 S2 <: T - /\ Gamma & {{x-->S1}} |- t2 \in S2. + Arrow S1 S2 <: T + /\ (x |-> S1 ; Gamma) |- t2 \in S2. Proof with eauto. intros Gamma x S1 t2 T H. - remember (tabs x S1 t2) as t. + remember (abs x S1 t2) as t. induction H; inversion Heqt; subst; intros; try solve_by_invert. - (* T_Abs *) @@ -1219,12 +1228,12 @@ Proof with eauto. (** Similarly... *) Lemma typing_inversion_var : forall Gamma x T, - Gamma |- (tvar x) \in T -> + Gamma |- (var x) \in T -> exists S, Gamma x = Some S /\ S <: T. Proof with eauto. intros Gamma x T Hty. - remember (tvar x) as t. + remember (var x) as t. induction Hty; intros; inversion Heqt; subst; try solve_by_invert. - (* T_Var *) @@ -1233,13 +1242,13 @@ Proof with eauto. destruct IHHty as [U [Hctx HsubU]]... Qed. Lemma typing_inversion_app : forall Gamma t1 t2 T2, - Gamma |- (tapp t1 t2) \in T2 -> + Gamma |- (app t1 t2) \in T2 -> exists T1, - Gamma |- t1 \in (TArrow T1 T2) /\ + Gamma |- t1 \in (Arrow T1 T2) /\ Gamma |- t2 \in T1. Proof with eauto. intros Gamma t1 t2 T2 Hty. - remember (tapp t1 t2) as t. + remember (app t1 t2) as t. induction Hty; intros; inversion Heqt; subst; try solve_by_invert. - (* T_App *) @@ -1249,44 +1258,44 @@ Proof with eauto. Qed. Lemma typing_inversion_true : forall Gamma T, - Gamma |- ttrue \in T -> - TBool <: T. + Gamma |- tru \in T -> + Bool <: T. Proof with eauto. - intros Gamma T Htyp. remember ttrue as tu. + intros Gamma T Htyp. remember tru as tu. induction Htyp; inversion Heqtu; subst; intros... Qed. Lemma typing_inversion_false : forall Gamma T, - Gamma |- tfalse \in T -> - TBool <: T. + Gamma |- fls \in T -> + Bool <: T. Proof with eauto. - intros Gamma T Htyp. remember tfalse as tu. + intros Gamma T Htyp. remember fls as tu. induction Htyp; 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 |- (test t1 t2 t3) \in T -> + Gamma |- t1 \in Bool /\ 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. + remember (test t1 t2 t3) as t. induction Hty; intros; inversion Heqt; subst; try solve_by_invert. - - (* T_If *) + - (* T_Test *) auto. - (* T_Sub *) destruct (IHHty H0) as [H1 [H2 H3]]... Qed. Lemma typing_inversion_unit : forall Gamma T, - Gamma |- tunit \in T -> - TUnit <: T. + Gamma |- unit \in T -> + Unit <: T. Proof with eauto. - intros Gamma T Htyp. remember tunit as tu. + intros Gamma T Htyp. remember unit as tu. induction Htyp; inversion Heqtu; subst; intros... Qed. @@ -1296,9 +1305,9 @@ Qed. 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) -> + empty |- (abs x S1 s2) \in (Arrow T1 T2) -> T1 <: S1 - /\ empty & {{x-->S1}} |- s2 \in T2. + /\ (x |-> S1 ; empty) |- s2 \in T2. Proof with eauto. intros x S1 s2 T1 T2 Hty. apply typing_inversion_abs in Hty. @@ -1315,24 +1324,24 @@ Proof with eauto. Inductive appears_free_in : string -> tm -> Prop := | afi_var : forall x, - appears_free_in x (tvar x) + appears_free_in x (var x) | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> appears_free_in x (tapp t1 t2) + appears_free_in x t1 -> appears_free_in x (app t1 t2) | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> appears_free_in x (tapp t1 t2) + appears_free_in x t2 -> appears_free_in x (app 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 (abs y T11 t12) + | afi_test1 : 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 (test t1 t2 t3) + | afi_test2 : 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 (test t1 t2 t3) + | afi_test3 : forall x t1 t2 t3, appears_free_in x t3 -> - appears_free_in x (tif t1 t2 t3) + appears_free_in x (test t1 t2 t3) . Hint Constructors appears_free_in. @@ -1350,8 +1359,8 @@ Proof with eauto. - (* T_Abs *) apply T_Abs... apply IHhas_type. intros x0 Hafi. unfold update, t_update. destruct (eqb_stringP x x0)... - - (* T_If *) - apply T_If... + - (* T_Test *) + apply T_Test... Qed. Lemma free_in_context : forall x t T Gamma, @@ -1379,14 +1388,14 @@ Proof with eauto. well-typedness of subterms. *) Lemma substitution_preserves_typing : forall Gamma x U v t S, - Gamma & {{x-->U}} |- t \in S -> + (x |-> U ; Gamma) |- 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. induction t; intros; simpl. - - (* tvar *) + - (* var *) rename s into y. destruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub]]. @@ -1399,15 +1408,15 @@ Proof with eauto. destruct (free_in_context _ _ S empty Hcontra) as [T' HT']... inversion HT'. - - (* tapp *) + - (* app *) destruct (typing_inversion_app _ _ _ _ Htypt) as [T1 [Htypt1 Htypt2]]. eapply T_App... - - (* tabs *) + - (* abs *) rename s 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... + apply T_Sub with (Arrow T1 T2)... apply T_Abs... destruct (eqb_stringP x y) as [Hxy|Hxy]. + (* x=y *) eapply context_invariance... @@ -1420,268 +1429,23 @@ Proof with eauto. destruct (eqb_stringP y z)... subst. rewrite <- eqb_string_false_iff in Hxy. rewrite Hxy... - - (* ttrue *) - assert (TBool <: S) + - (* tru *) + assert (Bool <: S) by apply (typing_inversion_true _ _ Htypt)... - - (* tfalse *) - assert (TBool <: S) + - (* fls *) + assert (Bool <: S) by apply (typing_inversion_false _ _ Htypt)... - - (* tif *) - assert (Gamma & {{x-->U}} |- t1 \in TBool - /\ Gamma & {{x-->U}} |- t2 \in S - /\ Gamma & {{x-->U}} |- t3 \in S) + - (* test *) + assert ((x |-> U ; Gamma) |- t1 \in Bool + /\ (x |-> U ; Gamma) |- t2 \in S + /\ (x |-> U ; Gamma) |- 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. - - (* tunit *) - assert (TUnit <: S) + - (* unit *) + assert (Unit <: 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'. - induction HT; - intros t' HeqGamma HE; subst; inversion HE; subst... - - (* T_App *) - inversion HE; subst... - + (* 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 omits 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. *) - -(* ================================================================= *) -(** ** Exercises *) - -(** **** 练习:2 星 (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 reduction rule: - - --------------------- (ST_Funny5) - (unit t) ==> (t unit) - - - - Suppose we add the same reduction 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 - - -*) - -(* 请勿修改下面这一行: *) -Definition manual_grade_for_variations : option (nat*string) := None. -(** [] *) - -(* ################################################################# *) -(** * Exercise: Adding Products *) - -(** **** 练习:4 星 (products) *) -(** Adding pairs, projections, and product types to the system we have - defined is a relatively straightforward matter. Carry out this - extension: - - - Below, we've added constructors for pairs, first and second - projections, and product types to the definitions of [ty] and - [tm]. - - - Copy the definitions of the substitution function and value - relation from above and extend them as in chapter - [MoreSTLC] to include products. - - - Similarly, copy and extend the operational semantics with the - same reduction rules as in chapter [MoreSTLC]. - - - (Copy and) 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 chapter [MoreSTLC]. - - - Extend the proofs of progress, preservation, and all their - supporting lemmas to deal with the new constructs. (You'll also - need to add a couple of completely new lemmas.) *) - -Module ProductExtension. - -Inductive ty : Type := - | TTop : ty - | TBool : ty - | TBase : string -> ty - | TArrow : ty -> ty -> ty - | TUnit : ty - | TProd : ty -> ty -> ty. - -Inductive tm : Type := - | tvar : string -> tm - | tapp : tm -> tm -> tm - | tabs : string -> ty -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm - | tunit : tm - | tpair : tm -> tm -> tm - | tfst : tm -> tm - | tsnd : tm -> tm. - -(** Copy and extend and/or fill in required definitions and lemmas - here. *) - -Theorem progress : forall t T, - empty |- t \in T -> - value t \/ exists t', t ==> t'. -Proof. - (* 请在此处解答 *) Admitted. -Theorem preservation : forall t t' T, - empty |- t \in T -> - t ==> t' -> - empty |- t' \in T. -Proof. - (* 请在此处解答 *) Admitted. - -End ProductExtension. -(* 请勿修改下面这一行: *) -Definition manual_grade_for_progress : option (nat*string) := None. -(* 请勿修改下面这一行: *) -Definition manual_grade_for_preservation : option (nat*string) := None. -(** [] *) - -(** $Date$ *) - +(* Sat Jan 26 15:15:44 UTC 2019 *) diff --git a/plf-current/SubTest.v b/plf-current/SubTest.v index 87a71da8..5efa2f06 100644 --- a/plf-current/SubTest.v +++ b/plf-current/SubTest.v @@ -127,39 +127,18 @@ idtac "#> sub_inversion_arrow". idtac "Possible points: 3". check_type @sub_inversion_arrow ( (forall U V1 V2 : ty, - U <: TArrow V1 V2 -> - exists U1 U2 : ty, U = TArrow U1 U2 /\ V1 <: U1 /\ U2 <: V2)). + U <: Arrow V1 V2 -> + exists U1 U2 : ty, U = Arrow U1 U2 /\ V1 <: U1 /\ U2 <: V2)). idtac "Assumptions:". Abort. Print Assumptions sub_inversion_arrow. Goal True. idtac " ". -idtac "------------------- variations --------------------". idtac " ". -idtac "#> Manually graded: variations". -idtac "Possible points: 2". -print_manual_grade manual_grade_for_variations. -idtac " ". - -idtac "------------------- products --------------------". -idtac " ". - -idtac "#> Manually graded: progress". -idtac "Possible points: 2". -print_manual_grade manual_grade_for_progress. -idtac " ". - -idtac "#> Manually graded: preservation". -idtac "Possible points: 2". -print_manual_grade manual_grade_for_preservation. -idtac " ". - -idtac " ". - -idtac "Max points - standard: 29". -idtac "Max points - advanced: 29". +idtac "Max points - standard: 23". +idtac "Max points - advanced: 23". idtac "". idtac "********** Summary **********". idtac "". @@ -188,12 +167,8 @@ idtac "---------- pair_permutation ---------". idtac "MANUAL". idtac "---------- sub_inversion_arrow ---------". Print Assumptions sub_inversion_arrow. -idtac "---------- variations ---------". -idtac "MANUAL". -idtac "---------- progress ---------". -idtac "MANUAL". -idtac "---------- preservation ---------". -idtac "MANUAL". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:20 UTC 2019 *) diff --git a/plf-current/Typechecking.html b/plf-current/Typechecking.html index fa96e212..4a118562 100644 --- a/plf-current/Typechecking.html +++ b/plf-current/Typechecking.html @@ -58,7 +58,7 @@

    TypecheckingA Typechecker for STLC Set Warnings "-notation-overridden,-parsing".
    -Require Import Coq.Bool.Bool.
    +From Coq Require Import Bool.Bool.
    From PLF Require Import Maps.
    From PLF Require Import Smallstep.
    From PLF Require Import Stlc.
    @@ -78,9 +78,9 @@

    TypecheckingA Typechecker for STLCFixpoint eqb_ty (T1 T2:ty) : bool :=
      match T1,T2 with
    -  | TBool, TBool
    +  | Bool, Bool
          true
    -  | TArrow T11 T12, TArrow T21 T22
    +  | Arrow T11 T12, Arrow T21 T22
          andb (eqb_ty T11 T21) (eqb_ty T12 T22)
      | _,_ ⇒
          false
    @@ -94,7 +94,7 @@

    TypecheckingA Typechecker for STLC
    -Lemma eqb_ty_refl : T1,
    +Lemma eqb_ty_refl : T1,
      eqb_ty T1 T1 = true.
    @@ -105,15 +105,15 @@

    TypecheckingA Typechecker for STLC
    -Lemma eqb_ty__eq : T1 T2,
    +Lemma eqb_ty__eq : T1 T2,
      eqb_ty T1 T2 = trueT1 = T2.
    Proof with auto.
      intros T1. induction T1; intros T2 Hbeq; destruct T2; inversion Hbeq.
    -  - (* T1=TBool *)
    +  - (* T1=Bool *)
        reflexivity.
    -  - (* T1=TArrow T1_1 T1_2 *)
    +  - (* T1=Arrow T1_1 T1_2 *)
        rewrite andb_true_iff in H0. inversion H0 as [Hbeq1 Hbeq2].
        apply IHT1_1 in Hbeq1. apply IHT1_2 in Hbeq2. subst... Qed.
    @@ -129,37 +129,37 @@

    TypecheckingA Typechecker for STLCSome T or None. Each time we make a recursive call to find out the types of the subterms, we need to pattern-match on the results to make sure that they are not - None. Also, in the tapp case, we use pattern matching to + None. Also, in the app case, we use pattern matching to extract the left- and right-hand sides of the function's arrow - type (and fail if the type of the function is not TArrow T11 T12 + type (and fail if the type of the function is not Arrow T11 T12 for some T11 and T12).

    Module FirstTry.
    Import STLCTypes.

    -Fixpoint type_check (Gamma:context) (t:tm) : option ty :=
    +Fixpoint type_check (Gamma : context) (t : tm) : option ty :=
      match t with
    -  | tvar x
    +  | var x
          Gamma x
    -  | tabs x T11 t12
    +  | abs x T11 t12
          match type_check (update Gamma x T11) t12 with
    -      | Some T12Some (TArrow T11 T12)
    +      | Some T12Some (Arrow T11 T12)
          | _None
          end
    -  | tapp t1 t2
    +  | app t1 t2
          match type_check Gamma t1, type_check Gamma t2 with
    -      | Some (TArrow T11 T12),Some T2
    +      | Some (Arrow T11 T12),Some T2
              if eqb_ty T11 T2 then Some T12 else None
          | _,_ ⇒ None
          end
    -  | ttrue
    -      Some TBool
    -  | tfalse
    -      Some TBool
    -  | tif guard t f
    +  | tru
    +      Some Bool
    +  | fls
    +      Some Bool
    +  | test guard t f
          match type_check Gamma guard with
    -      | Some TBool
    +      | Some Bool
              match type_check Gamma t, type_check Gamma f with
              | Some T1, Some T2
                  if eqb_ty T1 T2 then Some T1 else None
    @@ -184,12 +184,11 @@

    TypecheckingA Typechecker for STLC
    -Notation " x <- e1 ;; e2"
    -   := (match e1 with
    -         | Some xe2
    -         | NoneNone
    -       end)
    -   (right associativity, at level 60).
    +Notation " x <- e1 ;; e2" := (match e1 with
    +                              | Some xe2
    +                              | NoneNone
    +                              end)
    +         (right associativity, at level 60).
    @@ -208,38 +207,38 @@

    TypecheckingA Typechecker for STLC Now we can write the same type-checking function in a more - "imperative" style using these notations. + imperative-looking style using these notations.

    -Fixpoint type_check (Gamma:context) (t:tm) : option ty :=
    +Fixpoint type_check (Gamma : context) (t : tm) : option ty :=
      match t with
    -  | tvar x
    +  | var x
          match Gamma x with
          | Some Treturn T
          | Nonefail
          end
    -  | tabs x T11 t12
    +  | abs x T11 t12
          T12 <- type_check (update Gamma x T11) t12 ;;
    -      return (TArrow T11 T12)
    -  | tapp t1 t2
    +      return (Arrow T11 T12)
    +  | app t1 t2
          T1 <- type_check Gamma t1 ;;
          T2 <- type_check Gamma t2 ;;
          match T1 with
    -      | TArrow T11 T12
    +      | Arrow T11 T12
              if eqb_ty T11 T2 then return T12 else fail
          | _fail
          end
    -  | ttrue
    -      return TBool
    -  | tfalse
    -      return TBool
    -  | tif guard t1 t2
    +  | tru
    +      return Bool
    +  | fls
    +      return Bool
    +  | test guard t1 t2
          Tguard <- type_check Gamma guard ;;
          T1 <- type_check Gamma t1 ;;
          T2 <- type_check Gamma t2 ;;
          match Tguard with
    -      | TBool
    +      | Bool
              if eqb_ty T1 T2 then return T1 else fail
          | _fail
          end
    @@ -251,23 +250,23 @@

    TypecheckingA Typechecker for STLC

    - To verify that th typechecking algorithm is correct, we show that + To verify that the typechecking algorithm is correct, we show that it is _sound_ and _complete_ for the original has_type relation — that is, type_check and has_type define the same partial function.

    -Theorem type_checking_sound : Gamma t T,
    +Theorem type_checking_sound : Gamma t T,
      type_check Gamma t = Some Thas_type Gamma t T.
    Proof with eauto.
      intros Gamma t. generalize dependent Gamma.
      induction t; intros Gamma T Htc; inversion Htc.
    -  - (* tvar *) rename s into x. destruct (Gamma x) eqn:H.
    +  - (* var *) rename s into x. destruct (Gamma x) eqn:H.
        rename t into T'. inversion H0. subst. eauto. solve_by_invert.
    -  - (* tapp *)
    +  - (* app *)
        remember (type_check Gamma t1) as TO1.
        destruct TO1 as [T1|]; try solve_by_invert;
        destruct T1 as [|T11 T12]; try solve_by_invert;
    @@ -277,15 +276,15 @@

    TypecheckingA Typechecker for STLCapply eqb_ty__eq in Heqb.
        inversion H0; subst...
        inversion H0.
    -  - (* tabs *)
    +  - (* abs *)
        rename s into x. rename t into T1.
        remember (update Gamma x T1) as G'.
        remember (type_check G' t0) as TO2.
        destruct TO2; try solve_by_invert.
        inversion H0; subst...
    -  - (* ttrue *) eauto.
    -  - (* tfalse *) eauto.
    -  - (* tif *)
    +  - (* tru *) eauto.
    +  - (* fls *) eauto.
    +  - (* test *)
        remember (type_check Gamma t1) as TOc.
        remember (type_check Gamma t2) as TO1.
        remember (type_check Gamma t3) as TO2.
    @@ -301,7 +300,7 @@

    TypecheckingA Typechecker for STLC
    -Theorem type_checking_complete : Gamma t T,
    +Theorem type_checking_complete : Gamma t T,
      has_type Gamma t Ttype_check Gamma t = Some T.
    @@ -329,7 +328,7 @@

    TypecheckingA Typechecker for STLC

    -

    练习:5 星 (typechecker_extensions)

    +

    练习:5 星, standard (typechecker_extensions)

    In this exercise we'll extend the typechecker to deal with the extended features discussed in chapter MoreStlc. Your job is to fill in the omitted cases in the following. @@ -343,24 +342,24 @@

    TypecheckingA Typechecker for STLCDefinition manual_grade_for_type_checking_complete : option (nat*string) := None.
    Import MoreStlc.
    Import STLCExtended.

    -Fixpoint eqb_ty (T1 T2: ty) : bool :=
    +Fixpoint eqb_ty (T1 T2 : ty) : bool :=
      match T1,T2 with
    -  | TNat, TNat
    +  | Nat, Nat
          true
    -  | TUnit, TUnit
    +  | Unit, Unit
          true
    -  | TArrow T11 T12, TArrow T21 T22
    +  | Arrow T11 T12, Arrow T21 T22
          andb (eqb_ty T11 T21) (eqb_ty T12 T22)
    -  | TProd T11 T12, TProd T21 T22
    +  | Prod T11 T12, Prod T21 T22
          andb (eqb_ty T11 T21) (eqb_ty T12 T22)
    -  | TSum T11 T12, TSum T21 T22
    +  | Sum T11 T12, Sum T21 T22
          andb (eqb_ty T11 T21) (eqb_ty T12 T22)
    -  | TList T11, TList T21
    +  | List T11, List T21
          eqb_ty T11 T21
      | _,_ ⇒
          false
      end.

    -Lemma eqb_ty_refl : T1,
    +Lemma eqb_ty_refl : T1,
      eqb_ty T1 T1 = true.
    Proof.
      intros T1.
    @@ -368,7 +367,7 @@

    TypecheckingA Typechecker for STLCtry reflexivity;
        try (rewrite IHT1_1; rewrite IHT1_2; reflexivity);
        try (rewrite IHT1; reflexivity). Qed.

    -Lemma eqb_ty__eq : T1 T2,
    +Lemma eqb_ty__eq : T1 T2,
      eqb_ty T1 T2 = trueT1 = T2.
    Proof.
      intros T1.
    @@ -378,67 +377,80 @@

    TypecheckingA Typechecker for STLCapply IHT1_1 in Hbeq1; apply IHT1_2 in Hbeq2; subst; auto);
        try (apply IHT1 in Hbeq; subst; auto).
     Qed.

    -Fixpoint type_check (Gamma:context) (t:tm) : option ty :=
    +Fixpoint type_check (Gamma : context) (t : tm) : option ty :=
      match t with
    -  | tvar x
    +  | var x
          match Gamma x with
          | Some Treturn T
          | Nonefail
          end
    -  | tabs x T11 t12
    -      T12 <- type_check (update Gamma x T11) t12 ;;
    -      return (TArrow T11 T12)
    -  | tapp t1 t2
    +  | abs x1 T1 t2
    +      T2 <- type_check (update Gamma x1 T1) t2 ;;
    +      return (Arrow T1 T2)
    +  | app t1 t2
          T1 <- type_check Gamma t1 ;;
          T2 <- type_check Gamma t2 ;;
          match T1 with
    -      | TArrow T11 T12
    +      | Arrow T11 T12
              if eqb_ty T11 T2 then return T12 else fail
          | _fail
          end
    -  | tnat _
    -      return TNat
    -  | tsucc t1
    +  | const _
    +      return Nat
    +  | scc t1
          T1 <- type_check Gamma t1 ;;
          match T1 with
    -      | TNatreturn TNat
    +      | Natreturn Nat
          | _fail
          end
    -  | tpred t1
    +  | prd t1
          T1 <- type_check Gamma t1 ;;
          match T1 with
    -      | TNatreturn TNat
    +      | Natreturn Nat
          | _fail
          end
    -  | tmult t1 t2
    +  | mlt t1 t2
          T1 <- type_check Gamma t1 ;;
          T2 <- type_check Gamma t2 ;;
          match T1, T2 with
    -      | TNat, TNatreturn TNat
    +      | Nat, Natreturn Nat
          | _,_ ⇒ fail
          end
    -  | tif0 guard t f
    +  | test0 guard t f
          Tguard <- type_check Gamma guard ;;
          T1 <- type_check Gamma t ;;
          T2 <- type_check Gamma f ;;
          match Tguard with
    -      | TNatif eqb_ty T1 T2 then return T1 else fail
    +      | Natif eqb_ty T1 T2 then return T1 else fail
          | _fail
          end
    +
    +  (* Complete the following cases. *)
    +  
    +  (* sums *)
    +  (* 请在此处解答 *)
    +  (* lists (the tlcase is given for free) *)
      (* 请在此处解答 *)
      | tlcase t0 t1 x21 x22 t2
          match type_check Gamma t0 with
    -      | Some (TList T) ⇒
    +      | Some (List T) ⇒
              match type_check Gamma t1,
    -                type_check (update (update Gamma x22 (TList T)) x21 T) t2 with
    +                type_check (update (update Gamma x22 (List T)) x21 T) t2 with
              | Some T1', Some T2'
                  if eqb_ty T1' T2' then Some T1' else None
              | _,_ ⇒ None
              end
          | _None
          end
    +  (* unit *)
    +  (* 请在此处解答 *)
    +  (* pairs *)
    +  (* 请在此处解答 *)
    +  (* let *)
    +  (* 请在此处解答 *)
    +  (* fix *)
      (* 请在此处解答 *)
    -  | _None (* ... and delete this line *)
    +  | _None (* ... and delete this line when you complete the exercise. *)
      end.

    @@ -453,45 +465,45 @@

    TypecheckingA Typechecker for STLCdestruct TO as [T|];
      try solve_by_invert; try (inversion H0; eauto); try (subst; eauto).

    Ltac analyze T T1 T2 :=
    -  destruct T as [T1 T2| | | T1 T2| T1 T2| T1]; try solve_by_invert.

    +  destruct T as [T1 T2| |T1 T2|T1| |T1 T2]; try solve_by_invert.

    Ltac fully_invert_typecheck Gamma t T T1 T2 :=
      let TX := fresh T in
      remember (type_check Gamma t) as TO;
      destruct TO as [TX|]; try solve_by_invert;
    -  destruct TX as [T1 T2| | | T1 T2| T1 T2| T1];
    +  destruct TX as [T1 T2| |T1 T2|T1| |T1 T2];
      try solve_by_invert; try (inversion H0; eauto); try (subst; eauto).

    Ltac case_equality S T :=
      destruct (eqb_ty S T) eqn: Heqb;
      inversion H0; apply eqb_ty__eq in Heqb; subst; subst; eauto.

    -Theorem type_checking_sound : Gamma t T,
    +Theorem type_checking_sound : Gamma t T,
      type_check Gamma t = Some Thas_type Gamma t T.
    Proof with eauto.
      intros Gamma t. generalize dependent Gamma.
      induction t; intros Gamma T Htc; inversion Htc.
    -  - (* tvar *) rename s into x. destruct (Gamma x) eqn:H.
    +  - (* var *) rename s into x. destruct (Gamma x) eqn:H.
        rename t into T'. inversion H0. subst. eauto. solve_by_invert.
    -  - (* tapp *)
    +  - (* app *)
        invert_typecheck Gamma t1 T1.
        invert_typecheck Gamma t2 T2.
        analyze T1 T11 T12.
        case_equality T11 T2.
    -  - (* tabs *)
    +  - (* abs *)
        rename s into x. rename t into T1.
        remember (update Gamma x T1) as Gamma'.
        invert_typecheck Gamma' t0 T0.
    -  - (* tnat *) eauto.
    -  - (* tsucc *)
    +  - (* const *) eauto.
    +  - (* scc *)
        rename t into t1.
        fully_invert_typecheck Gamma t1 T1 T11 T12.
    -  - (* tpred *)
    +  - (* prd *)
        rename t into t1.
        fully_invert_typecheck Gamma t1 T1 T11 T12.
    -  - (* tmult *)
    +  - (* mlt *)
        invert_typecheck Gamma t1 T1.
        invert_typecheck Gamma t2 T2.
        analyze T1 T11 T12; analyze T2 T21 T22.
        inversion H0. subst. eauto.
    -  - (* tif0 *)
    +  - (* test0 *)
        invert_typecheck Gamma t1 T1.
        invert_typecheck Gamma t2 T2.
        invert_typecheck Gamma t3 T3.
    @@ -502,12 +514,12 @@

    TypecheckingA Typechecker for STLCrename s into x31. rename s0 into x32.
        fully_invert_typecheck Gamma t1 T1 T11 T12.
        invert_typecheck Gamma t2 T2.
    -    remember (update (update Gamma x32 (TList T11)) x31 T11) as Gamma'2.
    +    remember (update (update Gamma x32 (List T11)) x31 T11) as Gamma'2.
        invert_typecheck Gamma'2 t3 T3.
        case_equality T2 T3.
      (* 请在此处解答 *)
    Qed.

    -Theorem type_checking_complete : Gamma t T,
    +Theorem type_checking_complete : Gamma t T,
      has_type Gamma t Ttype_check Gamma t = Some T.
    Proof.
      intros Gamma t T Hty.
    @@ -532,7 +544,7 @@

    TypecheckingA Typechecker for STLC
    -

    练习:5 星, optional (stlc_step_function)

    +

    练习:5 星, standard, optional (stlc_step_function)

    Above, we showed how to write a typechecking function and prove it sound and complete for the typing relation. Do the same for the operational semantics — i.e., write a function stepf of type @@ -542,8 +554,19 @@

    TypecheckingA Typechecker for STLC Module StepFunction.
    -Import TypecheckerExtensions.

    -(* 请在此处解答 *)
    +Import MoreStlc.
    +Import STLCExtended.

    +(* Operational semantics as a Coq function. *)
    +Fixpoint stepf (t : tm) : option tm
    +  (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    +(* Soundness of stepf. *)
    +Theorem sound_stepf : t t',
    +    stepf t = Some t't --> t'.
    +Proof. (* 请在此处解答 *) Admitted.

    +(* Completeness of stepf. *)
    +Theorem complete_stepf : t t',
    +    t --> t'stepf t = Some t'.
    +Proof. (* 请在此处解答 *) Admitted.

    End StepFunction.

    @@ -551,10 +574,10 @@

    TypecheckingA Typechecker for STLC
    -

    练习:5 星, optional (stlc_impl)

    +

    练习:5 星, standard, optional (stlc_impl)

    Using the Imp parser described in the ImpParser chapter of _Logical Foundations_ as a guide, build a parser for extended - Stlc programs. Combine it with the typechecking and stepping + STLC programs. Combine it with the typechecking and stepping functions from the above exercises to yield a complete typechecker and interpreter for this language.

    @@ -567,10 +590,9 @@

    TypecheckingA Typechecker for STLC -
    -
    +
    - +(* Sat Jan 26 15:15:45 UTC 2019 *)
    diff --git a/plf-current/Typechecking.v b/plf-current/Typechecking.v index 92c23bd1..81c60134 100644 --- a/plf-current/Typechecking.v +++ b/plf-current/Typechecking.v @@ -17,7 +17,7 @@ correct. *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Bool.Bool. +From Coq Require Import Bool.Bool. From PLF Require Import Maps. From PLF Require Import Smallstep. From PLF Require Import Stlc. @@ -33,9 +33,9 @@ Export STLC. Fixpoint eqb_ty (T1 T2:ty) : bool := match T1,T2 with - | TBool, TBool => + | Bool, Bool => true - | TArrow T11 T12, TArrow T21 T22 => + | Arrow T11 T12, Arrow T21 T22 => andb (eqb_ty T11 T21) (eqb_ty T12 T22) | _,_ => false @@ -56,9 +56,9 @@ Lemma eqb_ty__eq : forall T1 T2, eqb_ty T1 T2 = true -> T1 = T2. Proof with auto. intros T1. induction T1; intros T2 Hbeq; destruct T2; inversion Hbeq. - - (* T1=TBool *) + - (* T1=Bool *) reflexivity. - - (* T1=TArrow T1_1 T1_2 *) + - (* T1=Arrow T1_1 T1_2 *) rewrite andb_true_iff in H0. inversion H0 as [Hbeq1 Hbeq2]. apply IHT1_1 in Hbeq1. apply IHT1_2 in Hbeq2. subst... Qed. End STLCTypes. @@ -70,36 +70,36 @@ End STLCTypes. term, returning either [Some T] or [None]. Each time we make a recursive call to find out the types of the subterms, we need to pattern-match on the results to make sure that they are not - [None]. Also, in the [tapp] case, we use pattern matching to + [None]. Also, in the [app] case, we use pattern matching to extract the left- and right-hand sides of the function's arrow - type (and fail if the type of the function is not [TArrow T11 T12] + type (and fail if the type of the function is not [Arrow T11 T12] for some [T11] and [T12]). *) Module FirstTry. Import STLCTypes. -Fixpoint type_check (Gamma:context) (t:tm) : option ty := +Fixpoint type_check (Gamma : context) (t : tm) : option ty := match t with - | tvar x => + | var x => Gamma x - | tabs x T11 t12 => + | abs x T11 t12 => match type_check (update Gamma x T11) t12 with - | Some T12 => Some (TArrow T11 T12) + | Some T12 => Some (Arrow T11 T12) | _ => None end - | tapp t1 t2 => + | app t1 t2 => match type_check Gamma t1, type_check Gamma t2 with - | Some (TArrow T11 T12),Some T2 => + | Some (Arrow T11 T12),Some T2 => if eqb_ty T11 T2 then Some T12 else None | _,_ => None end - | ttrue => - Some TBool - | tfalse => - Some TBool - | tif guard t f => + | tru => + Some Bool + | fls => + Some Bool + | test guard t f => match type_check Gamma guard with - | Some TBool => + | Some Bool => match type_check Gamma t, type_check Gamma f with | Some T1, Some T2 => if eqb_ty T1 T2 then Some T1 else None @@ -120,12 +120,11 @@ End FirstTry. define a notation for composing two potentially failing (i.e., option-returning) computations: *) -Notation " x <- e1 ;; e2" - := (match e1 with - | Some x => e2 - | None => None - end) - (right associativity, at level 60). +Notation " x <- e1 ;; e2" := (match e1 with + | Some x => e2 + | None => None + end) + (right associativity, at level 60). (** Second, we define [return] and [fail] as synonyms for [Some] and [None]: *) @@ -140,36 +139,36 @@ Module STLCChecker. Import STLCTypes. (** Now we can write the same type-checking function in a more - "imperative" style using these notations. *) + imperative-looking style using these notations. *) -Fixpoint type_check (Gamma:context) (t:tm) : option ty := +Fixpoint type_check (Gamma : context) (t : tm) : option ty := match t with - | tvar x => + | var x => match Gamma x with | Some T => return T | None => fail end - | tabs x T11 t12 => + | abs x T11 t12 => T12 <- type_check (update Gamma x T11) t12 ;; - return (TArrow T11 T12) - | tapp t1 t2 => + return (Arrow T11 T12) + | app t1 t2 => T1 <- type_check Gamma t1 ;; T2 <- type_check Gamma t2 ;; match T1 with - | TArrow T11 T12 => + | Arrow T11 T12 => if eqb_ty T11 T2 then return T12 else fail | _ => fail end - | ttrue => - return TBool - | tfalse => - return TBool - | tif guard t1 t2 => + | tru => + return Bool + | fls => + return Bool + | test guard t1 t2 => Tguard <- type_check Gamma guard ;; T1 <- type_check Gamma t1 ;; T2 <- type_check Gamma t2 ;; match Tguard with - | TBool => + | Bool => if eqb_ty T1 T2 then return T1 else fail | _ => fail end @@ -178,7 +177,7 @@ Fixpoint type_check (Gamma:context) (t:tm) : option ty := (* ################################################################# *) (** * Properties *) -(** To verify that th typechecking algorithm is correct, we show that +(** To verify that the typechecking algorithm is correct, we show that it is _sound_ and _complete_ for the original [has_type] relation -- that is, [type_check] and [has_type] define the same partial function. *) @@ -188,9 +187,9 @@ Theorem type_checking_sound : forall Gamma t T, Proof with eauto. intros Gamma t. generalize dependent Gamma. induction t; intros Gamma T Htc; inversion Htc. - - (* tvar *) rename s into x. destruct (Gamma x) eqn:H. + - (* var *) rename s into x. destruct (Gamma x) eqn:H. rename t into T'. inversion H0. subst. eauto. solve_by_invert. - - (* tapp *) + - (* app *) remember (type_check Gamma t1) as TO1. destruct TO1 as [T1|]; try solve_by_invert; destruct T1 as [|T11 T12]; try solve_by_invert; @@ -200,15 +199,15 @@ Proof with eauto. apply eqb_ty__eq in Heqb. inversion H0; subst... inversion H0. - - (* tabs *) + - (* abs *) rename s into x. rename t into T1. remember (update Gamma x T1) as G'. remember (type_check G' t0) as TO2. destruct TO2; try solve_by_invert. inversion H0; subst... - - (* ttrue *) eauto. - - (* tfalse *) eauto. - - (* tif *) + - (* tru *) eauto. + - (* fls *) eauto. + - (* test *) remember (type_check Gamma t1) as TOc. remember (type_check Gamma t2) as TO1. remember (type_check Gamma t3) as TO2. @@ -243,8 +242,9 @@ End STLCChecker. (* ################################################################# *) (** * Exercises *) -(** **** 练习:5 星 (typechecker_extensions) *) -(** In this exercise we'll extend the typechecker to deal with the +(** **** 练习:5 星, standard (typechecker_extensions) + + In this exercise we'll extend the typechecker to deal with the extended features discussed in chapter [MoreStlc]. Your job is to fill in the omitted cases in the following. *) @@ -255,20 +255,20 @@ Definition manual_grade_for_type_checking_sound : option (nat*string) := None. Definition manual_grade_for_type_checking_complete : option (nat*string) := None. Import MoreStlc. Import STLCExtended. - -Fixpoint eqb_ty (T1 T2: ty) : bool := + +Fixpoint eqb_ty (T1 T2 : ty) : bool := match T1,T2 with - | TNat, TNat => + | Nat, Nat => true - | TUnit, TUnit => + | Unit, Unit => true - | TArrow T11 T12, TArrow T21 T22 => + | Arrow T11 T12, Arrow T21 T22 => andb (eqb_ty T11 T21) (eqb_ty T12 T22) - | TProd T11 T12, TProd T21 T22 => + | Prod T11 T12, Prod T21 T22 => andb (eqb_ty T11 T21) (eqb_ty T12 T22) - | TSum T11 T12, TSum T21 T22 => + | Sum T11 T12, Sum T21 T22 => andb (eqb_ty T11 T21) (eqb_ty T12 T22) - | TList T11, TList T21 => + | List T11, List T21 => eqb_ty T11 T21 | _,_ => false @@ -294,67 +294,80 @@ Proof. try (apply IHT1 in Hbeq; subst; auto). Qed. -Fixpoint type_check (Gamma:context) (t:tm) : option ty := +Fixpoint type_check (Gamma : context) (t : tm) : option ty := match t with - | tvar x => + | var x => match Gamma x with | Some T => return T | None => fail end - | tabs x T11 t12 => - T12 <- type_check (update Gamma x T11) t12 ;; - return (TArrow T11 T12) - | tapp t1 t2 => + | abs x1 T1 t2 => + T2 <- type_check (update Gamma x1 T1) t2 ;; + return (Arrow T1 T2) + | app t1 t2 => T1 <- type_check Gamma t1 ;; T2 <- type_check Gamma t2 ;; match T1 with - | TArrow T11 T12 => + | Arrow T11 T12 => if eqb_ty T11 T2 then return T12 else fail | _ => fail end - | tnat _ => - return TNat - | tsucc t1 => + | const _ => + return Nat + | scc t1 => T1 <- type_check Gamma t1 ;; match T1 with - | TNat => return TNat + | Nat => return Nat | _ => fail end - | tpred t1 => + | prd t1 => T1 <- type_check Gamma t1 ;; match T1 with - | TNat => return TNat + | Nat => return Nat | _ => fail end - | tmult t1 t2 => + | mlt t1 t2 => T1 <- type_check Gamma t1 ;; T2 <- type_check Gamma t2 ;; match T1, T2 with - | TNat, TNat => return TNat + | Nat, Nat => return Nat | _,_ => fail end - | tif0 guard t f => + | test0 guard t f => Tguard <- type_check Gamma guard ;; T1 <- type_check Gamma t ;; T2 <- type_check Gamma f ;; match Tguard with - | TNat => if eqb_ty T1 T2 then return T1 else fail + | Nat => if eqb_ty T1 T2 then return T1 else fail | _ => fail end + + (* Complete the following cases. *) + + (* sums *) + (* 请在此处解答 *) + (* lists (the [tlcase] is given for free) *) (* 请在此处解答 *) | tlcase t0 t1 x21 x22 t2 => match type_check Gamma t0 with - | Some (TList T) => + | Some (List T) => match type_check Gamma t1, - type_check (update (update Gamma x22 (TList T)) x21 T) t2 with + type_check (update (update Gamma x22 (List T)) x21 T) t2 with | Some T1', Some T2' => if eqb_ty T1' T2' then Some T1' else None | _,_ => None end | _ => None end + (* unit *) + (* 请在此处解答 *) + (* pairs *) + (* 请在此处解答 *) + (* let *) (* 请在此处解答 *) - | _ => None (* ... and delete this line *) + (* fix *) + (* 请在此处解答 *) + | _ => None (* ... and delete this line when you complete the exercise. *) end. (** Just for fun, we'll do the soundness proof with just a bit more @@ -366,13 +379,13 @@ Ltac invert_typecheck Gamma t T := try solve_by_invert; try (inversion H0; eauto); try (subst; eauto). Ltac analyze T T1 T2 := - destruct T as [T1 T2| | | T1 T2| T1 T2| T1]; try solve_by_invert. + destruct T as [T1 T2| |T1 T2|T1| |T1 T2]; try solve_by_invert. Ltac fully_invert_typecheck Gamma t T T1 T2 := let TX := fresh T in remember (type_check Gamma t) as TO; destruct TO as [TX|]; try solve_by_invert; - destruct TX as [T1 T2| | | T1 T2| T1 T2| T1]; + destruct TX as [T1 T2| |T1 T2|T1| |T1 T2]; try solve_by_invert; try (inversion H0; eauto); try (subst; eauto). Ltac case_equality S T := @@ -384,30 +397,30 @@ Theorem type_checking_sound : forall Gamma t T, Proof with eauto. intros Gamma t. generalize dependent Gamma. induction t; intros Gamma T Htc; inversion Htc. - - (* tvar *) rename s into x. destruct (Gamma x) eqn:H. + - (* var *) rename s into x. destruct (Gamma x) eqn:H. rename t into T'. inversion H0. subst. eauto. solve_by_invert. - - (* tapp *) + - (* app *) invert_typecheck Gamma t1 T1. invert_typecheck Gamma t2 T2. analyze T1 T11 T12. case_equality T11 T2. - - (* tabs *) + - (* abs *) rename s into x. rename t into T1. remember (update Gamma x T1) as Gamma'. invert_typecheck Gamma' t0 T0. - - (* tnat *) eauto. - - (* tsucc *) + - (* const *) eauto. + - (* scc *) rename t into t1. fully_invert_typecheck Gamma t1 T1 T11 T12. - - (* tpred *) + - (* prd *) rename t into t1. fully_invert_typecheck Gamma t1 T1 T11 T12. - - (* tmult *) + - (* mlt *) invert_typecheck Gamma t1 T1. invert_typecheck Gamma t2 T2. analyze T1 T11 T12; analyze T2 T21 T22. inversion H0. subst. eauto. - - (* tif0 *) + - (* test0 *) invert_typecheck Gamma t1 T1. invert_typecheck Gamma t2 T2. invert_typecheck Gamma t3 T3. @@ -418,7 +431,7 @@ Proof with eauto. rename s into x31. rename s0 into x32. fully_invert_typecheck Gamma t1 T1 T11 T12. invert_typecheck Gamma t2 T2. - remember (update (update Gamma x32 (TList T11)) x31 T11) as Gamma'2. + remember (update (update Gamma x32 (List T11)) x31 T11) as Gamma'2. invert_typecheck Gamma'2 t3 T3. case_equality T2 T3. (* 请在此处解答 *) @@ -445,24 +458,40 @@ Qed. (* ... and uncomment this one *) End TypecheckerExtensions. (** [] *) -(** **** 练习:5 星, optional (stlc_step_function) *) -(** Above, we showed how to write a typechecking function and prove it +(** **** 练习:5 星, standard, optional (stlc_step_function) + + Above, we showed how to write a typechecking function and prove it sound and complete for the typing relation. Do the same for the operational semantics -- i.e., write a function [stepf] of type [tm -> option tm] and prove that it is sound and complete with respect to [step] from chapter [MoreStlc]. *) Module StepFunction. -Import TypecheckerExtensions. +Import MoreStlc. +Import STLCExtended. + +(* Operational semantics as a Coq function. *) +Fixpoint stepf (t : tm) : option tm + (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. + +(* Soundness of [stepf]. *) +Theorem sound_stepf : forall t t', + stepf t = Some t' -> t --> t'. +Proof. (* 请在此处解答 *) Admitted. + +(* Completeness of [stepf]. *) +Theorem complete_stepf : forall t t', + t --> t' -> stepf t = Some t'. +Proof. (* 请在此处解答 *) Admitted. -(* 请在此处解答 *) End StepFunction. (** [] *) -(** **** 练习:5 星, optional (stlc_impl) *) -(** Using the Imp parser described in the [ImpParser] chapter +(** **** 练习:5 星, standard, optional (stlc_impl) + + Using the Imp parser described in the [ImpParser] chapter of _Logical Foundations_ as a guide, build a parser for extended - Stlc programs. Combine it with the typechecking and stepping + STLC programs. Combine it with the typechecking and stepping functions from the above exercises to yield a complete typechecker and interpreter for this language. *) @@ -473,4 +502,4 @@ Import StepFunction. End StlcImpl. (** [] *) -(** $Date$ *) +(* Sat Jan 26 15:15:45 UTC 2019 *) diff --git a/plf-current/TypecheckingTest.v b/plf-current/TypecheckingTest.v index 055737f2..fd001a35 100644 --- a/plf-current/TypecheckingTest.v +++ b/plf-current/TypecheckingTest.v @@ -60,3 +60,5 @@ idtac "MANUAL". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:25 UTC 2019 *) diff --git a/plf-current/Types.html b/plf-current/Types.html index 4b424906..c36c7d43 100644 --- a/plf-current/Types.html +++ b/plf-current/Types.html @@ -45,7 +45,7 @@

    Types类型系统

    Set Warnings "-notation-overridden,-parsing".
    -Require Import Coq.Arith.Arith.
    +From Coq Require Import Arith.Arith.
    From PLF Require Import Maps.
    From PLF Require Import Imp.
    From PLF Require Import Smallstep.

    @@ -53,12 +53,12 @@

    Types类型系统

    -

    有类型算数表达式

    +

    有类型算数表达式

    作为对类型系统讨论的动机,让我们像过去一样以一个小型玩具语言开始。 - 我们想要让程序有机会产生运行时类型错误,因此除了 Smallstep + 我们想要让程序有机会产生运行时类型错误,因此除了 Smallstep 一章中用到的常量和加法,还需要一点更复杂的语言构造:只有一种数据类型(比如说数字) 太过于简单,但是两种(数字和布尔值)便足够产生有趣的故事了。 @@ -68,7 +68,7 @@

    Types类型系统

    -

    语法

    +

    语法

    @@ -77,13 +77,13 @@

    Types类型系统

    -    t ::= true
    -        | false
    -        | if t then t else t
    -        | 0
    -        | succ t
    -        | pred t
    -        | iszero t +    t ::= tru
    +        | fls
    +        | test t then t else t
    +        | zro
    +        | scc t
    +        | prd t
    +        | iszro t
    @@ -92,34 +92,34 @@

    Types类型系统

    Inductive tm : Type :=
    -  | ttrue : tm
    -  | tfalse : tm
    -  | tif : tmtmtmtm
    -  | tzero : tm
    -  | tsucc : tmtm
    -  | tpred : tmtm
    -  | tiszero : tmtm.
    +  | tru : tm
    +  | fls : tm
    +  | test : tmtmtmtm
    +  | zro : tm
    +  | scc : tmtm
    +  | prd : tmtm
    +  | iszro : tmtm.
    -对值(values)的定义包括 truefalse 以及数值…… +对值(values)的定义包括 trufls 以及数值……
    Inductive bvalue : tmProp :=
    -  | bv_true : bvalue ttrue
    -  | bv_false : bvalue tfalse.

    +  | bv_tru : bvalue tru
    +  | bv_fls : bvalue fls.

    Inductive nvalue : tmProp :=
    -  | nv_zero : nvalue tzero
    -  | nv_succ : t, nvalue tnvalue (tsucc t).

    -Definition value (t:tm) := bvalue tnvalue t.

    +  | nv_zro : nvalue zro
    +  | nv_scc : t, nvalue tnvalue (scc t).

    +Definition value (t : tm) := bvalue tnvalue t.

    Hint Constructors bvalue nvalue.
    Hint Unfold value.
    Hint Unfold update.
    -

    操作语义

    +

    操作语义

    @@ -130,130 +130,130 @@

    Types类型系统

       - (ST_IfTrue)   + (ST_TestTru)  
    - if true then t1 else t2 ==> t1 + test tru then t1 else t2 --> t1
    - +
       - (ST_IfFalse)   + (ST_TestFls)  

    if false then t1 else t2 ==> t2test fls then t1 else t2 --> t2
    - + - +
    t1 ==> t1't1 --> t1' - (ST_If)   + (ST_Test)  

    if t1 then t2 else t3 ==> if t1' then t2 else t3test t1 then t2 else t3 --> test t1' then t2 else t3
    - + - +
    t1 ==> t1't1 --> t1' - (ST_Succ)   + (ST_Scc)  

    succ t1 ==> succ t1'scc t1 --> scc t1'
    - +
       - (ST_PredZero)   + (ST_PrdZro)  

    pred 0 ==> 0prd zro --> zro
    - +
    numeric value v1 - (ST_PredSucc)   + (ST_PrdScc)  

    pred (succ v1) ==> v1prd (scc v1--> v1
    - + - +
    t1 ==> t1't1 --> t1' - (ST_Pred)   + (ST_Prd)  

    pred t1 ==> pred t1'prd t1 --> prd t1'
    - +
       - (ST_IszeroZero)   + (ST_IszroZro)  

    iszero 0 ==> trueiszro zro --> tru
    - +
    numeric value v1 - (ST_IszeroSucc)   + (ST_IszroScc)  

    iszero (succ v1) ==> falseiszro (scc v1--> fls
    - + - +
    t1 ==> t1't1 --> t1' - (ST_Iszero)   + (ST_Iszro)  

    iszero t1 ==> iszero t1'iszro t1 --> iszro t1'
    @@ -263,48 +263,48 @@

    Types类型系统

    -Reserved Notation "t1 '==>' t2" (at level 40).

    +Reserved Notation "t1 '-->' t2" (at level 40).

    Inductive step : tmtmProp :=
    -  | 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,
    +  | ST_TestTru : t1 t2,
    +      (test tru t1 t2) --> t1
    +  | ST_TestFls : t1 t2,
    +      (test fls t1 t2) --> t2
    +  | ST_Test : t1 t1' t2 t3,
    +      t1 --> t1'
    +      (test t1 t2 t3) --> (test t1' t2 t3)
    +  | ST_Scc : t1 t1',
    +      t1 --> t1'
    +      (scc t1) --> (scc t1')
    +  | ST_PrdZro :
    +      (prd zro) --> zro
    +  | ST_PrdScc : 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,
    +      (prd (scc t1)) --> t1
    +  | ST_Prd : t1 t1',
    +      t1 --> t1'
    +      (prd t1) --> (prd t1')
    +  | ST_IszroZro :
    +      (iszro zro) --> tru
    +  | ST_IszroScc : t1,
           nvalue t1
    -      (tiszero (tsucc t1)) ==> tfalse
    -  | ST_Iszero : t1 t1',
    -      t1 ==> t1'
    -      (tiszero t1) ==> (tiszero t1')
    +      (iszro (scc t1)) --> fls
    +  | ST_Iszro : t1 t1',
    +      t1 --> t1'
    +      (iszro t1) --> (iszro t1')

    -where "t1 '==>' t2" := (step t1 t2).

    +where "t1 '-->' t2" := (step t1 t2).

    Hint Constructors step.
    -请注意 step 关系并不在意表达式是否有全局意义——它只是检查下一步 - 的归约操作是否在正确的操作对象上。比如,项 succ true(用形式语法来说是 - tsucc true)无法前进一步,但这个几乎显然无意义的项 +请注意 step 关系并不在意步进表达式是否有全局意义——它只是检查下一步 + 的归约操作是否在正确的操作对象上。比如,项 succ true + 无法前进一步,但这个几乎显然无意义的项
    -       succ (if true then true else true) +       scc (test tru then tru else tru)
    @@ -312,7 +312,7 @@

    Types类型系统

    -

    正规式和值

    +

    正规式和值

    @@ -323,18 +323,18 @@

    Types类型系统

    Notation step_normal_form := (normal_form step).

    -Definition stuck (t:tm) : Prop :=
    -  step_normal_form t ∧ ¬ value t.

    +Definition stuck (t : tm) : Prop :=
    +  step_normal_form t ∧ ¬value t.

    Hint Unfold stuck.
    -

    练习:2 星 (some_term_is_stuck)

    +

    练习:2 星, standard (some_term_is_stuck)

    Example some_term_is_stuck :
    -   t, stuck t.
    +  t, stuck t.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -343,15 +343,15 @@

    Types类型系统

    - 然而,值和正规式在这个语言中并相同,值的集合被包括在正规式的集合中。 + 然而,值和正规式在这个语言中并不相同,值的集合被包括在正规式的集合中。 这一点很重要,因为这说明我们没有不小心定义了一些仍然能前进一步的值。
    -

    练习:3 星 (value_is_nf)

    +

    练习:3 星, standard (value_is_nf)

    -Lemma value_is_nf : t,
    +Lemma value_is_nf : t,
      value tstep_normal_form t.
    @@ -366,7 +366,7 @@

    Types类型系统

    但你发现一种要比另一种稍微简短一点。作为练习,请尝试使用这两种方法完成证明。)
    -

    练习:3 星, optional (step_deterministic)

    +

    练习:3 星, standard, optional (step_deterministic)

    使用 value_is_nf 来证明 step 关系是确定的。
    @@ -380,7 +380,7 @@

    Types类型系统

    -

    定型

    +

    定型

    @@ -392,141 +392,141 @@

    Types类型系统

    Inductive ty : Type :=
    -  | TBool : ty
    -  | TNat : ty.
    +  | Bool : ty
    +  | Nat : ty.
    -在非形式化的记号中,类型关系经常写做 |- t T,并读做“t 有类型 T”。 - |- 符号叫做“十字转门(turnstile)”。下面,我们会看到更加丰富的类型关系,其中 - 我们会在 |- 左侧添加一个或多个“上下文(context)”。目前暂时来说,上下文总是空的。
    +在非形式化的记号中,类型关系经常写做 tT,并读做“t 有类型 T”。 + 符号叫做“十字转门(turnstile)”。下面,我们会看到更加丰富的类型关系,其中 + 我们会在 左侧添加一个或多个“上下文(context)”。目前暂时来说,上下文总是空的。
    - +
       - (T_True)   + (T_Tru)  

    |- true ∈ Bool⊢ tru ∈ Bool
    - +
       - (T_False)   + (T_Fls)  

    |- false ∈ Bool⊢ fls ∈ Bool
    - + - +
    |- t1 ∈ Bool    |- t2 ∈ T    |- t3 ∈ T⊢ t1 ∈ Bool    ⊢ t2 ∈ T    ⊢ t3 ∈ T - (T_If)   + (T_Test)  

    |- if t1 then t2 else t3 ∈ T⊢ test t1 then t2 else t3 ∈ T
    - +
       - (T_Zero)   + (T_Zro)  

    |- 0 ∈ Nat⊢ zro ∈ Nat
    - + - +
    |- t1 ∈ Nat⊢ t1 ∈ Nat - (T_Succ)   + (T_Scc)  

    |- succ t1 ∈ Nat⊢ scc t1 ∈ Nat
    - + - +
    |- t1 ∈ Nat⊢ t1 ∈ Nat - (T_Pred)   + (T_Prd)  

    |- pred t1 ∈ Nat⊢ prd t1 ∈ Nat
    - + - +
    |- t1 ∈ Nat⊢ t1 ∈ Nat - (T_IsZero)   + (T_IsZro)  

    |- iszero t1 ∈ Bool⊢ iszro t1 ∈ Bool
    -Reserved Notation "'|-' t '∈' T" (at level 40).

    +Reserved Notation "'⊢' t '∈' T" (at level 40).

    Inductive has_type : tmtyProp :=
    -  | T_True :
    -       |- ttrueTBool
    -  | T_False :
    -       |- tfalseTBool
    -  | T_If : t1 t2 t3 T,
    -       |- t1TBool
    -       |- t2T
    -       |- t3T
    -       |- tif t1 t2 t3T
    -  | T_Zero :
    -       |- tzeroTNat
    -  | T_Succ : t1,
    -       |- t1TNat
    -       |- tsucc t1TNat
    -  | T_Pred : t1,
    -       |- t1TNat
    -       |- tpred t1TNat
    -  | T_Iszero : t1,
    -       |- t1TNat
    -       |- tiszero t1TBool
    +  | T_Tru :
    +       ⊢ truBool
    +  | T_Fls :
    +       ⊢ flsBool
    +  | T_Test : t1 t2 t3 T,
    +       ⊢ t1Bool
    +       ⊢ t2T
    +       ⊢ t3T
    +       ⊢ test t1 t2 t3T
    +  | T_Zro :
    +       ⊢ zroNat
    +  | T_Scc : t1,
    +       ⊢ t1Nat
    +       ⊢ scc t1Nat
    +  | T_Prd : t1,
    +       ⊢ t1Nat
    +       ⊢ prd t1Nat
    +  | T_Iszro : t1,
    +       ⊢ t1Nat
    +       ⊢ iszro t1Bool

    -where "'|-' t '∈' T" := (has_type t T).

    +where "'⊢' t '∈' T" := (has_type t T).

    Hint Constructors has_type.

    Example has_type_1 :
    -  |- tif tfalse tzero (tsucc tzero) ∈ TNat.
    +  ⊢ test fls zro (scc zro) ∈ Nat.
    Proof.
    -  apply T_If.
    -    - apply T_False.
    -    - apply T_Zero.
    -    - apply T_Succ.
    -       + apply T_Zero.
    +  apply T_Test.
    +    - apply T_Fls.
    +    - apply T_Zro.
    +    - apply T_Scc.
    +       + apply T_Zro.
    Qed.
    @@ -542,7 +542,7 @@

    Types类型系统

    Example has_type_not :
    -  ¬ (|- tif tfalse tzero ttrueTBool).
    +  ¬( ⊢ test fls zro truBool ).
    Proof.
    @@ -551,13 +551,13 @@

    Types类型系统

    -

    练习:1 星, optional (succ_hastype_nat__hastype_nat)

    +

    练习:1 星, standard, optional (scc_hastype_nat__hastype_nat)

    -Example succ_hastype_nat__hastype_nat : t,
    -  |- tsucc tTNat
    -  |- tTNat.
    +Example scc_hastype_nat__hastype_nat : t,
    +  ⊢ scc tNat
    +  ⊢ tNat.
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -565,7 +565,7 @@

    Types类型系统

    -

    典范形式

    +

    典范形式

    @@ -573,33 +573,32 @@

    Types类型系统

    -Lemma bool_canonical : t,
    -  |- tTBoolvalue tbvalue t.
    +Lemma bool_canonical : t,
    +  ⊢ tBoolvalue tbvalue t.
    Proof.
    -  intros t HT HV.
    -  inversion HV; auto.
    -  induction H; inversion HT; auto.
    +  intros t HT [Hb | Hn].
    +  - assumption.
    +  - induction Hn; inversion HT; auto.
    Qed.

    -Lemma nat_canonical : t,
    -  |- tTNatvalue tnvalue t.
    +Lemma nat_canonical : t,
    +  ⊢ tNatvalue tnvalue t.
    Proof.
    -  intros t HT HV.
    -  inversion HV.
    -  inversion H; subst; inversion HT.
    -  auto.
    +  intros t HT [Hb | Hn].
    +  - inversion Hb; subst; inversion HT.
    +  - assumption.
    Qed.
    -

    可进性

    +

    可进性

    @@ -608,13 +607,13 @@

    Types类型系统

    可进性(progress)
    -

    练习:3 星 (finish_progress)

    +

    练习:3 星, standard (finish_progress)

    -Theorem progress : t T,
    -  |- tT
    -  value t t', t ==> t'.
    +Theorem progress : t T,
    +  ⊢ tT
    +  value tt', t --> t'.
    @@ -627,17 +626,17 @@

    Types类型系统

    Proof with auto.
      intros t T HT.
      induction HT...
    -  (* 对于显然是值的情形,比如 T_True 和 T_False,我们直接使用 auto 完成。*)
    -  - (* T_If *)
    +  (* 对于显然是值的情形,比如 T_Tru 和 T_Fls,我们直接使用 auto 完成。*)
    +  - (* T_Test *)
        right. inversion IHHT1; clear IHHT1.
        + (* t1 是值 *)
        apply (bool_canonical t1 HT1) in H.
        inversion H; subst; clear H.
    -       t2...
    -       t3...
    +      t2...
    +      t3...
        + (* t1 可前进一步 *)
          inversion H as [t1' H1].
    -       (tif t1' t2 t3)...
    +      (test t1' t2 t3)...
      (* 请在此处解答 *) Admitted.
    @@ -646,43 +645,44 @@

    Types类型系统

    -

    练习:3 星, advanced (finish_progress_informal)

    +

    练习:3 星, advanced (finish_progress_informal)

    请完成非形式化的证明:
    - 定理:如果 |- t T,那么 t 要么是值,要么存在某个 t' 使 t ==> t'。 + 定理:如果 t T,那么 t 要么是值,要么存在某个 t' 使 t --> t'
    - 证明:对 |- t T 的导出式进行归纳。 + 证明:对 t T 的导出式进行归纳。
      -
    • 如果导出式的最后一条规则是 T_If,那么 t = if t1 then t2 else t3, - 其中 |- t1 Bool|- t2 T 以及 |- t3 T。 +
    • 如果导出式的最后一条规则是 T_Test,那么 t = test t1 then t2 else t3, + 其中 t1 Bool t2 T 以及 t3 T。 根据归纳假设,t1 要么是值,要么可前进一步到某个 t1'
      -
        + +
      • 如果 t1 是值,那么根据典范形式(canonical forms)引理以及 - |- t1 Bool 的事实,可得 t1 是一个 bvalue——也即, - 它要么是 true 要么是 false。如果 t1 = true,由 ST_IfTrue - 可得 t 前进到 t2;而当 t1 = false 时,由 ST_IfFalse - 可得 t 前进到 t3。不论哪种情况,t 都可以前进一步,这是我们 - 想要证明的。 + t1 Bool 的事实,可得 t1 是一个 bvalue——也即, + 它要么是 tru 要么是 fls。如果 t1 = tru,由 ST_TestTru + 可得 t 前进到 t2;而当 t1 = fls 时,由 ST_TestFls + 可得 t 前进到 t3。不论哪种情况,t 都可以前进一步,这是我们 + 想要证明的。
      • -
      • 如果 t1 自己可以前进一步,那么根据 ST_If 可得 t 也可以。 +
      • 如果 t1 自己可以前进一步,那么根据 ST_Test 可得 t 也可以。
        -
      • -
      +
      +
    • (* 请在此处解答 *)
      @@ -705,21 +705,21 @@

      Types类型系统

    -

    维型性

    +

    维型性

    关于类型的第二个重要性质是,当一个良型项可前进一步时,其结果也是一个良型项。
    -

    练习:2 星 (finish_preservation)

    +

    练习:2 星, standard (finish_preservation)

    -Theorem preservation : t t' T,
    -  |- tT
    -  t ==> t'
    -  |- t'T.
    +Theorem preservation : t t' T,
    +  ⊢ tT
    +  t --> t'
    +  ⊢ t'T.
    @@ -738,10 +738,10 @@

    Types类型系统

             intros t' HE;
             (* 我们还需要处理一些不可能发生的情形 *)
             try solve_by_invert.
    -    - (* T_If *) inversion HE; subst; clear HE.
    -      + (* ST_IFTrue *) assumption.
    -      + (* ST_IfFalse *) assumption.
    -      + (* ST_If *) apply T_If; try assumption.
    +    - (* T_Test *) inversion HE; subst; clear HE.
    +      + (* ST_TESTTru *) assumption.
    +      + (* ST_TestFls *) assumption.
    +      + (* ST_Test *) apply T_Test; try assumption.
            apply IHHT1; assumption.
        (* 请在此处解答 *) Admitted.
    @@ -751,54 +751,55 @@

    Types类型系统

    -

    练习:3 星, advanced (finish_preservation_informal)

    +

    练习:3 星, advanced (finish_preservation_informal)

    请完成非形式化的证明:
    - 定理:如果 |- t Tt ==> t',那么 |- t' T。 + 定理:如果 t Tt --> t',那么 t' T
    - 证明:对 |- t T 的导出式进行归纳。 + 证明:对 t T 的导出式进行归纳。
      -
    • 如果导出式的最后一条规则是 T_If,那么 t = if t1 - then t2 else t3,其中 |- t1 Bool|- t2 T 以及 |- t3 +
    • 如果导出式的最后一条规则是 T_Test,那么 t = test t1 + then t2 else t3,其中 t1 Bool t2 T 以及 t3 T
      - 请记着 t 形如 if ...,通过检查小步归约关系的规则,我们看到可以用来证明 - t ==> t' 的规则仅有 ST_IfTrueST_IfFalse 或者 ST_If。 + 请记着 t 形如 test ...,通过检查小步归约关系的规则,我们看到可以用来证明 + t --> t' 的规则仅有 ST_TestTruST_TestFls 或者 ST_Test
      -
        -
      • 如果最后的规则是 ST_IfTrue,那么 t' = t2。但是我们有 - |- t2 T,所以证明完成。 + +
      • +
      • 如果最后的规则是 ST_TestTru,那么 t' = t2。但是我们有 + t2 T,所以证明完成。
      • -
      • 如果最后的规则是 ST_IfFalse,那么 t' = t3。但是我们有 - |- t3 T,所以证明完成。 +
      • 如果最后的规则是 ST_TestFls,那么 t' = t3。但是我们有 + t3 T,所以证明完成。
      • -
      • 如果最后的规则是 ST_If,那么 t' = if t1' then t2 - else t3,其中 t1 ==> t1'。我们知道 |- t1 Bool, - 因此根据归纳假设可得 |- t1' Bool。正如需要的那样,规则 - T_If 为我们提供了 |- if t1' then t2 else t3 T。 +
      • 如果最后的规则是 ST_Test,那么 t' = test t1' then t2 + else t3,其中 t1 --> t1'。我们知道 t1 Bool, + 因此根据归纳假设可得 t1' Bool。正如需要的那样,规则 + T_Test 为我们提供了 test t1' then t2 else t3 T
        -
      • -
      +
      +
    • (* 请在此处解答 *)
      @@ -816,17 +817,17 @@

      Types类型系统

      -

      练习:3 星 (preservation_alternate_proof)

      +

      练习:3 星, standard (preservation_alternate_proof)

      现在请对求值导出式(而非类型导出式)进行归纳来证明维型性定理。 请仔细阅读和思考上面证明中最开始的几行,确保你理解了他们是在做什么。 本证明的开始部分类似,但并不完全一样。
      -Theorem preservation' : t t' T,
      -  |- tT
      -  t ==> t'
      -  |- t'T.
      +Theorem preservation' : t t' T,
      +  ⊢ tT
      +  t --> t'
      +  ⊢ t'T.
      Proof with eauto.
        (* 请在此处解答 *) Admitted.
      @@ -841,7 +842,7 @@

      Types类型系统

    -

    类型可靠性

    +

    类型可靠性

    @@ -850,10 +851,10 @@

    Types类型系统

    Definition multistep := (multi step).
    -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40).

    -Corollary soundness : t t' T,
    -  |- tT
    -  t ==>* t'
    +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).

    +Corollary soundness : t t' T,
    +  ⊢ tT
    +  t -->* t'
      ~(stuck t').
    @@ -866,144 +867,14 @@

    Types类型系统

    -

    题外话:normalize 策略

    - -
    - - -
    - - 在使用 Coq 对程序语言的定义进行一些实验时,我们经常想要看看某个具体的项会归约到什么—— - 也即,我们想要为形如 t ==>* t' 的目标找到证明,其中 t 是一个具体的项,而 - t' 是未知的。比如说,使用小步关系 astep 来归约一个算数表达式。 -
    -
    - -Module NormalizePlayground.
    -Import Smallstep.

    -Example step_example1 :
    -  (P (C 3) (P (C 3) (C 4)))
    -  ==>* (C 10).
    -Proof.
    -  apply multi_step with (P (C 3) (C 7)).
    -    apply ST_Plus2.
    -      apply v_const.
    -      apply ST_PlusConstConst.
    -  apply multi_step with (C 10).
    -    apply ST_PlusConstConst.
    -  apply multi_refl.
    -Qed.
    -
    - -
    -证明重复地应用了 multi_step,直到项被化简为一个正规式。幸运地是,如果有合适的 - 提示,中间证明步骤可以被 auto 策略解决。 -
    -
    - -Hint Constructors step value.
    -Example step_example1' :
    -  (P (C 3) (P (C 3) (C 4)))
    -  ==>* (C 10).
    -Proof.
    -  eapply multi_step. auto. simpl.
    -  eapply multi_step. auto. simpl.
    -  apply multi_refl.
    -Qed.
    -
    - -
    -下面使用 Tactic Notation 自定义的策略捕捉了这种模式。此外,在每次归约前, - 我们打印出当前的目标,这样我们可以观察到项是如何被归约的。 -
    -
    - -Tactic Notation "print_goal" :=
    -  match goal with |- ?xidtac x end.

    -Tactic Notation "normalize" :=
    -  repeat (print_goal; eapply multi_step ;
    -            [ (eauto 10; fail) | (instantiate; simpl)]);
    -  apply multi_refl.

    -Example step_example1'' :
    -  (P (C 3) (P (C 3) (C 4)))
    -  ==>* (C 10).
    -Proof.
    -  normalize.
    -  (* normalize 策略中的 print_goal 显示了项是如何一步步被归约的……
    -         (P (C 3) (P (C 3) (C 4)) ==>* C 10)
    -         (P (C 3) (C 7) ==>* C 10)
    -         (C 10 ==>* C 10)
    -  *)

    -Qed.
    -
    - -
    -normalize 策略以一个目标和存在变量开始,提供了一种简单的方法计算出项的正规式。 -
    -
    - -Example step_example1''' : e',
    -  (P (C 3) (P (C 3) (C 4)))
    -  ==>* e'.
    -Proof.
    -  eapply ex_intro. normalize.
    -(* This time, the trace is:
    -       (P (C 3) (P (C 3) (C 4)) ==>* ?e')
    -       (P (C 3) (C 7) ==>* ?e')
    -       (C 10 ==>* ?e')
    -   这列的 ?e' 是由 eapply “猜”出来的变量。 *)

    -Qed.
    -
    - -
    -

    练习:1 星 (normalize_ex)

    - -
    -
    -Theorem normalize_ex : e',
    -  (P (C 3) (P (C 2) (C 1)))
    -  ==>* e'.
    -Proof.
    -  (* 请在此处解答 *) Admitted.
    -
    - - -
    -
    - -

    练习:1 星, optional (normalize_ex')

    - 作为比较,请使用 apply 而非 eapply 证明它。 -
    -
    - -Theorem normalize_ex' : e',
    -  (P (C 3) (P (C 2) (C 1)))
    -  ==>* e'.
    -Proof.
    -  (* 请在此处解答 *) Admitted.
    -
    - - -
    - -End NormalizePlayground.

    -Tactic Notation "print_goal" :=
    -  match goal with |- ?xidtac x end.
    -Tactic Notation "normalize" :=
    -  repeat (print_goal; eapply multi_step ;
    -            [ (eauto 10; fail) | (instantiate; simpl)]);
    -  apply multi_refl.
    -
    - -
    -

    额外练习

    +

    额外练习

    -

    练习:2 星, recommended (subject_expansion)

    +

    练习:2 星, standard, recommended (subject_expansion)

    在学习了主语归约属性后,你可能会好奇其相反的属性——主语扩张(subject expasion) - ——是否也成立。也即,如果有 t ==> t'|- t' T,是否总是有 - |- t T?如果是的话,请证明它。如果不是的话,请给出一个反例。 + ——是否也成立。也即,如果有 t --> t' t' T,是否总是有 + t T?如果是的话,请证明它。如果不是的话,请给出一个反例。 (你并不需要在 Coq 中证明你的反例,不过也可以这样做。)
    @@ -1020,15 +891,15 @@

    Types类型系统

    -

    练习:2 星 (variation1)

    - 假设,我们为类型关系添加新的规则: +

    练习:2 星, standard (variation1)

    + 假设我们为类型关系添加新的规则:
    -      | T_SuccBool :  t,
    -           |- t ∈ TBool →
    -           |- tsucc t ∈ TBool +      | T_SccBool : t,
    +           ⊢ t ∈ Bool →
    +           ⊢ scc t ∈ Bool
    @@ -1039,25 +910,19 @@

    Types类型系统

    • step 的确定性 - -
      - + (* 请在此处解答 *)
    • 可进性 - -
      - + (* 请在此处解答 *)
    • 维型性 + (* 请在此处解答 *)
    -
    - -
    (* 请勿修改下面这一行: *)
    @@ -1068,21 +933,19 @@

    Types类型系统

    -

    练习:2 星 (variation2)

    +

    练习:2 星, standard (variation2)

    假设,我们仅为 step 关系添加新的规则:
    -      | ST_Funny1 :  t2 t3,
    -           (tif ttrue t2 t3) ==> t3 +      | ST_Funny1 : t2 t3,
    +           (test tru t2 t3--> t3
    上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - -
    - + (* 请在此处解答 *)
    @@ -1094,88 +957,87 @@

    Types类型系统

    -

    练习:2 星, optional (variation3)

    +

    练习:2 星, standard, optional (variation3)

    假设,我们仅添加新的规则:
    -      | ST_Funny2 :  t1 t2 t2' t3,
    -           t2 ==> t2' →
    -           (tif t1 t2 t3) ==> (tif t1 t2' t3) +      | ST_Funny2 : t1 t2 t2' t3,
    +           t2 --> t2' →
    +           (test t1 t2 t3--> (test t1 t2' t3)
    - 上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - -
    - + this rule? For each one that does, give a counter-example. + (* 请在此处解答 *)
    -

    练习:2 星, optional (variation4)

    +

    练习:2 星, standard, optional (variation4)

    假设,我们仅添加新的规则:
          | ST_Funny3 :
    -          (tpred tfalse) ==> (tpred (tpred tfalse)) +          (prd fls--> (prd (prd fls))
    上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - -
    - +(* 请在此处解答 *)
    -

    练习:2 星, optional (variation5)

    +

    练习:2 星, standard, optional (variation5)

    假设,我们仅添加新的规则:
          | T_Funny4 :
    -            |- tzero ∈ TBool +            ⊢ zro ∈ Bool
    上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - -
    - +(* 请在此处解答 *)
    -

    练习:2 星, optional (variation6)

    +

    练习:2 星, standard, optional (variation6)

    假设,我们仅添加新的规则:
          | T_Funny5 :
    -            |- tpred tzero ∈ TBool +            ⊢ prd zro ∈ Bool
    上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - -
    - +(* 请在此处解答 *)
    -

    练习:3 星, optional (more_variations)

    +

    练习:3 星, standard, optional (more_variations)

    请使用上面的模式编写更多的练习。尝试有选择地使某些性质不再成立—— 即,对定义的改变只会导致某一个性质不再成立,而其他仍然成立。 - + +
    +
    +(* 请在此处解答 *)
    +
    + + +
    -

    练习:1 星 (remove_predzero)

    - 归约规则 ST_PredZero 可能有一点反直觉:我们想要让零的前继变为未定义的, - 而非定义为零。我们是否可以通过仅仅移除 step 中的某条规则达到这一点? +

    练习:1 星, standard (remove_prdzro)

    + 归约规则 ST_PrdZro 可能有一点反直觉:我们想要让 zro 的前趋变为未定义的, + 而非定义为 zro。我们是否可以通过仅仅移除 step 中的某条规则达到这一点? 这样做会导致别的问题出现吗?
    @@ -1185,14 +1047,14 @@

    Types类型系统

    (* 请勿修改下面这一行: *)
    -Definition manual_grade_for_remove_predzero : option (nat*string) := None.
    +Definition manual_grade_for_remove_predzro : option (nat*string) := None.
    -

    练习:4 星, advanced (prog_pres_bigstep)

    +

    练习:4 星, advanced (prog_pres_bigstep)

    假设我们的求值关系是以大步语义方式定义的。请陈述类似的可进性和维型性定理。 (你不需要证明他们。) @@ -1212,10 +1074,9 @@

    Types类型系统

    -
    -
    +
    - +(* Sat Jan 26 15:15:44 UTC 2019 *)
    diff --git a/plf-current/Types.v b/plf-current/Types.v index a2593fdc..b89a582c 100644 --- a/plf-current/Types.v +++ b/plf-current/Types.v @@ -7,7 +7,7 @@ _'简单类型λ-演算'_,它是几乎每个现代函数式语言的核心(也包括 Coq!)。 *) Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Arith.Arith. +From Coq Require Import Arith.Arith. From PLF Require Import Maps. From PLF Require Import Imp. From PLF Require Import Smallstep. @@ -18,7 +18,7 @@ Hint Constructors multi. (** * 有类型算数表达式 *) (** 作为对类型系统讨论的动机,让我们像过去一样以一个小型玩具语言开始。 - 我们想要让程序有机会产生运行时类型错误,因此除了 [Smallstep] + 我们想要让程序有机会产生运行时类型错误,因此除了 [Smallstep] 一章中用到的常量和加法,还需要一点更复杂的语言构造:只有一种数据类型(比如说数字) 太过于简单,但是两种(数字和布尔值)便足够产生有趣的故事了。 @@ -29,36 +29,36 @@ Hint Constructors multi. (** 这是非形式化的语法表述: - t ::= true - | false - | if t then t else t - | 0 - | succ t - | pred t - | iszero t + t ::= tru + | fls + | test t then t else t + | zro + | scc t + | prd t + | iszro t 以及形式化的: *) Inductive tm : Type := - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm - | tzero : tm - | tsucc : tm -> tm - | tpred : tm -> tm - | tiszero : tm -> tm. + | tru : tm + | fls : tm + | test : tm -> tm -> tm -> tm + | zro : tm + | scc : tm -> tm + | prd : tm -> tm + | iszro : tm -> tm. -(** 对_'值(values)'_的定义包括 [true],[false] 以及数值…… *) +(** 对_'值(values)'_的定义包括 [tru],[fls] 以及数值…… *) Inductive bvalue : tm -> Prop := - | bv_true : bvalue ttrue - | bv_false : bvalue tfalse. + | bv_tru : bvalue tru + | bv_fls : bvalue fls. Inductive nvalue : tm -> Prop := - | nv_zero : nvalue tzero - | nv_succ : forall t, nvalue t -> nvalue (tsucc t). + | nv_zro : nvalue zro + | nv_scc : forall t, nvalue t -> nvalue (scc t). -Definition value (t:tm) := bvalue t \/ nvalue t. +Definition value (t : tm) := bvalue t \/ nvalue t. Hint Constructors bvalue nvalue. Hint Unfold value. @@ -67,87 +67,86 @@ Hint Unfold update. (* ================================================================= *) (** ** 操作语义 *) -(** 首先我们非形式化地描述单步关系…… *) -(** +(** 首先我们非形式化地描述单步关系…… - ------------------------------ (ST_IfTrue) - if true then t1 else t2 ==> t1 + ------------------------------- (ST_TestTru) + test tru then t1 else t2 --> t1 - ------------------------------- (ST_IfFalse) - if false then t1 else t2 ==> t2 + ------------------------------- (ST_TestFls) + test fls then t1 else t2 --> t2 - t1 ==> t1' - ------------------------------------------------ (ST_If) - if t1 then t2 else t3 ==> if t1' then t2 else t3 + t1 --> t1' + ---------------------------------------------------- (ST_Test) + test t1 then t2 else t3 --> test t1' then t2 else t3 - t1 ==> t1' - -------------------- (ST_Succ) - succ t1 ==> succ t1' + t1 --> t1' + ------------------ (ST_Scc) + scc t1 --> scc t1' - ------------ (ST_PredZero) - pred 0 ==> 0 + --------------- (ST_PrdZro) + prd zro --> zro - numeric value v1 - --------------------- (ST_PredSucc) - pred (succ v1) ==> v1 + numeric value v1 + ------------------- (ST_PrdScc) + prd (scc v1) --> v1 - t1 ==> t1' - -------------------- (ST_Pred) - pred t1 ==> pred t1' + t1 --> t1' + ------------------ (ST_Prd) + prd t1 --> prd t1' - ----------------- (ST_IszeroZero) - iszero 0 ==> true + ----------------- (ST_IszroZro) + iszro zro --> tru - numeric value v1 - -------------------------- (ST_IszeroSucc) - iszero (succ v1) ==> false + numeric value v1 + ---------------------- (ST_IszroScc) + iszro (scc v1) --> fls - t1 ==> t1' - ------------------------ (ST_Iszero) - iszero t1 ==> iszero t1' + t1 --> t1' + ---------------------- (ST_Iszro) + iszro t1 --> iszro t1' *) (** 接着形式化地: *) -Reserved Notation "t1 '==>' t2" (at level 40). +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, + | ST_TestTru : forall t1 t2, + (test tru t1 t2) --> t1 + | ST_TestFls : forall t1 t2, + (test fls t1 t2) --> t2 + | ST_Test : forall t1 t1' t2 t3, + t1 --> t1' -> + (test t1 t2 t3) --> (test t1' t2 t3) + | ST_Scc : forall t1 t1', + t1 --> t1' -> + (scc t1) --> (scc t1') + | ST_PrdZro : + (prd zro) --> zro + | ST_PrdScc : 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, + (prd (scc t1)) --> t1 + | ST_Prd : forall t1 t1', + t1 --> t1' -> + (prd t1) --> (prd t1') + | ST_IszroZro : + (iszro zro) --> tru + | ST_IszroScc : forall t1, nvalue t1 -> - (tiszero (tsucc t1)) ==> tfalse - | ST_Iszero : forall t1 t1', - t1 ==> t1' -> - (tiszero t1) ==> (tiszero t1') + (iszro (scc t1)) --> fls + | ST_Iszro : forall t1 t1', + t1 --> t1' -> + (iszro t1) --> (iszro t1') -where "t1 '==>' t2" := (step t1 t2). +where "t1 '-->' t2" := (step t1 t2). Hint Constructors step. -(** 请注意 [step] 关系并不在意表达式是否有全局意义——它只是检查_'下一步'_ - 的归约操作是否在正确的操作对象上。比如,项 [succ true](用形式语法来说是 - [tsucc true])无法前进一步,但这个几乎显然无意义的项 +(** 请注意 [step] 关系并不在意步进表达式是否有全局意义——它只是检查_'下一步'_ + 的归约操作是否在正确的操作对象上。比如,项 [succ true] + 无法前进一步,但这个几乎显然无意义的项 - succ (if true then true else true) + scc (test tru then tru else tru) 却可以前进一步(注意是在卡住之前)。 *) @@ -160,22 +159,22 @@ Hint Constructors step. Notation step_normal_form := (normal_form step). -Definition stuck (t:tm) : Prop := +Definition stuck (t : tm) : Prop := step_normal_form t /\ ~ value t. Hint Unfold stuck. -(** **** 练习:2 星 (some_term_is_stuck) *) +(** **** 练习:2 星, standard (some_term_is_stuck) *) Example some_term_is_stuck : exists t, stuck t. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** 然而,值和正规式在这个语言中并_'不'_相同,值的集合被包括在正规式的集合中。 +(** 然而,值和正规式在这个语言中_'并不'_相同,值的集合被包括在正规式的集合中。 这一点很重要,因为这说明我们没有不小心定义了一些仍然能前进一步的值。*) -(** **** 练习:3 星 (value_is_nf) *) +(** **** 练习:3 星, standard (value_is_nf) *) Lemma value_is_nf : forall t, value t -> step_normal_form t. Proof. @@ -183,11 +182,13 @@ Proof. (** (提示:在证明中的某个地方,你需要使用归纳来推理某个项,这个项已知是数值。 归纳可以对项本身进行,也可以对它是数值这个证据进行。两种方法均可完成证明, - 但你发现一种要比另一种稍微简短一点。作为练习,请尝试使用这两种方法完成证明。)*) -(** [] *) + 但你发现一种要比另一种稍微简短一点。作为练习,请尝试使用这两种方法完成证明。) + + [] *) -(** **** 练习:3 星, optional (step_deterministic) *) -(** 使用 [value_is_nf] 来证明 [step] 关系是确定的。*) +(** **** 练习:3 星, standard, optional (step_deterministic) + + 使用 [value_is_nf] 来证明 [step] 关系是确定的。*) Theorem step_deterministic: deterministic step. @@ -204,75 +205,76 @@ Proof with eauto. 类型(数字或布尔值),我们可以容易地排除这些劣型(ill-typed)项。*) Inductive ty : Type := - | TBool : ty - | TNat : ty. + | Bool : ty + | Nat : ty. (** 在非形式化的记号中,类型关系经常写做 [|- t \in T],并读做“[t] 有类型 [T]”。 [|-] 符号叫做“十字转门(turnstile)”。下面,我们会看到更加丰富的类型关系,其中 - 我们会在 [|-] 左侧添加一个或多个“上下文(context)”。目前暂时来说,上下文总是空的。 *) -(** - ---------------- (T_True) - |- true \in Bool + 我们会在 [|-] 左侧添加一个或多个“上下文(context)”。目前暂时来说,上下文总是空的。 + + + --------------- (T_Tru) + |- tru \in Bool - ----------------- (T_False) - |- false \in Bool + --------------- (T_Fls) + |- fls \in Bool |- t1 \in Bool |- t2 \in T |- t3 \in T - -------------------------------------------- (T_If) - |- if t1 then t2 else t3 \in T + -------------------------------------------- (T_Test) + |- test t1 then t2 else t3 \in T - ------------ (T_Zero) - |- 0 \in Nat + -------------- (T_Zro) + |- zro \in Nat |- t1 \in Nat - ------------------ (T_Succ) - |- succ t1 \in Nat + ----------------- (T_Scc) + |- scc t1 \in Nat |- t1 \in Nat - ------------------ (T_Pred) - |- pred t1 \in Nat + ----------------- (T_Prd) + |- prd t1 \in Nat |- t1 \in Nat - --------------------- (T_IsZero) - |- iszero t1 \in Bool + -------------------- (T_IsZro) + |- iszro 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 -> + | T_Tru : + |- tru \in Bool + | T_Fls : + |- fls \in Bool + | T_Test : forall t1 t2 t3 T, + |- t1 \in Bool -> |- 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 + |- test t1 t2 t3 \in T + | T_Zro : + |- zro \in Nat + | T_Scc : forall t1, + |- t1 \in Nat -> + |- scc t1 \in Nat + | T_Prd : forall t1, + |- t1 \in Nat -> + |- prd t1 \in Nat + | T_Iszro : forall t1, + |- t1 \in Nat -> + |- iszro t1 \in Bool where "'|-' t '\in' T" := (has_type t T). Hint Constructors has_type. Example has_type_1 : - |- tif tfalse tzero (tsucc tzero) \in TNat. + |- test fls zro (scc zro) \in Nat. Proof. - apply T_If. - - apply T_False. - - apply T_Zero. - - apply T_Succ. - + apply T_Zero. + apply T_Test. + - apply T_Fls. + - apply T_Zro. + - apply T_Scc. + + apply T_Zro. Qed. (** (因为我们在提示数据库(hint database)中包括了类型关系的所有构造子, @@ -283,14 +285,14 @@ Qed. 它并不计算项的正规式的类型。 *) Example has_type_not : - ~ (|- tif tfalse tzero ttrue \in TBool). + ~ ( |- test fls zro tru \in Bool ). Proof. intros Contra. solve_by_inverts 2. Qed. -(** **** 练习:1 星, optional (succ_hastype_nat__hastype_nat) *) -Example succ_hastype_nat__hastype_nat : forall t, - |- tsucc t \in TNat -> - |- t \in TNat. +(** **** 练习:1 星, standard, optional (scc_hastype_nat__hastype_nat) *) +Example scc_hastype_nat__hastype_nat : forall t, + |- scc t \in Nat -> + |- t \in Nat. Proof. (* 请在此处解答 *) Admitted. (** [] *) @@ -301,20 +303,19 @@ Proof. (** 下面的两个引理作为基础性质表达了布尔值和数值的定义同类型关系相一致。*) Lemma bool_canonical : forall t, - |- t \in TBool -> value t -> bvalue t. + |- t \in Bool -> value t -> bvalue t. Proof. - intros t HT HV. - inversion HV; auto. - induction H; inversion HT; auto. + intros t HT [Hb | Hn]. + - assumption. + - induction Hn; inversion HT; auto. Qed. Lemma nat_canonical : forall t, - |- t \in TNat -> value t -> nvalue t. + |- t \in Nat -> value t -> nvalue t. Proof. - intros t HT HV. - inversion HV. - inversion H; subst; inversion HT. - auto. + intros t HT [Hb | Hn]. + - inversion Hb; subst; inversion HT. + - assumption. Qed. (* ================================================================= *) @@ -324,18 +325,18 @@ Qed. 如果一个项是良型的,那么它要么是一个值,要么可以至少前进一步。我们把这个性质叫做 _'可进性(progress)'_。 *) -(** **** 练习:3 星 (finish_progress) *) +(** **** 练习:3 星, standard (finish_progress) *) Theorem progress : forall t T, |- t \in T -> - value t \/ exists t', t ==> t'. + value t \/ exists t', t --> t'. (** 请完成 [progress] 性质的形式化证明。(在开始前请确保你理解了下一个练习中的非 形式化证明——这会节省很多你的时间。)*) Proof with auto. intros t T HT. induction HT... - (* 对于显然是值的情形,比如 T_True 和 T_False,我们直接使用 auto 完成。*) - - (* T_If *) + (* 对于显然是值的情形,比如 T_Tru 和 T_Fls,我们直接使用 auto 完成。*) + - (* T_Test *) right. inversion IHHT1; clear IHHT1. + (* t1 是值 *) apply (bool_canonical t1 HT1) in H. @@ -344,31 +345,32 @@ Proof with auto. exists t3... + (* t1 可前进一步 *) inversion H as [t1' H1]. - exists (tif t1' t2 t3)... + exists (test t1' t2 t3)... (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced (finish_progress_informal) *) -(** 请完成非形式化的证明: *) +(** **** 练习:3 星, advanced (finish_progress_informal) -(** _'定理'_:如果 [|- t \in T],那么 [t] 要么是值,要么存在某个 [t'] 使 [t ==> t']。*) + 请完成非形式化的证明: *) + +(** _'定理'_:如果 [|- t \in T],那么 [t] 要么是值,要么存在某个 [t'] 使 [t --> t']。*) (** _'证明'_:对 [|- t \in T] 的导出式进行归纳。 - - 如果导出式的最后一条规则是 [T_If],那么 [t = if t1 then t2 else t3], + - 如果导出式的最后一条规则是 [T_Test],那么 [t = test t1 then t2 else t3], 其中 [|- t1 \in Bool],[|- t2 \in T] 以及 [|- t3 \in T]。 根据归纳假设,[t1] 要么是值,要么可前进一步到某个 [t1']。 - - 如果 [t1] 是值,那么根据典范形式(canonical forms)引理以及 - [|- t1 \in Bool] 的事实,可得 [t1] 是一个 [bvalue]——也即, - 它要么是 [true] 要么是 [false]。如果 [t1 = true],由 [ST_IfTrue] - 可得 [t] 前进到 [t2];而当 [t1 = false] 时,由 [ST_IfFalse] - 可得 [t] 前进到 [t3]。不论哪种情况,[t] 都可以前进一步,这是我们 - 想要证明的。 + - 如果 [t1] 是值,那么根据典范形式(canonical forms)引理以及 + [|- t1 \in Bool] 的事实,可得 [t1] 是一个 [bvalue]——也即, + 它要么是 [tru] 要么是 [fls]。如果 [t1 = tru],由 [ST_TestTru] + 可得 [t] 前进到 [t2];而当 [t1 = fls] 时,由 [ST_TestFls] + 可得 [t] 前进到 [t3]。不论哪种情况,[t] 都可以前进一步,这是我们 + 想要证明的。 - - 如果 [t1] 自己可以前进一步,那么根据 [ST_If] 可得 [t] 也可以。 + - 如果 [t1] 自己可以前进一步,那么根据 [ST_Test] 可得 [t] 也可以。 - - (* 请在此处解答 *) + - (* 请在此处解答 *) *) (* 请勿修改下面这一行: *) Definition manual_grade_for_finish_progress_informal : option (nat*string) := None. @@ -382,10 +384,10 @@ Definition manual_grade_for_finish_progress_informal : option (nat*string) := No (** 关于类型的第二个重要性质是,当一个良型项可前进一步时,其结果也是一个良型项。*) -(** **** 练习:2 星 (finish_preservation) *) +(** **** 练习:2 星, standard (finish_preservation) *) Theorem preservation : forall t t' T, |- t \in T -> - t ==> t' -> + t --> t' -> |- t' \in T. (** 请完成 [preservation] 性质的形式化证明。(和上次一样,在开始前请确保你理解了 @@ -399,53 +401,55 @@ Proof with auto. intros t' HE; (* 我们还需要处理一些不可能发生的情形 *) try solve_by_invert. - - (* T_If *) inversion HE; subst; clear HE. - + (* ST_IFTrue *) assumption. - + (* ST_IfFalse *) assumption. - + (* ST_If *) apply T_If; try assumption. + - (* T_Test *) inversion HE; subst; clear HE. + + (* ST_TESTTru *) assumption. + + (* ST_TestFls *) assumption. + + (* ST_Test *) apply T_Test; try assumption. apply IHHT1; assumption. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, advanced (finish_preservation_informal) *) -(** 请完成非形式化的证明: *) +(** **** 练习:3 星, advanced (finish_preservation_informal) + + 请完成非形式化的证明: *) -(** _'定理'_:如果 [|- t \in T] 且 [t ==> t'],那么 [|- t' \in T]。 *) +(** _'定理'_:如果 [|- t \in T] 且 [t --> t'],那么 [|- t' \in T]。 *) (** _'证明'_:对 [|- t \in T] 的导出式进行归纳。 - - 如果导出式的最后一条规则是 [T_If],那么 [t = if t1 + - 如果导出式的最后一条规则是 [T_Test],那么 [t = test t1 then t2 else t3],其中 [|- t1 \in Bool], [|- t2 \in T] 以及 [|- t3 \in T]。 - 请记着 [t] 形如 [if ...],通过检查小步归约关系的规则,我们看到可以用来证明 - [t ==> t'] 的规则仅有 [ST_IfTrue],[ST_IfFalse] 或者 [ST_If]。 + 请记着 [t] 形如 [test ...],通过检查小步归约关系的规则,我们看到可以用来证明 + [t --> t'] 的规则仅有 [ST_TestTru],[ST_TestFls] 或者 [ST_Test]。 - - 如果最后的规则是 [ST_IfTrue],那么 [t' = t2]。但是我们有 - [|- t2 \in T],所以证明完成。 + - 如果最后的规则是 [ST_TestTru],那么 [t' = t2]。但是我们有 + [|- t2 \in T],所以证明完成。 - - 如果最后的规则是 [ST_IfFalse],那么 [t' = t3]。但是我们有 - [|- t3 \in T],所以证明完成。 + - 如果最后的规则是 [ST_TestFls],那么 [t' = t3]。但是我们有 + [|- t3 \in T],所以证明完成。 - - 如果最后的规则是 [ST_If],那么 [t' = if t1' then t2 - else t3],其中 [t1 ==> t1']。我们知道 [|- t1 \in Bool], - 因此根据归纳假设可得 [|- t1' \in Bool]。正如需要的那样,规则 - [T_If] 为我们提供了 [|- if t1' then t2 else t3 \in T]。 + - 如果最后的规则是 [ST_Test],那么 [t' = test t1' then t2 + else t3],其中 [t1 --> t1']。我们知道 [|- t1 \in Bool], + 因此根据归纳假设可得 [|- t1' \in Bool]。正如需要的那样,规则 + [T_Test] 为我们提供了 [|- test t1' then t2 else t3 \in T]。 - - (* 请在此处解答 *) + - (* 请在此处解答 *) *) (* 请勿修改下面这一行: *) Definition manual_grade_for_finish_preservation_informal : option (nat*string) := None. (** [] *) -(** **** 练习:3 星 (preservation_alternate_proof) *) -(** 现在请对_'求值'_导出式(而非类型导出式)进行归纳来证明维型性定理。 +(** **** 练习:3 星, standard (preservation_alternate_proof) + + 现在请对_'求值'_导出式(而非类型导出式)进行归纳来证明维型性定理。 请仔细阅读和思考上面证明中最开始的几行,确保你理解了他们是在做什么。 本证明的开始部分类似,但并不完全一样。*) Theorem preservation' : forall t t' T, |- t \in T -> - t ==> t' -> + t --> t' -> |- t' \in T. Proof with eauto. (* 请在此处解答 *) Admitted. @@ -461,11 +465,11 @@ Proof with eauto. (** 把可进行与维型性放在一起,我们可以看到一个良型的项永远不会有卡住状态。*) Definition multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). +Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40). Corollary soundness : forall t t' T, |- t \in T -> - t ==>* t' -> + t -->* t' -> ~(stuck t'). Proof. intros t t' T HT P. induction P; intros [R S]. @@ -473,114 +477,13 @@ Proof. apply IHP. apply (preservation x y T HT H). unfold stuck. split; auto. Qed. -(* ################################################################# *) -(** * 题外话:[normalize] 策略 *) - -(** - 在使用 Coq 对程序语言的定义进行一些实验时,我们经常想要看看某个具体的项会归约到什么—— - 也即,我们想要为形如 [t ==>* t'] 的目标找到证明,其中 [t] 是一个具体的项,而 - [t'] 是未知的。比如说,使用小步关系 [astep] 来归约一个算数表达式。*) - -Module NormalizePlayground. -Import Smallstep. - -Example step_example1 : - (P (C 3) (P (C 3) (C 4))) - ==>* (C 10). -Proof. - apply multi_step with (P (C 3) (C 7)). - apply ST_Plus2. - apply v_const. - apply ST_PlusConstConst. - apply multi_step with (C 10). - apply ST_PlusConstConst. - apply multi_refl. -Qed. - -(** 证明重复地应用了 [multi_step],直到项被化简为一个正规式。幸运地是,如果有合适的 - 提示,中间证明步骤可以被 [auto] 策略解决。*) - -Hint Constructors step value. -Example step_example1' : - (P (C 3) (P (C 3) (C 4))) - ==>* (C 10). -Proof. - eapply multi_step. auto. simpl. - eapply multi_step. auto. simpl. - apply multi_refl. -Qed. - -(** 下面使用 [Tactic Notation] 自定义的策略捕捉了这种模式。此外,在每次归约前, - 我们打印出当前的目标,这样我们可以观察到项是如何被归约的。 *) - -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 step_example1'' : - (P (C 3) (P (C 3) (C 4))) - ==>* (C 10). -Proof. - normalize. - (* [normalize] 策略中的 [print_goal] 显示了项是如何一步步被归约的…… - (P (C 3) (P (C 3) (C 4)) ==>* C 10) - (P (C 3) (C 7) ==>* C 10) - (C 10 ==>* C 10) - *) -Qed. - -(** [normalize] 策略以一个目标和存在变量开始,提供了一种简单的方法计算出项的正规式。*) - -Example step_example1''' : exists e', - (P (C 3) (P (C 3) (C 4))) - ==>* e'. -Proof. - eapply ex_intro. normalize. -(* This time, the trace is: - (P (C 3) (P (C 3) (C 4)) ==>* ?e') - (P (C 3) (C 7) ==>* ?e') - (C 10 ==>* ?e') - 这列的 ?e' 是由 eapply “猜”出来的变量。 *) -Qed. - - -(** **** 练习:1 星 (normalize_ex) *) -Theorem normalize_ex : exists e', - (P (C 3) (P (C 2) (C 1))) - ==>* e'. -Proof. - (* 请在此处解答 *) Admitted. -(** [] *) - -(** **** 练习:1 星, optional (normalize_ex') *) -(** 作为比较,请使用 [apply] 而非 [eapply] 证明它。*) - -Theorem normalize_ex' : exists e', - (P (C 3) (P (C 2) (C 1))) - ==>* e'. -Proof. - (* 请在此处解答 *) Admitted. -(** [] *) - -End NormalizePlayground. - -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. - (* ================================================================= *) (** ** 额外练习 *) -(** **** 练习:2 星, recommended (subject_expansion) *) -(** 在学习了主语归约属性后,你可能会好奇其相反的属性——主语_'扩张'_(subject expasion) - ——是否也成立。也即,如果有 [t ==> t'] 且 [|- t' \in T],是否总是有 +(** **** 练习:2 星, standard, recommended (subject_expansion) + + 在学习了主语归约属性后,你可能会好奇其相反的属性——主语_'扩张'_(subject expasion) + ——是否也成立。也即,如果有 [t --> t'] 且 [|- t' \in T],是否总是有 [|- t \in T]?如果是的话,请证明它。如果不是的话,请给出一个反例。 (你并不需要在 Coq 中证明你的反例,不过也可以这样做。) @@ -590,103 +493,114 @@ Tactic Notation "normalize" := Definition manual_grade_for_subject_expansion : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (variation1) *) -(** 假设,我们为类型关系添加新的规则: +(** **** 练习:2 星, standard (variation1) + + 假设我们为类型关系添加新的规则: - | T_SuccBool : forall t, - |- t \in TBool -> - |- tsucc t \in TBool + | T_SccBool : forall t, + |- t \in Bool -> + |- scc t \in Bool 下面的哪些性质仍然成立?对于每个性质,写下“仍然成立”或“不成立”。 如果性质不再成立,请给出一个反例。 - [step] 的确定性 - + (* 请在此处解答 *) - 可进性 - + (* 请在此处解答 *) - 维型性 - + (* 请在此处解答 *) *) (* 请勿修改下面这一行: *) Definition manual_grade_for_variation1 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星 (variation2) *) -(** 假设,我们仅为 [step] 关系添加新的规则: +(** **** 练习:2 星, standard (variation2) + + 假设,我们仅为 [step] 关系添加新的规则: | ST_Funny1 : forall t2 t3, - (tif ttrue t2 t3) ==> t3 + (test tru t2 t3) --> t3 上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - + (* 请在此处解答 *) *) (* 请勿修改下面这一行: *) Definition manual_grade_for_variation2 : option (nat*string) := None. (** [] *) -(** **** 练习:2 星, optional (variation3) *) -(** 假设,我们仅添加新的规则: +(** **** 练习:2 星, standard, optional (variation3) - | ST_Funny2 : forall t1 t2 t2' t3, - t2 ==> t2' -> - (tif t1 t2 t3) ==> (tif t1 t2' t3) + 假设,我们仅添加新的规则: - 上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 + | ST_Funny2 : forall t1 t2 t2' t3, + t2 --> t2' -> + (test t1 t2 t3) --> (test t1 t2' t3) + this rule? For each one that does, give a counter-example. + (* 请在此处解答 *) [] *) -(** **** 练习:2 星, optional (variation4) *) -(** 假设,我们仅添加新的规则: +(** **** 练习:2 星, standard, optional (variation4) + + 假设,我们仅添加新的规则: | ST_Funny3 : - (tpred tfalse) ==> (tpred (tpred tfalse)) + (prd fls) --> (prd (prd fls)) 上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - +(* 请在此处解答 *) [] *) -(** **** 练习:2 星, optional (variation5) *) -(** 假设,我们仅添加新的规则: +(** **** 练习:2 星, standard, optional (variation5) + + 假设,我们仅添加新的规则: | T_Funny4 : - |- tzero \in TBool + |- zro \in Bool 上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - +(* 请在此处解答 *) [] *) -(** **** 练习:2 星, optional (variation6) *) -(** 假设,我们仅添加新的规则: +(** **** 练习:2 星, standard, optional (variation6) + + 假设,我们仅添加新的规则: | T_Funny5 : - |- tpred tzero \in TBool + |- prd zro \in Bool 上面的哪些性质不再成立?对于不再成立的性质,给出一个反例。 - +(* 请在此处解答 *) [] *) -(** **** 练习:3 星, optional (more_variations) *) -(** 请使用上面的模式编写更多的练习。尝试有选择地使某些性质不再成立—— +(** **** 练习:3 星, standard, optional (more_variations) + + 请使用上面的模式编写更多的练习。尝试有选择地使某些性质不再成立—— 即,对定义的改变只会导致某一个性质不再成立,而其他仍然成立。 *) -(** [] *) +(* 请在此处解答 + + [] *) -(** **** 练习:1 星 (remove_predzero) *) -(** 归约规则 [ST_PredZero] 可能有一点反直觉:我们想要让零的前继变为未定义的, - 而非定义为零。我们是否可以通过仅仅移除 [step] 中的某条规则达到这一点? +(** **** 练习:1 星, standard (remove_prdzro) + + 归约规则 [ST_PrdZro] 可能有一点反直觉:我们想要让 [ zro] 的前趋变为未定义的, + 而非定义为 [zro]。我们是否可以通过仅仅移除 [step] 中的某条规则达到这一点? 这样做会导致别的问题出现吗? (* 请在此处解答 *) *) (* 请勿修改下面这一行: *) -Definition manual_grade_for_remove_predzero : option (nat*string) := None. +Definition manual_grade_for_remove_predzro : option (nat*string) := None. (** [] *) -(** **** 练习:4 星, advanced (prog_pres_bigstep) *) -(** 假设我们的求值关系是以大步语义方式定义的。请陈述类似的可进性和维型性定理。 +(** **** 练习:4 星, advanced (prog_pres_bigstep) + + 假设我们的求值关系是以大步语义方式定义的。请陈述类似的可进性和维型性定理。 (你不需要证明他们。) 你可以发现这两个属性中存在的局限吗?他们是否允许非停机的命令?我们为什么倾向于 @@ -698,4 +612,6 @@ Definition manual_grade_for_remove_predzero : option (nat*string) := None. Definition manual_grade_for_prog_pres_bigstep : option (nat*string) := None. (** [] *) -(** $Date$ *) + + +(* Sat Jan 26 15:15:44 UTC 2019 *) diff --git a/plf-current/TypesTest.v b/plf-current/TypesTest.v index 76b02321..2411d502 100644 --- a/plf-current/TypesTest.v +++ b/plf-current/TypesTest.v @@ -63,7 +63,7 @@ idtac "#> progress". idtac "Possible points: 3". check_type @progress ( (forall (t : tm) (T : ty), - |- t \in T -> value t \/ (exists t' : tm, t ==> t'))). + |- t \in T -> value t \/ (exists t' : tm, t --> t'))). idtac "Assumptions:". Abort. Print Assumptions progress. @@ -85,7 +85,7 @@ idtac " ". idtac "#> preservation". idtac "Possible points: 2". check_type @preservation ( -(forall (t t' : tm) (T : ty), |- t \in T -> t ==> t' -> |- t' \in T)). +(forall (t t' : tm) (T : ty), |- t \in T -> t --> t' -> |- t' \in T)). idtac "Assumptions:". Abort. Print Assumptions preservation. @@ -107,29 +107,13 @@ idtac " ". idtac "#> preservation'". idtac "Possible points: 3". check_type @preservation' ( -(forall (t t' : tm) (T : ty), |- t \in T -> t ==> t' -> |- t' \in T)). +(forall (t t' : tm) (T : ty), |- t \in T -> t --> t' -> |- t' \in T)). idtac "Assumptions:". Abort. Print Assumptions preservation'. Goal True. idtac " ". -idtac "------------------- normalize_ex --------------------". -idtac " ". - -idtac "#> NormalizePlayground.normalize_ex". -idtac "Possible points: 1". -check_type @NormalizePlayground.normalize_ex ( -(exists e' : Smallstep.tm, - @Smallstep.multi Smallstep.tm Smallstep.step - (Smallstep.P (Smallstep.C 3) - (Smallstep.P (Smallstep.C 2) (Smallstep.C 1))) e')). -idtac "Assumptions:". -Abort. -Print Assumptions NormalizePlayground.normalize_ex. -Goal True. -idtac " ". - idtac "------------------- subject_expansion --------------------". idtac " ". @@ -154,12 +138,12 @@ idtac "Possible points: 2". print_manual_grade manual_grade_for_variation2. idtac " ". -idtac "------------------- remove_predzero --------------------". +idtac "------------------- remove_prdzro --------------------". idtac " ". -idtac "#> Manually graded: remove_predzero". +idtac "#> Manually graded: remove_predzro". idtac "Possible points: 1". -print_manual_grade manual_grade_for_remove_predzero. +print_manual_grade manual_grade_for_remove_predzro. idtac " ". idtac "------------------- prog_pres_bigstep --------------------". @@ -173,8 +157,8 @@ idtac " ". idtac " ". -idtac "Max points - standard: 21". -idtac "Max points - advanced: 31". +idtac "Max points - standard: 20". +idtac "Max points - advanced: 30". idtac "". idtac "********** Summary **********". idtac "". @@ -189,15 +173,13 @@ idtac "---------- preservation ---------". Print Assumptions preservation. idtac "---------- preservation' ---------". Print Assumptions preservation'. -idtac "---------- NormalizePlayground.normalize_ex ---------". -Print Assumptions NormalizePlayground.normalize_ex. idtac "---------- subject_expansion ---------". idtac "MANUAL". idtac "---------- variation1 ---------". idtac "MANUAL". idtac "---------- variation2 ---------". idtac "MANUAL". -idtac "---------- remove_predzero ---------". +idtac "---------- remove_predzro ---------". idtac "MANUAL". idtac "". idtac "********** Advanced **********". @@ -208,3 +190,5 @@ idtac "MANUAL". idtac "---------- prog_pres_bigstep ---------". idtac "MANUAL". Abort. + +(* Sat Jan 26 15:16:07 UTC 2019 *) diff --git a/plf-current/UseAuto.html b/plf-current/UseAuto.html index 9187b83f..b823554e 100644 --- a/plf-current/UseAuto.html +++ b/plf-current/UseAuto.html @@ -33,7 +33,6 @@

    UseAutoTheory and Practice of Automa
    - (* Chapter written and maintained by Arthur Chargueraud *)
    @@ -69,18 +68,18 @@

    UseAutoTheory and Practice of Automa

    -Require Import Coq.Arith.Arith.

    +From Coq Require Import Arith.Arith.

    From PLF Require Import Maps.
    From PLF Require Import Smallstep.
    From PLF Require Import Stlc.
    From PLF Require Import LibTactics.

    From PLF Require Imp.

    -Require Import Coq.Lists.List.
    +From Coq Require Import Lists.List.
    Import ListNotations.
    -

    Basic Features of Proof Search

    +

    Basic Features of Proof Search

    @@ -100,7 +99,7 @@

    UseAutoTheory and Practice of Automa

    -

    Strength of Proof Search

    +

    Strength of Proof Search

    @@ -141,7 +140,7 @@

    UseAutoTheory and Practice of Automa

    -

    Basics

    +

    Basics

    @@ -166,9 +165,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_by_apply : (P Q : natProp),
    -  ( n, Q nP n) →
    -  ( n, Q n) →
    +Lemma solving_by_apply : (P Q : natProp),
    +  (n, Q nP n) →
    +  (n, Q n) →
      P 2.
    Proof. auto. Qed.
    @@ -188,7 +187,7 @@

    UseAutoTheory and Practice of Automa
    - fun (P Q : nat Prop) (H : n : nat, Q n P n) (H0 : n : nat, Q n) + fun (P Q : nat Prop) (H : n : nat, Q n P n) (H0 : n : nat, Q n) H 2 (H0 2)
    @@ -211,22 +210,22 @@

    UseAutoTheory and Practice of Automa In the following example, the first hypothesis asserts that P n is true when Q m is true for some m, and the goal is to prove - that Q 1 implies P 2. This implication follows direction from + that Q 1 implies P 2. This implication follows directly from the hypothesis by instantiating m as the value 1. The following proof script shows that eauto successfully solves the goal, whereas auto is not able to do so.

    -Lemma solving_by_eapply : (P Q : natProp),
    -  ( n m, Q mP n) →
    +Lemma solving_by_eapply : (P Q : natProp),
    +  (n m, Q mP n) →
      Q 1 →
      P 2.
    Proof. auto. eauto. Qed.
    -

    Conjunctions

    +

    Conjunctions

    @@ -243,8 +242,8 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_conj_goal : (P : natProp) (F : Prop),
    -  ( n, P n) →
    +Lemma solving_conj_goal : (P : natProp) (F : Prop),
    +  (n, P n) →
      F
      FP 2.
    Proof. auto. Qed.
    @@ -260,7 +259,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_conj_hyp : (F F' : Prop),
    +Lemma solving_conj_hyp : (F F' : Prop),
      FF'
      F.
    Proof. auto. eauto. jauto. (* or iauto *) Qed.
    @@ -274,7 +273,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_conj_hyp' : (F F' : Prop),
    +Lemma solving_conj_hyp' : (F F' : Prop),
      FF'
      F.
    Proof. intros. jauto_set. eauto. Qed.
    @@ -286,8 +285,8 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_conj_more : (P Q R : natProp) (F : Prop),
    -  (F ∧ ( n m, (Q mR n) → P n)) →
    +Lemma solving_conj_more : (P Q R : natProp) (F : Prop),
    +  (F ∧ (n m, (Q mR n) → P n)) →
      (FR 2) →
      Q 1 →
      P 2 ∧ F.
    @@ -304,8 +303,8 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_conj_hyp_forall : (P Q : natProp),
    -  ( n, P nQ n) →
    +Lemma solving_conj_hyp_forall : (P Q : natProp),
    +  (n, P nQ n) →
      P 2.
    Proof.
      auto. eauto. iauto. jauto.
    @@ -322,14 +321,14 @@

    UseAutoTheory and Practice of Automa

    -Lemma solved_by_jauto : (P Q : natProp) (F : Prop),
    -  ( n, P n) ∧ ( n, Q n) →
    +Lemma solved_by_jauto : (P Q : natProp) (F : Prop),
    +  (n, P n) ∧ (n, Q n) →
      P 2.
    Proof. jauto. (* or iauto *) Qed.
    -

    Disjunctions

    +

    Disjunctions

    @@ -338,7 +337,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_disj_goal : (F F' : Prop),
    +Lemma solving_disj_goal : (F F' : Prop),
      F
      FF'.
    Proof. auto. Qed.
    @@ -351,7 +350,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_disj_hyp : (F F' : Prop),
    +Lemma solving_disj_hyp : (F F' : Prop),
      FF'
      F'F.
    Proof. auto. eauto. jauto. iauto. Qed.
    @@ -363,7 +362,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_tauto : (F1 F2 F3 : Prop),
    +Lemma solving_tauto : (F1 F2 F3 : Prop),
      ((¬F1F3) ∨ (F2 ∧ ¬F3)) →
      (F2F1) →
      (F2F3) →
    @@ -382,7 +381,7 @@

    UseAutoTheory and Practice of Automa

    -

    Existentials

    +

    Existentials

    @@ -397,9 +396,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma solving_exists_goal : (f : natProp),
    +Lemma solving_exists_goal : (f : natProp),
      f 2 →
    -   x, f x.
    +  x, f x.
    Proof.
      auto. (* observe that auto does not deal with existentials, *)
      eauto. (* whereas eautoiauto and jauto solve the goal *)
    @@ -409,14 +408,14 @@

    UseAutoTheory and Practice of Automa
    A major strength of jauto over the other proof search tactics is that it is able to exploit the existentially-quantified - hypotheses, i.e., those of the form x, P. + hypotheses, i.e., those of the form x, P.
    -Lemma solving_exists_hyp : (f g : natProp),
    -  ( x, f xg x) →
    -  ( a, f a) →
    -  ( a, g a).
    +Lemma solving_exists_hyp : (f g : natProp),
    +  (x, f xg x) →
    +  (a, f a) →
    +  (a, g a).
    Proof.
      auto. eauto. iauto. (* All of these tactics fail, *)
      jauto. (* whereas jauto succeeds. *)
    @@ -425,7 +424,7 @@

    UseAutoTheory and Practice of Automa

    -

    Negation

    +

    Negation

    @@ -437,9 +436,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma negation_study_1 : (P : natProp),
    +Lemma negation_study_1 : (P : natProp),
      P 0 →
    -  ( x, ¬ P x) →
    +  (x, ¬P x) →
      False.
    Proof.
      intros P H0 HX.
    @@ -455,9 +454,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma negation_study_2 : (P : natProp),
    +Lemma negation_study_2 : (P : natProp),
      P 0 →
    -  ( x, ¬ P x) →
    +  (x, ¬P x) →
      False.
    Proof. jauto. (* or iauto *) Qed.
    @@ -468,7 +467,7 @@

    UseAutoTheory and Practice of Automa

    -

    Equalities

    +

    Equalities

    @@ -480,8 +479,8 @@

    UseAutoTheory and Practice of Automa

    -Lemma equality_by_auto : (f g : natProp),
    -  ( x, f x = g x) →
    +Lemma equality_by_auto : (f g : natProp),
    +  (x, f x = g x) →
      g 2 = f 2.
    Proof. auto. Qed.
    @@ -493,7 +492,7 @@

    UseAutoTheory and Practice of Automa

    -

    How Proof Search Works

    +

    How Proof Search Works

    @@ -502,7 +501,7 @@

    UseAutoTheory and Practice of Automa

    -

    Search Depth

    +

    Search Depth

    @@ -576,7 +575,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma search_depth_1 : (P : natProp),
    +Lemma search_depth_1 : (P : natProp),
      P 0 →
      (P 0 → P 1) →
      (P 1 → P 2) →
    @@ -599,9 +598,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma search_depth_3 : (P : natProp),
    +Lemma search_depth_3 : (P : natProp),
      (* Hypothesis H1: *) (P 0) →
    -  (* Hypothesis H2: *) ( k, P (k-1) → P k) →
    +  (* Hypothesis H2: *) (k, P (k-1) → P k) →
      (* Goal:          *) (P 4).
    Proof. auto. Qed.
    @@ -611,9 +610,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma search_depth_4 : (P : natProp),
    +Lemma search_depth_4 : (P : natProp),
      (* Hypothesis H1: *) (P 0) →
    -  (* Hypothesis H2: *) ( k, P (k-1) → P k) →
    +  (* Hypothesis H2: *) (k, P (k-1) → P k) →
      (* Goal:          *) (P 5).
    Proof. auto. auto 6. Qed.
    @@ -629,15 +628,15 @@

    UseAutoTheory and Practice of Automa

    -Lemma search_depth_5 : (P : natProp),
    +Lemma search_depth_5 : (P : natProp),
      (* Hypothesis H1: *) (P 0) →
    -  (* Hypothesis H2: *) ( k, P (k-1) → P k) →
    +  (* Hypothesis H2: *) (k, P (k-1) → P k) →
      (* Goal:          *) (P 4 ∧ P 4).
    Proof. auto. auto 6. Qed.
    -

    Backtracking

    +

    Backtracking

    @@ -664,10 +663,10 @@

    UseAutoTheory and Practice of Automa

    -Lemma working_of_auto_1 : (P : natProp),
    +Lemma working_of_auto_1 : (P : natProp),
      (* Hypothesis H1: *) (P 0) →
    -  (* Hypothesis H2: *) ( k, P (k-1) → P k) →
    -  (* Hypothesis H3: *) ( k, P (k+1) → P k) →
    +  (* Hypothesis H2: *) (k, P (k-1) → P k) →
    +  (* Hypothesis H3: *) (k, P (k+1) → P k) →
      (* Goal:          *) (P 2).
    (* Uncomment "debug" in the following line to see the debug trace: *)
    Proof. intros P H1 H2 H3. (* debug *) eauto. Qed.
    @@ -697,10 +696,10 @@

    UseAutoTheory and Practice of Automa

    -Lemma working_of_auto_2 : (P : natProp),
    +Lemma working_of_auto_2 : (P : natProp),
      (* Hypothesis H1: *) (P 0) →
    -  (* Hypothesis H3: *) ( k, P (k+1) → P k) →
    -  (* Hypothesis H2: *) ( k, P (k-1) → P k) →
    +  (* Hypothesis H3: *) (k, P (k+1) → P k) →
    +  (* Hypothesis H2: *) (k, P (k-1) → P k) →
      (* Goal:          *) (P 2).
    Proof. intros P H1 H3 H2. (* debug *) eauto. Qed.
    @@ -727,36 +726,36 @@

    UseAutoTheory and Practice of Automa |5||4||3||2||1||0| -- below, tabulation indicates the depth [P 2] - -> [P 3] - -> [P 4] - -> [P 5] - -> [P 6] - -> [P 7] - -> [P 5] - -> [P 4] - -> [P 5] - -> [P 3] - --> [P 3] - -> [P 4] - -> [P 5] - -> [P 3] - -> [P 2] - -> [P 3] - -> [P 1] - -> [P 2] - -> [P 3] - -> [P 4] - -> [P 5] - -> [P 3] - -> [P 2] - -> [P 3] - -> [P 1] - -> [P 1] - -> [P 2] - -> [P 3] - -> [P 1] - -> [P 0] - -> !! Done !! + -> [P 3] + -> [P 4] + -> [P 5] + -> [P 6] + -> [P 7] + -> [P 5] + -> [P 4] + -> [P 5] + -> [P 3] + --> [P 3] + -> [P 4] + -> [P 5] + -> [P 3] + -> [P 2] + -> [P 3] + -> [P 1] + -> [P 2] + -> [P 3] + -> [P 4] + -> [P 5] + -> [P 3] + -> [P 2] + -> [P 3] + -> [P 1] + -> [P 1] + -> [P 2] + -> [P 3] + -> [P 1] + -> [P 0] + -> !! Done !!

    The first few lines read as follows. To prove P 2, eauto 5 has first tried to apply H3, producing the subgoal P 3. @@ -777,7 +776,7 @@

    UseAutoTheory and Practice of Automa

    -

    Adding Hints

    +

    Adding Hints

    @@ -799,14 +798,13 @@

    UseAutoTheory and Practice of Automa The second possibility is useful for lemmas that need to be exploited several times. The syntax for adding a lemma as a hint - is Hint Resolve mylemma. For example, the lemma asserting than - any number is less than or equal to itself, x, x x, - called Le.le_refl in the Coq standard library, can be added as a - hint as follows. + is Hint Resolve mylemma. For example:

    -Hint Resolve Le.le_refl.
    +Lemma nat_le_refl : (x:nat), xx.
    +Proof. apply le_n. Qed.

    +Hint Resolve nat_le_refl.
    @@ -824,7 +822,7 @@

    UseAutoTheory and Practice of Automa

    -

    Integration of Automation in Tactics

    +

    Integration of Automation in Tactics

    @@ -908,7 +906,7 @@

    UseAutoTheory and Practice of Automa

    -

    Example Proofs using Automation

    +

    Example Proofs using Automation

    @@ -918,7 +916,7 @@

    UseAutoTheory and Practice of Automa

    -

    Determinism

    +

    Determinism

    @@ -934,9 +932,9 @@

    UseAutoTheory and Practice of Automa

    -Theorem ceval_deterministic: c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic: c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      intros c st st1 st2 E1 E2.
    @@ -981,9 +979,9 @@

    UseAutoTheory and Practice of Automa

    -Theorem ceval_deterministic': c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic': c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      (* 请在此处解答 *) admit.
    @@ -1013,19 +1011,16 @@

    UseAutoTheory and Practice of Automa
  • use tryfalse to handle contradictions, and get rid of the cases where beval st b1 = true and beval st b1 = false - both appear in the context, - -
  • -
  • stop using ceval_cases to label subcases. + both appear in the context.
  • -Theorem ceval_deterministic'': c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic'': c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      introv E1 E2. gen st2.
    @@ -1042,7 +1037,7 @@

    UseAutoTheory and Practice of Automa
    To obtain a nice clean proof script, we have to remove the calls - assert (st' = st'0). Such a tactic invokation is not nice + assert (st' = st'0). Such a tactic call is not nice because it refers to some variables whose name has been automatically generated. This kind of tactics tend to be very brittle. The tactic assert (st' = st'0) is used to assert the @@ -1056,9 +1051,9 @@

    UseAutoTheory and Practice of Automa

    -Theorem ceval_deterministic''': c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic''': c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      (* Let's replay the proof up to the assert tactic. *)
    @@ -1086,13 +1081,13 @@

    UseAutoTheory and Practice of Automa
    To polish the proof script, it remains to factorize the calls to auto, using the star symbol. The proof of determinism can then - be rewritten in only four lines, including no more than 10 tactics. + be rewritten in just 4 lines, including no more than 10 tactics.
    -Theorem ceval_deterministic'''': c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic'''': c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      introv E1 E2. gen st2.
    @@ -1104,12 +1099,15 @@

    UseAutoTheory and Practice of Automa

    -

    Preservation for STLC

    +

    Preservation for STLC

    +
    + + To investigate how to automate the proof of the lemma preservation, + let us first import the definitions required to state that lemma.
    -
    +
    -
    Set Warnings "-notation-overridden,-parsing".
    From PLF Require Import StlcProp.
    Module PreservationProgressStlc.
    @@ -1124,9 +1122,9 @@

    UseAutoTheory and Practice of Automa

    -Theorem preservation : t t' T,
    +Theorem preservation : t t' T,
      has_type empty t T
    -  t ==> t'
    +  t --> t'
      has_type empty t' T.
    Proof with eauto.
      remember (@empty ty) as Gamma.
    @@ -1157,13 +1155,13 @@

    UseAutoTheory and Practice of Automa and calling automation using the star symbol rather than the triple-dot notation. More precisely, make use of the tactics inverts* and applys* to call auto* after a call to - inverts or to applys. The solution is three lines long. + inverts or to applys. The solution is three lines long.

    -Theorem preservation' : t t' T,
    +Theorem preservation' : t t' T,
      has_type empty t T
    -  t ==> t'
    +  t --> t'
      has_type empty t' T.
    Proof.
      (* 请在此处解答 *) admit.
    @@ -1171,7 +1169,7 @@

    UseAutoTheory and Practice of Automa

    -

    Progress for STLC

    +

    Progress for STLC

    @@ -1179,9 +1177,9 @@

    UseAutoTheory and Practice of Automa

    -Theorem progress : t T,
    +Theorem progress : t T,
      has_type empty t T
    -  value t t', t ==> t'.
    +  value tt', t --> t'.
    Proof with eauto.
      intros t T Ht.
      remember (@empty ty) as Gamma.
    @@ -1194,28 +1192,28 @@

    UseAutoTheory and Practice of Automa       destruct IHHt2...
          * (* t2 is a value *)
            inversion H; subst; try solve_by_invert.
    -         ([x0:=t2]t)...
    +        ([x0:=t2]t)...
          * (* t2 steps *)
    -       destruct H0 as [t2' Hstp]. (tapp t1 t2')...
    +       destruct H0 as [t2' Hstp]. (app t1 t2')...
        + (* t1 steps *)
    -      destruct H as [t1' Hstp]. (tapp t1' t2)...
    +      destruct H as [t1' Hstp]. (app t1' t2)...
      - (* T_If *)
        right. destruct IHHt1...
        destruct t1; try solve_by_invert...
    -    inversion H. (tif x0 t2 t3)...
    +    inversion H. (test x0 t2 t3)...
    Qed.

    Exercise: optimize the above proof. Hint: make use of destruct* and inverts*. - The solution consists of 10 short lines. + The solution fits on 10 short lines.
    -Theorem progress' : t T,
    +Theorem progress' : t T,
      has_type empty t T
    -  value t t', t ==> t'.
    +  value tt', t --> t'.
    Proof.
      (* 请在此处解答 *) admit.
    Admitted.

    @@ -1223,7 +1221,7 @@

    UseAutoTheory and Practice of Automa

    -

    BigStep and SmallStep

    +

    BigStep and SmallStep

    @@ -1240,14 +1238,14 @@

    UseAutoTheory and Practice of Automa

    -Theorem multistep__eval : t v,
    -  normal_form_of t v n, v = C nt \\ n.
    +Theorem multistep__eval : t v,
    +  normal_form_of t vn, v = C nt ==> n.
    Proof.
      intros t v Hnorm.
      unfold normal_form_of in Hnorm.
      inversion Hnorm as [Hs Hnf]; clear Hnorm.
      rewrite nf_same_as_value in Hnf. inversion Hnf. clear Hnf.
    -   n. split. reflexivity.
    +  n. split. reflexivity.
      induction Hs; subst.
      - (* multi_refl *)
        apply E_Const.
    @@ -1266,12 +1264,12 @@

    UseAutoTheory and Practice of Automa Exercise: prove the following result, using tactics introv, induction and subst, and apply*. - The solution is 3 lines long. + The solution fits on 3 short lines.

    -Theorem multistep_eval_ind : t v,
    -  t ==>* v n, C n = vt \\ n.
    +Theorem multistep_eval_ind : t v,
    +  t -->* vn, C n = vt ==> n.
    Proof.
      (* 请在此处解答 *) admit.
    Admitted.
    @@ -1281,12 +1279,12 @@

    UseAutoTheory and Practice of Automa Exercise: using the lemma above, simplify the proof of the result multistep__eval. You should use the tactics introv, inverts, split* and apply*. - The solution is 2 lines long. + The solution fits on 2 lines.

    -Theorem multistep__eval' : t v,
    -  normal_form_of t v n, v = C nt \\ n.
    +Theorem multistep__eval' : t v,
    +  normal_form_of t vn, v = C nt ==> n.
    Proof.
      (* 请在此处解答 *) admit.
    Admitted.
    @@ -1295,9 +1293,9 @@

    UseAutoTheory and Practice of Automa
    If we try to combine the two proofs into a single one, we will likely fail, because of a limitation of the - induction tactic. Indeed, this tactic looses + induction tactic. Indeed, this tactic loses information when applied to a property whose arguments - are not reduced to variables, such as t ==>* (C n). + are not reduced to variables, such as t -->* (C n). You will thus need to use the more powerful tactic called dependent induction. (This tactic is available only after importing the Program library, as we did above.) @@ -1307,12 +1305,12 @@

    UseAutoTheory and Practice of Automa the lemma multistep_eval_ind, that is, by inlining the proof by induction involved in multistep_eval_ind, using the tactic dependent induction instead of induction. - The solution is 5 lines long. + The solution fits on 6 lines.

    -Theorem multistep__eval'' : t v,
    -  normal_form_of t v n, v = C nt \\ n.
    +Theorem multistep__eval'' : t v,
    +  normal_form_of t vn, v = C nt ==> n.
    Proof.
      (* 请在此处解答 *) admit.
    Admitted.

    @@ -1320,13 +1318,13 @@

    UseAutoTheory and Practice of Automa

    -

    Preservation for STLCRef

    +

    Preservation for STLCRef


    -Require Import Coq.omega.Omega.
    +From Coq Require Import omega.Omega.
    From PLF Require Import References.
    Import STLCRef.
    Require Import Program.
    @@ -1343,11 +1341,11 @@

    UseAutoTheory and Practice of Automa

    -Theorem preservation : ST t t' T st st',
    +Theorem preservation : ST t t' T st st',
      has_type empty ST t T
      store_well_typed ST st
    -  t / st ==> t' / st'
    -   ST',
    +  t / st --> t' / st'
    +  ST',
        (extends ST' ST
         has_type empty ST' t' T
         store_well_typed ST' st').
    @@ -1372,7 +1370,7 @@

    UseAutoTheory and Practice of Automa       split; try split... eapply substitution_preserves_typing... *)
      (* new: we use inverts in place of inversion and splits to
         split the conjunction, and applys* in place of eapply... *)

    -   ST. inverts Ht1. splits*. applys* substitution_preserves_typing.

    +  ST. inverts Ht1. splits*. applys* substitution_preserves_typing.

      - (* ST_App1 *)
      (* old:
          eapply IHHt1 in H0...
    @@ -1426,7 +1424,7 @@

    UseAutoTheory and Practice of Automa     (* new: In this proof case, we need to perform an inversion
           without removing the hypothesis. The tactic inverts keep
           serves exactly this purpose. *)

    -     (ST ++ T1::nil). inverts keep HST. splits.
    +    (ST ++ T1::nil). inverts keep HST. splits.
        (* The proof of the first subgoal needs no change *)
          apply extends_app.
        (* For the second subgoal, we use the tactic applys_eq to avoid
    @@ -1454,8 +1452,8 @@

    UseAutoTheory and Practice of Automa       replace T11 with (store_Tlookup l ST).
          apply Hsty...
          inversion Ht; subst... *)

    -  (* new: we start by calling ST and splits*. *)
    -   ST. splits*.
    +  (* new: we start by calling  ST and splits*. *)
    +  ST. splits*.
      (* new: we replace destruct HST as [_ Hsty] by the following *)
      lets [_ Hsty]: HST.
      (* new: then we use the tactic applys_eq to avoid the need to
    @@ -1471,7 +1469,7 @@

    UseAutoTheory and Practice of Automa       eapply assign_pres_store_typing...
          inversion Ht1; subst... *)

      (* new: simply using nicer tactics *)
    -   ST. splits*. applys* assign_pres_store_typing. inverts* Ht1.

    +  ST. splits*. applys* assign_pres_store_typing. inverts* Ht1.

      - forwards*: IHHt1.
      - forwards*: IHHt2.
    Qed.
    @@ -1492,7 +1490,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma nth_eq_last' : (A : Type) (l : list A) (x d : A) (n : nat),
    +Lemma nth_eq_last' : (A : Type) (l : list A) (x d : A) (n : nat),
      n = length lnth n (l ++ x::nil) d = x.
    Proof. intros. subst. apply nth_eq_last. Qed.
    @@ -1504,9 +1502,9 @@

    UseAutoTheory and Practice of Automa

    -Lemma preservation_ref : (st:store) (ST : store_ty) T1,
    +Lemma preservation_ref : (st:store) (ST : store_ty) T1,
      length ST = length st
    -  TRef T1 = TRef (store_Tlookup (length st) (ST ++ T1::nil)).
    +  Ref T1 = Ref (store_Tlookup (length st) (ST ++ T1::nil)).
    Proof.
      intros. dup.

      (* A first proof, with an explicit unfold *)
    @@ -1521,18 +1519,18 @@

    UseAutoTheory and Practice of Automa

    -Theorem preservation' : ST t t' T st st',
    +Theorem preservation' : ST t t' T st st',
      has_type empty ST t T
      store_well_typed ST st
    -  t / st ==> t' / st'
    -   ST',
    +  t / st --> t' / st'
    +  ST',
        (extends ST' ST
         has_type empty ST' t' T
         store_well_typed ST' st').
    Proof.
      remember (@empty ty) as Gamma. introv Ht. gen t'.
      induction Ht; introv HST Hstep; subst Gamma; inverts Hstep; eauto.
    -  - ST. inverts Ht1. splits*. applys* substitution_preserves_typing.
    +  - ST. inverts Ht1. splits*. applys* substitution_preserves_typing.
      - forwards*: IHHt1.
      - forwards*: IHHt2.
      - forwards*: IHHt.
    @@ -1540,24 +1538,24 @@

    UseAutoTheory and Practice of Automa   - forwards*: IHHt1.
      - forwards*: IHHt2.
      - forwards*: IHHt1.
    -  - (ST ++ T1::nil). inverts keep HST. splits.
    +  - (ST ++ T1::nil). inverts keep HST. splits.
        apply extends_app.
        applys_eq T_Loc 1.
          rewrite app_length. simpl. omega.
          unfold store_Tlookup. rewrite* nth_eq_last'.
        apply* store_well_typed_app.
      - forwards*: IHHt.
    -  - ST. splits*. lets [_ Hsty]: HST.
    +  - ST. splits*. lets [_ Hsty]: HST.
        applys_eq* Hsty 1. inverts* Ht.
      - forwards*: IHHt.
    -  - ST. splits*. applys* assign_pres_store_typing. inverts* Ht1.
    +  - ST. splits*. applys* assign_pres_store_typing. inverts* Ht1.
      - forwards*: IHHt1.
      - forwards*: IHHt2.
    Qed.

    -

    Progress for STLCRef

    +

    Progress for STLCRef

    @@ -1567,10 +1565,10 @@

    UseAutoTheory and Practice of Automa

    -Theorem progress : ST t T st,
    +Theorem progress : ST t T st,
      has_type empty ST t T
      store_well_typed ST st
    -  (value t t', st', t / st ==> t' / st').
    +  (value tt' st', t / st --> t' / st').
    Proof.
      introv Ht HST. remember (@empty ty) as Gamma.
      induction Ht; subst Gamma; tryfalse; try solve [left*].
    @@ -1600,7 +1598,7 @@

    UseAutoTheory and Practice of Automa

    -

    Subtyping

    +

    Subtyping

    @@ -1617,8 +1615,8 @@

    UseAutoTheory and Practice of Automa

    -Lemma abs_arrow : x S1 s2 T1 T2,
    -  has_type empty (tabs x S1 s2) (TArrow T1 T2) →
    +Lemma abs_arrow : x S1 s2 T1 T2,
    +  has_type empty (abs x S1 s2) (Arrow T1 T2) →
         subtype T1 S1
      ∧ has_type (update empty x S1) s2 T2.
    Proof with eauto.
    @@ -1636,40 +1634,22 @@

    UseAutoTheory and Practice of Automa introv, lets and inverts*. In particular, you will find it useful to replace the pattern apply K in H. destruct H as I with lets I: K H. - The solution is 4 lines. + The solution fits on 3 lines.

    -Lemma abs_arrow' : x S1 s2 T1 T2,
    -  has_type empty (tabs x S1 s2) (TArrow T1 T2) →
    +Lemma abs_arrow' : x S1 s2 T1 T2,
    +  has_type empty (abs x S1 s2) (Arrow T1 T2) →
         subtype T1 S1
      ∧ has_type (update empty x S1) s2 T2.
    Proof.
      (* 请在此处解答 *) admit.
    -Admitted.
    -
    - -
    -The lemma substitution_preserves_typing has already been used to - illustrate the working of lets and applys in chapter - UseTactics. Optimize further this proof using automation (with - the star symbol), and using the tactic cases_if'. The solution - is 33 lines). -
    -
    - -Lemma substitution_preserves_typing : Gamma x U v t S,
    -  has_type (update Gamma x U) t S
    -  has_type empty v U
    -  has_type Gamma ([x:=v]t) S.
    -Proof.
    -  (* 请在此处解答 *) admit.
    Admitted.

    End SubtypingInversion.
    -

    Advanced Topics in Proof Search

    +

    Advanced Topics in Proof Search

    @@ -1678,7 +1658,7 @@

    UseAutoTheory and Practice of Automa

    -

    Stating Lemmas in the Right Way

    +

    Stating Lemmas in the Right Way

    @@ -1699,21 +1679,21 @@

    UseAutoTheory and Practice of Automa P n holds for any n as soon as P m holds for at least one m different from zero. The goal is to prove that P 2 implies P 1. When the hypothesis about P is stated in the form - n m, P m m 0 P n, then eauto works. However, with - n m, m 0 P m P n, the tactic eauto fails. + n m, P m m 0 P n, then eauto works. However, with + n m, m 0 P m P n, the tactic eauto fails.

    -Lemma order_matters_1 : (P : natProp),
    -  ( n m, P mm ≠ 0 → P n) →
    +Lemma order_matters_1 : (P : natProp),
    +  (n m, P mm ≠ 0 → P n) →
      P 2 →
      P 1.
    Proof.
      eauto. (* Success *)
      (* The proof: intros P H K. eapply H. apply K. auto. *)
    Qed.

    -Lemma order_matters_2 : (P : natProp),
    -  ( n m, m ≠ 0 → P mP n) →
    +Lemma order_matters_2 : (P : natProp),
    +  (n m, m ≠ 0 → P mP n) →
      P 5 →
      P 1.
    Proof.
    @@ -1733,8 +1713,8 @@

    UseAutoTheory and Practice of Automa

    -It is very important to understand that the hypothesis n - m, P m m 0 P n is eauto-friendly, whereas n m, m +It is very important to understand that the hypothesis n + m, P m m 0 P n is eauto-friendly, whereas n m, m 0 P m P n really isn't. Guessing a value of m for which P m holds and then checking that m 0 holds works well because there are few values of m for which P m holds. So, it @@ -1745,7 +1725,7 @@

    UseAutoTheory and Practice of Automa

    -

    Unfolding of Definitions During Proof-Search

    +

    Unfolding of Definitions During Proof-Search

    @@ -1769,7 +1749,7 @@

    UseAutoTheory and Practice of Automa
    Axiom P : natProp.

    -Definition myFact := x, x ≤ 3 → P x.
    +Definition myFact := x, x ≤ 3 → P x.
    @@ -1780,7 +1760,7 @@

    UseAutoTheory and Practice of Automa
    Lemma demo_hint_unfold_goal_1 :
    -  ( x, P x) →
    +  (x, P x) →
      myFact.
    Proof.
      auto. (* Proof search doesn't know what to do, *)
    @@ -1806,7 +1786,7 @@

    UseAutoTheory and Practice of Automa
    Lemma demo_hint_unfold_goal_2 :
    -  ( x, P x) →
    +  (x, P x) →
      myFact.
    Proof. auto. Qed.
    @@ -1845,7 +1825,7 @@

    UseAutoTheory and Practice of Automa

    -

    Automation for Proving Absurd Goals

    +

    Automation for Proving Absurd Goals

    @@ -1861,9 +1841,9 @@

    UseAutoTheory and Practice of Automa

    -Parameter le_not_gt : x,
    +Parameter le_not_gt : x,
      (x ≤ 3) →
    -  ¬ (x > 3).
    +  ¬(x > 3).
    @@ -1872,9 +1852,9 @@

    UseAutoTheory and Practice of Automa

    -Parameter gt_not_le : x,
    +Parameter gt_not_le : x,
      (x > 3) →
    -  ¬ (x ≤ 3).
    +  ¬(x ≤ 3).
    @@ -1884,7 +1864,7 @@

    UseAutoTheory and Practice of Automa

    -Parameter le_gt_false : x,
    +Parameter le_gt_false : x,
      (x ≤ 3) →
      (x > 3) →
      False.
    @@ -1896,7 +1876,7 @@

    UseAutoTheory and Practice of Automa automation. The following material is enclosed inside a Section, so as to restrict the scope of the hints that we are adding. In other words, after the end of the section, the hints added within - the section will no longer be active. + the section will no longer be active.

    @@ -1906,13 +1886,13 @@

    UseAutoTheory and Practice of Automa
    Let's try to add the first lemma, le_not_gt, as hint, and see whether we can prove that the proposition - x, x 3 x > 3 is absurd. + x, x 3 x > 3 is absurd.
    Hint Resolve le_not_gt.

    Lemma demo_auto_absurd_1 :
    -  ( x, x ≤ 3 ∧ x > 3) →
    +  (x, x ≤ 3 ∧ x > 3) →
      False.
    Proof.
      intros. jauto_set. (* decomposes the assumption *)
    @@ -1931,7 +1911,7 @@

    UseAutoTheory and Practice of Automa Hint Resolve le_gt_false.

    Lemma demo_auto_absurd_2 :
    -  ( x, x ≤ 3 ∧ x > 3) →
    +  (x, x ≤ 3 ∧ x > 3) →
      False.
    Proof.
      dup.

    @@ -1972,7 +1952,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma demo_false : x,
    +Lemma demo_false : x,
      (x ≤ 3) →
      (x > 3) →
      4 = 5.
    @@ -1981,7 +1961,7 @@

    UseAutoTheory and Practice of Automa   (* A failed proof: *)
      - false. eapply le_gt_false.
        + auto. (* here, auto does not prove ?x 3 by using H but
    -             by using the lemma le_refl : x, x x. *)

    +             by using the lemma le_refl : x, x x. *)

        (* The second subgoal becomes 3 > 3, which is not provable. *)
        + skip.

      (* A correct proof: *)
    @@ -1991,8 +1971,8 @@

    UseAutoTheory and Practice of Automa   (* The same proof using false: *)
      - false le_gt_false. eauto. eauto.

      (* The lemmas le_not_gt and gt_not_le work as well *)
    -  - false le_not_gt. eauto. eauto.
    -Qed.
    +  - false le_not_gt. eauto. eauto.

    +Abort.

    @@ -2006,7 +1986,7 @@

    UseAutoTheory and Practice of Automa

    -

    Automation for Transitivity Lemmas

    +

    Automation for Transitivity Lemmas

    @@ -2026,9 +2006,9 @@

    UseAutoTheory and Practice of Automa Parameter typ : Type.

    Parameter subtype : typtypProp.

    -Parameter subtype_refl : T,
    +Parameter subtype_refl : T,
      subtype T T.

    -Parameter subtype_trans : S T U,
    +Parameter subtype_trans : S T U,
      subtype S Tsubtype T Usubtype S U.

    @@ -2055,12 +2035,12 @@

    UseAutoTheory and Practice of Automa

    -Now, consider the goal S T, subtype S T, which clearly has +Now, consider the goal S T, subtype S T, which clearly has no hope of being solved. Let's call eauto on this goal.
    -Lemma transitivity_bad_hint_1 : S T,
    +Lemma transitivity_bad_hint_1 : S T,
      subtype S T.
    Proof.
      intros. (* debug *) eauto. (* Investigates 106 applications... *)
    @@ -2117,8 +2097,8 @@

    UseAutoTheory and Practice of Automa Hint Extern 1 (subtype ?S ?U) ⇒
      match goal with
    -  | H: subtype S ?T |- _apply (@subtype_trans S T U)
    -  | H: subtype ?T U |- _apply (@subtype_trans S T U)
    +  | H: subtype S ?T_apply (@subtype_trans S T U)
    +  | H: subtype ?T U_apply (@subtype_trans S T U)
      end.

    @@ -2145,13 +2125,13 @@

    UseAutoTheory and Practice of Automa patterns in the goal, or in the proof context, or both. -
  • The first pattern is H: subtype S ?T |- _. It indices that +
  • The first pattern is H: subtype S ?T _. It indices that the context should contain an hypothesis H of type subtype S ?T, where S has to be the same as in the goal, and where ?T can have any value.
  • -
  • The symbol |- _ at the end of H: subtype S ?T |- _ indicates +
  • The symbol _ at the end of H: subtype S ?T _ indicates that we do not impose further condition on how the proof obligation has to look like. @@ -2178,7 +2158,7 @@

    UseAutoTheory and Practice of Automa

  • -Lemma transitivity_workaround_1 : T1 T2 T3 T4,
    +Lemma transitivity_workaround_1 : T1 T2 T3 T4,
      subtype T1 T2
      subtype T2 T3
      subtype T3 T4
    @@ -2194,7 +2174,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma transitivity_workaround_2 : S T,
    +Lemma transitivity_workaround_2 : S T,
      subtype S T.
    Proof.
      intros. (* debug *) eauto. (* Investigates 0 applications *)
    @@ -2202,7 +2182,7 @@

    UseAutoTheory and Practice of Automa

    -

    Decision Procedures

    +

    Decision Procedures

    @@ -2218,7 +2198,7 @@

    UseAutoTheory and Practice of Automa

    -

    Omega

    +

    Omega

    @@ -2241,7 +2221,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma omega_demo_1 : (x y : nat),
    +Lemma omega_demo_1 : (x y : nat),
      (y ≤ 4) →
      (x + x + 1 ≤ y) →
      (x ≠ 0) →
    @@ -2256,7 +2236,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma omega_demo_2 : (x y z : nat),
    +Lemma omega_demo_2 : (x y z : nat),
      (x + y = z + z) →
      (x - y ≤ 4) →
      (x - z ≤ 2).
    @@ -2271,7 +2251,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma omega_demo_3 : (x y : nat),
    +Lemma omega_demo_3 : (x y : nat),
      (x + 5 ≤ y) →
      (y - x < 3) →
      False.
    @@ -2286,7 +2266,7 @@

    UseAutoTheory and Practice of Automa

    -Lemma omega_demo_4 : (x y : nat) (P : Prop),
    +Lemma omega_demo_4 : (x y : nat) (P : Prop),
      (x + 5 ≤ y) →
      (y - x < 3) →
      P.
    @@ -2300,7 +2280,7 @@

    UseAutoTheory and Practice of Automa

    -

    Ring

    +

    Ring

    @@ -2316,7 +2296,7 @@

    UseAutoTheory and Practice of Automa Module RingDemo.
      Open Scope Z_scope.
      (* Arithmetic symbols are now interpreted in Z *)

    -Lemma ring_demo : (x y z : Z),
    +Lemma ring_demo : (x y z : Z),
        x * (y + z) - z * 3 * x
      = x * y - 2 * x * z.
    Proof. intros. ring. Qed.

    @@ -2324,7 +2304,7 @@

    UseAutoTheory and Practice of Automa

    -

    Congruence

    +

    Congruence

    @@ -2338,7 +2318,7 @@

    UseAutoTheory and Practice of Automa
    Lemma congruence_demo_1 :
    -    (f : natnatnat) (g h : natnat) (x y z : nat),
    +   (f : natnatnat) (g h : natnat) (x y z : nat),
       f (g x) (g y) = z
       2 = g x
       g y = h z
    @@ -2348,13 +2328,13 @@

    UseAutoTheory and Practice of Automa
    Moreover, congruence is able to exploit universally quantified - equalities, for example a, g a = h a. + equalities, for example a, g a = h a.
    Lemma congruence_demo_2 :
    -    (f : natnatnat) (g h : natnat) (x y z : nat),
    -   ( a, g a = h a) →
    +   (f : natnatnat) (g h : natnat) (x y z : nat),
    +   (a, g a = h a) →
       f (g x) (g y) = z
       g x = 2 →
       f 2 (h y) = z.
    @@ -2366,8 +2346,8 @@

    UseAutoTheory and Practice of Automa

    -Lemma congruence_demo_4 : (f g : natnat),
    -  ( a, f a = g a) →
    +Lemma congruence_demo_4 : (f g : natnat),
    +  (a, f a = g a) →
      f (g (g 2)) = g (f (f 2)).
    Proof. congruence. Qed.
    @@ -2380,8 +2360,8 @@

    UseAutoTheory and Practice of Automa
    Lemma congruence_demo_3 :
    -    (f g h : natnat) (x : nat),
    -   ( a, f a = h a) →
    +   (f g h : natnat) (x : nat),
    +   (a, f a = h a) →
       g x = f x
       g xh x
       False.
    @@ -2395,7 +2375,7 @@

    UseAutoTheory and Practice of Automa

    -

    Summary

    +

    Summary

    @@ -2495,9 +2475,10 @@

    UseAutoTheory and Practice of Automa Becoming a master in the black art of automation certainly requires some investment, however this investment will pay off very quickly. -
    +

    +
    - +(* Sat Jan 26 15:15:46 UTC 2019 *)

    diff --git a/plf-current/UseAuto.v b/plf-current/UseAuto.v index 8d0ed4fd..fccf7075 100644 --- a/plf-current/UseAuto.v +++ b/plf-current/UseAuto.v @@ -1,5 +1,4 @@ (** * UseAuto: Theory and Practice of Automation in Coq Proofs *) - (* Chapter written and maintained by Arthur Chargueraud *) (** In a machine-checked proof, every single detail has to be @@ -27,7 +26,7 @@ from the library [LibTactics.v], which is presented in the chapter [UseTactics]. *) -Require Import Coq.Arith.Arith. +From Coq Require Import Arith.Arith. From PLF Require Import Maps. From PLF Require Import Smallstep. @@ -36,7 +35,7 @@ From PLF Require Import LibTactics. From PLF Require Imp. -Require Import Coq.Lists.List. +From Coq Require Import Lists.List. Import ListNotations. (* ################################################################# *) @@ -56,7 +55,6 @@ Import ListNotations. lot of time both in building proof scripts and in subsequently maintaining those proof scripts. *) - (* ================================================================= *) (** ** Strength of Proof Search *) @@ -91,7 +89,6 @@ Import ListNotations. the various branches of a proof. It is not able to discover the overall structure of a proof. *) - (* ================================================================= *) (** ** Basics *) @@ -140,7 +137,7 @@ Proof. auto. Qed. In the following example, the first hypothesis asserts that [P n] is true when [Q m] is true for some [m], and the goal is to prove - that [Q 1] implies [P 2]. This implication follows direction from + that [Q 1] implies [P 2]. This implication follows directly from the hypothesis by instantiating [m] as the value [1]. The following proof script shows that [eauto] successfully solves the goal, whereas [auto] is not able to do so. *) @@ -152,7 +149,6 @@ Lemma solving_by_eapply : forall (P Q : nat->Prop), Proof. auto. eauto. Qed. - (* ================================================================= *) (** ** Conjunctions *) @@ -230,7 +226,6 @@ Lemma solved_by_jauto : forall (P Q : nat->Prop) (F : Prop), P 2. Proof. jauto. (* or [iauto] *) Qed. - (* ================================================================= *) (** ** Disjunctions *) @@ -269,7 +264,6 @@ Proof. iauto. Qed. compared with [iauto] is that it never spends time performing this kind of case analyses. *) - (* ================================================================= *) (** ** Existentials *) @@ -304,7 +298,6 @@ Proof. (* For the details, run [intros. jauto_set. eauto] *) Qed. - (* ================================================================= *) (** ** Negation *) @@ -337,7 +330,6 @@ Proof. jauto. (* or [iauto] *) Qed. (** We will come back later on to the behavior of proof search with respect to the unfolding of definitions. *) - (* ================================================================= *) (** ** Equalities *) @@ -356,7 +348,6 @@ Proof. auto. Qed. rather try to use the tactic [congruence], which is presented at the end of this chapter in the "Decision Procedures" section. *) - (* ################################################################# *) (** * How Proof Search Works *) @@ -467,7 +458,6 @@ Lemma search_depth_5 : forall (P : nat->Prop), (* Goal: *) (P 4 /\ P 4). Proof. auto. auto 6. Qed. - (* ================================================================= *) (** ** Backtracking *) @@ -583,7 +573,6 @@ Proof. intros P H1 H3 H2. (* debug *) eauto. Qed. and [P 0]. This search tree explains why [eauto] came up with a proof term starting with an application of [H3]. *) - (* ================================================================= *) (** ** Adding Hints *) @@ -601,12 +590,12 @@ Proof. intros P H1 H3 H2. (* debug *) eauto. Qed. The second possibility is useful for lemmas that need to be exploited several times. The syntax for adding a lemma as a hint - is [Hint Resolve mylemma]. For example, the lemma asserting than - any number is less than or equal to itself, [forall x, x <= x], - called [Le.le_refl] in the Coq standard library, can be added as a - hint as follows. *) + is [Hint Resolve mylemma]. For example: *) + +Lemma nat_le_refl : forall (x:nat), x <= x. +Proof. apply le_n. Qed. -Hint Resolve Le.le_refl. +Hint Resolve nat_le_refl. (** A convenient shorthand for adding all the constructors of an inductive datatype as hints is the command [Hint Constructors @@ -618,7 +607,6 @@ Hint Resolve Le.le_refl. and the presentation of a general work-around for transitivity lemmas appear further on. *) - (* ================================================================= *) (** ** Integration of Automation in Tactics *) @@ -684,7 +672,6 @@ Ltac auto_tilde ::= auto. of the "Software Foundations" course, proving in particular results such as determinism, preservation and progress. *) - (* ================================================================= *) (** ** Determinism *) @@ -695,8 +682,8 @@ Module DeterministicImp. language, shown below. *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. intros c st st1 st2 E1 E2. @@ -738,8 +725,8 @@ Qed. (The solution uses [auto] 9 times.) *) Theorem ceval_deterministic': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. (* 请在此处解答 *) admit. @@ -757,12 +744,11 @@ Admitted. - use [inverts H] instead of [inversion H; subst], - use [tryfalse] to handle contradictions, and get rid of the cases where [beval st b1 = true] and [beval st b1 = false] - both appear in the context, - - stop using [ceval_cases] to label subcases. *) + both appear in the context. *) Theorem ceval_deterministic'': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. introv E1 E2. gen st2. @@ -777,7 +763,7 @@ Proof. Qed. (** To obtain a nice clean proof script, we have to remove the calls - [assert (st' = st'0)]. Such a tactic invokation is not nice + [assert (st' = st'0)]. Such a tactic call is not nice because it refers to some variables whose name has been automatically generated. This kind of tactics tend to be very brittle. The tactic [assert (st' = st'0)] is used to assert the @@ -790,8 +776,8 @@ Qed. example. *) Theorem ceval_deterministic''': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. (* Let's replay the proof up to the [assert] tactic. *) @@ -822,11 +808,11 @@ Abort. (** To polish the proof script, it remains to factorize the calls to [auto], using the star symbol. The proof of determinism can then - be rewritten in only four lines, including no more than 10 tactics. *) + be rewritten in just 4 lines, including no more than 10 tactics. *) Theorem ceval_deterministic'''': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. introv E1 E2. gen st2. @@ -837,10 +823,12 @@ Qed. End DeterministicImp. - (* ================================================================= *) (** ** Preservation for STLC *) +(** To investigate how to automate the proof of the lemma [preservation], + let us first import the definitions required to state that lemma. *) + Set Warnings "-notation-overridden,-parsing". From PLF Require Import StlcProp. Module PreservationProgressStlc. @@ -853,7 +841,7 @@ Import STLCProp. Theorem preservation : forall t t' T, has_type empty t T -> - t ==> t' -> + t --> t' -> has_type empty t' T. Proof with eauto. remember (@empty ty) as Gamma. @@ -882,17 +870,16 @@ Qed. and calling automation using the star symbol rather than the triple-dot notation. More precisely, make use of the tactics [inverts*] and [applys*] to call [auto*] after a call to - [inverts] or to [applys]. The solution is three lines long.*) + [inverts] or to [applys]. The solution is three lines long. *) Theorem preservation' : forall t t' T, has_type empty t T -> - t ==> t' -> + t --> t' -> has_type empty t' T. Proof. (* 请在此处解答 *) admit. Admitted. - (* ================================================================= *) (** ** Progress for STLC *) @@ -900,7 +887,7 @@ Admitted. Theorem progress : forall t T, has_type empty t T -> - value t \/ exists t', t ==> t'. + value t \/ exists t', t --> t'. Proof with eauto. intros t T Ht. remember (@empty ty) as Gamma. @@ -915,29 +902,28 @@ Proof with eauto. inversion H; subst; try solve_by_invert. exists ([x0:=t2]t)... * (* t2 steps *) - destruct H0 as [t2' Hstp]. exists (tapp t1 t2')... + destruct H0 as [t2' Hstp]. exists (app t1 t2')... + (* t1 steps *) - destruct H as [t1' Hstp]. exists (tapp t1' t2)... + destruct H as [t1' Hstp]. exists (app t1' t2)... - (* T_If *) right. destruct IHHt1... destruct t1; try solve_by_invert... - inversion H. exists (tif x0 t2 t3)... + inversion H. exists (test x0 t2 t3)... Qed. (** Exercise: optimize the above proof. Hint: make use of [destruct*] and [inverts*]. - The solution consists of 10 short lines. *) + The solution fits on 10 short lines. *) Theorem progress' : forall t T, has_type empty t T -> - value t \/ exists t', t ==> t'. + value t \/ exists t', t --> t'. Proof. (* 请在此处解答 *) admit. Admitted. End PreservationProgressStlc. - (* ================================================================= *) (** ** BigStep and SmallStep *) @@ -949,7 +935,7 @@ Module Semantics. to a big-step reduction judgment. *) Theorem multistep__eval : forall t v, - normal_form_of t v -> exists n, v = C n /\ t \\ n. + normal_form_of t v -> exists n, v = C n /\ t ==> n. Proof. intros t v Hnorm. unfold normal_form_of in Hnorm. @@ -971,10 +957,10 @@ Qed. (** Exercise: prove the following result, using tactics [introv], [induction] and [subst], and [apply*]. - The solution is 3 lines long. *) + The solution fits on 3 short lines. *) Theorem multistep_eval_ind : forall t v, - t ==>* v -> forall n, C n = v -> t \\ n. + t -->* v -> forall n, C n = v -> t ==> n. Proof. (* 请在此处解答 *) admit. Admitted. @@ -982,19 +968,19 @@ Admitted. (** Exercise: using the lemma above, simplify the proof of the result [multistep__eval]. You should use the tactics [introv], [inverts], [split*] and [apply*]. - The solution is 2 lines long. *) + The solution fits on 2 lines. *) Theorem multistep__eval' : forall t v, - normal_form_of t v -> exists n, v = C n /\ t \\ n. + normal_form_of t v -> exists n, v = C n /\ t ==> n. Proof. (* 请在此处解答 *) admit. Admitted. (** If we try to combine the two proofs into a single one, we will likely fail, because of a limitation of the - [induction] tactic. Indeed, this tactic looses + [induction] tactic. Indeed, this tactic loses information when applied to a property whose arguments - are not reduced to variables, such as [t ==>* (C n)]. + are not reduced to variables, such as [t -->* (C n)]. You will thus need to use the more powerful tactic called [dependent induction]. (This tactic is available only after importing the [Program] library, as we did above.) *) @@ -1003,21 +989,20 @@ Admitted. the lemma [multistep_eval_ind], that is, by inlining the proof by induction involved in [multistep_eval_ind], using the tactic [dependent induction] instead of [induction]. - The solution is 5 lines long. *) + The solution fits on 6 lines. *) Theorem multistep__eval'' : forall t v, - normal_form_of t v -> exists n, v = C n /\ t \\ n. + normal_form_of t v -> exists n, v = C n /\ t ==> n. Proof. (* 请在此处解答 *) admit. Admitted. End Semantics. - (* ================================================================= *) (** ** Preservation for STLCRef *) -Require Import Coq.omega.Omega. +From Coq Require Import omega.Omega. From PLF Require Import References. Import STLCRef. Require Import Program. @@ -1033,7 +1018,7 @@ Hint Resolve store_weakening extends_refl. Theorem preservation : forall ST t t' T st st', has_type empty ST t T -> store_well_typed ST st -> - t / st ==> t' / st' -> + t / st --> t' / st' -> exists ST', (extends ST' ST /\ has_type empty ST' t' T /\ @@ -1196,7 +1181,7 @@ Proof. intros. subst. apply nth_eq_last. Qed. Lemma preservation_ref : forall (st:store) (ST : store_ty) T1, length ST = length st -> - TRef T1 = TRef (store_Tlookup (length st) (ST ++ T1::nil)). + Ref T1 = Ref (store_Tlookup (length st) (ST ++ T1::nil)). Proof. intros. dup. @@ -1212,7 +1197,7 @@ Qed. Theorem preservation' : forall ST t t' T st st', has_type empty ST t T -> store_well_typed ST st -> - t / st ==> t' / st' -> + t / st --> t' / st' -> exists ST', (extends ST' ST /\ has_type empty ST' t' T /\ @@ -1243,7 +1228,6 @@ Proof. - forwards*: IHHt2. Qed. - (* ================================================================= *) (** ** Progress for STLCRef *) @@ -1254,7 +1238,7 @@ Qed. Theorem progress : forall ST t T st, has_type empty ST t T -> store_well_typed ST st -> - (value t \/ exists t', exists st', t / st ==> t' / st'). + (value t \/ exists t' st', t / st --> t' / st'). Proof. introv Ht HST. remember (@empty ty) as Gamma. induction Ht; subst Gamma; tryfalse; try solve [left*]. @@ -1283,7 +1267,6 @@ Qed. End PreservationProgressReferences. - (* ================================================================= *) (** ** Subtyping *) @@ -1295,7 +1278,7 @@ Import Sub. of abstractions in a type system with subtyping. *) Lemma abs_arrow : forall x S1 s2 T1 T2, - has_type empty (tabs x S1 s2) (TArrow T1 T2) -> + has_type empty (abs x S1 s2) (Arrow T1 T2) -> subtype T1 S1 /\ has_type (update empty x S1) s2 T2. Proof with eauto. @@ -1311,33 +1294,18 @@ Qed. [introv], [lets] and [inverts*]. In particular, you will find it useful to replace the pattern [apply K in H. destruct H as I] with [lets I: K H]. - The solution is 4 lines. *) + The solution fits on 3 lines. *) Lemma abs_arrow' : forall x S1 s2 T1 T2, - has_type empty (tabs x S1 s2) (TArrow T1 T2) -> + has_type empty (abs x S1 s2) (Arrow T1 T2) -> subtype T1 S1 /\ has_type (update empty x S1) s2 T2. Proof. (* 请在此处解答 *) admit. Admitted. -(** The lemma [substitution_preserves_typing] has already been used to - illustrate the working of [lets] and [applys] in chapter - [UseTactics]. Optimize further this proof using automation (with - the star symbol), and using the tactic [cases_if']. The solution - is 33 lines). *) - -Lemma substitution_preserves_typing : forall Gamma x U v t S, - has_type (update Gamma x U) t S -> - has_type empty v U -> - has_type Gamma ([x:=v]t) S. -Proof. - (* 请在此处解答 *) admit. -Admitted. - End SubtypingInversion. - (* ################################################################# *) (** * Advanced Topics in Proof Search *) @@ -1401,7 +1369,6 @@ Abort. that [P m] holds does not work well, because there are many values of [m] that satisfy [m <> 0] but not [P m]. *) - (* ================================================================= *) (** ** Unfolding of Definitions During Proof-Search *) @@ -1477,7 +1444,6 @@ Lemma demo_hint_unfold_context_2 : P 3. Proof. auto. Qed. - (* ================================================================= *) (** ** Automation for Proving Absurd Goals *) @@ -1515,7 +1481,7 @@ Parameter le_gt_false : forall x, automation. The following material is enclosed inside a [Section], so as to restrict the scope of the hints that we are adding. In other words, after the end of the section, the hints added within - the section will no longer be active.*) + the section will no longer be active. *) Section DemoAbsurd1. @@ -1600,7 +1566,8 @@ Proof. (* The lemmas [le_not_gt] and [gt_not_le] work as well *) - false le_not_gt. eauto. eauto. -Qed. + +Abort. (** In the above example, [false le_gt_false; eauto] proves the goal, but [false le_gt_false; auto] does not, because [auto] does not @@ -1610,7 +1577,6 @@ Qed. completing the proof: either call [false le_gt_false; eauto], or call [false* (le_gt_false 3)]. *) - (* ================================================================= *) (** ** Automation for Transitivity Lemmas *) @@ -1750,7 +1716,6 @@ Proof. intros. (* debug *) eauto. (* Investigates 0 applications *) Abort. - (* ################################################################# *) (** * Decision Procedures *) @@ -1764,7 +1729,6 @@ Abort. and inequalities by exploiting equalities available in the proof context. *) - (* ================================================================= *) (** ** Omega *) @@ -1826,7 +1790,6 @@ Proof. false. omega. Qed. - (* ================================================================= *) (** ** Ring *) @@ -1848,7 +1811,6 @@ Proof. intros. ring. Qed. End RingDemo. - (* ================================================================= *) (** ** Congruence *) @@ -1951,4 +1913,4 @@ Proof. congruence. Qed. some investment, however this investment will pay off very quickly. *) -(** $Date$ *) +(* Sat Jan 26 15:15:46 UTC 2019 *) diff --git a/plf-current/UseAutoTest.v b/plf-current/UseAutoTest.v index 74c5fdad..d8371eb5 100644 --- a/plf-current/UseAutoTest.v +++ b/plf-current/UseAutoTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:46 UTC 2019 *) diff --git a/plf-current/UseTactics.html b/plf-current/UseTactics.html index ebf5559e..ce3fb477 100644 --- a/plf-current/UseTactics.html +++ b/plf-current/UseTactics.html @@ -49,7 +49,7 @@

    UseTacticsTactic Library for Coq: A
    Set Warnings "-notation-overridden,-parsing".

    -Require Import Coq.Arith.Arith.

    +From Coq Require Import Arith.Arith.

    From PLF Require Import Maps.
    From PLF Require Import Imp.
    From PLF Require Import Types.
    @@ -146,9 +146,9 @@

    UseTacticsTactic Library for Coq: A

    -Theorem ceval_deterministic: c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic: c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      introv E1 E2. (* was intros c st st1 st2 E1 E2 *)
    @@ -161,8 +161,8 @@

    UseTacticsTactic Library for Coq: A

    -Theorem dist_exists_or : (X:Type) (P Q : XProp),
    -  ( x, P xQ x) ↔ ( x, P x) ∨ ( x, Q x).
    +Theorem dist_exists_or : (X:Type) (P Q : XProp),
    +  (x, P xQ x) ↔ (x, P x) ∨ (x, Q x).
    Proof.
      introv. (* was intros X P Q *)
    Abort.
    @@ -170,14 +170,14 @@

    UseTacticsTactic Library for Coq: A
    The tactic introv also applies to statements in which - and are interleaved. + and are interleaved.
    -Theorem ceval_deterministic': c st st1,
    -  (c / st \\ st1) →
    -   st2,
    -  (c / st \\ st2) →
    +Theorem ceval_deterministic': c st st1,
    +  (st =[ c ]⇒ st1) →
    +  st2,
    +  (st =[ c ]⇒ st2) →
      st1 = st2.
    Proof.
      introv E1 E2. (* was intros c st st1 E1 st2 E2 *)
    @@ -190,9 +190,9 @@

    UseTacticsTactic Library for Coq: A

    -Theorem exists_impl: X (P : XProp) (Q : Prop) (R : Prop),
    -  ( x, P xQ) →
    -  (( x, P x) → Q).
    +Theorem exists_impl: X (P : XProp) (Q : Prop) (R : Prop),
    +  (x, P xQ) →
    +  ((x, P x) → Q).
    Proof.
      introv [x H2]. eauto.
      (* same as intros X P Q R H1 [x H2]., which is itself short
    @@ -242,7 +242,7 @@

    UseTacticsTactic Library for Coq: A

    -Theorem skip_left: c,
    +Theorem skip_left: c,
      cequiv (SKIP;; c) c.
    Proof.
      introv. split; intros H.
    @@ -259,9 +259,9 @@

    UseTacticsTactic Library for Coq: A

    -Theorem ceval_deterministic: c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic: c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      introv E1 E2. generalize dependent st2.
    @@ -284,9 +284,9 @@

    UseTacticsTactic Library for Coq: A

    -Theorem ceval_deterministic': c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic': c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      introv E1 E2. generalize dependent st2.
    @@ -331,7 +331,7 @@

    UseTacticsTactic Library for Coq: A

    -Theorem skip_left': c,
    +Theorem skip_left': c,
      cequiv (SKIP;; c) c.
    Proof.
      introv. split; intros H.
    @@ -347,11 +347,11 @@

    UseTacticsTactic Library for Coq: A
    Example typing_nonexample_1 :
    -  ¬ T,
    +  ¬T,
          has_type empty
    -        (tabs x TBool
    -            (tabs y TBool
    -               (tapp (tvar x) (tvar y))))
    +        (abs x Bool
    +            (abs y Bool
    +               (app (var x) (var y))))
            T.
    Proof.
      dup 3.

    @@ -408,10 +408,7 @@

    UseTacticsTactic Library for Coq: A
  • splits for decomposing n-ary conjunctions,
  • -
  • branch for decomposing n-ary disjunctions, - -
  • -
  • for proving n-ary existentials. +
  • branch for decomposing n-ary disjunctions
  • @@ -436,7 +433,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_splits : n m,
    +Lemma demo_splits : n m,
      n > 0 ∧ n < mm < n+10 ∧ m ≠ 3.
    Proof.
      intros. splits.
    @@ -455,7 +452,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_branch : n m,
    +Lemma demo_branch : n m,
      n < mn = mm < n.
    Proof.
      intros.
    @@ -463,68 +460,12 @@

    UseTacticsTactic Library for Coq: A   - branch 1. apply H1.
      - branch 2. apply H2.
      - branch 3. apply H3.
    -Qed.
    -

    - -
    -

    The Tactic

    - -
    - - Coq supports n-ary existentials. For example, instead of - writing t', st', t / st ==> t' / st', one - may write t' st', t / st ==> t' / st'. - -
    - - Coq also supports a n-ary version of the tactic , - which is used for providing witnesses. For example - a, b, c is short for a; b; c. - -
    - - Note: for historical reasons, the library "LibTactics" also - supports a syntax without comas: a b c. - -
    - - The following example illustrates n-ary existentials. -
    -
    - -Theorem progress : ST t T st,
    -  has_type empty ST t T
    -  store_well_typed ST st
    -  value t t' st', t / st ==> t' / st'.
    -  (* was: value t t', st', t / st ==> t' / st' *)
    -Proof with eauto.
    -  intros ST t T st Ht HST. remember (@empty ty) as Gamma.
    -  (induction Ht); subst; try solve_by_invert...
    -  - (* T_App *)
    -    right. destruct IHHt1 as [Ht1p | Ht1p]...
    -    + (* t1 is a value *)
    -      inversion Ht1p; subst; try solve_by_invert.
    -      destruct IHHt2 as [Ht2p | Ht2p]...
    -      (* t2 steps *)
    -      inversion Ht2p as [t2' [st' Hstep]].
    -       (tapp (tabs x T t) t2'), st'...
    -      (* was: (tapp (tabs x T t) t2'). st'... *)
    -Abort.
    -
    - -
    -Remark: a similar facility for n-ary existentials is provided - by the module Coq.Program.Syntax from the standard library. - (Coq.Program.Syntax supports existentials up to arity 4; - LibTactics supports them up to arity 10. -
    -
    - +Qed.

    End NaryExamples.
    -

    Tactics for Working with Equality

    +

    Tactics for Working with Equality

    @@ -563,7 +504,7 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactics asserts_rewrite and cuts_rewrite

    +

    The Tactics asserts_rewrite and cuts_rewrite

    @@ -572,7 +513,7 @@

    UseTacticsTactic Library for Coq: A

    -Theorem mult_0_plus : n m : nat,
    +Theorem mult_0_plus : n m : nat,
      (0 + n) * m = n * m.
    Proof.
      dup.
    @@ -597,7 +538,7 @@

    UseTacticsTactic Library for Coq: A

    -Theorem mult_0_plus' : n m : nat,
    +Theorem mult_0_plus' : n m : nat,
      (0 + n) * m = n * m.
    Proof.
      intros n m.
    @@ -610,23 +551,23 @@

    UseTacticsTactic Library for Coq: A
    More generally, the tactics asserts_rewrite and cuts_rewrite can be provided a lemma as argument. For example, one can write - asserts_rewrite (a b, a*(S b) = a*b+a). + asserts_rewrite ( a b, a*(S b) = a*b+a). This formulation is useful when a and b are big terms, since there is no need to repeat their statements.
    -Theorem mult_0_plus'' : u v w x y z: nat,
    +Theorem mult_0_plus'' : u v w x y z: nat,
      (u + v) * (S (w * x + y)) = z.
    Proof.
    -  intros. asserts_rewrite ( a b, a*(S b) = a*b+a).
    -    (* first subgoal:  a b, a*(S b) = a*b+a *)
    +  intros. asserts_rewrite (a b, a*(S b) = a*b+a).
    +    (* first subgoal:   a b, a*(S b) = a*b+a *)
        (* second subgoal: (u + v) * (w * x + y) + (u + v) = z *)
    Abort.
    -

    The Tactic substs

    +

    The Tactic substs

    @@ -636,7 +577,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_substs : x y (f:natnat),
    +Lemma demo_substs : x y (f:natnat),
      x = f x
      y = x
      y = f x.
    @@ -647,7 +588,7 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactic fequals

    +

    The Tactic fequals

    @@ -658,7 +599,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_fequals : (a b c d e : nat) (f : natnatnatnatnat),
    +Lemma demo_fequals : (a b c d e : nat) (f : natnatnatnatnat),
      a = 1 →
      b = e
      e = 2 →
    @@ -670,7 +611,7 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactic applys_eq

    +

    The Tactic applys_eq

    @@ -692,7 +633,7 @@

    UseTacticsTactic Library for Coq: A
    Axiom big_expression_using : natnat. (* Used in the example *)

    -Lemma demo_applys_eq_1 : (P:natnatProp) x y z,
    +Lemma demo_applys_eq_1 : (P:natnatProp) x y z,
      P x (big_expression_using z) →
      P x (big_expression_using y).
    Proof.
    @@ -714,7 +655,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_applys_eq_2 : (P:natnatProp) x y z,
    +Lemma demo_applys_eq_2 : (P:natnatProp) x y z,
      P (big_expression_using z) x
      P (big_expression_using y) x.
    Proof.
    @@ -730,7 +671,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_applys_eq_3 : (P:natnatProp) x1 x2 y1 y2,
    +Lemma demo_applys_eq_3 : (P:natnatProp) x1 x2 y1 y2,
      P (big_expression_using x2) (big_expression_using y2) →
      P (big_expression_using x1) (big_expression_using y1).
    Proof.
    @@ -743,7 +684,7 @@

    UseTacticsTactic Library for Coq: A

    -

    Some Convenient Shorthands

    +

    Some Convenient Shorthands

    @@ -762,7 +703,14 @@

    UseTacticsTactic Library for Coq: A
  • gen as a shorthand for dependent generalize,
  • -
  • skip for skipping a subgoal even if it contains existential variables, +
  • admits for naming an addmited fact, + +
  • +
  • admit_rewrite for rewriting using an admitted equality, + +
  • +
  • admit_goal to set up a proof by induction by skipping the + justification that some order decreases,
  • sort for re-ordering the proof context by moving moving all @@ -773,7 +721,7 @@

    UseTacticsTactic Library for Coq: A

  • -

    The Tactic unfolds

    +

    The Tactic unfolds

    @@ -790,7 +738,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma bexp_eval_true : b st,
    +Lemma bexp_eval_true : b st,
      beval st b = true
      (bassn b) st.
    Proof.
    @@ -816,7 +764,7 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactics false and tryfalse

    +

    The Tactics false and tryfalse

    @@ -828,7 +776,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_false : n,
    +Lemma demo_false : n,
      S n = 1 →
      n = 0.
    Proof.
    @@ -843,7 +791,7 @@

    UseTacticsTactic Library for Coq: A
    Lemma demo_false_arg :
    -  ( n, n < 0 → False) →
    +  (n, n < 0 → False) →
      3 < 0 →
      4 < 0.
    Proof.
    @@ -858,7 +806,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_tryfalse : n,
    +Lemma demo_tryfalse : n,
      S n = 1 →
      n = 0.
    Proof.
    @@ -867,7 +815,7 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactic gen

    +

    The Tactic gen

    @@ -880,7 +828,7 @@

    UseTacticsTactic Library for Coq: A Module GenExample.
      Import Stlc.
      Import STLC.

    -Lemma substitution_preserves_typing : Gamma x U v t S,
    +Lemma substitution_preserves_typing : Gamma x U v t S,
      has_type (update Gamma x U) t S
      has_type empty v U
      has_type Gamma ([x:=v]t) S.
    @@ -900,77 +848,63 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactics skip, skip_rewrite and skip_goal

    +

    The Tactics admits, admit_rewrite and admit_goal

    Temporarily admitting a given subgoal is very useful when - constructing proofs. It gives the ability to focus first - on the most interesting cases of a proof. The tactic skip - is like admit except that it also works when the proof - includes existential variables. Recall that existential - variables are those whose name starts with a question mark, - (e.g., ?24), and which are typically introduced by eapply. + constructing proofs. Several tactics are provided as + useful wrappers around the builtin admit tactic.
    Module SkipExample.
      Import Stlc.
    -  Import STLC.

    -Notation " t '/' st '==>a*' t' " := (multi (astep st) t t')
    -                                    (at level 40, st at level 39).

    -Example astep_example1 :
    -  (3 + (3 * 4)) / { --> 0 } ==>a* 15.
    -Proof.
    -  eapply multi_step. skip. (* the tactic admit would not work here *)
    -  eapply multi_step. skip. skip.
    -  (* Note that because some unification variables have
    -     not been instantiated, we still need to write
    -     Abort instead of Qed at the end of the proof. *)

    -Abort.
    +  Import STLC.
    -The tactic skip H: P adds the hypothesis H: P to the context, +The tactic admits H: P adds the hypothesis H: P to the context, without checking whether the proposition P is true. It is useful for exploiting a fact and postponing its proof. - Note: skip H: P is simply a shorthand for assert (H:P). skip. + Note: admits H: P is simply a shorthand for assert (H:P). admit.
    -Theorem demo_skipH : True.
    +Theorem demo_admits : True.
    Proof.
    -  skip H: ( n m : nat, (0 + n) * m = n * m).
    +  admits H: (n m : nat, (0 + n) * m = n * m).
    Abort.
    -The tactic skip_rewrite (E1 = E2) replaces E1 with E2 in +The tactic admit_rewrite (E1 = E2) replaces E1 with E2 in the goal, without checking that E1 is actually equal to E2.
    -Theorem mult_0_plus : n m : nat,
    -  (0 + n) * m = n * m.
    +Theorem mult_plus_0 : n m : nat,
    +  (n + 0) * m = n * m.
    Proof.
    -  dup.

    +  dup 3.

      (* The old proof: *)
      intros n m.
    -  assert (H: 0 + n = n). skip. rewriteH.
    +  assert (H: n + 0 = n). admit. rewriteH. clear H.
      reflexivity.

      (* The new proof: *)
      intros n m.
    -  skip_rewrite (0 + n = n).
    +  admit_rewrite (n + 0 = n).
    +  reflexivity.

    +  (* Remark: admit_rewrite can be given a lemma statement as argument,
    +   like asserts_rewrite. For example: *)

    +  intros n m.
    +  admit_rewrite (a, a + 0 = a).
      reflexivity.
    -Qed.
    +Admitted.
    -Remark: the tactic skip_rewrite can in fact be given a lemma - statement as argument, in the same way as asserts_rewrite. -
    - - The tactic skip_goal adds the current goal as hypothesis. +The tactic admit_goal adds the current goal as hypothesis. This cheat is useful to set up the structure of a proof by induction without having to worry about the induction hypothesis being applied only to smaller arguments. Using skip_goal, one @@ -981,14 +915,14 @@

    UseTacticsTactic Library for Coq: A

    -Theorem ceval_deterministic: c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic: c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
    -  (* The tactic skip_goal creates an hypothesis called IH
    +  (* The tactic admit_goal creates an hypothesis called IH
         asserting that the statment of ceval_deterministic is true. *)

    -  skip_goal.
    +  admit_goal.
      (* Of course, if we call assumption here, then the goal is solved
         right away, but the point is to do the proof and use IH
         only at the places where we need an induction hypothesis. *)

    @@ -1013,7 +947,7 @@

    UseTacticsTactic Library for Coq: A

    -

    The Tactic sort

    +

    The Tactic sort

    @@ -1030,9 +964,9 @@

    UseTacticsTactic Library for Coq: A

    -Theorem ceval_deterministic: c st st1 st2,
    -  c / st \\ st1
    -  c / st \\ st2
    +Theorem ceval_deterministic: c st st1 st2,
    +  st =[ c ]⇒ st1
    +  st =[ c ]⇒ st2
      st1 = st2.
    Proof.
      intros c st st1 st2 E1 E2.
    @@ -1045,7 +979,7 @@

    UseTacticsTactic Library for Coq: A

    -

    Tactics for Advanced Lemma Instantiation

    +

    Tactics for Advanced Lemma Instantiation

    @@ -1073,7 +1007,7 @@

    UseTacticsTactic Library for Coq: A

    -

    Working of lets

    +

    Working of lets

    @@ -1104,21 +1038,22 @@

    UseTacticsTactic Library for Coq: A   Import Sub.

    (* To illustrate the working of lets, assume that we want to
       exploit the following lemma. *)


    -Axiom typing_inversion_var : (G:context) (x:string) (T:ty),
    -  has_type G (tvar x) T
    -   S, G x = Some Ssubtype S T.
    +Import Sub.

    +Axiom typing_inversion_var : (G:context) (x:string) (T:ty),
    +  has_type G (var x) T
    +  S, G x = Some Ssubtype S T.

    First, assume we have an assumption H with the type of the form - has_type G (tvar x) T. We can obtain the conclusion of the + has_type G (var x) T. We can obtain the conclusion of the lemma typing_inversion_var by invoking the tactics lets K: typing_inversion_var H, as shown next.
    -Lemma demo_lets_1 : (G:context) (x:string) (T:ty),
    -  has_type G (tvar x) T
    +Lemma demo_lets_1 : (G:context) (x:string) (T:ty),
    +  has_type G (var x) T
      True.
    Proof.
      intros G x T H. dup.

    @@ -1134,7 +1069,7 @@

    UseTacticsTactic Library for Coq: A
    Assume now that we know the values of G, x and T and we - want to obtain S, and have has_type G (tvar x) T be produced + want to obtain S, and have has_type G (var x) T be produced as a subgoal. To indicate that we want all the remaining arguments of typing_inversion_var to be produced as subgoals, we use a triple-underscore symbol ___. (We'll later introduce a shorthand @@ -1142,7 +1077,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_lets_2 : (G:context) (x:string) (T:ty), True.
    +Lemma demo_lets_2 : (G:context) (x:string) (T:ty), True.
    Proof.
      intros G x T.
      lets (S & Eq & Sub): typing_inversion_var G x T ___.
    @@ -1151,7 +1086,7 @@

    UseTacticsTactic Library for Coq: A
    Usually, there is only one context G and one type T that are - going to be suitable for proving has_type G (tvar x) T, so + going to be suitable for proving has_type G (var x) T, so we don't really need to bother giving G and T explicitly. It suffices to call lets (S & Eq & Sub): typing_inversion_var x. The variables G and T are then instantiated using existential @@ -1159,7 +1094,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma demo_lets_3 : (x:string), True.
    +Lemma demo_lets_3 : (x:string), True.
    Proof.
      intros x.
      lets (S & Eq & Sub): typing_inversion_var x ___.
    @@ -1203,13 +1138,13 @@

    UseTacticsTactic Library for Coq: A
    Lemma demo_lets_underscore :
    -  ( n m, nmn < m+1) →
    +  (n m, nmn < m+1) →
      True.
    Proof.
      intros H.

      (* If we do not use a double underscore, the first argument,
         which is n, gets instantiated as 3. *)

    -  lets K: H 3. (* gives K of type m, 3 m 3 < m+1 *)
    +  lets K: H 3. (* gives K of type  m, 3 m 3 < m+1 *)
        clear K.

      (* The double underscore preceeding 3 indicates that we want
         to skip a value that has the type nat (because 3 has
    @@ -1236,7 +1171,7 @@

    UseTacticsTactic Library for Coq: A

    -

    Working of applys, forwards and specializes

    +

    Working of applys, forwards and specializes

    @@ -1284,7 +1219,7 @@

    UseTacticsTactic Library for Coq: A

    -

    Example of Instantiations

    +

    Example of Instantiations

    @@ -1302,7 +1237,7 @@

    UseTacticsTactic Library for Coq: A

    -Lemma substitution_preserves_typing : Gamma x U v t S,
    +Lemma substitution_preserves_typing : Gamma x U v t S,
      has_type (update Gamma x U) t S
      has_type empty v U
      has_type Gamma ([x:=v]t) S.
    @@ -1310,7 +1245,7 @@

    UseTacticsTactic Library for Coq: A   intros Gamma x U v t S Htypt Htypv.
      generalize dependent S. generalize dependent Gamma.
      (induction t); intros; simpl.
    -  - (* tvar *)
    +  - (* var *)
        rename s into y.

        (* An example where destruct is replaced with lets. *)
        (* old: destruct (typing_inversion_var _ _ _ Htypt) as T [Hctx Hsub].*)
    @@ -1328,20 +1263,20 @@

    UseTacticsTactic Library for Coq: A        (* new: *)
            lets [T' HT']: free_in_context S (@empty ty) Hcontra...
            inversion HT'.
    -  - (* tapp *)
    +  - (* app *)

        (* Exercise: replace the following destruct with a lets. *)
        (* old: destruct (typing_inversion_app _ _ _ _ Htypt)
                  as T1 [Htypt1 Htypt2]. eapply T_App... *)

        (* 请在此处解答 *) admit.

    -  - (* tabs *)
    +  - (* abs *)
        rename s into y. rename t into T1.

        (* Here is another example of using lets. *)
        (* old: destruct (typing_inversion_abs _ _ _ _ _ Htypt). *)
        (* new: *) lets (T2&Hsub&Htypt2): typing_inversion_abs Htypt.

        (* An example of where apply with can be replaced with applys. *)
    -    (* old: apply T_Sub with (TArrow T1 T2)... *)
    -    (* new: *) applys T_Sub (TArrow T1 T2)...
    +    (* old: apply T_Sub with (Arrow T1 T2)... *)
    +    (* new: *) applys T_Sub (Arrow T1 T2)...
         apply T_Abs...
        destruct (eqb_stringP x y).
        + (* x=y *)
    @@ -1354,15 +1289,15 @@

    UseTacticsTactic Library for Coq: A       intros z Hafi. unfold update, t_update.
          destruct (eqb_stringP y z)...
          subst. rewrite false_eqb_string...
    -  - (* ttrue *)
    +  - (* tru *)
        lets: typing_inversion_true Htypt...
    -  - (* tfalse *)
    +  - (* fls *)
        lets: typing_inversion_false Htypt...
    -  - (* tif *)
    +  - (* test *)
        lets (Htyp1&Htyp2&Htyp3): typing_inversion_if Htypt...
    -  - (* tunit *)
    +  - (* unit *)
        (* An example where assert can be replaced with lets. *)
    -    (* old: assert (subtype TUnit S)
    +    (* old: assert (subtype Unit S)
                 by apply (typing_inversion_unit _ _ Htypt)... *)

        (* new: *) lets: typing_inversion_unit Htypt...

    Admitted.

    @@ -1370,7 +1305,7 @@

    UseTacticsTactic Library for Coq: A

    -

    Summary

    +

    Summary

    @@ -1410,7 +1345,7 @@

    UseTacticsTactic Library for Coq: A -
  • splits, branch and to deal with n-ary constructs. +
  • splits and branch, to deal with n-ary constructs.
    @@ -1437,7 +1372,7 @@

    UseTacticsTactic Library for Coq: A

  • -
  • skip, skip_rewrite and skip_goal give the flexibility to +
  • admits, admit_rewrite and admit_goal give the flexibility to choose which subgoals to try and discharge first.
  • @@ -1453,9 +1388,10 @@

    UseTacticsTactic Library for Coq: A
    -
    +

    +
    - +(* Sat Jan 26 15:15:46 UTC 2019 *)

    diff --git a/plf-current/UseTactics.v b/plf-current/UseTactics.v index a3e3bbef..5e7c88fe 100644 --- a/plf-current/UseTactics.v +++ b/plf-current/UseTactics.v @@ -12,7 +12,7 @@ Set Warnings "-notation-overridden,-parsing". -Require Import Coq.Arith.Arith. +From Coq Require Import Arith.Arith. From PLF Require Import Maps. From PLF Require Import Imp. @@ -53,7 +53,6 @@ From PLF Require Sub. tactic that duplicates a given goal. More precisely, [dup] produces two copies of the current goal, and [dup n] produces [n] copies of it. *) - (* ################################################################# *) (** * Tactics for Naming and Performing Inversion *) @@ -61,7 +60,6 @@ From PLF Require Sub. - [introv], for naming hypotheses more efficiently, - [inverts], for improving the [inversion] tactic. *) - (* ================================================================= *) (** ** The Tactic [introv] *) @@ -80,8 +78,8 @@ Module IntrovExamples. name [E1] and [E2], respectively. *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. introv E1 E2. (* was [intros c st st1 st2 E1 E2] *) @@ -100,9 +98,9 @@ Abort. [forall] and [->] are interleaved. *) Theorem ceval_deterministic': forall c st st1, - (c / st \\ st1) -> + (st =[ c ]=> st1) -> forall st2, - (c / st \\ st2) -> + (st =[ c ]=> st2) -> st1 = st2. Proof. introv E1 E2. (* was [intros c st st1 E1 st2 E2] *) @@ -125,7 +123,6 @@ Qed. End IntrovExamples. - (* ================================================================= *) (** ** The Tactic [inverts] *) @@ -164,8 +161,8 @@ Abort. (** A slightly more interesting example appears next. *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. introv E1 E2. generalize dependent st2. @@ -185,8 +182,8 @@ Abort. or [introv]. *) Theorem ceval_deterministic': forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. introv E1 E2. generalize dependent st2. @@ -241,9 +238,9 @@ Abort. Example typing_nonexample_1 : ~ exists T, has_type empty - (tabs x TBool - (tabs y TBool - (tapp (tvar x) (tvar y)))) + (abs x Bool + (abs y Bool + (app (var x) (var y)))) T. Proof. dup 3. @@ -282,7 +279,6 @@ End InvertsExamples. - (* ################################################################# *) (** * Tactics for N-ary Connectives *) @@ -295,8 +291,7 @@ End InvertsExamples. (** This section presents the following tactics: - [splits] for decomposing n-ary conjunctions, - - [branch] for decomposing n-ary disjunctions, - - [exists] for proving n-ary existentials. *) + - [branch] for decomposing n-ary disjunctions *) Module NaryExamples. Import References. @@ -317,7 +312,6 @@ Proof. intros. splits. Abort. - (* ================================================================= *) (** ** The Tactic [branch] *) @@ -336,50 +330,8 @@ Proof. - branch 3. apply H3. Qed. - -(* ================================================================= *) -(** ** The Tactic [exists] *) - -(** Coq supports n-ary existentials. For example, instead of - writing [exists t', exists st', t / st ==> t' / st'], one - may write [exists t' st', t / st ==> t' / st']. - - Coq also supports a n-ary version of the tactic [exists], - which is used for providing witnesses. For example - [exists a, b, c] is short for [exists a; exists b; exists c]. - - Note: for historical reasons, the library "LibTactics" also - supports a syntax without comas: [exists a b c]. - - The following example illustrates n-ary existentials. *) - -Theorem progress : forall ST t T st, - has_type empty ST t T -> - store_well_typed ST st -> - value t \/ exists t' st', t / st ==> t' / st'. - (* was: [value t \/ exists t', exists st', t / st ==> t' / st'] *) -Proof with eauto. - intros ST t T st Ht HST. remember (@empty ty) as Gamma. - (induction Ht); subst; try solve_by_invert... - - (* T_App *) - right. destruct IHHt1 as [Ht1p | Ht1p]... - + (* t1 is a value *) - inversion Ht1p; subst; try solve_by_invert. - destruct IHHt2 as [Ht2p | Ht2p]... - (* t2 steps *) - inversion Ht2p as [t2' [st' Hstep]]. - exists (tapp (tabs x T t) t2'), st'... - (* was: [exists (tapp (tabs x T t) t2'). exists st'...] *) -Abort. - -(** Remark: a similar facility for n-ary existentials is provided - by the module [Coq.Program.Syntax] from the standard library. - ([Coq.Program.Syntax] supports existentials up to arity 4; - [LibTactics] supports them up to arity 10. *) - End NaryExamples. - (* ################################################################# *) (** * Tactics for Working with Equality *) @@ -398,7 +350,6 @@ End NaryExamples. Module EqualityExamples. - (* ================================================================= *) (** ** The Tactics [asserts_rewrite] and [cuts_rewrite] *) @@ -451,7 +402,6 @@ Proof. (* second subgoal: [(u + v) * (w * x + y) + (u + v) = z] *) Abort. - (* ================================================================= *) (** ** The Tactic [substs] *) @@ -468,7 +418,6 @@ Proof. assumption. Qed. - (* ================================================================= *) (** ** The Tactic [fequals] *) @@ -487,7 +436,6 @@ Proof. (* subgoals [a = 1], [b = 2] and [c = c] are proved, [d = 4] remains *) Abort. - (* ================================================================= *) (** ** The Tactic [applys_eq] *) @@ -552,7 +500,6 @@ Abort. End EqualityExamples. - (* ################################################################# *) (** * Some Convenient Shorthands *) @@ -561,11 +508,13 @@ End EqualityExamples. - [unfolds] (without argument) for unfolding the head definition, - [false] for replacing the goal with [False], - [gen] as a shorthand for [dependent generalize], - - [skip] for skipping a subgoal even if it contains existential variables, + - [admits] for naming an addmited fact, + - [admit_rewrite] for rewriting using an admitted equality, + - [admit_goal] to set up a proof by induction by skipping the + justification that some order decreases, - [sort] for re-ordering the proof context by moving moving all propositions at the bottom. *) - (* ================================================================= *) (** ** The Tactic [unfolds] *) @@ -597,7 +546,6 @@ Qed. End UnfoldsExample. - (* ================================================================= *) (** ** The Tactics [false] and [tryfalse] *) @@ -636,7 +584,6 @@ Proof. intros. destruct n; tryfalse. reflexivity. Qed. - (* ================================================================= *) (** ** The Tactic [gen] *) @@ -669,68 +616,53 @@ Abort. End GenExample. - (* ================================================================= *) -(** ** The Tactics [skip], [skip_rewrite] and [skip_goal] *) +(** ** The Tactics [admits], [admit_rewrite] and [admit_goal] *) (** Temporarily admitting a given subgoal is very useful when - constructing proofs. It gives the ability to focus first - on the most interesting cases of a proof. The tactic [skip] - is like [admit] except that it also works when the proof - includes existential variables. Recall that existential - variables are those whose name starts with a question mark, - (e.g., [?24]), and which are typically introduced by [eapply]. *) + constructing proofs. Several tactics are provided as + useful wrappers around the builtin [admit] tactic. *) Module SkipExample. Import Stlc. Import STLC. -Notation " t '/' st '==>a*' t' " := (multi (astep st) t t') - (at level 40, st at level 39). - -Example astep_example1 : - (3 + (3 * 4)) / { --> 0 } ==>a* 15. -Proof. - eapply multi_step. skip. (* the tactic [admit] would not work here *) - eapply multi_step. skip. skip. - (* Note that because some unification variables have - not been instantiated, we still need to write - [Abort] instead of [Qed] at the end of the proof. *) -Abort. - -(** The tactic [skip H: P] adds the hypothesis [H: P] to the context, +(** The tactic [admits H: P] adds the hypothesis [H: P] to the context, without checking whether the proposition [P] is true. It is useful for exploiting a fact and postponing its proof. - Note: [skip H: P] is simply a shorthand for [assert (H:P). skip.] *) + Note: [admits H: P] is simply a shorthand for [assert (H:P). admit.] *) -Theorem demo_skipH : True. +Theorem demo_admits : True. Proof. - skip H: (forall n m : nat, (0 + n) * m = n * m). + admits H: (forall n m : nat, (0 + n) * m = n * m). Abort. -(** The tactic [skip_rewrite (E1 = E2)] replaces [E1] with [E2] in +(** The tactic [admit_rewrite (E1 = E2)] replaces [E1] with [E2] in the goal, without checking that [E1] is actually equal to [E2]. *) -Theorem mult_0_plus : forall n m : nat, - (0 + n) * m = n * m. +Theorem mult_plus_0 : forall n m : nat, + (n + 0) * m = n * m. Proof. - dup. + dup 3. (* The old proof: *) intros n m. - assert (H: 0 + n = n). skip. rewrite -> H. + assert (H: n + 0 = n). admit. rewrite -> H. clear H. reflexivity. (* The new proof: *) intros n m. - skip_rewrite (0 + n = n). + admit_rewrite (n + 0 = n). reflexivity. -Qed. -(** Remark: the tactic [skip_rewrite] can in fact be given a lemma - statement as argument, in the same way as [asserts_rewrite]. *) + (* Remark: [admit_rewrite] can be given a lemma statement as argument, + like [asserts_rewrite]. For example: *) + intros n m. + admit_rewrite (forall a, a + 0 = a). + reflexivity. +Admitted. -(** The tactic [skip_goal] adds the current goal as hypothesis. +(** The tactic [admit_goal] adds the current goal as hypothesis. This cheat is useful to set up the structure of a proof by induction without having to worry about the induction hypothesis being applied only to smaller arguments. Using [skip_goal], one @@ -740,13 +672,13 @@ Qed. of the induction hypothesis. *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. - (* The tactic [skip_goal] creates an hypothesis called [IH] + (* The tactic [admit_goal] creates an hypothesis called [IH] asserting that the statment of [ceval_deterministic] is true. *) - skip_goal. + admit_goal. (* Of course, if we call [assumption] here, then the goal is solved right away, but the point is to do the proof and use [IH] only at the places where we need an induction hypothesis. *) @@ -770,7 +702,6 @@ Abort. End SkipExample. - (* ================================================================= *) (** ** The Tactic [sort] *) @@ -782,8 +713,8 @@ Module SortExamples. bottom, thereby making the proof context more readable. *) Theorem ceval_deterministic: forall c st st1 st2, - c / st \\ st1 -> - c / st \\ st2 -> + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> st1 = st2. Proof. intros c st st1 st2 E1 E2. @@ -795,7 +726,6 @@ Abort. End SortExamples. - (* ################################################################# *) (** * Tactics for Advanced Lemma Instantiation *) @@ -818,7 +748,6 @@ End SortExamples. [destruct (H _ _ _ Htypt) as [T [Hctx Hsub]].] can be rewritten in the form [destruct (H _ _ _ Htypt) as (T & Hctx & Hsub).] *) - (* ================================================================= *) (** ** Working of [lets] *) @@ -847,17 +776,19 @@ Module ExamplesLets. (* To illustrate the working of [lets], assume that we want to exploit the following lemma. *) +Import Sub. + Axiom typing_inversion_var : forall (G:context) (x:string) (T:ty), - has_type G (tvar x) T -> + has_type G (var x) T -> exists S, G x = Some S /\ subtype S T. (** First, assume we have an assumption [H] with the type of the form - [has_type G (tvar x) T]. We can obtain the conclusion of the + [has_type G (var x) T]. We can obtain the conclusion of the lemma [typing_inversion_var] by invoking the tactics [lets K: typing_inversion_var H], as shown next. *) Lemma demo_lets_1 : forall (G:context) (x:string) (T:ty), - has_type G (tvar x) T -> + has_type G (var x) T -> True. Proof. intros G x T H. dup. @@ -873,7 +804,7 @@ Proof. Abort. (** Assume now that we know the values of [G], [x] and [T] and we - want to obtain [S], and have [has_type G (tvar x) T] be produced + want to obtain [S], and have [has_type G (var x) T] be produced as a subgoal. To indicate that we want all the remaining arguments of [typing_inversion_var] to be produced as subgoals, we use a triple-underscore symbol [___]. (We'll later introduce a shorthand @@ -886,7 +817,7 @@ Proof. Abort. (** Usually, there is only one context [G] and one type [T] that are - going to be suitable for proving [has_type G (tvar x) T], so + going to be suitable for proving [has_type G (var x) T], so we don't really need to bother giving [G] and [T] explicitly. It suffices to call [lets (S & Eq & Sub): typing_inversion_var x]. The variables [G] and [T] are then instantiated using existential @@ -941,7 +872,6 @@ Proof. clear K. Abort. - (** Note: one can write [lets: E0 E1 E2] in place of [lets H: E0 E1 E2]. In this case, the name [H] is chosen arbitrarily. @@ -952,7 +882,6 @@ Abort. End ExamplesLets. - (* ================================================================= *) (** ** Working of [applys], [forwards] and [specializes] *) @@ -978,7 +907,6 @@ End ExamplesLets. Examples of use of [applys] appear further on. Several examples of use of [forwards] can be found in the tutorial chapter [UseAuto]. *) - (* ================================================================= *) (** ** Example of Instantiations *) @@ -998,7 +926,7 @@ Proof with eauto. intros Gamma x U v t S Htypt Htypv. generalize dependent S. generalize dependent Gamma. (induction t); intros; simpl. - - (* tvar *) + - (* var *) rename s into y. (* An example where [destruct] is replaced with [lets]. *) @@ -1018,14 +946,14 @@ Proof with eauto. (* new: *) lets [T' HT']: free_in_context S (@empty ty) Hcontra... inversion HT'. - - (* tapp *) + - (* app *) (* Exercise: replace the following [destruct] with a [lets]. *) (* old: destruct (typing_inversion_app _ _ _ _ Htypt) as [T1 [Htypt1 Htypt2]]. eapply T_App... *) (* 请在此处解答 *) admit. - - (* tabs *) + - (* abs *) rename s into y. rename t into T1. (* Here is another example of using [lets]. *) @@ -1033,8 +961,8 @@ Proof with eauto. (* new: *) lets (T2&Hsub&Htypt2): typing_inversion_abs Htypt. (* An example of where [apply with] can be replaced with [applys]. *) - (* old: apply T_Sub with (TArrow T1 T2)... *) - (* new: *) applys T_Sub (TArrow T1 T2)... + (* old: apply T_Sub with (Arrow T1 T2)... *) + (* new: *) applys T_Sub (Arrow T1 T2)... apply T_Abs... destruct (eqb_stringP x y). + (* x=y *) @@ -1047,15 +975,15 @@ Proof with eauto. intros z Hafi. unfold update, t_update. destruct (eqb_stringP y z)... subst. rewrite false_eqb_string... - - (* ttrue *) + - (* tru *) lets: typing_inversion_true Htypt... - - (* tfalse *) + - (* fls *) lets: typing_inversion_false Htypt... - - (* tif *) + - (* test *) lets (Htyp1&Htyp2&Htyp3): typing_inversion_if Htypt... - - (* tunit *) + - (* unit *) (* An example where [assert] can be replaced with [lets]. *) - (* old: assert (subtype TUnit S) + (* old: assert (subtype Unit S) by apply (typing_inversion_unit _ _ Htypt)... *) (* new: *) lets: typing_inversion_unit Htypt... @@ -1063,7 +991,6 @@ Admitted. End ExamplesInstantiations. - (* ################################################################# *) (** * Summary *) @@ -1080,7 +1007,7 @@ End ExamplesInstantiations. - [cases] and [cases_if] help with case analysis. - - [splits], [branch] and [exists] to deal with n-ary constructs. + - [splits] and [branch], to deal with n-ary constructs. - [asserts_rewrite], [cuts_rewrite], [substs] and [fequals] help working with equalities. @@ -1091,7 +1018,7 @@ End ExamplesInstantiations. - [applys_eq] can save the need to perform manual rewriting steps before being able to apply lemma. - - [skip], [skip_rewrite] and [skip_goal] give the flexibility to + - [admits], [admit_rewrite] and [admit_goal] give the flexibility to choose which subgoals to try and discharge first. Making use of these tactics can boost one's productivity in Coq proofs. @@ -1102,4 +1029,4 @@ End ExamplesInstantiations. *) -(** $Date$ *) +(* Sat Jan 26 15:15:46 UTC 2019 *) diff --git a/plf-current/UseTacticsTest.v b/plf-current/UseTacticsTest.v index 69caec51..f426a6ac 100644 --- a/plf-current/UseTacticsTest.v +++ b/plf-current/UseTacticsTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:16:41 UTC 2019 *) diff --git a/plf-current/common/css/sf.css b/plf-current/common/css/sf.css index be9fcb10..12d4abc1 100644 --- a/plf-current/common/css/sf.css +++ b/plf-current/common/css/sf.css @@ -489,6 +489,9 @@ tr.infrulemiddle hr { color: rgb(0%,0%,0%); } +.nowrap { + white-space: nowrap; +} /* TOC */ diff --git a/plf-current/common/css/slides.css b/plf-current/common/css/slides.css index 0f1fc55a..b9d0327d 100644 --- a/plf-current/common/css/slides.css +++ b/plf-current/common/css/slides.css @@ -34,5 +34,7 @@ h1.libtitle { line-height: 34px; } - +body { + background: white; +} diff --git a/plf-current/coqindex.html b/plf-current/coqindex.html index 109c27cc..88e11a4b 100644 --- a/plf-current/coqindex.html +++ b/plf-current/coqindex.html @@ -60,7 +60,7 @@ Z : _ -(1863 entries) +(1908 entries) Notation Index @@ -92,7 +92,7 @@ Z : _ -(124 entries) +(132 entries) Module Index @@ -123,7 +123,7 @@ Y Z _ -(66 entries) +(65 entries) Variable Index @@ -194,7 +194,7 @@ C D E -F +F G H I @@ -209,14 +209,14 @@ R S T -U +U V W X Y -Z +Z _ -(665 entries) +(670 entries) Lemma Index @@ -247,7 +247,7 @@ Y Z _ -(446 entries) +(454 entries) Axiom Index @@ -278,7 +278,7 @@ Y Z _ -(12 entries) +(11 entries) Inductive Index @@ -309,7 +309,7 @@ Y Z _ -(120 entries) +(121 entries) Section Index @@ -402,50 +402,59 @@ Y Z _ -(343 entries) +(368 entries)

    Global Index

    A

    +abs [constructor, in PLF.Norm]
    +abs [constructor, in PLF.RecordSub]
    +abs [constructor, in PLF.Sub]
    abs_arrow [lemma, in PLF.RecordSub]
    abs_arrow [lemma, in PLF.Sub]
    aequiv [definition, in PLF.Equiv]
    aequiv_example [lemma, in PLF.Equiv]
    aeval_weakening [lemma, in PLF.Equiv]
    +afi_abs [constructor, in PLF.RecordSub]
    afi_abs [constructor, in PLF.Norm]
    afi_abs [constructor, in PLF.Sub]
    -afi_abs [constructor, in PLF.RecordSub]
    +afi_app1 [constructor, in PLF.RecordSub]
    afi_app1 [constructor, in PLF.Norm]
    afi_app1 [constructor, in PLF.Sub]
    -afi_app1 [constructor, in PLF.RecordSub]
    afi_app2 [constructor, in PLF.RecordSub]
    afi_app2 [constructor, in PLF.Sub]
    afi_app2 [constructor, in PLF.Norm]
    afi_fst [constructor, in PLF.Norm]
    -afi_if0 [constructor, in PLF.Norm]
    -afi_if1 [constructor, in PLF.Sub]
    -afi_if1 [constructor, in PLF.Norm]
    -afi_if2 [constructor, in PLF.Norm]
    -afi_if2 [constructor, in PLF.Sub]
    -afi_if3 [constructor, in PLF.Sub]
    afi_pair1 [constructor, in PLF.Norm]
    afi_pair2 [constructor, in PLF.Norm]
    afi_proj [constructor, in PLF.RecordSub]
    afi_rhead [constructor, in PLF.RecordSub]
    afi_rtail [constructor, in PLF.RecordSub]
    afi_snd [constructor, in PLF.Norm]
    +afi_test0 [constructor, in PLF.Norm]
    +afi_test1 [constructor, in PLF.Norm]
    +afi_test1 [constructor, in PLF.Sub]
    +afi_test2 [constructor, in PLF.Sub]
    +afi_test2 [constructor, in PLF.Norm]
    +afi_test3 [constructor, in PLF.Sub]
    afi_var [constructor, in PLF.Norm]
    -afi_var [constructor, in PLF.RecordSub]
    afi_var [constructor, in PLF.Sub]
    +afi_var [constructor, in PLF.RecordSub]
    always_loop_hoare [lemma, in PLF.Hoare]
    -appears_free_in [inductive, in PLF.Sub]
    -appears_free_in [inductive, in PLF.RecordSub]
    +app [constructor, in PLF.Norm]
    +app [constructor, in PLF.RecordSub]
    +app [constructor, in PLF.Sub]
    appears_free_in [inductive, in PLF.Norm]
    +appears_free_in [inductive, in PLF.RecordSub]
    +appears_free_in [inductive, in PLF.Sub]
    +Arrow [constructor, in PLF.RecordSub]
    +Arrow [constructor, in PLF.Sub]
    +Arrow [constructor, in PLF.Norm]
    Assertion [definition, in PLF.Hoare]
    assert_implies [definition, in PLF.Hoare]
    -Assign [constructor, in PLF.PE]
    assign [definition, in PLF.PE]
    +Assign [constructor, in PLF.PE]
    assigned [definition, in PLF.PE]
    assign_aequiv [lemma, in PLF.Equiv]
    assign_removes [lemma, in PLF.PE]
    @@ -467,6 +476,8 @@

    Global Index

    aval [inductive, in PLF.Smallstep]
    av_num [constructor, in PLF.Smallstep]


    B

    +Base [constructor, in PLF.Sub]
    +Base [constructor, in PLF.RecordSub]
    bassn [definition, in PLF.Hoare]
    bassn_eval_false [lemma, in PLF.HoareAsLogic]
    bequiv [definition, in PLF.Equiv]
    @@ -476,6 +487,9 @@

    Global Index

    Bib [library]
    block [inductive, in PLF.PE]
    body [constructor, in PLF.PE]
    +Bool [constructor, in PLF.Norm]
    +Bool [constructor, in PLF.Sub]
    +Bool [constructor, in PLF.Types]
    bool_canonical [lemma, in PLF.Types]
    boxer [constructor, in PLF.LibTactics]
    Boxer [inductive, in PLF.LibTactics]
    @@ -496,8 +510,8 @@

    Global Index

    BS_NotTrue [constructor, in PLF.Smallstep]
    btrans_sound [definition, in PLF.Equiv]
    bvalue [inductive, in PLF.Types]
    -bv_false [constructor, in PLF.Types]
    -bv_true [constructor, in PLF.Types]
    +bv_fls [constructor, in PLF.Types]
    +bv_tru [constructor, in PLF.Types]


    C

    C [constructor, in PLF.Smallstep]
    canonical_forms_of_arrow_types [lemma, in PLF.Sub]
    @@ -535,13 +549,13 @@

    Global Index

    CImp.par_loop_any_X [lemma, in PLF.Smallstep]
    CImp.par_loop_example_0 [definition, in PLF.Smallstep]
    CImp.par_loop_example_2 [definition, in PLF.Smallstep]
    -CImp.::x_'/'_x_'==>'_x_'/'_x [notation, in PLF.Smallstep]
    -CImp.::x_'/'_x_'==>*'_x_'/'_x [notation, in PLF.Smallstep]
    +-->
    '_x_'/'_x">CImp.::x_'/'_x_'-->'_x_'/'_x [notation, in PLF.Smallstep]
    +-->*'_x_'/'_x">CImp.::x_'/'_x_'-->*'_x_'/'_x [notation, in PLF.Smallstep]
    CImp.::x_'::='_x [notation, in PLF.Smallstep]
    CImp.::x_';;'_x [notation, in PLF.Smallstep]
    -CImp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Smallstep]
    CImp.::'PAR'_x_'WITH'_x_'END' [notation, in PLF.Smallstep]
    CImp.::'SKIP' [notation, in PLF.Smallstep]
    +CImp.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Smallstep]
    CImp.::'WHILE'_x_'DO'_x_'END' [notation, in PLF.Smallstep]
    closed [definition, in PLF.Norm]
    closed_env [definition, in PLF.Norm]
    @@ -550,6 +564,7 @@

    Global Index

    COIND [definition, in PLF.LibTactics]
    Combined [module, in PLF.Smallstep]
    Combined.C [constructor, in PLF.Smallstep]
    +Combined.fls [constructor, in PLF.Smallstep]
    Combined.P [constructor, in PLF.Smallstep]
    Combined.step [inductive, in PLF.Smallstep]
    Combined.ST_If [constructor, in PLF.Smallstep]
    @@ -558,15 +573,14 @@

    Global Index

    Combined.ST_PlusConstConst [constructor, in PLF.Smallstep]
    Combined.ST_Plus1 [constructor, in PLF.Smallstep]
    Combined.ST_Plus2 [constructor, in PLF.Smallstep]
    -Combined.tfalse [constructor, in PLF.Smallstep]
    -Combined.tif [constructor, in PLF.Smallstep]
    +Combined.test [constructor, in PLF.Smallstep]
    Combined.tm [inductive, in PLF.Smallstep]
    -Combined.ttrue [constructor, in PLF.Smallstep]
    +Combined.tru [constructor, in PLF.Smallstep]
    Combined.value [inductive, in PLF.Smallstep]
    Combined.v_const [constructor, in PLF.Smallstep]
    -Combined.v_false [constructor, in PLF.Smallstep]
    -Combined.v_true [constructor, in PLF.Smallstep]
    -Combined.::x_'==>'_x [notation, in PLF.Smallstep]
    +Combined.v_fls [constructor, in PLF.Smallstep]
    +Combined.v_tru [constructor, in PLF.Smallstep]
    +-->'_x">Combined.::x_'-->'_x [notation, in PLF.Smallstep]
    compiler_is_correct [lemma, in PLF.Smallstep]
    compiler_is_correct_statement [definition, in PLF.Smallstep]
    congruence_demo_1 [lemma, in PLF.UseAuto]
    @@ -574,12 +588,12 @@

    Global Index

    congruence_demo_3 [lemma, in PLF.UseAuto]
    congruence_demo_4 [lemma, in PLF.UseAuto]
    congruence_example [definition, in PLF.Equiv]
    -context [definition, in PLF.Norm]
    context [definition, in PLF.Sub]
    context [definition, in PLF.RecordSub]
    -context_invariance [lemma, in PLF.Norm]
    +context [definition, in PLF.Norm]
    context_invariance [lemma, in PLF.RecordSub]
    context_invariance [lemma, in PLF.Sub]
    +context_invariance [lemma, in PLF.Norm]
    CSeq_congruence [lemma, in PLF.Equiv]
    cstep [inductive, in PLF.Smallstep]
    CS_Ass [constructor, in PLF.Smallstep]
    @@ -606,6 +620,8 @@

    Global Index

    DCWhile [constructor, in PLF.Hoare2]
    decorated [inductive, in PLF.Hoare2]
    Decorated [constructor, in PLF.Hoare2]
    +dec0 [definition, in PLF.Hoare2]
    +dec1 [definition, in PLF.Hoare2]
    dec_correct [definition, in PLF.Hoare2]
    dec_while [definition, in PLF.Hoare2]
    dec_while_correct [lemma, in PLF.Hoare2]
    @@ -613,8 +629,8 @@

    Global Index

    demo_auto_absurd_1 [lemma, in PLF.UseAuto]
    demo_auto_absurd_2 [lemma, in PLF.UseAuto]
    demo_clears_all_and_clears_but [lemma, in PLF.LibTactics]
    -demo_false [lemma, in PLF.UseAuto]
    demo_false [lemma, in PLF.UseTactics]
    +demo_false [lemma, in PLF.UseAuto]
    demo_false_arg [lemma, in PLF.UseTactics]
    demo_hint_unfold_context_1 [lemma, in PLF.UseAuto]
    demo_hint_unfold_context_2 [lemma, in PLF.UseAuto]
    @@ -691,12 +707,12 @@

    Global Index

    ExamplesLets.demo_lets_4 [lemma, in PLF.UseTactics]
    ExamplesLets.demo_lets_5 [lemma, in PLF.UseTactics]
    ExamplesLets.typing_inversion_var [axiom, in PLF.UseTactics]
    -Examples.A [abbreviation, in PLF.RecordSub]
    Examples.A [abbreviation, in PLF.Sub]
    -Examples.B [abbreviation, in PLF.RecordSub]
    +Examples.A [abbreviation, in PLF.RecordSub]
    Examples.B [abbreviation, in PLF.Sub]
    -Examples.C [abbreviation, in PLF.RecordSub]
    +Examples.B [abbreviation, in PLF.RecordSub]
    Examples.C [abbreviation, in PLF.Sub]
    +Examples.C [abbreviation, in PLF.RecordSub]
    Examples.Employee [definition, in PLF.Sub]
    Examples.Float [abbreviation, in PLF.Sub]
    Examples.i [abbreviation, in PLF.RecordSub]
    @@ -706,26 +722,26 @@

    Global Index

    Examples.Person [definition, in PLF.Sub]
    Examples.String [abbreviation, in PLF.Sub]
    Examples.Student [definition, in PLF.Sub]
    -Examples.subtyping_example_0 [definition, in PLF.Sub]
    Examples.subtyping_example_0 [definition, in PLF.RecordSub]
    -Examples.subtyping_example_1 [definition, in PLF.Sub]
    +Examples.subtyping_example_0 [definition, in PLF.Sub]
    Examples.subtyping_example_1 [definition, in PLF.RecordSub]
    -Examples.subtyping_example_2 [definition, in PLF.Sub]
    +Examples.subtyping_example_1 [definition, in PLF.Sub]
    Examples.subtyping_example_2 [definition, in PLF.RecordSub]
    +Examples.subtyping_example_2 [definition, in PLF.Sub]
    Examples.subtyping_example_3 [definition, in PLF.RecordSub]
    Examples.subtyping_example_4 [definition, in PLF.RecordSub]
    Examples.sub_employee_person [definition, in PLF.Sub]
    Examples.sub_student_person [definition, in PLF.Sub]
    Examples.TRcd_j [definition, in PLF.RecordSub]
    Examples.TRcd_kj [definition, in PLF.RecordSub]
    -Examples.x [abbreviation, in PLF.RecordSub]
    Examples.x [abbreviation, in PLF.Sub]
    +Examples.x [abbreviation, in PLF.RecordSub]
    Examples.y [abbreviation, in PLF.Sub]
    Examples.y [abbreviation, in PLF.RecordSub]
    -Examples.z [abbreviation, in PLF.RecordSub]
    Examples.z [abbreviation, in PLF.Sub]
    -Examples2 [module, in PLF.Sub]
    +Examples.z [abbreviation, in PLF.RecordSub]
    Examples2 [module, in PLF.RecordSub]
    +Examples2 [module, in PLF.Sub]
    Examples2.trcd_kj [definition, in PLF.RecordSub]
    Examples2.typing_example_0 [definition, in PLF.RecordSub]
    Examples2.typing_example_1 [definition, in PLF.RecordSub]
    @@ -754,6 +770,9 @@

    Global Index

    find_parity_dec' [definition, in PLF.Hoare2]
    FirstTry [module, in PLF.Typechecking]
    FirstTry.type_check [definition, in PLF.Typechecking]
    +fls [constructor, in PLF.Types]
    +fls [constructor, in PLF.Sub]
    +fls [constructor, in PLF.Norm]
    fold_aexp_ex1 [definition, in PLF.Equiv]
    fold_aexp_ex2 [definition, in PLF.Equiv]
    fold_bexp_ex1 [definition, in PLF.Equiv]
    @@ -765,9 +784,10 @@

    Global Index

    fold_constants_bexp_sound [lemma, in PLF.Equiv]
    fold_constants_com [definition, in PLF.Equiv]
    fold_constants_com_sound [lemma, in PLF.Equiv]
    -free_in_context [lemma, in PLF.Norm]
    free_in_context [lemma, in PLF.RecordSub]
    +free_in_context [lemma, in PLF.Norm]
    free_in_context [lemma, in PLF.Sub]
    +fst [constructor, in PLF.Norm]


    G

    GenExample [module, in PLF.UseTactics]
    GenExample.substitution_preserves_typing [lemma, in PLF.UseTactics]
    @@ -775,9 +795,9 @@

    Global Index

    gt_not_le [axiom, in PLF.UseAuto]


    H

    halts [definition, in PLF.Norm]
    -has_type [inductive, in PLF.RecordSub]
    has_type [inductive, in PLF.Sub]
    has_type [inductive, in PLF.Types]
    +has_type [inductive, in PLF.RecordSub]
    has_type [inductive, in PLF.Norm]
    has_type_not [definition, in PLF.Types]
    has_type_1 [definition, in PLF.Types]
    @@ -791,31 +811,31 @@

    Global Index

    Himp.ceval [inductive, in PLF.Equiv]
    Himp.CHavoc [constructor, in PLF.Hoare]
    Himp.CHavoc [constructor, in PLF.Equiv]
    -Himp.CIf [constructor, in PLF.Hoare]
    Himp.CIf [constructor, in PLF.Equiv]
    +Himp.CIf [constructor, in PLF.Hoare]
    Himp.com [inductive, in PLF.Hoare]
    Himp.com [inductive, in PLF.Equiv]
    -Himp.CSeq [constructor, in PLF.Equiv]
    Himp.CSeq [constructor, in PLF.Hoare]
    -Himp.CSkip [constructor, in PLF.Equiv]
    +Himp.CSeq [constructor, in PLF.Equiv]
    Himp.CSkip [constructor, in PLF.Hoare]
    +Himp.CSkip [constructor, in PLF.Equiv]
    Himp.CWhile [constructor, in PLF.Equiv]
    Himp.CWhile [constructor, in PLF.Hoare]
    Himp.E_Ass [constructor, in PLF.Equiv]
    Himp.E_Ass [constructor, in PLF.Hoare]
    Himp.E_Havoc [constructor, in PLF.Hoare]
    -Himp.E_IfFalse [constructor, in PLF.Equiv]
    Himp.E_IfFalse [constructor, in PLF.Hoare]
    -Himp.E_IfTrue [constructor, in PLF.Equiv]
    +Himp.E_IfFalse [constructor, in PLF.Equiv]
    Himp.E_IfTrue [constructor, in PLF.Hoare]
    -Himp.E_Seq [constructor, in PLF.Equiv]
    +Himp.E_IfTrue [constructor, in PLF.Equiv]
    Himp.E_Seq [constructor, in PLF.Hoare]
    -Himp.E_Skip [constructor, in PLF.Hoare]
    +Himp.E_Seq [constructor, in PLF.Equiv]
    Himp.E_Skip [constructor, in PLF.Equiv]
    -Himp.E_WhileFalse [constructor, in PLF.Hoare]
    +Himp.E_Skip [constructor, in PLF.Hoare]
    Himp.E_WhileFalse [constructor, in PLF.Equiv]
    -Himp.E_WhileTrue [constructor, in PLF.Equiv]
    +Himp.E_WhileFalse [constructor, in PLF.Hoare]
    Himp.E_WhileTrue [constructor, in PLF.Hoare]
    +Himp.E_WhileTrue [constructor, in PLF.Equiv]
    Himp.havoc_example1 [definition, in PLF.Equiv]
    Himp.havoc_example2 [definition, in PLF.Equiv]
    Himp.havoc_pre [definition, in PLF.Hoare]
    @@ -840,25 +860,70 @@

    Global Index

    Himp.p5_p6_equiv [lemma, in PLF.Equiv]
    Himp.p6 [definition, in PLF.Equiv]
    Himp.:hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [notation, in PLF.Hoare]
    -Himp.::x_'/'_x_'\\'_x [notation, in PLF.Hoare]
    -Himp.::x_'/'_x_'\\'_x [notation, in PLF.Equiv]
    -Himp.::x_'::='_x [notation, in PLF.Equiv]
    +Himp.:imp_scope:x_'::='_x [notation, in PLF.Equiv]
    +Himp.:imp_scope:x_';;'_x [notation, in PLF.Equiv]
    +Himp.:imp_scope:'HAVOC'_x [notation, in PLF.Equiv]
    +Himp.:imp_scope:'SKIP' [notation, in PLF.Equiv]
    +Himp.:imp_scope:'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Equiv]
    +Himp.:imp_scope:'WHILE'_x_'DO'_x_'END' [notation, in PLF.Equiv]
    Himp.::x_'::='_x [notation, in PLF.Hoare]
    Himp.::x_';;'_x [notation, in PLF.Hoare]
    -Himp.::x_';;'_x [notation, in PLF.Equiv]
    -Himp.::'HAVOC'_x [notation, in PLF.Equiv]
    +Himp.::x_'=['_x_']=>'_x [notation, in PLF.Hoare]
    +Himp.::x_'=['_x_']=>'_x [notation, in PLF.Equiv]
    Himp.::'HAVOC'_x [notation, in PLF.Hoare]
    -Himp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    -Himp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Equiv]
    -Himp.::'SKIP' [notation, in PLF.Equiv]
    Himp.::'SKIP' [notation, in PLF.Hoare]
    +Himp.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    Himp.::'WHILE'_x_'DO'_x_'END' [notation, in PLF.Hoare]
    -Himp.::'WHILE'_x_'DO'_x_'END' [notation, in PLF.Equiv]
    Himp2 [module, in PLF.Hoare2]
    Himp2.hoare_havoc_weakest [lemma, in PLF.Hoare2]
    HintsTransitivity [section, in PLF.UseAuto]
    Hoare [library]
    HoareAsLogic [library]
    +HoareAssertAssume [module, in PLF.Hoare]
    +HoareAssertAssume.assert_assume_differ [lemma, in PLF.Hoare]
    +HoareAssertAssume.assert_assume_example [definition, in PLF.Hoare]
    +HoareAssertAssume.assert_implies_assume [lemma, in PLF.Hoare]
    +HoareAssertAssume.CAss [constructor, in PLF.Hoare]
    +HoareAssertAssume.CAssert [constructor, in PLF.Hoare]
    +HoareAssertAssume.CAssume [constructor, in PLF.Hoare]
    +HoareAssertAssume.ceval [inductive, in PLF.Hoare]
    +HoareAssertAssume.CIf [constructor, in PLF.Hoare]
    +HoareAssertAssume.com [inductive, in PLF.Hoare]
    +HoareAssertAssume.CSeq [constructor, in PLF.Hoare]
    +HoareAssertAssume.CSkip [constructor, in PLF.Hoare]
    +HoareAssertAssume.CWhile [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_Ass [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_AssertFalse [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_AssertTrue [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_Assume [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_IfFalse [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_IfTrue [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_SeqError [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_SeqNormal [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_Skip [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_WhileFalse [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_WhileTrueError [constructor, in PLF.Hoare]
    +HoareAssertAssume.E_WhileTrueNormal [constructor, in PLF.Hoare]
    +HoareAssertAssume.hoare_asgn [lemma, in PLF.Hoare]
    +HoareAssertAssume.hoare_consequence_post [lemma, in PLF.Hoare]
    +HoareAssertAssume.hoare_consequence_pre [lemma, in PLF.Hoare]
    +HoareAssertAssume.hoare_if [lemma, in PLF.Hoare]
    +HoareAssertAssume.hoare_seq [lemma, in PLF.Hoare]
    +HoareAssertAssume.hoare_skip [lemma, in PLF.Hoare]
    +HoareAssertAssume.hoare_triple [definition, in PLF.Hoare]
    +HoareAssertAssume.hoare_while [lemma, in PLF.Hoare]
    +HoareAssertAssume.RError [constructor, in PLF.Hoare]
    +HoareAssertAssume.result [inductive, in PLF.Hoare]
    +HoareAssertAssume.RNormal [constructor, in PLF.Hoare]
    +HoareAssertAssume.:hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [notation, in PLF.Hoare]
    +HoareAssertAssume.::x_'::='_x [notation, in PLF.Hoare]
    +HoareAssertAssume.::x_';;'_x [notation, in PLF.Hoare]
    +HoareAssertAssume.::x_'=['_x_']=>'_x [notation, in PLF.Hoare]
    +HoareAssertAssume.::'ASSERT'_x [notation, in PLF.Hoare]
    +HoareAssertAssume.::'ASSUME'_x [notation, in PLF.Hoare]
    +HoareAssertAssume.::'SKIP' [notation, in PLF.Hoare]
    +HoareAssertAssume.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    +HoareAssertAssume.::'WHILE'_x_'DO'_x_'END' [notation, in PLF.Hoare]
    Hoare2 [library]
    hoare_asgn [lemma, in PLF.Hoare]
    hoare_asgn_example1 [definition, in PLF.Hoare]
    @@ -894,9 +959,6 @@

    Global Index



    I

    identity_assignment [lemma, in PLF.Equiv]
    If [constructor, in PLF.PE]
    -IFB_false [lemma, in PLF.Equiv]
    -IFB_true [lemma, in PLF.Equiv]
    -IFB_true_simple [lemma, in PLF.Equiv]
    iff_intro_swap [lemma, in PLF.LibTactics]
    iff_trans [lemma, in PLF.Equiv]
    If1 [module, in PLF.Hoare]
    @@ -918,13 +980,13 @@

    Global Index

    If1.hoare_if1_good [lemma, in PLF.Hoare]
    If1.hoare_triple [definition, in PLF.Hoare]
    If1.:hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [notation, in PLF.Hoare]
    -If1.::x_'/'_x_'\\'_x [notation, in PLF.Hoare]
    -If1.::x_'::='_x [notation, in PLF.Hoare]
    -If1.::x_';;'_x [notation, in PLF.Hoare]
    -If1.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    -If1.::'IF1'_x_'THEN'_x_'FI' [notation, in PLF.Hoare]
    -If1.::'SKIP' [notation, in PLF.Hoare]
    -If1.::'WHILE'_x_'DO'_x_'END' [notation, in PLF.Hoare]
    +If1.:imp_scope:x_'::='_x [notation, in PLF.Hoare]
    +If1.:imp_scope:x_';;'_x [notation, in PLF.Hoare]
    +If1.:imp_scope:'IF1'_x_'THEN'_x_'FI' [notation, in PLF.Hoare]
    +If1.:imp_scope:'SKIP' [notation, in PLF.Hoare]
    +If1.:imp_scope:'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    +If1.:imp_scope:'WHILE'_x_'DO'_x_'END' [notation, in PLF.Hoare]
    +If1.::x_'=['_x_']=>'_x [notation, in PLF.Hoare]
    if_example [definition, in PLF.Hoare]
    if_minus_correct [lemma, in PLF.Hoare2]
    if_minus_dec [definition, in PLF.Hoare2]
    @@ -953,6 +1015,7 @@

    Global Index

    InvertsExamples.skip_left [lemma, in PLF.UseTactics]
    InvertsExamples.skip_left' [lemma, in PLF.UseTactics]
    InvertsExamples.typing_nonexample_1 [definition, in PLF.UseTactics]
    +iszro [constructor, in PLF.Types]
    is_wp [definition, in PLF.Hoare2]
    is_wp_example [lemma, in PLF.Hoare2]


    K

    @@ -965,8 +1028,8 @@

    Global Index

    LibTacticsCompatibility [module, in PLF.LibTactics]
    lookup [definition, in PLF.Norm]
    lookup_field_in_value [lemma, in PLF.RecordSub]
    -loop [constructor, in PLF.PE]
    Loop [module, in PLF.PE]
    +loop [constructor, in PLF.PE]
    Loop.ceval_count [inductive, in PLF.PE]
    Loop.ceval_count_complete [lemma, in PLF.PE]
    Loop.ceval_count_sound [lemma, in PLF.PE]
    @@ -1057,23 +1120,19 @@

    Global Index

    manual_grade_for_norm [definition, in PLF.Norm]
    manual_grade_for_norm_fail [definition, in PLF.Norm]
    manual_grade_for_pair_permutation [definition, in PLF.Sub]
    -manual_grade_for_preservation [definition, in PLF.Sub]
    -manual_grade_for_progress [definition, in PLF.Sub]
    manual_grade_for_prog_pres_bigstep [definition, in PLF.Types]
    manual_grade_for_proper_subtypes [definition, in PLF.Sub]
    manual_grade_for_rcd_types_match_informal [definition, in PLF.RecordSub]
    -manual_grade_for_remove_predzero [definition, in PLF.Types]
    +manual_grade_for_remove_predzro [definition, in PLF.Types]
    manual_grade_for_smallest_1 [definition, in PLF.Sub]
    manual_grade_for_smallest_2 [definition, in PLF.Sub]
    manual_grade_for_small_large_1 [definition, in PLF.Sub]
    manual_grade_for_small_large_2 [definition, in PLF.Sub]
    manual_grade_for_small_large_4 [definition, in PLF.Sub]
    -manual_grade_for_STLC_extensions [definition, in PLF.MoreStlc]
    manual_grade_for_subject_expansion [definition, in PLF.Types]
    manual_grade_for_subtype_concepts_tf [definition, in PLF.Sub]
    manual_grade_for_subtype_instances_tf_2 [definition, in PLF.Sub]
    manual_grade_for_subtype_order [definition, in PLF.Sub]
    -manual_grade_for_variations [definition, in PLF.Sub]
    manual_grade_for_variation1 [definition, in PLF.Types]
    manual_grade_for_variation2 [definition, in PLF.Types]
    MoreStlc [library]
    @@ -1085,8 +1144,8 @@

    Global Index

    msubst_R [lemma, in PLF.Norm]
    msubst_var [lemma, in PLF.Norm]
    multi [inductive, in PLF.Smallstep]
    -multistep [abbreviation, in PLF.Norm]
    multistep [definition, in PLF.Types]
    +multistep [abbreviation, in PLF.Norm]
    multistep_App2 [lemma, in PLF.Norm]
    multistep_congr_1 [lemma, in PLF.Smallstep]
    multistep_congr_2 [lemma, in PLF.Smallstep]
    @@ -1105,28 +1164,24 @@

    Global Index

    NaryExamples [module, in PLF.UseTactics]
    NaryExamples.demo_branch [lemma, in PLF.UseTactics]
    NaryExamples.demo_splits [lemma, in PLF.UseTactics]
    -NaryExamples.progress [lemma, in PLF.UseTactics]
    +Nat [constructor, in PLF.Types]
    nat_canonical [lemma, in PLF.Types]
    +nat_le_refl [lemma, in PLF.UseAuto]
    negation_study_1 [lemma, in PLF.UseAuto]
    negation_study_2 [lemma, in PLF.UseAuto]
    nf_is_value [lemma, in PLF.Smallstep]
    nf_same_as_value [lemma, in PLF.Smallstep]
    Norm [library]
    normalization [lemma, in PLF.Norm]
    -NormalizePlayground [module, in PLF.Types]
    -NormalizePlayground.normalize_ex [lemma, in PLF.Types]
    -NormalizePlayground.normalize_ex' [lemma, in PLF.Types]
    -NormalizePlayground.step_example1 [definition, in PLF.Types]
    -NormalizePlayground.step_example1' [definition, in PLF.Types]
    -NormalizePlayground.step_example1'' [definition, in PLF.Types]
    -NormalizePlayground.step_example1''' [definition, in PLF.Types]
    +normalize_ex [lemma, in PLF.Smallstep]
    +normalize_ex' [lemma, in PLF.Smallstep]
    normalizing [definition, in PLF.Smallstep]
    normal_form [definition, in PLF.Smallstep]
    normal_forms_unique [lemma, in PLF.Smallstep]
    normal_form_of [definition, in PLF.Smallstep]
    nvalue [inductive, in PLF.Types]
    -nv_succ [constructor, in PLF.Types]
    -nv_zero [constructor, in PLF.Types]
    +nv_scc [constructor, in PLF.Types]
    +nv_zro [constructor, in PLF.Types]


    O

    omega_demo_1 [lemma, in PLF.UseAuto]
    omega_demo_2 [lemma, in PLF.UseAuto]
    @@ -1137,6 +1192,7 @@

    Global Index



    P

    P [constructor, in PLF.Smallstep]
    P [axiom, in PLF.UseAuto]
    +pair [constructor, in PLF.Norm]
    parity [definition, in PLF.Hoare2]
    parity [definition, in PLF.PE]
    parity_body [definition, in PLF.PE]
    @@ -1207,11 +1263,11 @@

    Global Index

    pow2 [definition, in PLF.Hoare2]
    pow2_le_1 [lemma, in PLF.Hoare2]
    pow2_plus_1 [lemma, in PLF.Hoare2]
    +prd [constructor, in PLF.Types]
    Preface [library]
    -preservation [lemma, in PLF.Norm]
    -preservation [lemma, in PLF.Sub]
    preservation [lemma, in PLF.Types]
    preservation [lemma, in PLF.RecordSub]
    +preservation [lemma, in PLF.Norm]
    PreservationProgressReferences [module, in PLF.UseAuto]
    PreservationProgressReferences.nth_eq_last' [lemma, in PLF.UseAuto]
    PreservationProgressReferences.preservation [lemma, in PLF.UseAuto]
    @@ -1225,32 +1281,12 @@

    Global Index

    PreservationProgressStlc.progress' [lemma, in PLF.UseAuto]
    preservation' [lemma, in PLF.Types]
    pre_dec [definition, in PLF.Hoare2]
    -ProductExtension [module, in PLF.Sub]
    -ProductExtension.preservation [lemma, in PLF.Sub]
    -ProductExtension.progress [lemma, in PLF.Sub]
    -ProductExtension.tabs [constructor, in PLF.Sub]
    -ProductExtension.tapp [constructor, in PLF.Sub]
    -ProductExtension.TArrow [constructor, in PLF.Sub]
    -ProductExtension.TBase [constructor, in PLF.Sub]
    -ProductExtension.TBool [constructor, in PLF.Sub]
    -ProductExtension.tfalse [constructor, in PLF.Sub]
    -ProductExtension.tfst [constructor, in PLF.Sub]
    -ProductExtension.tif [constructor, in PLF.Sub]
    -ProductExtension.tm [inductive, in PLF.Sub]
    -ProductExtension.tpair [constructor, in PLF.Sub]
    -ProductExtension.TProd [constructor, in PLF.Sub]
    -ProductExtension.tsnd [constructor, in PLF.Sub]
    -ProductExtension.TTop [constructor, in PLF.Sub]
    -ProductExtension.ttrue [constructor, in PLF.Sub]
    -ProductExtension.tunit [constructor, in PLF.Sub]
    -ProductExtension.TUnit [constructor, in PLF.Sub]
    -ProductExtension.tvar [constructor, in PLF.Sub]
    -ProductExtension.ty [inductive, in PLF.Sub]
    +Prod [constructor, in PLF.Norm]
    prog [definition, in PLF.Smallstep]
    program [definition, in PLF.PE]
    -progress [lemma, in PLF.Types]
    progress [lemma, in PLF.RecordSub]
    progress [lemma, in PLF.Sub]
    +progress [lemma, in PLF.Types]
    prog_a [definition, in PLF.Equiv]
    prog_b [definition, in PLF.Equiv]
    prog_c [definition, in PLF.Equiv]
    @@ -1263,6 +1299,8 @@

    Global Index



    R

    R [definition, in PLF.Norm]
    rcd_types_match [lemma, in PLF.RecordSub]
    +rcons [constructor, in PLF.RecordSub]
    +RCons [constructor, in PLF.RecordSub]
    real_fact [definition, in PLF.Hoare2]
    Records [library]
    RecordSub [library]
    @@ -1294,25 +1332,30 @@

    Global Index

    RepeatExercise.E_WhileFalse [constructor, in PLF.Hoare]
    RepeatExercise.E_WhileTrue [constructor, in PLF.Hoare]
    RepeatExercise.hoare_triple [definition, in PLF.Hoare]
    -RepeatExercise.::x_'/'_x_'\\'_x [notation, in PLF.Hoare]
    RepeatExercise.::x_'::='_x [notation, in PLF.Hoare]
    RepeatExercise.::x_';;'_x [notation, in PLF.Hoare]
    -RepeatExercise.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    +RepeatExercise.::x_'=['_x_']=>'_x [notation, in PLF.Hoare]
    RepeatExercise.::'REPEAT'_x_'UNTIL'_x_'END' [notation, in PLF.Hoare]
    RepeatExercise.::'SKIP' [notation, in PLF.Hoare]
    +RepeatExercise.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in PLF.Hoare]
    RepeatExercise.::'WHILE'_x_'DO'_x_'END' [notation, in PLF.Hoare]
    RepeatExercise.::'{{'_x_'}}'_x_'{{'_x_'}}' [notation, in PLF.Hoare]
    RingDemo [module, in PLF.UseAuto]
    RingDemo.ring_demo [lemma, in PLF.UseAuto]
    rm [definition, in PLF.LibTactics]
    -rtcons [constructor, in PLF.RecordSub]
    +rnil [constructor, in PLF.RecordSub]
    +RNil [constructor, in PLF.RecordSub]
    +rproj [constructor, in PLF.RecordSub]
    RTcons [constructor, in PLF.RecordSub]
    +rtcons [constructor, in PLF.RecordSub]
    RTnil [constructor, in PLF.RecordSub]
    rtnil [constructor, in PLF.RecordSub]
    R_halts [lemma, in PLF.Norm]
    R_typable_empty [lemma, in PLF.Norm]


    S

    sample_proof [definition, in PLF.HoareAsLogic]
    +scc [constructor, in PLF.Types]
    +scc_hastype_nat__hastype_nat [definition, in PLF.Types]
    search_depth_0 [lemma, in PLF.UseAuto]
    search_depth_1 [lemma, in PLF.UseAuto]
    search_depth_3 [lemma, in PLF.UseAuto]
    @@ -1335,23 +1378,21 @@

    Global Index

    SimpleArith1.ST_Plus2 [constructor, in PLF.Smallstep]
    SimpleArith1.test_step_1 [definition, in PLF.Smallstep]
    SimpleArith1.test_step_2 [definition, in PLF.Smallstep]
    -SimpleArith1.::x_'==>'_x [notation, in PLF.Smallstep]
    +-->'_x">SimpleArith1.::x_'-->'_x [notation, in PLF.Smallstep]
    SimpleArith2 [module, in PLF.Smallstep]
    SimpleArith2.step_deterministic [lemma, in PLF.Smallstep]
    SimpleArith3 [module, in PLF.Smallstep]
    SimpleArith3.step_deterministic_alt [lemma, in PLF.Smallstep]
    SkipExample [module, in PLF.UseTactics]
    -SkipExample.astep_example1 [definition, in PLF.UseTactics]
    SkipExample.ceval_deterministic [lemma, in PLF.UseTactics]
    -SkipExample.demo_skipH [lemma, in PLF.UseTactics]
    -SkipExample.mult_0_plus [lemma, in PLF.UseTactics]
    -SkipExample.::x_'/'_x_'==>a*'_x [notation, in PLF.UseTactics]
    -skip_axiom [axiom, in PLF.LibTactics]
    +SkipExample.demo_admits [lemma, in PLF.UseTactics]
    +SkipExample.mult_plus_0 [lemma, in PLF.UseTactics]
    skip_left [lemma, in PLF.Equiv]
    skip_right [lemma, in PLF.Equiv]
    slow_assignment_dec [definition, in PLF.Hoare2]
    slow_assignment_dec_correct [lemma, in PLF.Hoare2]
    Smallstep [library]
    +snd [constructor, in PLF.Norm]
    solved_by_jauto [lemma, in PLF.UseAuto]
    solving_by_apply [lemma, in PLF.UseAuto]
    solving_by_eapply [lemma, in PLF.UseAuto]
    @@ -1387,18 +1428,25 @@

    Global Index

    stack_multistep [definition, in PLF.Smallstep]
    stack_step [inductive, in PLF.Smallstep]
    stack_step_deterministic [lemma, in PLF.Smallstep]
    -step [inductive, in PLF.RecordSub]
    step [inductive, in PLF.Norm]
    +step [inductive, in PLF.Smallstep]
    +step [inductive, in PLF.RecordSub]
    step [inductive, in PLF.Types]
    step [inductive, in PLF.Sub]
    -step [inductive, in PLF.Smallstep]
    StepFunction [module, in PLF.Typechecking]
    +StepFunction.complete_stepf [lemma, in PLF.Typechecking]
    +StepFunction.sound_stepf [lemma, in PLF.Typechecking]
    +StepFunction.stepf [definition, in PLF.Typechecking]
    +step_deterministic [lemma, in PLF.Norm]
    step_deterministic [lemma, in PLF.Types]
    step_deterministic [lemma, in PLF.Smallstep]
    -step_deterministic [lemma, in PLF.Norm]
    +step_example1 [definition, in PLF.Smallstep]
    +step_example1' [definition, in PLF.Smallstep]
    +step_example1'' [definition, in PLF.Smallstep]
    +step_example1''' [definition, in PLF.Smallstep]
    step_normalizing [lemma, in PLF.Smallstep]
    -step_normal_form [definition, in PLF.Smallstep]
    step_normal_form [abbreviation, in PLF.Norm]
    +step_normal_form [definition, in PLF.Smallstep]
    step_normal_form [abbreviation, in PLF.Types]
    step_preserves_halting [lemma, in PLF.Norm]
    step_preserves_R [lemma, in PLF.Norm]
    @@ -1408,19 +1456,19 @@

    Global Index

    STLC [module, in PLF.Stlc]
    Stlc [library]
    STLCArith [module, in PLF.StlcProp]
    +STLCArith.abs [constructor, in PLF.StlcProp]
    +STLCArith.app [constructor, in PLF.StlcProp]
    +STLCArith.Arrow [constructor, in PLF.StlcProp]
    +STLCArith.const [constructor, in PLF.StlcProp]
    STLCArith.manual_grade_for_stlc_arith [definition, in PLF.StlcProp]
    -STLCArith.tabs [constructor, in PLF.StlcProp]
    -STLCArith.tapp [constructor, in PLF.StlcProp]
    -STLCArith.TArrow [constructor, in PLF.StlcProp]
    -STLCArith.tif0 [constructor, in PLF.StlcProp]
    +STLCArith.mlt [constructor, in PLF.StlcProp]
    +STLCArith.Nat [constructor, in PLF.StlcProp]
    +STLCArith.prd [constructor, in PLF.StlcProp]
    +STLCArith.scc [constructor, in PLF.StlcProp]
    +STLCArith.test0 [constructor, in PLF.StlcProp]
    STLCArith.tm [inductive, in PLF.StlcProp]
    -STLCArith.tmult [constructor, in PLF.StlcProp]
    -STLCArith.tnat [constructor, in PLF.StlcProp]
    -STLCArith.TNat [constructor, in PLF.StlcProp]
    -STLCArith.tpred [constructor, in PLF.StlcProp]
    -STLCArith.tsucc [constructor, in PLF.StlcProp]
    -STLCArith.tvar [constructor, in PLF.StlcProp]
    STLCArith.ty [inductive, in PLF.StlcProp]
    +STLCArith.var [constructor, in PLF.StlcProp]
    STLCChecker [module, in PLF.Typechecking]
    STLCChecker.type_check [definition, in PLF.Typechecking]
    STLCChecker.type_checking_complete [lemma, in PLF.Typechecking]
    @@ -1429,6 +1477,7 @@

    Global Index

    STLCExtendedRecords [module, in PLF.Records]
    STLCExtendedRecords.A [abbreviation, in PLF.Records]
    STLCExtendedRecords.a [abbreviation, in PLF.Records]
    +STLCExtendedRecords.abs [constructor, in PLF.Records]
    STLCExtendedRecords.afi_abs [constructor, in PLF.Records]
    STLCExtendedRecords.afi_app1 [constructor, in PLF.Records]
    STLCExtendedRecords.afi_app2 [constructor, in PLF.Records]
    @@ -1436,15 +1485,18 @@

    Global Index

    STLCExtendedRecords.afi_rhead [constructor, in PLF.Records]
    STLCExtendedRecords.afi_rtail [constructor, in PLF.Records]
    STLCExtendedRecords.afi_var [constructor, in PLF.Records]
    +STLCExtendedRecords.app [constructor, in PLF.Records]
    STLCExtendedRecords.appears_free_in [inductive, in PLF.Records]
    +STLCExtendedRecords.Arrow [constructor, in PLF.Records]
    STLCExtendedRecords.B [abbreviation, in PLF.Records]
    +STLCExtendedRecords.Base [constructor, in PLF.Records]
    STLCExtendedRecords.context [definition, in PLF.Records]
    STLCExtendedRecords.context_invariance [lemma, in PLF.Records]
    STLCExtendedRecords.f [abbreviation, in PLF.Records]
    STLCExtendedRecords.FirstTry [module, in PLF.Records]
    STLCExtendedRecords.FirstTry.alist [definition, in PLF.Records]
    -STLCExtendedRecords.FirstTry.TArrow [constructor, in PLF.Records]
    -STLCExtendedRecords.FirstTry.TBase [constructor, in PLF.Records]
    +STLCExtendedRecords.FirstTry.Arrow [constructor, in PLF.Records]
    +STLCExtendedRecords.FirstTry.Base [constructor, in PLF.Records]
    STLCExtendedRecords.FirstTry.TRcd [constructor, in PLF.Records]
    STLCExtendedRecords.FirstTry.ty [inductive, in PLF.Records]
    STLCExtendedRecords.free_in_context [lemma, in PLF.Records]
    @@ -1459,10 +1511,14 @@

    Global Index

    STLCExtendedRecords.multistep [abbreviation, in PLF.Records]
    STLCExtendedRecords.preservation [lemma, in PLF.Records]
    STLCExtendedRecords.progress [lemma, in PLF.Records]
    +STLCExtendedRecords.RCons [constructor, in PLF.Records]
    +STLCExtendedRecords.rcons [constructor, in PLF.Records]
    STLCExtendedRecords.record_tm [inductive, in PLF.Records]
    STLCExtendedRecords.record_ty [inductive, in PLF.Records]
    -STLCExtendedRecords.rtcons [constructor, in PLF.Records]
    +STLCExtendedRecords.RNil [constructor, in PLF.Records]
    +STLCExtendedRecords.rproj [constructor, in PLF.Records]
    STLCExtendedRecords.RTcons [constructor, in PLF.Records]
    +STLCExtendedRecords.rtcons [constructor, in PLF.Records]
    STLCExtendedRecords.RTnil [constructor, in PLF.Records]
    STLCExtendedRecords.rtnil [constructor, in PLF.Records]
    STLCExtendedRecords.step [inductive, in PLF.Records]
    @@ -1476,19 +1532,10 @@

    Global Index

    STLCExtendedRecords.ST_Rcd_Tail [constructor, in PLF.Records]
    STLCExtendedRecords.subst [definition, in PLF.Records]
    STLCExtendedRecords.substitution_preserves_typing [lemma, in PLF.Records]
    -STLCExtendedRecords.tabs [constructor, in PLF.Records]
    -STLCExtendedRecords.tapp [constructor, in PLF.Records]
    -STLCExtendedRecords.TArrow [constructor, in PLF.Records]
    -STLCExtendedRecords.TBase [constructor, in PLF.Records]
    STLCExtendedRecords.tlookup [definition, in PLF.Records]
    STLCExtendedRecords.Tlookup [definition, in PLF.Records]
    STLCExtendedRecords.tm [inductive, in PLF.Records]
    -STLCExtendedRecords.tproj [constructor, in PLF.Records]
    -STLCExtendedRecords.trcons [constructor, in PLF.Records]
    -STLCExtendedRecords.TRCons [constructor, in PLF.Records]
    -STLCExtendedRecords.TRNil [constructor, in PLF.Records]
    STLCExtendedRecords.trnil [constructor, in PLF.Records]
    -STLCExtendedRecords.tvar [constructor, in PLF.Records]
    STLCExtendedRecords.ty [inductive, in PLF.Records]
    STLCExtendedRecords.typing_example_2 [lemma, in PLF.Records]
    STLCExtendedRecords.typing_nonexample [definition, in PLF.Records]
    @@ -1500,20 +1547,22 @@

    Global Index

    STLCExtendedRecords.T_RNil [constructor, in PLF.Records]
    STLCExtendedRecords.T_Var [constructor, in PLF.Records]
    STLCExtendedRecords.value [inductive, in PLF.Records]
    +STLCExtendedRecords.var [constructor, in PLF.Records]
    STLCExtendedRecords.v_abs [constructor, in PLF.Records]
    STLCExtendedRecords.v_rcons [constructor, in PLF.Records]
    STLCExtendedRecords.v_rnil [constructor, in PLF.Records]
    STLCExtendedRecords.weird_type [definition, in PLF.Records]
    STLCExtendedRecords.well_formed_ty [inductive, in PLF.Records]
    -STLCExtendedRecords.wfTArrow [constructor, in PLF.Records]
    -STLCExtendedRecords.wfTBase [constructor, in PLF.Records]
    -STLCExtendedRecords.wfTRCons [constructor, in PLF.Records]
    -STLCExtendedRecords.wfTRNil [constructor, in PLF.Records]
    +STLCExtendedRecords.wfArrow [constructor, in PLF.Records]
    +STLCExtendedRecords.wfBase [constructor, in PLF.Records]
    +STLCExtendedRecords.wfRCons [constructor, in PLF.Records]
    +STLCExtendedRecords.wfRNil [constructor, in PLF.Records]
    STLCExtendedRecords.wf_rcd_lookup [lemma, in PLF.Records]
    -STLCExtendedRecords.::x_'==>'_x [notation, in PLF.Records]
    -STLCExtendedRecords.::x_'==>*'_x [notation, in PLF.Records]
    -STLCExtendedRecords.::x_'|-'_x_'∈'_x [notation, in PLF.Records]
    +-->'_x">STLCExtendedRecords.::x_'-->'_x [notation, in PLF.Records]
    +-->*'_x">STLCExtendedRecords.::x_'-->*'_x [notation, in PLF.Records]
    +STLCExtendedRecords.::x_'⊢'_x_'∈'_x [notation, in PLF.Records]
    STLCExtendedRecords.::'['_x_':='_x_']'_x [notation, in PLF.Records]
    +STLCExtended.abs [constructor, in PLF.MoreStlc]
    STLCExtended.afi_abs [constructor, in PLF.MoreStlc]
    STLCExtended.afi_app1 [constructor, in PLF.MoreStlc]
    STLCExtended.afi_app2 [constructor, in PLF.MoreStlc]
    @@ -1522,9 +1571,6 @@

    Global Index

    STLCExtended.afi_case2 [constructor, in PLF.MoreStlc]
    STLCExtended.afi_cons1 [constructor, in PLF.MoreStlc]
    STLCExtended.afi_cons2 [constructor, in PLF.MoreStlc]
    -STLCExtended.afi_if01 [constructor, in PLF.MoreStlc]
    -STLCExtended.afi_if02 [constructor, in PLF.MoreStlc]
    -STLCExtended.afi_if03 [constructor, in PLF.MoreStlc]
    STLCExtended.afi_inl [constructor, in PLF.MoreStlc]
    STLCExtended.afi_inr [constructor, in PLF.MoreStlc]
    STLCExtended.afi_lcase1 [constructor, in PLF.MoreStlc]
    @@ -1534,8 +1580,14 @@

    Global Index

    STLCExtended.afi_mult2 [constructor, in PLF.MoreStlc]
    STLCExtended.afi_pred [constructor, in PLF.MoreStlc]
    STLCExtended.afi_succ [constructor, in PLF.MoreStlc]
    +STLCExtended.afi_test01 [constructor, in PLF.MoreStlc]
    +STLCExtended.afi_test02 [constructor, in PLF.MoreStlc]
    +STLCExtended.afi_test03 [constructor, in PLF.MoreStlc]
    STLCExtended.afi_var [constructor, in PLF.MoreStlc]
    +STLCExtended.app [constructor, in PLF.MoreStlc]
    STLCExtended.appears_free_in [inductive, in PLF.MoreStlc]
    +STLCExtended.Arrow [constructor, in PLF.MoreStlc]
    +STLCExtended.const [constructor, in PLF.MoreStlc]
    STLCExtended.context [definition, in PLF.MoreStlc]
    STLCExtended.context_invariance [lemma, in PLF.MoreStlc]
    STLCExtended.Examples [module, in PLF.MoreStlc]
    @@ -1547,40 +1599,75 @@

    Global Index

    STLCExtended.Examples.f [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest1 [module, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest1.fact [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest1.reduces [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest1.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest2 [module, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest2.map [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest2.reduces [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest2.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest3 [module, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest3.equal [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest3.reduces [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest3.reduces2 [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest3.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest4 [module, in PLF.MoreStlc]
    STLCExtended.Examples.FixTest4.eotest [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest4.reduces [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest4.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.g [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.i1 [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.i2 [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.k [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.l [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.LetTest [module, in PLF.MoreStlc]
    +STLCExtended.Examples.LetTest.reduces [definition, in PLF.MoreStlc]
    STLCExtended.Examples.LetTest.test [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.LetTest.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.ListTest [module, in PLF.MoreStlc]
    +STLCExtended.Examples.ListTest.reduces [definition, in PLF.MoreStlc]
    STLCExtended.Examples.ListTest.test [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.ListTest.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.m [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.n [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.Numtest [module, in PLF.MoreStlc]
    +STLCExtended.Examples.Numtest.numtest_reduces [definition, in PLF.MoreStlc]
    STLCExtended.Examples.Numtest.test [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.Numtest.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.odd [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.processSum [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.Prodtest [module, in PLF.MoreStlc]
    +STLCExtended.Examples.Prodtest.reduces [definition, in PLF.MoreStlc]
    STLCExtended.Examples.Prodtest.test [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.Prodtest.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.Sumtest1 [module, in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest1.reduces [definition, in PLF.MoreStlc]
    STLCExtended.Examples.Sumtest1.test [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest1.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.Sumtest2 [module, in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest2.reduces [definition, in PLF.MoreStlc]
    STLCExtended.Examples.Sumtest2.test [definition, in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest2.typechecks [definition, in PLF.MoreStlc]
    STLCExtended.Examples.x [abbreviation, in PLF.MoreStlc]
    STLCExtended.Examples.y [abbreviation, in PLF.MoreStlc]
    STLCExtended.free_in_context [lemma, in PLF.MoreStlc]
    +STLCExtended.fst [constructor, in PLF.MoreStlc]
    STLCExtended.has_type [inductive, in PLF.MoreStlc]
    +STLCExtended.List [constructor, in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_context_invariance [definition, in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_extensions_definition [definition, in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_preservation [definition, in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_progress [definition, in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_substitution_preserves_typing [definition, in PLF.MoreStlc]
    +STLCExtended.mlt [constructor, in PLF.MoreStlc]
    STLCExtended.multistep [abbreviation, in PLF.MoreStlc]
    +STLCExtended.Nat [constructor, in PLF.MoreStlc]
    +STLCExtended.pair [constructor, in PLF.MoreStlc]
    +STLCExtended.prd [constructor, in PLF.MoreStlc]
    STLCExtended.preservation [lemma, in PLF.MoreStlc]
    +STLCExtended.Prod [constructor, in PLF.MoreStlc]
    STLCExtended.progress [lemma, in PLF.MoreStlc]
    +STLCExtended.scc [constructor, in PLF.MoreStlc]
    +STLCExtended.snd [constructor, in PLF.MoreStlc]
    STLCExtended.step [inductive, in PLF.MoreStlc]
    STLCExtended.ST_AppAbs [constructor, in PLF.MoreStlc]
    STLCExtended.ST_App1 [constructor, in PLF.MoreStlc]
    @@ -1590,56 +1677,39 @@

    Global Index

    STLCExtended.ST_CaseInr [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Cons1 [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Cons2 [constructor, in PLF.MoreStlc]
    -STLCExtended.ST_If0Nonzero [constructor, in PLF.MoreStlc]
    -STLCExtended.ST_If0Zero [constructor, in PLF.MoreStlc]
    -STLCExtended.ST_If01 [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Inl [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Inr [constructor, in PLF.MoreStlc]
    STLCExtended.ST_LcaseCons [constructor, in PLF.MoreStlc]
    STLCExtended.ST_LcaseNil [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Lcase1 [constructor, in PLF.MoreStlc]
    -STLCExtended.ST_MultNats [constructor, in PLF.MoreStlc]
    +STLCExtended.ST_Mulconsts [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Mult1 [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Mult2 [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Pred [constructor, in PLF.MoreStlc]
    STLCExtended.ST_PredNat [constructor, in PLF.MoreStlc]
    STLCExtended.ST_SuccNat [constructor, in PLF.MoreStlc]
    STLCExtended.ST_Succ1 [constructor, in PLF.MoreStlc]
    +STLCExtended.ST_Test0Nonzero [constructor, in PLF.MoreStlc]
    +STLCExtended.ST_Test0Zero [constructor, in PLF.MoreStlc]
    +STLCExtended.ST_Test01 [constructor, in PLF.MoreStlc]
    STLCExtended.subst [definition, in PLF.MoreStlc]
    STLCExtended.substitution_preserves_typing [lemma, in PLF.MoreStlc]
    -STLCExtended.tabs [constructor, in PLF.MoreStlc]
    -STLCExtended.tapp [constructor, in PLF.MoreStlc]
    -STLCExtended.TArrow [constructor, in PLF.MoreStlc]
    +STLCExtended.Sum [constructor, in PLF.MoreStlc]
    STLCExtended.tcase [constructor, in PLF.MoreStlc]
    STLCExtended.tcons [constructor, in PLF.MoreStlc]
    +STLCExtended.test0 [constructor, in PLF.MoreStlc]
    STLCExtended.tfix [constructor, in PLF.MoreStlc]
    -STLCExtended.tfst [constructor, in PLF.MoreStlc]
    -STLCExtended.tif0 [constructor, in PLF.MoreStlc]
    STLCExtended.tinl [constructor, in PLF.MoreStlc]
    STLCExtended.tinr [constructor, in PLF.MoreStlc]
    STLCExtended.tlcase [constructor, in PLF.MoreStlc]
    STLCExtended.tlet [constructor, in PLF.MoreStlc]
    -STLCExtended.TList [constructor, in PLF.MoreStlc]
    STLCExtended.tm [inductive, in PLF.MoreStlc]
    -STLCExtended.tmult [constructor, in PLF.MoreStlc]
    -STLCExtended.tnat [constructor, in PLF.MoreStlc]
    -STLCExtended.TNat [constructor, in PLF.MoreStlc]
    STLCExtended.tnil [constructor, in PLF.MoreStlc]
    -STLCExtended.tpair [constructor, in PLF.MoreStlc]
    -STLCExtended.tpred [constructor, in PLF.MoreStlc]
    -STLCExtended.TProd [constructor, in PLF.MoreStlc]
    -STLCExtended.tsnd [constructor, in PLF.MoreStlc]
    -STLCExtended.tsucc [constructor, in PLF.MoreStlc]
    -STLCExtended.TSum [constructor, in PLF.MoreStlc]
    -STLCExtended.TUnit [constructor, in PLF.MoreStlc]
    -STLCExtended.tunit [constructor, in PLF.MoreStlc]
    -STLCExtended.tvar [constructor, in PLF.MoreStlc]
    STLCExtended.ty [inductive, in PLF.MoreStlc]
    STLCExtended.T_Abs [constructor, in PLF.MoreStlc]
    STLCExtended.T_App [constructor, in PLF.MoreStlc]
    STLCExtended.T_Case [constructor, in PLF.MoreStlc]
    STLCExtended.T_Cons [constructor, in PLF.MoreStlc]
    -STLCExtended.T_If0 [constructor, in PLF.MoreStlc]
    STLCExtended.T_Inl [constructor, in PLF.MoreStlc]
    STLCExtended.T_Inr [constructor, in PLF.MoreStlc]
    STLCExtended.T_Lcase [constructor, in PLF.MoreStlc]
    @@ -1648,9 +1718,13 @@

    Global Index

    STLCExtended.T_Nil [constructor, in PLF.MoreStlc]
    STLCExtended.T_Pred [constructor, in PLF.MoreStlc]
    STLCExtended.T_Succ [constructor, in PLF.MoreStlc]
    +STLCExtended.T_Test0 [constructor, in PLF.MoreStlc]
    STLCExtended.T_Unit [constructor, in PLF.MoreStlc]
    STLCExtended.T_Var [constructor, in PLF.MoreStlc]
    +STLCExtended.unit [constructor, in PLF.MoreStlc]
    +STLCExtended.Unit [constructor, in PLF.MoreStlc]
    STLCExtended.value [inductive, in PLF.MoreStlc]
    +STLCExtended.var [constructor, in PLF.MoreStlc]
    STLCExtended.v_abs [constructor, in PLF.MoreStlc]
    STLCExtended.v_inl [constructor, in PLF.MoreStlc]
    STLCExtended.v_inr [constructor, in PLF.MoreStlc]
    @@ -1659,9 +1733,9 @@

    Global Index

    STLCExtended.v_nat [constructor, in PLF.MoreStlc]
    STLCExtended.v_pair [constructor, in PLF.MoreStlc]
    STLCExtended.v_unit [constructor, in PLF.MoreStlc]
    -STLCExtended.::x_'==>'_x [notation, in PLF.MoreStlc]
    -STLCExtended.::x_'==>*'_x [notation, in PLF.MoreStlc]
    -STLCExtended.::x_'|-'_x_'∈'_x [notation, in PLF.MoreStlc]
    +-->'_x">STLCExtended.::x_'-->'_x [notation, in PLF.MoreStlc]
    +-->*'_x">STLCExtended.::x_'-->*'_x [notation, in PLF.MoreStlc]
    +STLCExtended.::x_'⊢'_x_'∈'_x [notation, in PLF.MoreStlc]
    STLCExtended.::'['_x_':='_x_']'_x [notation, in PLF.MoreStlc]
    StlcImpl [module, in PLF.Typechecking]
    STLCProp [module, in PLF.StlcProp]
    @@ -1669,9 +1743,9 @@

    Global Index

    STLCProp.afi_abs [constructor, in PLF.StlcProp]
    STLCProp.afi_app1 [constructor, in PLF.StlcProp]
    STLCProp.afi_app2 [constructor, in PLF.StlcProp]
    -STLCProp.afi_if1 [constructor, in PLF.StlcProp]
    -STLCProp.afi_if2 [constructor, in PLF.StlcProp]
    -STLCProp.afi_if3 [constructor, in PLF.StlcProp]
    +STLCProp.afi_test1 [constructor, in PLF.StlcProp]
    +STLCProp.afi_test2 [constructor, in PLF.StlcProp]
    +STLCProp.afi_test3 [constructor, in PLF.StlcProp]
    STLCProp.afi_var [constructor, in PLF.StlcProp]
    STLCProp.appears_free_in [inductive, in PLF.StlcProp]
    STLCProp.canonical_forms_bool [lemma, in PLF.StlcProp]
    @@ -1685,7 +1759,6 @@

    Global Index

    STLCProp.manual_grade_for_stlc_variation2 [definition, in PLF.StlcProp]
    STLCProp.manual_grade_for_stlc_variation3 [definition, in PLF.StlcProp]
    STLCProp.manual_grade_for_subject_expansion_stlc [definition, in PLF.StlcProp]
    -STLCProp.manual_grade_for_types_unique [definition, in PLF.StlcProp]
    STLCProp.preservation [lemma, in PLF.StlcProp]
    STLCProp.progress [lemma, in PLF.StlcProp]
    STLCProp.progress' [lemma, in PLF.StlcProp]
    @@ -1693,7 +1766,9 @@

    Global Index

    STLCProp.stuck [definition, in PLF.StlcProp]
    STLCProp.substitution_preserves_typing [lemma, in PLF.StlcProp]
    STLCProp.typable_empty__closed [lemma, in PLF.StlcProp]
    +STLCProp.unique_types [lemma, in PLF.StlcProp]
    STLCRef [module, in PLF.References]
    +STLCRef.abs [constructor, in PLF.References]
    STLCRef.afi_abs [constructor, in PLF.References]
    STLCRef.afi_app1 [constructor, in PLF.References]
    STLCRef.afi_app2 [constructor, in PLF.References]
    @@ -1709,10 +1784,15 @@

    Global Index

    STLCRef.afi_ref [constructor, in PLF.References]
    STLCRef.afi_succ [constructor, in PLF.References]
    STLCRef.afi_var [constructor, in PLF.References]
    +STLCRef.app [constructor, in PLF.References]
    STLCRef.appears_free_in [inductive, in PLF.References]
    +STLCRef.Arrow [constructor, in PLF.References]
    +STLCRef.assign [constructor, in PLF.References]
    STLCRef.assign_pres_store_typing [lemma, in PLF.References]
    +STLCRef.const [constructor, in PLF.References]
    STLCRef.context [definition, in PLF.References]
    STLCRef.context_invariance [lemma, in PLF.References]
    +STLCRef.deref [constructor, in PLF.References]
    STLCRef.ExampleVariables [module, in PLF.References]
    STLCRef.ExampleVariables.r [definition, in PLF.References]
    STLCRef.ExampleVariables.s [definition, in PLF.References]
    @@ -1728,6 +1808,7 @@

    Global Index

    STLCRef.has_type [inductive, in PLF.References]
    STLCRef.length_extends [lemma, in PLF.References]
    STLCRef.length_replace [lemma, in PLF.References]
    +STLCRef.loc [constructor, in PLF.References]
    STLCRef.lookup_replace_eq [lemma, in PLF.References]
    STLCRef.lookup_replace_neq [lemma, in PLF.References]
    STLCRef.manual_grade_for_compact_update [definition, in PLF.References]
    @@ -1735,13 +1816,18 @@

    Global Index

    STLCRef.manual_grade_for_preservation_informal [definition, in PLF.References]
    STLCRef.manual_grade_for_store_not_unique [definition, in PLF.References]
    STLCRef.manual_grade_for_type_safety_violation [definition, in PLF.References]
    +STLCRef.mlt [constructor, in PLF.References]
    STLCRef.multistep [definition, in PLF.References]
    +STLCRef.Nat [constructor, in PLF.References]
    STLCRef.nth_eq_last [lemma, in PLF.References]
    +STLCRef.prd [constructor, in PLF.References]
    STLCRef.preservation [lemma, in PLF.References]
    STLCRef.preservation_theorem [definition, in PLF.References]
    STLCRef.preservation_wrong1 [lemma, in PLF.References]
    STLCRef.preservation_wrong2 [lemma, in PLF.References]
    STLCRef.progress [lemma, in PLF.References]
    +STLCRef.ref [constructor, in PLF.References]
    +STLCRef.Ref [constructor, in PLF.References]
    STLCRef.RefsAndNontermination [module, in PLF.References]
    STLCRef.RefsAndNontermination.factorial [definition, in PLF.References]
    STLCRef.RefsAndNontermination.factorial_type [lemma, in PLF.References]
    @@ -1754,9 +1840,10 @@

    Global Index

    STLCRef.RefsAndNontermination.sc_one [constructor, in PLF.References]
    STLCRef.RefsAndNontermination.sc_step [constructor, in PLF.References]
    STLCRef.RefsAndNontermination.step_closure [inductive, in PLF.References]
    -STLCRef.RefsAndNontermination.::x_'/'_x_'==>+'_x_'/'_x [notation, in PLF.References]
    +-->+'_x_'/'_x">STLCRef.RefsAndNontermination.::x_'/'_x_'-->+'_x_'/'_x [notation, in PLF.References]
    STLCRef.replace [definition, in PLF.References]
    STLCRef.replace_nil [lemma, in PLF.References]
    +STLCRef.scc [constructor, in PLF.References]
    STLCRef.step [inductive, in PLF.References]
    STLCRef.store [definition, in PLF.References]
    STLCRef.store_lookup [definition, in PLF.References]
    @@ -1787,25 +1874,9 @@

    Global Index

    STLCRef.ST_SuccNat [constructor, in PLF.References]
    STLCRef.subst [definition, in PLF.References]
    STLCRef.substitution_preserves_typing [lemma, in PLF.References]
    -STLCRef.tabs [constructor, in PLF.References]
    -STLCRef.tapp [constructor, in PLF.References]
    -STLCRef.TArrow [constructor, in PLF.References]
    -STLCRef.tassign [constructor, in PLF.References]
    -STLCRef.tderef [constructor, in PLF.References]
    -STLCRef.tif0 [constructor, in PLF.References]
    -STLCRef.tloc [constructor, in PLF.References]
    +STLCRef.test0 [constructor, in PLF.References]
    STLCRef.tm [inductive, in PLF.References]
    -STLCRef.tmult [constructor, in PLF.References]
    -STLCRef.TNat [constructor, in PLF.References]
    -STLCRef.tnat [constructor, in PLF.References]
    -STLCRef.tpred [constructor, in PLF.References]
    -STLCRef.TRef [constructor, in PLF.References]
    -STLCRef.tref [constructor, in PLF.References]
    STLCRef.tseq [definition, in PLF.References]
    -STLCRef.tsucc [constructor, in PLF.References]
    -STLCRef.tunit [constructor, in PLF.References]
    -STLCRef.TUnit [constructor, in PLF.References]
    -STLCRef.tvar [constructor, in PLF.References]
    STLCRef.ty [inductive, in PLF.References]
    STLCRef.T_Abs [constructor, in PLF.References]
    STLCRef.T_App [constructor, in PLF.References]
    @@ -1820,20 +1891,28 @@

    Global Index

    STLCRef.T_Succ [constructor, in PLF.References]
    STLCRef.T_Unit [constructor, in PLF.References]
    STLCRef.T_Var [constructor, in PLF.References]
    +STLCRef.unit [constructor, in PLF.References]
    +STLCRef.Unit [constructor, in PLF.References]
    STLCRef.value [inductive, in PLF.References]
    +STLCRef.var [constructor, in PLF.References]
    STLCRef.v_abs [constructor, in PLF.References]
    STLCRef.v_loc [constructor, in PLF.References]
    STLCRef.v_nat [constructor, in PLF.References]
    STLCRef.v_unit [constructor, in PLF.References]
    -STLCRef.::x_'/'_x_'==>'_x_'/'_x [notation, in PLF.References]
    -STLCRef.::x_'/'_x_'==>*'_x_'/'_x [notation, in PLF.References]
    -STLCRef.::x_';'_x_'|-'_x_'∈'_x [notation, in PLF.References]
    +-->'_x_'/'_x">STLCRef.::x_'/'_x_'-->'_x_'/'_x [notation, in PLF.References]
    +-->*'_x_'/'_x">STLCRef.::x_'/'_x_'-->*'_x_'/'_x [notation, in PLF.References]
    +STLCRef.::x_';'_x_'⊢'_x_'∈'_x [notation, in PLF.References]
    STLCRef.::'['_x_':='_x_']'_x [notation, in PLF.References]
    STLCTypes [module, in PLF.Typechecking]
    STLCTypes.eqb_ty [definition, in PLF.Typechecking]
    STLCTypes.eqb_ty_refl [lemma, in PLF.Typechecking]
    STLCTypes.eqb_ty__eq [lemma, in PLF.Typechecking]
    +STLC.abs [constructor, in PLF.Stlc]
    +STLC.app [constructor, in PLF.Stlc]
    +STLC.Arrow [constructor, in PLF.Stlc]
    +STLC.Bool [constructor, in PLF.Stlc]
    STLC.context [definition, in PLF.Stlc]
    +STLC.fls [constructor, in PLF.Stlc]
    STLC.has_type [inductive, in PLF.Stlc]
    STLC.idB [abbreviation, in PLF.Stlc]
    STLC.idBB [abbreviation, in PLF.Stlc]
    @@ -1855,22 +1934,16 @@

    Global Index

    STLC.ST_AppAbs [constructor, in PLF.Stlc]
    STLC.ST_App1 [constructor, in PLF.Stlc]
    STLC.ST_App2 [constructor, in PLF.Stlc]
    -STLC.ST_If [constructor, in PLF.Stlc]
    -STLC.ST_IfFalse [constructor, in PLF.Stlc]
    -STLC.ST_IfTrue [constructor, in PLF.Stlc]
    +STLC.ST_Test [constructor, in PLF.Stlc]
    +STLC.ST_TestFls [constructor, in PLF.Stlc]
    +STLC.ST_TestTru [constructor, in PLF.Stlc]
    STLC.subst [definition, in PLF.Stlc]
    STLC.substi [inductive, in PLF.Stlc]
    STLC.substi_correct [lemma, in PLF.Stlc]
    STLC.s_var1 [constructor, in PLF.Stlc]
    -STLC.tabs [constructor, in PLF.Stlc]
    -STLC.tapp [constructor, in PLF.Stlc]
    -STLC.TArrow [constructor, in PLF.Stlc]
    -STLC.TBool [constructor, in PLF.Stlc]
    -STLC.tfalse [constructor, in PLF.Stlc]
    -STLC.tif [constructor, in PLF.Stlc]
    +STLC.test [constructor, in PLF.Stlc]
    STLC.tm [inductive, in PLF.Stlc]
    -STLC.ttrue [constructor, in PLF.Stlc]
    -STLC.tvar [constructor, in PLF.Stlc]
    +STLC.tru [constructor, in PLF.Stlc]
    STLC.ty [inductive, in PLF.Stlc]
    STLC.typing_example_1 [definition, in PLF.Stlc]
    STLC.typing_example_1' [definition, in PLF.Stlc]
    @@ -1881,61 +1954,62 @@

    Global Index

    STLC.typing_nonexample_3 [definition, in PLF.Stlc]
    STLC.T_Abs [constructor, in PLF.Stlc]
    STLC.T_App [constructor, in PLF.Stlc]
    -STLC.T_False [constructor, in PLF.Stlc]
    -STLC.T_If [constructor, in PLF.Stlc]
    -STLC.T_True [constructor, in PLF.Stlc]
    +STLC.T_Fls [constructor, in PLF.Stlc]
    +STLC.T_Test [constructor, in PLF.Stlc]
    +STLC.T_Tru [constructor, in PLF.Stlc]
    STLC.T_Var [constructor, in PLF.Stlc]
    STLC.value [inductive, in PLF.Stlc]
    +STLC.var [constructor, in PLF.Stlc]
    STLC.v_abs [constructor, in PLF.Stlc]
    -STLC.v_false [constructor, in PLF.Stlc]
    -STLC.v_true [constructor, in PLF.Stlc]
    +STLC.v_fls [constructor, in PLF.Stlc]
    +STLC.v_tru [constructor, in PLF.Stlc]
    STLC.x [definition, in PLF.Stlc]
    STLC.y [definition, in PLF.Stlc]
    STLC.z [definition, in PLF.Stlc]
    -STLC.::x_'==>'_x [notation, in PLF.Stlc]
    -STLC.::x_'==>*'_x [notation, in PLF.Stlc]
    -STLC.::x_'|-'_x_'∈'_x [notation, in PLF.Stlc]
    +-->'_x">STLC.::x_'-->'_x [notation, in PLF.Stlc]
    +-->*'_x">STLC.::x_'-->*'_x [notation, in PLF.Stlc]
    +STLC.::x_'⊢'_x_'∈'_x [notation, in PLF.Stlc]
    STLC.::'['_x_':='_x_']'_x [notation, in PLF.Stlc]
    strong_progress [lemma, in PLF.Smallstep]
    stuck [definition, in PLF.Types]
    -ST_AppAbs [constructor, in PLF.Norm]
    ST_AppAbs [constructor, in PLF.Sub]
    +ST_AppAbs [constructor, in PLF.Norm]
    ST_AppAbs [constructor, in PLF.RecordSub]
    -ST_App1 [constructor, in PLF.Sub]
    ST_App1 [constructor, in PLF.Norm]
    ST_App1 [constructor, in PLF.RecordSub]
    -ST_App2 [constructor, in PLF.RecordSub]
    +ST_App1 [constructor, in PLF.Sub]
    ST_App2 [constructor, in PLF.Norm]
    +ST_App2 [constructor, in PLF.RecordSub]
    ST_App2 [constructor, in PLF.Sub]
    ST_Fst [constructor, in PLF.Norm]
    ST_FstPair [constructor, in PLF.Norm]
    -ST_If [constructor, in PLF.Norm]
    -ST_If [constructor, in PLF.Sub]
    -ST_If [constructor, in PLF.Types]
    -ST_IfFalse [constructor, in PLF.Norm]
    -ST_IfFalse [constructor, in PLF.Sub]
    -ST_IfFalse [constructor, in PLF.Types]
    -ST_IfTrue [constructor, in PLF.Sub]
    -ST_IfTrue [constructor, in PLF.Norm]
    -ST_IfTrue [constructor, in PLF.Types]
    -ST_Iszero [constructor, in PLF.Types]
    -ST_IszeroSucc [constructor, in PLF.Types]
    -ST_IszeroZero [constructor, in PLF.Types]
    +ST_Iszro [constructor, in PLF.Types]
    +ST_IszroScc [constructor, in PLF.Types]
    +ST_IszroZro [constructor, in PLF.Types]
    ST_Pair1 [constructor, in PLF.Norm]
    ST_Pair2 [constructor, in PLF.Norm]
    ST_PlusConstConst [constructor, in PLF.Smallstep]
    ST_Plus1 [constructor, in PLF.Smallstep]
    ST_Plus2 [constructor, in PLF.Smallstep]
    -ST_Pred [constructor, in PLF.Types]
    -ST_PredSucc [constructor, in PLF.Types]
    -ST_PredZero [constructor, in PLF.Types]
    +ST_Prd [constructor, in PLF.Types]
    +ST_PrdScc [constructor, in PLF.Types]
    +ST_PrdZro [constructor, in PLF.Types]
    ST_ProjRcd [constructor, in PLF.RecordSub]
    ST_Proj1 [constructor, in PLF.RecordSub]
    ST_Rcd_Head [constructor, in PLF.RecordSub]
    ST_Rcd_Tail [constructor, in PLF.RecordSub]
    +ST_Scc [constructor, in PLF.Types]
    ST_Snd [constructor, in PLF.Norm]
    ST_SndPair [constructor, in PLF.Norm]
    -ST_Succ [constructor, in PLF.Types]
    +ST_Test [constructor, in PLF.Sub]
    +ST_Test [constructor, in PLF.Types]
    +ST_Test [constructor, in PLF.Norm]
    +ST_TestFalse [constructor, in PLF.Sub]
    +ST_TestFalse [constructor, in PLF.Norm]
    +ST_TestFls [constructor, in PLF.Types]
    +ST_TestTru [constructor, in PLF.Types]
    +ST_TestTrue [constructor, in PLF.Sub]
    +ST_TestTrue [constructor, in PLF.Norm]
    Sub [library]
    subst [definition, in PLF.Norm]
    subst [definition, in PLF.RecordSub]
    @@ -1952,20 +2026,18 @@

    Global Index

    subst_not_afi [lemma, in PLF.Norm]
    subtract_slowly_dec [definition, in PLF.Hoare2]
    subtract_slowly_dec_correct [lemma, in PLF.Hoare2]
    +subtype [axiom, in PLF.UseAuto]
    subtype [inductive, in PLF.RecordSub]
    subtype [inductive, in PLF.Sub]
    -subtype [axiom, in PLF.UseAuto]
    subtype_refl [axiom, in PLF.UseAuto]
    subtype_trans [axiom, in PLF.UseAuto]
    subtype__wf [lemma, in PLF.RecordSub]
    SubtypingInversion [module, in PLF.UseAuto]
    SubtypingInversion.abs_arrow [lemma, in PLF.UseAuto]
    SubtypingInversion.abs_arrow' [lemma, in PLF.UseAuto]
    -SubtypingInversion.substitution_preserves_typing [lemma, in PLF.UseAuto]
    sub_inversion_arrow [lemma, in PLF.RecordSub]
    sub_inversion_arrow [lemma, in PLF.Sub]
    sub_inversion_Bool [lemma, in PLF.Sub]
    -succ_hastype_nat__hastype_nat [definition, in PLF.Types]
    swap [definition, in PLF.Hoare2]
    swap_correct [lemma, in PLF.Hoare2]
    swap_dec [definition, in PLF.Hoare2]
    @@ -1984,27 +2056,13 @@

    Global Index

    S_RcdWidth [constructor, in PLF.RecordSub]
    S_Refl [constructor, in PLF.Sub]
    S_Refl [constructor, in PLF.RecordSub]
    -S_Top [constructor, in PLF.Sub]
    S_Top [constructor, in PLF.RecordSub]
    -S_Trans [constructor, in PLF.RecordSub]
    +S_Top [constructor, in PLF.Sub]
    S_Trans [constructor, in PLF.Sub]
    +S_Trans [constructor, in PLF.RecordSub]


    T

    T [definition, in PLF.Hoare2]
    -tabs [constructor, in PLF.Sub]
    -tabs [constructor, in PLF.RecordSub]
    -tabs [constructor, in PLF.Norm]
    -tapp [constructor, in PLF.Sub]
    -tapp [constructor, in PLF.RecordSub]
    -tapp [constructor, in PLF.Norm]
    -TArrow [constructor, in PLF.Norm]
    -TArrow [constructor, in PLF.Sub]
    -TArrow [constructor, in PLF.RecordSub]
    tass [definition, in PLF.Norm]
    -TBase [constructor, in PLF.Sub]
    -TBase [constructor, in PLF.RecordSub]
    -TBool [constructor, in PLF.Sub]
    -TBool [constructor, in PLF.Types]
    -TBool [constructor, in PLF.Norm]
    Temp1 [module, in PLF.Smallstep]
    Temp1.step [inductive, in PLF.Smallstep]
    Temp1.ST_PlusConstConst [constructor, in PLF.Smallstep]
    @@ -2014,7 +2072,7 @@

    Global Index

    Temp1.value_not_same_as_normal_form [lemma, in PLF.Smallstep]
    Temp1.v_const [constructor, in PLF.Smallstep]
    Temp1.v_funny [constructor, in PLF.Smallstep]
    -Temp1.::x_'==>'_x [notation, in PLF.Smallstep]
    +-->'_x">Temp1.::x_'-->'_x [notation, in PLF.Smallstep]
    Temp2 [module, in PLF.Smallstep]
    Temp2.step [inductive, in PLF.Smallstep]
    Temp2.ST_Funny [constructor, in PLF.Smallstep]
    @@ -2024,7 +2082,7 @@

    Global Index

    Temp2.value [inductive, in PLF.Smallstep]
    Temp2.value_not_same_as_normal_form [lemma, in PLF.Smallstep]
    Temp2.v_const [constructor, in PLF.Smallstep]
    -Temp2.::x_'==>'_x [notation, in PLF.Smallstep]
    +-->'_x">Temp2.::x_'-->'_x [notation, in PLF.Smallstep]
    Temp3 [module, in PLF.Smallstep]
    Temp3.step [inductive, in PLF.Smallstep]
    Temp3.ST_PlusConstConst [constructor, in PLF.Smallstep]
    @@ -2032,11 +2090,12 @@

    Global Index

    Temp3.value [inductive, in PLF.Smallstep]
    Temp3.value_not_same_as_normal_form [lemma, in PLF.Smallstep]
    Temp3.v_const [constructor, in PLF.Smallstep]
    -Temp3.::x_'==>'_x [notation, in PLF.Smallstep]
    +-->'_x">Temp3.::x_'-->'_x [notation, in PLF.Smallstep]
    Temp4 [module, in PLF.Smallstep]
    Temp4.bool_step_prop1 [definition, in PLF.Smallstep]
    Temp4.bool_step_prop2 [definition, in PLF.Smallstep]
    Temp4.bool_step_prop3 [definition, in PLF.Smallstep]
    +Temp4.fls [constructor, in PLF.Smallstep]
    Temp4.manual_grade_for_smallstep_bools [definition, in PLF.Smallstep]
    Temp4.step [inductive, in PLF.Smallstep]
    Temp4.step_deterministic [lemma, in PLF.Smallstep]
    @@ -2051,15 +2110,18 @@

    Global Index

    Temp4.Temp5.ST_If [constructor, in PLF.Smallstep]
    Temp4.Temp5.ST_IfFalse [constructor, in PLF.Smallstep]
    Temp4.Temp5.ST_IfTrue [constructor, in PLF.Smallstep]
    -Temp4.Temp5.::x_'==>'_x [notation, in PLF.Smallstep]
    -Temp4.tfalse [constructor, in PLF.Smallstep]
    -Temp4.tif [constructor, in PLF.Smallstep]
    +-->'_x">Temp4.Temp5.::x_'-->'_x [notation, in PLF.Smallstep]
    +Temp4.test [constructor, in PLF.Smallstep]
    Temp4.tm [inductive, in PLF.Smallstep]
    -Temp4.ttrue [constructor, in PLF.Smallstep]
    +Temp4.tru [constructor, in PLF.Smallstep]
    Temp4.value [inductive, in PLF.Smallstep]
    -Temp4.v_false [constructor, in PLF.Smallstep]
    -Temp4.v_true [constructor, in PLF.Smallstep]
    -Temp4.::x_'==>'_x [notation, in PLF.Smallstep]
    +Temp4.v_fls [constructor, in PLF.Smallstep]
    +Temp4.v_tru [constructor, in PLF.Smallstep]
    +-->'_x">Temp4.::x_'-->'_x [notation, in PLF.Smallstep]
    +test [constructor, in PLF.Types]
    +test [constructor, in PLF.Norm]
    +test [constructor, in PLF.Sub]
    +TEST_false [lemma, in PLF.Equiv]
    test_multistep_1 [lemma, in PLF.Smallstep]
    test_multistep_1' [lemma, in PLF.Smallstep]
    test_multistep_2 [lemma, in PLF.Smallstep]
    @@ -2069,54 +2131,32 @@

    Global Index

    test_pe_bexp1 [definition, in PLF.PE]
    test_pe_bexp2 [definition, in PLF.PE]
    test_pe_update [definition, in PLF.PE]
    +TEST_true [lemma, in PLF.Equiv]
    +TEST_true_simple [lemma, in PLF.Equiv]
    text_pe_aexp2 [definition, in PLF.PE]
    -tfalse [constructor, in PLF.Types]
    -tfalse [constructor, in PLF.Norm]
    -tfalse [constructor, in PLF.Sub]
    -tfst [constructor, in PLF.Norm]
    -tif [constructor, in PLF.Sub]
    -tif [constructor, in PLF.Norm]
    -tif [constructor, in PLF.Types]
    -tiszero [constructor, in PLF.Types]
    -tlookup [definition, in PLF.RecordSub]
    Tlookup [definition, in PLF.RecordSub]
    -tm [inductive, in PLF.Smallstep]
    -tm [inductive, in PLF.Sub]
    +tlookup [definition, in PLF.RecordSub]
    tm [inductive, in PLF.Norm]
    tm [inductive, in PLF.Types]
    +tm [inductive, in PLF.Smallstep]
    tm [inductive, in PLF.RecordSub]
    -TNat [constructor, in PLF.Types]
    -tpair [constructor, in PLF.Norm]
    -tpred [constructor, in PLF.Types]
    -TProd [constructor, in PLF.Norm]
    -tproj [constructor, in PLF.RecordSub]
    +tm [inductive, in PLF.Sub]
    +Top [constructor, in PLF.RecordSub]
    +Top [constructor, in PLF.Sub]
    transitivity_bad_hint_1 [lemma, in PLF.UseAuto]
    transitivity_workaround_1 [lemma, in PLF.UseAuto]
    transitivity_workaround_2 [lemma, in PLF.UseAuto]
    trans_aequiv [lemma, in PLF.Equiv]
    trans_bequiv [lemma, in PLF.Equiv]
    trans_cequiv [lemma, in PLF.Equiv]
    -TRCons [constructor, in PLF.RecordSub]
    -trcons [constructor, in PLF.RecordSub]
    -trnil [constructor, in PLF.RecordSub]
    -TRNil [constructor, in PLF.RecordSub]
    -tsnd [constructor, in PLF.Norm]
    -tsucc [constructor, in PLF.Types]
    -TTop [constructor, in PLF.RecordSub]
    -TTop [constructor, in PLF.Sub]
    -ttrue [constructor, in PLF.Norm]
    -ttrue [constructor, in PLF.Types]
    -ttrue [constructor, in PLF.Sub]
    -TUnit [constructor, in PLF.Sub]
    -tunit [constructor, in PLF.Sub]
    -tvar [constructor, in PLF.RecordSub]
    -tvar [constructor, in PLF.Sub]
    -tvar [constructor, in PLF.Norm]
    +tru [constructor, in PLF.Norm]
    +tru [constructor, in PLF.Sub]
    +tru [constructor, in PLF.Types]
    two_loops_correct [lemma, in PLF.Hoare2]
    two_loops_dec [definition, in PLF.Hoare2]
    +ty [inductive, in PLF.Norm]
    ty [inductive, in PLF.RecordSub]
    ty [inductive, in PLF.Types]
    -ty [inductive, in PLF.Norm]
    ty [inductive, in PLF.Sub]
    typ [axiom, in PLF.UseAuto]
    typable_empty__closed [lemma, in PLF.Norm]
    @@ -2133,64 +2173,68 @@

    Global Index

    Types [library]
    typing_inversion_abs [lemma, in PLF.RecordSub]
    typing_inversion_abs [lemma, in PLF.Sub]
    -typing_inversion_app [lemma, in PLF.Sub]
    typing_inversion_app [lemma, in PLF.RecordSub]
    +typing_inversion_app [lemma, in PLF.Sub]
    typing_inversion_false [lemma, in PLF.Sub]
    typing_inversion_if [lemma, in PLF.Sub]
    typing_inversion_proj [lemma, in PLF.RecordSub]
    typing_inversion_rcons [lemma, in PLF.RecordSub]
    typing_inversion_true [lemma, in PLF.Sub]
    typing_inversion_unit [lemma, in PLF.Sub]
    -typing_inversion_var [lemma, in PLF.Sub]
    typing_inversion_var [lemma, in PLF.RecordSub]
    -tzero [constructor, in PLF.Types]
    +typing_inversion_var [lemma, in PLF.Sub]
    T_Abs [constructor, in PLF.RecordSub]
    -T_Abs [constructor, in PLF.Norm]
    T_Abs [constructor, in PLF.Sub]
    -T_App [constructor, in PLF.Sub]
    +T_Abs [constructor, in PLF.Norm]
    T_App [constructor, in PLF.RecordSub]
    T_App [constructor, in PLF.Norm]
    +T_App [constructor, in PLF.Sub]
    T_False [constructor, in PLF.Norm]
    -T_False [constructor, in PLF.Types]
    T_False [constructor, in PLF.Sub]
    +T_Fls [constructor, in PLF.Types]
    T_Fst [constructor, in PLF.Norm]
    -T_If [constructor, in PLF.Types]
    -T_If [constructor, in PLF.Norm]
    -T_If [constructor, in PLF.Sub]
    -T_Iszero [constructor, in PLF.Types]
    +T_Iszro [constructor, in PLF.Types]
    T_Pair [constructor, in PLF.Norm]
    -T_Pred [constructor, in PLF.Types]
    +T_Prd [constructor, in PLF.Types]
    T_Proj [constructor, in PLF.RecordSub]
    T_RCons [constructor, in PLF.RecordSub]
    T_RNil [constructor, in PLF.RecordSub]
    +T_Scc [constructor, in PLF.Types]
    T_Snd [constructor, in PLF.Norm]
    T_Sub [constructor, in PLF.RecordSub]
    T_Sub [constructor, in PLF.Sub]
    -T_Succ [constructor, in PLF.Types]
    +T_Test [constructor, in PLF.Sub]
    +T_Test [constructor, in PLF.Norm]
    +T_Test [constructor, in PLF.Types]
    +T_Tru [constructor, in PLF.Types]
    T_True [constructor, in PLF.Norm]
    -T_True [constructor, in PLF.Types]
    T_True [constructor, in PLF.Sub]
    T_Unit [constructor, in PLF.Sub]
    T_Var [constructor, in PLF.Sub]
    -T_Var [constructor, in PLF.RecordSub]
    T_Var [constructor, in PLF.Norm]
    -T_Zero [constructor, in PLF.Types]
    +T_Var [constructor, in PLF.RecordSub]
    +T_Zro [constructor, in PLF.Types]


    U

    UnfoldsExample [module, in PLF.UseTactics]
    UnfoldsExample.bexp_eval_true [lemma, in PLF.UseTactics]
    +unit [constructor, in PLF.Sub]
    +Unit [constructor, in PLF.Sub]
    UseAuto [library]
    UseTactics [library]


    V

    vacuous_substitution [lemma, in PLF.Norm]
    -value [inductive, in PLF.RecordSub]
    -value [inductive, in PLF.Sub]
    value [definition, in PLF.Types]
    value [inductive, in PLF.Smallstep]
    +value [inductive, in PLF.RecordSub]
    value [inductive, in PLF.Norm]
    +value [inductive, in PLF.Sub]
    value_halts [lemma, in PLF.Norm]
    -value_is_nf [lemma, in PLF.Types]
    value_is_nf [lemma, in PLF.Smallstep]
    +value_is_nf [lemma, in PLF.Types]
    value__normal [lemma, in PLF.Norm]
    +var [constructor, in PLF.Norm]
    +var [constructor, in PLF.Sub]
    +var [constructor, in PLF.RecordSub]
    var_not_used_in_aexp [inductive, in PLF.Equiv]
    verification_conditions [definition, in PLF.Hoare2]
    verification_conditions_dec [definition, in PLF.Hoare2]
    @@ -2201,27 +2245,27 @@

    Global Index

    VNUMult [constructor, in PLF.Equiv]
    VNUNum [constructor, in PLF.Equiv]
    VNUPlus [constructor, in PLF.Equiv]
    -v_abs [constructor, in PLF.RecordSub]
    v_abs [constructor, in PLF.Sub]
    +v_abs [constructor, in PLF.RecordSub]
    v_abs [constructor, in PLF.Norm]
    V_cons [constructor, in PLF.Norm]
    v_const [constructor, in PLF.Smallstep]
    -v_false [constructor, in PLF.Norm]
    v_false [constructor, in PLF.Sub]
    +v_fls [constructor, in PLF.Norm]
    V_nil [constructor, in PLF.Norm]
    v_pair [constructor, in PLF.Norm]
    v_rcons [constructor, in PLF.RecordSub]
    v_rnil [constructor, in PLF.RecordSub]
    -v_true [constructor, in PLF.Norm]
    +v_tru [constructor, in PLF.Norm]
    v_true [constructor, in PLF.Sub]
    v_unit [constructor, in PLF.Sub]


    W

    well_formed_ty [inductive, in PLF.RecordSub]
    -wfTArrow [constructor, in PLF.RecordSub]
    -wfTBase [constructor, in PLF.RecordSub]
    -wfTRCons [constructor, in PLF.RecordSub]
    -wfTRNil [constructor, in PLF.RecordSub]
    -wfTTop [constructor, in PLF.RecordSub]
    +wfArrow [constructor, in PLF.RecordSub]
    +wfBase [constructor, in PLF.RecordSub]
    +wfRCons [constructor, in PLF.RecordSub]
    +wfRNil [constructor, in PLF.RecordSub]
    +wfTop [constructor, in PLF.RecordSub]
    wf_rcd_lookup [lemma, in PLF.RecordSub]
    while_example [definition, in PLF.Hoare]
    WHILE_false [lemma, in PLF.Equiv]
    @@ -2235,17 +2279,18 @@

    Global Index



    Z

    zprop [definition, in PLF.Equiv]
    zprop_preserving [lemma, in PLF.Equiv]
    +zro [constructor, in PLF.Types]


    :

    -:dcom_scope:x_'->>'_'{{'_x_'}}' [notation, in PLF.Hoare2]
    +->>'_'{{'_x_'}}'">:dcom_scope:x_'->>'_'{{'_x_'}}' [notation, in PLF.Hoare2]
    :dcom_scope:x_'::='_x_'{{'_x_'}}' [notation, in PLF.Hoare2]
    :dcom_scope:x_';;'_x [notation, in PLF.Hoare2]
    -:dcom_scope:'IFB'_x_'THEN'_'{{'_x_'}}'_x_'ELSE'_'{{'_x_'}}'_x_'FI'_'{{'_x_'}}' [notation, in PLF.Hoare2]
    :dcom_scope:'SKIP'_'{{'_x_'}}' [notation, in PLF.Hoare2]
    +:dcom_scope:'TEST'_x_'THEN'_'{{'_x_'}}'_x_'ELSE'_'{{'_x_'}}'_x_'FI'_'{{'_x_'}}' [notation, in PLF.Hoare2]
    :dcom_scope:'WHILE'_x_'DO'_'{{'_x_'}}'_x_'END'_'{{'_x_'}}' [notation, in PLF.Hoare2]
    -:dcom_scope:'->>'_'{{'_x_'}}'_x [notation, in PLF.Hoare2]
    +->>'_'{{'_x_'}}'_x">:dcom_scope:'->>'_'{{'_x_'}}'_x [notation, in PLF.Hoare2]
    :dcom_scope:'{{'_x_'}}'_x [notation, in PLF.Hoare2]
    -:hoare_spec_scope:x_'->>'_x [notation, in PLF.Hoare]
    -:hoare_spec_scope:x_'<<->>'_x [notation, in PLF.Hoare]
    +->>'_x">:hoare_spec_scope:x_'->>'_x [notation, in PLF.Hoare]
    +<<->>'_x">:hoare_spec_scope:x_'<<->>'_x [notation, in PLF.Hoare]
    :hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [notation, in PLF.Hoare]
    :ltac_scope:'>>' [notation, in PLF.LibTactics]
    :ltac_scope:'>>'_x [notation, in PLF.LibTactics]
    @@ -2263,123 +2308,131 @@

    Global Index

    :ltac_scope:'>>'_x_x_x_x_x_x_x_x_x_x_x_x_x [notation, in PLF.LibTactics]
    :ltac_scope:'__' [notation, in PLF.LibTactics]
    :ltac_scope:'___' [notation, in PLF.LibTactics]
    +-->'_x">::x_'-->'_x [notation, in PLF.Types]
    +-->'_x">::x_'-->'_x [notation, in PLF.Norm]
    +-->'_x">::x_'-->'_x [notation, in PLF.RecordSub]
    +-->'_x">::x_'-->'_x [notation, in PLF.Sub]
    +-->'_x">::x_'-->'_x [notation, in PLF.Smallstep]
    +-->*'_x">::x_'-->*'_x [notation, in PLF.Smallstep]
    +-->*'_x">::x_'-->*'_x [notation, in PLF.Norm]
    +-->*'_x">::x_'-->*'_x [notation, in PLF.Types]
    +-->a'_x">::x_'/'_x_'-->a'_x [notation, in PLF.Smallstep]
    +-->b'_x">::x_'/'_x_'-->b'_x [notation, in PLF.Smallstep]
    +-->'_x_'/'_x">::x_'/'_x_'-->'_x_'/'_x [notation, in PLF.Smallstep]
    ::x_'/'_x_'/'_x_'\\'_x [notation, in PLF.PE]
    -::x_'/'_x_'==>a'_x [notation, in PLF.Smallstep]
    -::x_'/'_x_'==>b'_x [notation, in PLF.Smallstep]
    -::x_'/'_x_'==>'_x_'/'_x [notation, in PLF.Smallstep]
    ::x_'/'_x_'\\'_x_'/'_x [notation, in PLF.PE]
    ::x_'<-'_x_';;'_x [notation, in PLF.Typechecking]
    -::x_'<:'_x [notation, in PLF.Sub]
    ::x_'<:'_x [notation, in PLF.RecordSub]
    +::x_'<:'_x [notation, in PLF.Sub]
    ::x_'='''_x [notation, in PLF.LibTactics]
    -::x_'==>'_x [notation, in PLF.Sub]
    -::x_'==>'_x [notation, in PLF.RecordSub]
    -::x_'==>'_x [notation, in PLF.Types]
    -::x_'==>'_x [notation, in PLF.Norm]
    ::x_'==>'_x [notation, in PLF.Smallstep]
    -::x_'==>*'_x [notation, in PLF.Smallstep]
    -::x_'==>*'_x [notation, in PLF.Types]
    -::x_'==>*'_x [notation, in PLF.Norm]
    -::x_'['_x_'|->'_x_']' [notation, in PLF.Hoare]
    -::x_'\\'_x [notation, in PLF.Smallstep]
    -::x_'|-'_x_'∈'_x [notation, in PLF.Sub]
    -::x_'|-'_x_'∈'_x [notation, in PLF.RecordSub]
    +>'_x_']'">::x_'['_x_'>'_x_']' [notation, in PLF.Hoare]
    +::x_'⊢'_x_'∈'_x [notation, in PLF.Sub]
    +::x_'⊢'_x_'∈'_x [notation, in PLF.RecordSub]
    ::'fail' [notation, in PLF.Typechecking]
    ::'nosimpl'_x [notation, in PLF.LibTactics]
    ::'Register'_x_x [notation, in PLF.LibTactics]
    ::'return'_x [notation, in PLF.Typechecking]
    ::'Something' [notation, in PLF.LibTactics]
    -::'['_x_':='_x_']'_x [notation, in PLF.Sub]
    ::'['_x_':='_x_']'_x [notation, in PLF.Norm]
    ::'['_x_':='_x_']'_x [notation, in PLF.RecordSub]
    -::'|-'_x_'∈'_x [notation, in PLF.Types]
    +::'['_x_':='_x_']'_x [notation, in PLF.Sub]
    +::'⊢'_x_'∈'_x [notation, in PLF.Types]



    Notation Index

    C

    -CImp.::x_'/'_x_'==>'_x_'/'_x [in PLF.Smallstep]
    -CImp.::x_'/'_x_'==>*'_x_'/'_x [in PLF.Smallstep]
    +-->'_x_'/'_x">CImp.::x_'/'_x_'-->'_x_'/'_x [in PLF.Smallstep]
    +-->*'_x_'/'_x">CImp.::x_'/'_x_'-->*'_x_'/'_x [in PLF.Smallstep]
    CImp.::x_'::='_x [in PLF.Smallstep]
    CImp.::x_';;'_x [in PLF.Smallstep]
    -CImp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Smallstep]
    CImp.::'PAR'_x_'WITH'_x_'END' [in PLF.Smallstep]
    CImp.::'SKIP' [in PLF.Smallstep]
    +CImp.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Smallstep]
    CImp.::'WHILE'_x_'DO'_x_'END' [in PLF.Smallstep]
    -Combined.::x_'==>'_x [in PLF.Smallstep]
    +-->'_x">Combined.::x_'-->'_x [in PLF.Smallstep]


    H

    Himp.:hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [in PLF.Hoare]
    -Himp.::x_'/'_x_'\\'_x [in PLF.Hoare]
    -Himp.::x_'/'_x_'\\'_x [in PLF.Equiv]
    -Himp.::x_'::='_x [in PLF.Equiv]
    +Himp.:imp_scope:x_'::='_x [in PLF.Equiv]
    +Himp.:imp_scope:x_';;'_x [in PLF.Equiv]
    +Himp.:imp_scope:'HAVOC'_x [in PLF.Equiv]
    +Himp.:imp_scope:'SKIP' [in PLF.Equiv]
    +Himp.:imp_scope:'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Equiv]
    +Himp.:imp_scope:'WHILE'_x_'DO'_x_'END' [in PLF.Equiv]
    Himp.::x_'::='_x [in PLF.Hoare]
    Himp.::x_';;'_x [in PLF.Hoare]
    -Himp.::x_';;'_x [in PLF.Equiv]
    -Himp.::'HAVOC'_x [in PLF.Equiv]
    +Himp.::x_'=['_x_']=>'_x [in PLF.Hoare]
    +Himp.::x_'=['_x_']=>'_x [in PLF.Equiv]
    Himp.::'HAVOC'_x [in PLF.Hoare]
    -Himp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    -Himp.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Equiv]
    -Himp.::'SKIP' [in PLF.Equiv]
    Himp.::'SKIP' [in PLF.Hoare]
    +Himp.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    Himp.::'WHILE'_x_'DO'_x_'END' [in PLF.Hoare]
    -Himp.::'WHILE'_x_'DO'_x_'END' [in PLF.Equiv]
    +HoareAssertAssume.:hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [in PLF.Hoare]
    +HoareAssertAssume.::x_'::='_x [in PLF.Hoare]
    +HoareAssertAssume.::x_';;'_x [in PLF.Hoare]
    +HoareAssertAssume.::x_'=['_x_']=>'_x [in PLF.Hoare]
    +HoareAssertAssume.::'ASSERT'_x [in PLF.Hoare]
    +HoareAssertAssume.::'ASSUME'_x [in PLF.Hoare]
    +HoareAssertAssume.::'SKIP' [in PLF.Hoare]
    +HoareAssertAssume.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    +HoareAssertAssume.::'WHILE'_x_'DO'_x_'END' [in PLF.Hoare]


    I

    If1.:hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [in PLF.Hoare]
    -If1.::x_'/'_x_'\\'_x [in PLF.Hoare]
    -If1.::x_'::='_x [in PLF.Hoare]
    -If1.::x_';;'_x [in PLF.Hoare]
    -If1.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    -If1.::'IF1'_x_'THEN'_x_'FI' [in PLF.Hoare]
    -If1.::'SKIP' [in PLF.Hoare]
    -If1.::'WHILE'_x_'DO'_x_'END' [in PLF.Hoare]
    +If1.:imp_scope:x_'::='_x [in PLF.Hoare]
    +If1.:imp_scope:x_';;'_x [in PLF.Hoare]
    +If1.:imp_scope:'IF1'_x_'THEN'_x_'FI' [in PLF.Hoare]
    +If1.:imp_scope:'SKIP' [in PLF.Hoare]
    +If1.:imp_scope:'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    +If1.:imp_scope:'WHILE'_x_'DO'_x_'END' [in PLF.Hoare]
    +If1.::x_'=['_x_']=>'_x [in PLF.Hoare]


    L

    Loop.::x_'/'_x_'/'_x_'/'_x_'\\'_x_'#'_x [in PLF.PE]
    Loop.::x_'/'_x_'\\'_x_'#'_x [in PLF.PE]
    Loop.::x_'/'_x_'\\'_x_'/'_x_'/'_x [in PLF.PE]


    R

    -RepeatExercise.::x_'/'_x_'\\'_x [in PLF.Hoare]
    RepeatExercise.::x_'::='_x [in PLF.Hoare]
    RepeatExercise.::x_';;'_x [in PLF.Hoare]
    -RepeatExercise.::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    +RepeatExercise.::x_'=['_x_']=>'_x [in PLF.Hoare]
    RepeatExercise.::'REPEAT'_x_'UNTIL'_x_'END' [in PLF.Hoare]
    RepeatExercise.::'SKIP' [in PLF.Hoare]
    +RepeatExercise.::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in PLF.Hoare]
    RepeatExercise.::'WHILE'_x_'DO'_x_'END' [in PLF.Hoare]
    RepeatExercise.::'{{'_x_'}}'_x_'{{'_x_'}}' [in PLF.Hoare]


    S

    -SimpleArith1.::x_'==>'_x [in PLF.Smallstep]
    -SkipExample.::x_'/'_x_'==>a*'_x [in PLF.UseTactics]
    -STLCExtendedRecords.::x_'==>'_x [in PLF.Records]
    -STLCExtendedRecords.::x_'==>*'_x [in PLF.Records]
    -STLCExtendedRecords.::x_'|-'_x_'∈'_x [in PLF.Records]
    +-->'_x">SimpleArith1.::x_'-->'_x [in PLF.Smallstep]
    +-->'_x">STLCExtendedRecords.::x_'-->'_x [in PLF.Records]
    +-->*'_x">STLCExtendedRecords.::x_'-->*'_x [in PLF.Records]
    +STLCExtendedRecords.::x_'⊢'_x_'∈'_x [in PLF.Records]
    STLCExtendedRecords.::'['_x_':='_x_']'_x [in PLF.Records]
    -STLCExtended.::x_'==>'_x [in PLF.MoreStlc]
    -STLCExtended.::x_'==>*'_x [in PLF.MoreStlc]
    -STLCExtended.::x_'|-'_x_'∈'_x [in PLF.MoreStlc]
    +-->'_x">STLCExtended.::x_'-->'_x [in PLF.MoreStlc]
    +-->*'_x">STLCExtended.::x_'-->*'_x [in PLF.MoreStlc]
    +STLCExtended.::x_'⊢'_x_'∈'_x [in PLF.MoreStlc]
    STLCExtended.::'['_x_':='_x_']'_x [in PLF.MoreStlc]
    -STLCRef.RefsAndNontermination.::x_'/'_x_'==>+'_x_'/'_x [in PLF.References]
    -STLCRef.::x_'/'_x_'==>'_x_'/'_x [in PLF.References]
    -STLCRef.::x_'/'_x_'==>*'_x_'/'_x [in PLF.References]
    -STLCRef.::x_';'_x_'|-'_x_'∈'_x [in PLF.References]
    +-->+'_x_'/'_x">STLCRef.RefsAndNontermination.::x_'/'_x_'-->+'_x_'/'_x [in PLF.References]
    +-->'_x_'/'_x">STLCRef.::x_'/'_x_'-->'_x_'/'_x [in PLF.References]
    +-->*'_x_'/'_x">STLCRef.::x_'/'_x_'-->*'_x_'/'_x [in PLF.References]
    +STLCRef.::x_';'_x_'⊢'_x_'∈'_x [in PLF.References]
    STLCRef.::'['_x_':='_x_']'_x [in PLF.References]
    -STLC.::x_'==>'_x [in PLF.Stlc]
    -STLC.::x_'==>*'_x [in PLF.Stlc]
    -STLC.::x_'|-'_x_'∈'_x [in PLF.Stlc]
    +-->'_x">STLC.::x_'-->'_x [in PLF.Stlc]
    +-->*'_x">STLC.::x_'-->*'_x [in PLF.Stlc]
    +STLC.::x_'⊢'_x_'∈'_x [in PLF.Stlc]
    STLC.::'['_x_':='_x_']'_x [in PLF.Stlc]


    T

    -Temp1.::x_'==>'_x [in PLF.Smallstep]
    -Temp2.::x_'==>'_x [in PLF.Smallstep]
    -Temp3.::x_'==>'_x [in PLF.Smallstep]
    -Temp4.Temp5.::x_'==>'_x [in PLF.Smallstep]
    -Temp4.::x_'==>'_x [in PLF.Smallstep]
    +-->'_x">Temp1.::x_'-->'_x [in PLF.Smallstep]
    +-->'_x">Temp2.::x_'-->'_x [in PLF.Smallstep]
    +-->'_x">Temp3.::x_'-->'_x [in PLF.Smallstep]
    +-->'_x">Temp4.Temp5.::x_'-->'_x [in PLF.Smallstep]
    +-->'_x">Temp4.::x_'-->'_x [in PLF.Smallstep]


    :

    -:dcom_scope:x_'->>'_'{{'_x_'}}' [in PLF.Hoare2]
    +->>'_'{{'_x_'}}'">:dcom_scope:x_'->>'_'{{'_x_'}}' [in PLF.Hoare2]
    :dcom_scope:x_'::='_x_'{{'_x_'}}' [in PLF.Hoare2]
    :dcom_scope:x_';;'_x [in PLF.Hoare2]
    -:dcom_scope:'IFB'_x_'THEN'_'{{'_x_'}}'_x_'ELSE'_'{{'_x_'}}'_x_'FI'_'{{'_x_'}}' [in PLF.Hoare2]
    :dcom_scope:'SKIP'_'{{'_x_'}}' [in PLF.Hoare2]
    +:dcom_scope:'TEST'_x_'THEN'_'{{'_x_'}}'_x_'ELSE'_'{{'_x_'}}'_x_'FI'_'{{'_x_'}}' [in PLF.Hoare2]
    :dcom_scope:'WHILE'_x_'DO'_'{{'_x_'}}'_x_'END'_'{{'_x_'}}' [in PLF.Hoare2]
    -:dcom_scope:'->>'_'{{'_x_'}}'_x [in PLF.Hoare2]
    +->>'_'{{'_x_'}}'_x">:dcom_scope:'->>'_'{{'_x_'}}'_x [in PLF.Hoare2]
    :dcom_scope:'{{'_x_'}}'_x [in PLF.Hoare2]
    -:hoare_spec_scope:x_'->>'_x [in PLF.Hoare]
    -:hoare_spec_scope:x_'<<->>'_x [in PLF.Hoare]
    +->>'_x">:hoare_spec_scope:x_'->>'_x [in PLF.Hoare]
    +<<->>'_x">:hoare_spec_scope:x_'<<->>'_x [in PLF.Hoare]
    :hoare_spec_scope:'{{'_x_'}}'_x_'{{'_x_'}}' [in PLF.Hoare]
    :ltac_scope:'>>' [in PLF.LibTactics]
    :ltac_scope:'>>'_x [in PLF.LibTactics]
    @@ -2397,36 +2450,36 @@

    Notation Index

    :ltac_scope:'>>'_x_x_x_x_x_x_x_x_x_x_x_x_x [in PLF.LibTactics]
    :ltac_scope:'__' [in PLF.LibTactics]
    :ltac_scope:'___' [in PLF.LibTactics]
    +-->'_x">::x_'-->'_x [in PLF.Types]
    +-->'_x">::x_'-->'_x [in PLF.Norm]
    +-->'_x">::x_'-->'_x [in PLF.RecordSub]
    +-->'_x">::x_'-->'_x [in PLF.Sub]
    +-->'_x">::x_'-->'_x [in PLF.Smallstep]
    +-->*'_x">::x_'-->*'_x [in PLF.Smallstep]
    +-->*'_x">::x_'-->*'_x [in PLF.Norm]
    +-->*'_x">::x_'-->*'_x [in PLF.Types]
    +-->a'_x">::x_'/'_x_'-->a'_x [in PLF.Smallstep]
    +-->b'_x">::x_'/'_x_'-->b'_x [in PLF.Smallstep]
    +-->'_x_'/'_x">::x_'/'_x_'-->'_x_'/'_x [in PLF.Smallstep]
    ::x_'/'_x_'/'_x_'\\'_x [in PLF.PE]
    -::x_'/'_x_'==>a'_x [in PLF.Smallstep]
    -::x_'/'_x_'==>b'_x [in PLF.Smallstep]
    -::x_'/'_x_'==>'_x_'/'_x [in PLF.Smallstep]
    ::x_'/'_x_'\\'_x_'/'_x [in PLF.PE]
    ::x_'<-'_x_';;'_x [in PLF.Typechecking]
    -::x_'<:'_x [in PLF.Sub]
    ::x_'<:'_x [in PLF.RecordSub]
    +::x_'<:'_x [in PLF.Sub]
    ::x_'='''_x [in PLF.LibTactics]
    -::x_'==>'_x [in PLF.Sub]
    -::x_'==>'_x [in PLF.RecordSub]
    -::x_'==>'_x [in PLF.Types]
    -::x_'==>'_x [in PLF.Norm]
    ::x_'==>'_x [in PLF.Smallstep]
    -::x_'==>*'_x [in PLF.Smallstep]
    -::x_'==>*'_x [in PLF.Types]
    -::x_'==>*'_x [in PLF.Norm]
    -::x_'['_x_'|->'_x_']' [in PLF.Hoare]
    -::x_'\\'_x [in PLF.Smallstep]
    -::x_'|-'_x_'∈'_x [in PLF.Sub]
    -::x_'|-'_x_'∈'_x [in PLF.RecordSub]
    +>'_x_']'">::x_'['_x_'>'_x_']' [in PLF.Hoare]
    +::x_'⊢'_x_'∈'_x [in PLF.Sub]
    +::x_'⊢'_x_'∈'_x [in PLF.RecordSub]
    ::'fail' [in PLF.Typechecking]
    ::'nosimpl'_x [in PLF.LibTactics]
    ::'Register'_x_x [in PLF.LibTactics]
    ::'return'_x [in PLF.Typechecking]
    ::'Something' [in PLF.LibTactics]
    -::'['_x_':='_x_']'_x [in PLF.Sub]
    ::'['_x_':='_x_']'_x [in PLF.Norm]
    ::'['_x_':='_x_']'_x [in PLF.RecordSub]
    -::'|-'_x_'∈'_x [in PLF.Types]
    +::'['_x_':='_x_']'_x [in PLF.Sub]
    +::'⊢'_x_'∈'_x [in PLF.Types]



    Module Index

    C

    @@ -2440,8 +2493,8 @@

    Module Index

    Examples [in PLF.RecordSub]
    ExamplesInstantiations [in PLF.UseTactics]
    ExamplesLets [in PLF.UseTactics]
    -Examples2 [in PLF.Sub]
    Examples2 [in PLF.RecordSub]
    +Examples2 [in PLF.Sub]
    ExAssertions [in PLF.Hoare]


    F

    FirstTry [in PLF.Typechecking]
    @@ -2451,6 +2504,7 @@

    Module Index

    Himp [in PLF.Hoare]
    Himp [in PLF.Equiv]
    Himp2 [in PLF.Hoare2]
    +HoareAssertAssume [in PLF.Hoare]


    I

    If1 [in PLF.Hoare]
    IntrovExamples [in PLF.UseTactics]
    @@ -2460,11 +2514,9 @@

    Module Index

    Loop [in PLF.PE]


    N

    NaryExamples [in PLF.UseTactics]
    -NormalizePlayground [in PLF.Types]


    P

    PreservationProgressReferences [in PLF.UseAuto]
    PreservationProgressStlc [in PLF.UseAuto]
    -ProductExtension [in PLF.Sub]


    R

    RepeatExercise [in PLF.Hoare]
    RingDemo [in PLF.UseAuto]
    @@ -2557,31 +2609,40 @@

    Library Index




    Constructor Index

    A

    +abs [in PLF.Norm]
    +abs [in PLF.RecordSub]
    +abs [in PLF.Sub]
    +afi_abs [in PLF.RecordSub]
    afi_abs [in PLF.Norm]
    afi_abs [in PLF.Sub]
    -afi_abs [in PLF.RecordSub]
    +afi_app1 [in PLF.RecordSub]
    afi_app1 [in PLF.Norm]
    afi_app1 [in PLF.Sub]
    -afi_app1 [in PLF.RecordSub]
    afi_app2 [in PLF.RecordSub]
    afi_app2 [in PLF.Sub]
    afi_app2 [in PLF.Norm]
    afi_fst [in PLF.Norm]
    -afi_if0 [in PLF.Norm]
    -afi_if1 [in PLF.Sub]
    -afi_if1 [in PLF.Norm]
    -afi_if2 [in PLF.Norm]
    -afi_if2 [in PLF.Sub]
    -afi_if3 [in PLF.Sub]
    afi_pair1 [in PLF.Norm]
    afi_pair2 [in PLF.Norm]
    afi_proj [in PLF.RecordSub]
    afi_rhead [in PLF.RecordSub]
    afi_rtail [in PLF.RecordSub]
    afi_snd [in PLF.Norm]
    +afi_test0 [in PLF.Norm]
    +afi_test1 [in PLF.Norm]
    +afi_test1 [in PLF.Sub]
    +afi_test2 [in PLF.Sub]
    +afi_test2 [in PLF.Norm]
    +afi_test3 [in PLF.Sub]
    afi_var [in PLF.Norm]
    -afi_var [in PLF.RecordSub]
    afi_var [in PLF.Sub]
    +afi_var [in PLF.RecordSub]
    +app [in PLF.Norm]
    +app [in PLF.RecordSub]
    +app [in PLF.Sub]
    +Arrow [in PLF.RecordSub]
    +Arrow [in PLF.Sub]
    +Arrow [in PLF.Norm]
    Assign [in PLF.PE]
    AS_Id [in PLF.Smallstep]
    AS_Minus [in PLF.Smallstep]
    @@ -2595,7 +2656,12 @@

    Constructor Index

    AS_Plus2 [in PLF.Smallstep]
    av_num [in PLF.Smallstep]


    B

    +Base [in PLF.Sub]
    +Base [in PLF.RecordSub]
    body [in PLF.PE]
    +Bool [in PLF.Norm]
    +Bool [in PLF.Sub]
    +Bool [in PLF.Types]
    boxer [in PLF.LibTactics]
    BS_AndFalse [in PLF.Smallstep]
    BS_AndStep [in PLF.Smallstep]
    @@ -2611,8 +2677,8 @@

    Constructor Index

    BS_NotFalse [in PLF.Smallstep]
    BS_NotStep [in PLF.Smallstep]
    BS_NotTrue [in PLF.Smallstep]
    -bv_false [in PLF.Types]
    -bv_true [in PLF.Types]
    +bv_fls [in PLF.Types]
    +bv_tru [in PLF.Types]


    C

    C [in PLF.Smallstep]
    CImp.CAss [in PLF.Smallstep]
    @@ -2633,6 +2699,7 @@

    Constructor Index

    CImp.CS_While [in PLF.Smallstep]
    CImp.CWhile [in PLF.Smallstep]
    Combined.C [in PLF.Smallstep]
    +Combined.fls [in PLF.Smallstep]
    Combined.P [in PLF.Smallstep]
    Combined.ST_If [in PLF.Smallstep]
    Combined.ST_IfFalse [in PLF.Smallstep]
    @@ -2640,12 +2707,11 @@

    Constructor Index

    Combined.ST_PlusConstConst [in PLF.Smallstep]
    Combined.ST_Plus1 [in PLF.Smallstep]
    Combined.ST_Plus2 [in PLF.Smallstep]
    -Combined.tfalse [in PLF.Smallstep]
    -Combined.tif [in PLF.Smallstep]
    -Combined.ttrue [in PLF.Smallstep]
    +Combined.test [in PLF.Smallstep]
    +Combined.tru [in PLF.Smallstep]
    Combined.v_const [in PLF.Smallstep]
    -Combined.v_false [in PLF.Smallstep]
    -Combined.v_true [in PLF.Smallstep]
    +Combined.v_fls [in PLF.Smallstep]
    +Combined.v_tru [in PLF.Smallstep]
    CS_Ass [in PLF.Smallstep]
    CS_AssStep [in PLF.Smallstep]
    CS_IfFalse [in PLF.Smallstep]
    @@ -2672,6 +2738,11 @@

    Constructor Index

    E_None [in PLF.PE]
    E_Plus [in PLF.Smallstep]
    E_Some [in PLF.PE]
    +

    F

    +fls [in PLF.Types]
    +fls [in PLF.Sub]
    +fls [in PLF.Norm]
    +fst [in PLF.Norm]


    G

    Goto [in PLF.PE]


    H

    @@ -2679,29 +2750,50 @@

    Constructor Index

    Himp.CAss [in PLF.Equiv]
    Himp.CHavoc [in PLF.Hoare]
    Himp.CHavoc [in PLF.Equiv]
    -Himp.CIf [in PLF.Hoare]
    Himp.CIf [in PLF.Equiv]
    -Himp.CSeq [in PLF.Equiv]
    +Himp.CIf [in PLF.Hoare]
    Himp.CSeq [in PLF.Hoare]
    -Himp.CSkip [in PLF.Equiv]
    +Himp.CSeq [in PLF.Equiv]
    Himp.CSkip [in PLF.Hoare]
    +Himp.CSkip [in PLF.Equiv]
    Himp.CWhile [in PLF.Equiv]
    Himp.CWhile [in PLF.Hoare]
    Himp.E_Ass [in PLF.Equiv]
    Himp.E_Ass [in PLF.Hoare]
    Himp.E_Havoc [in PLF.Hoare]
    -Himp.E_IfFalse [in PLF.Equiv]
    Himp.E_IfFalse [in PLF.Hoare]
    -Himp.E_IfTrue [in PLF.Equiv]
    +Himp.E_IfFalse [in PLF.Equiv]
    Himp.E_IfTrue [in PLF.Hoare]
    -Himp.E_Seq [in PLF.Equiv]
    +Himp.E_IfTrue [in PLF.Equiv]
    Himp.E_Seq [in PLF.Hoare]
    -Himp.E_Skip [in PLF.Hoare]
    +Himp.E_Seq [in PLF.Equiv]
    Himp.E_Skip [in PLF.Equiv]
    -Himp.E_WhileFalse [in PLF.Hoare]
    +Himp.E_Skip [in PLF.Hoare]
    Himp.E_WhileFalse [in PLF.Equiv]
    -Himp.E_WhileTrue [in PLF.Equiv]
    +Himp.E_WhileFalse [in PLF.Hoare]
    Himp.E_WhileTrue [in PLF.Hoare]
    +Himp.E_WhileTrue [in PLF.Equiv]
    +HoareAssertAssume.CAss [in PLF.Hoare]
    +HoareAssertAssume.CAssert [in PLF.Hoare]
    +HoareAssertAssume.CAssume [in PLF.Hoare]
    +HoareAssertAssume.CIf [in PLF.Hoare]
    +HoareAssertAssume.CSeq [in PLF.Hoare]
    +HoareAssertAssume.CSkip [in PLF.Hoare]
    +HoareAssertAssume.CWhile [in PLF.Hoare]
    +HoareAssertAssume.E_Ass [in PLF.Hoare]
    +HoareAssertAssume.E_AssertFalse [in PLF.Hoare]
    +HoareAssertAssume.E_AssertTrue [in PLF.Hoare]
    +HoareAssertAssume.E_Assume [in PLF.Hoare]
    +HoareAssertAssume.E_IfFalse [in PLF.Hoare]
    +HoareAssertAssume.E_IfTrue [in PLF.Hoare]
    +HoareAssertAssume.E_SeqError [in PLF.Hoare]
    +HoareAssertAssume.E_SeqNormal [in PLF.Hoare]
    +HoareAssertAssume.E_Skip [in PLF.Hoare]
    +HoareAssertAssume.E_WhileFalse [in PLF.Hoare]
    +HoareAssertAssume.E_WhileTrueError [in PLF.Hoare]
    +HoareAssertAssume.E_WhileTrueNormal [in PLF.Hoare]
    +HoareAssertAssume.RError [in PLF.Hoare]
    +HoareAssertAssume.RNormal [in PLF.Hoare]
    H_Asgn [in PLF.HoareAsLogic]
    H_Consequence [in PLF.HoareAsLogic]
    H_If [in PLF.HoareAsLogic]
    @@ -2723,6 +2815,7 @@

    Constructor Index

    If1.E_Skip [in PLF.Hoare]
    If1.E_WhileFalse [in PLF.Hoare]
    If1.E_WhileTrue [in PLF.Hoare]
    +iszro [in PLF.Types]


    L

    loop [in PLF.PE]
    Loop.E'Ass [in PLF.PE]
    @@ -2756,10 +2849,12 @@

    Constructor Index

    multi_refl [in PLF.Smallstep]
    multi_step [in PLF.Smallstep]


    N

    -nv_succ [in PLF.Types]
    -nv_zero [in PLF.Types]
    +Nat [in PLF.Types]
    +nv_scc [in PLF.Types]
    +nv_zro [in PLF.Types]


    P

    P [in PLF.Smallstep]
    +pair [in PLF.Norm]
    PE_AssDynamic [in PLF.PE]
    PE_AssStatic [in PLF.PE]
    pe_ceval_intro [in PLF.PE]
    @@ -2769,23 +2864,11 @@

    Constructor Index

    pe_peval_intro [in PLF.PE]
    PE_Seq [in PLF.PE]
    PE_Skip [in PLF.PE]
    -ProductExtension.tabs [in PLF.Sub]
    -ProductExtension.tapp [in PLF.Sub]
    -ProductExtension.TArrow [in PLF.Sub]
    -ProductExtension.TBase [in PLF.Sub]
    -ProductExtension.TBool [in PLF.Sub]
    -ProductExtension.tfalse [in PLF.Sub]
    -ProductExtension.tfst [in PLF.Sub]
    -ProductExtension.tif [in PLF.Sub]
    -ProductExtension.tpair [in PLF.Sub]
    -ProductExtension.TProd [in PLF.Sub]
    -ProductExtension.tsnd [in PLF.Sub]
    -ProductExtension.TTop [in PLF.Sub]
    -ProductExtension.ttrue [in PLF.Sub]
    -ProductExtension.tunit [in PLF.Sub]
    -ProductExtension.TUnit [in PLF.Sub]
    -ProductExtension.tvar [in PLF.Sub]
    +prd [in PLF.Types]
    +Prod [in PLF.Norm]


    R

    +rcons [in PLF.RecordSub]
    +RCons [in PLF.RecordSub]
    RepeatExercise.CAsgn [in PLF.Hoare]
    RepeatExercise.CIf [in PLF.Hoare]
    RepeatExercise.CRepeat [in PLF.Hoare]
    @@ -2799,29 +2882,35 @@

    Constructor Index

    RepeatExercise.E_Skip [in PLF.Hoare]
    RepeatExercise.E_WhileFalse [in PLF.Hoare]
    RepeatExercise.E_WhileTrue [in PLF.Hoare]
    -rtcons [in PLF.RecordSub]
    +rnil [in PLF.RecordSub]
    +RNil [in PLF.RecordSub]
    +rproj [in PLF.RecordSub]
    RTcons [in PLF.RecordSub]
    +rtcons [in PLF.RecordSub]
    RTnil [in PLF.RecordSub]
    rtnil [in PLF.RecordSub]


    S

    +scc [in PLF.Types]
    SimpleArith1.ST_PlusConstConst [in PLF.Smallstep]
    SimpleArith1.ST_Plus1 [in PLF.Smallstep]
    SimpleArith1.ST_Plus2 [in PLF.Smallstep]
    +snd [in PLF.Norm]
    SS_Load [in PLF.Smallstep]
    SS_Minus [in PLF.Smallstep]
    SS_Mult [in PLF.Smallstep]
    SS_Plus [in PLF.Smallstep]
    SS_Push [in PLF.Smallstep]
    -STLCArith.tabs [in PLF.StlcProp]
    -STLCArith.tapp [in PLF.StlcProp]
    -STLCArith.TArrow [in PLF.StlcProp]
    -STLCArith.tif0 [in PLF.StlcProp]
    -STLCArith.tmult [in PLF.StlcProp]
    -STLCArith.tnat [in PLF.StlcProp]
    -STLCArith.TNat [in PLF.StlcProp]
    -STLCArith.tpred [in PLF.StlcProp]
    -STLCArith.tsucc [in PLF.StlcProp]
    -STLCArith.tvar [in PLF.StlcProp]
    +STLCArith.abs [in PLF.StlcProp]
    +STLCArith.app [in PLF.StlcProp]
    +STLCArith.Arrow [in PLF.StlcProp]
    +STLCArith.const [in PLF.StlcProp]
    +STLCArith.mlt [in PLF.StlcProp]
    +STLCArith.Nat [in PLF.StlcProp]
    +STLCArith.prd [in PLF.StlcProp]
    +STLCArith.scc [in PLF.StlcProp]
    +STLCArith.test0 [in PLF.StlcProp]
    +STLCArith.var [in PLF.StlcProp]
    +STLCExtendedRecords.abs [in PLF.Records]
    STLCExtendedRecords.afi_abs [in PLF.Records]
    STLCExtendedRecords.afi_app1 [in PLF.Records]
    STLCExtendedRecords.afi_app2 [in PLF.Records]
    @@ -2829,11 +2918,18 @@

    Constructor Index

    STLCExtendedRecords.afi_rhead [in PLF.Records]
    STLCExtendedRecords.afi_rtail [in PLF.Records]
    STLCExtendedRecords.afi_var [in PLF.Records]
    -STLCExtendedRecords.FirstTry.TArrow [in PLF.Records]
    -STLCExtendedRecords.FirstTry.TBase [in PLF.Records]
    +STLCExtendedRecords.app [in PLF.Records]
    +STLCExtendedRecords.Arrow [in PLF.Records]
    +STLCExtendedRecords.Base [in PLF.Records]
    +STLCExtendedRecords.FirstTry.Arrow [in PLF.Records]
    +STLCExtendedRecords.FirstTry.Base [in PLF.Records]
    STLCExtendedRecords.FirstTry.TRcd [in PLF.Records]
    -STLCExtendedRecords.rtcons [in PLF.Records]
    +STLCExtendedRecords.RCons [in PLF.Records]
    +STLCExtendedRecords.rcons [in PLF.Records]
    +STLCExtendedRecords.RNil [in PLF.Records]
    +STLCExtendedRecords.rproj [in PLF.Records]
    STLCExtendedRecords.RTcons [in PLF.Records]
    +STLCExtendedRecords.rtcons [in PLF.Records]
    STLCExtendedRecords.RTnil [in PLF.Records]
    STLCExtendedRecords.rtnil [in PLF.Records]
    STLCExtendedRecords.ST_AppAbs [in PLF.Records]
    @@ -2843,29 +2939,22 @@

    Constructor Index

    STLCExtendedRecords.ST_Proj1 [in PLF.Records]
    STLCExtendedRecords.ST_Rcd_Head [in PLF.Records]
    STLCExtendedRecords.ST_Rcd_Tail [in PLF.Records]
    -STLCExtendedRecords.tabs [in PLF.Records]
    -STLCExtendedRecords.tapp [in PLF.Records]
    -STLCExtendedRecords.TArrow [in PLF.Records]
    -STLCExtendedRecords.TBase [in PLF.Records]
    -STLCExtendedRecords.tproj [in PLF.Records]
    -STLCExtendedRecords.trcons [in PLF.Records]
    -STLCExtendedRecords.TRCons [in PLF.Records]
    -STLCExtendedRecords.TRNil [in PLF.Records]
    STLCExtendedRecords.trnil [in PLF.Records]
    -STLCExtendedRecords.tvar [in PLF.Records]
    STLCExtendedRecords.T_Abs [in PLF.Records]
    STLCExtendedRecords.T_App [in PLF.Records]
    STLCExtendedRecords.T_Proj [in PLF.Records]
    STLCExtendedRecords.T_RCons [in PLF.Records]
    STLCExtendedRecords.T_RNil [in PLF.Records]
    STLCExtendedRecords.T_Var [in PLF.Records]
    +STLCExtendedRecords.var [in PLF.Records]
    STLCExtendedRecords.v_abs [in PLF.Records]
    STLCExtendedRecords.v_rcons [in PLF.Records]
    STLCExtendedRecords.v_rnil [in PLF.Records]
    -STLCExtendedRecords.wfTArrow [in PLF.Records]
    -STLCExtendedRecords.wfTBase [in PLF.Records]
    -STLCExtendedRecords.wfTRCons [in PLF.Records]
    -STLCExtendedRecords.wfTRNil [in PLF.Records]
    +STLCExtendedRecords.wfArrow [in PLF.Records]
    +STLCExtendedRecords.wfBase [in PLF.Records]
    +STLCExtendedRecords.wfRCons [in PLF.Records]
    +STLCExtendedRecords.wfRNil [in PLF.Records]
    +STLCExtended.abs [in PLF.MoreStlc]
    STLCExtended.afi_abs [in PLF.MoreStlc]
    STLCExtended.afi_app1 [in PLF.MoreStlc]
    STLCExtended.afi_app2 [in PLF.MoreStlc]
    @@ -2874,9 +2963,6 @@

    Constructor Index

    STLCExtended.afi_case2 [in PLF.MoreStlc]
    STLCExtended.afi_cons1 [in PLF.MoreStlc]
    STLCExtended.afi_cons2 [in PLF.MoreStlc]
    -STLCExtended.afi_if01 [in PLF.MoreStlc]
    -STLCExtended.afi_if02 [in PLF.MoreStlc]
    -STLCExtended.afi_if03 [in PLF.MoreStlc]
    STLCExtended.afi_inl [in PLF.MoreStlc]
    STLCExtended.afi_inr [in PLF.MoreStlc]
    STLCExtended.afi_lcase1 [in PLF.MoreStlc]
    @@ -2886,7 +2972,22 @@

    Constructor Index

    STLCExtended.afi_mult2 [in PLF.MoreStlc]
    STLCExtended.afi_pred [in PLF.MoreStlc]
    STLCExtended.afi_succ [in PLF.MoreStlc]
    +STLCExtended.afi_test01 [in PLF.MoreStlc]
    +STLCExtended.afi_test02 [in PLF.MoreStlc]
    +STLCExtended.afi_test03 [in PLF.MoreStlc]
    STLCExtended.afi_var [in PLF.MoreStlc]
    +STLCExtended.app [in PLF.MoreStlc]
    +STLCExtended.Arrow [in PLF.MoreStlc]
    +STLCExtended.const [in PLF.MoreStlc]
    +STLCExtended.fst [in PLF.MoreStlc]
    +STLCExtended.List [in PLF.MoreStlc]
    +STLCExtended.mlt [in PLF.MoreStlc]
    +STLCExtended.Nat [in PLF.MoreStlc]
    +STLCExtended.pair [in PLF.MoreStlc]
    +STLCExtended.prd [in PLF.MoreStlc]
    +STLCExtended.Prod [in PLF.MoreStlc]
    +STLCExtended.scc [in PLF.MoreStlc]
    +STLCExtended.snd [in PLF.MoreStlc]
    STLCExtended.ST_AppAbs [in PLF.MoreStlc]
    STLCExtended.ST_App1 [in PLF.MoreStlc]
    STLCExtended.ST_App2 [in PLF.MoreStlc]
    @@ -2895,52 +2996,35 @@

    Constructor Index

    STLCExtended.ST_CaseInr [in PLF.MoreStlc]
    STLCExtended.ST_Cons1 [in PLF.MoreStlc]
    STLCExtended.ST_Cons2 [in PLF.MoreStlc]
    -STLCExtended.ST_If0Nonzero [in PLF.MoreStlc]
    -STLCExtended.ST_If0Zero [in PLF.MoreStlc]
    -STLCExtended.ST_If01 [in PLF.MoreStlc]
    STLCExtended.ST_Inl [in PLF.MoreStlc]
    STLCExtended.ST_Inr [in PLF.MoreStlc]
    STLCExtended.ST_LcaseCons [in PLF.MoreStlc]
    STLCExtended.ST_LcaseNil [in PLF.MoreStlc]
    STLCExtended.ST_Lcase1 [in PLF.MoreStlc]
    -STLCExtended.ST_MultNats [in PLF.MoreStlc]
    +STLCExtended.ST_Mulconsts [in PLF.MoreStlc]
    STLCExtended.ST_Mult1 [in PLF.MoreStlc]
    STLCExtended.ST_Mult2 [in PLF.MoreStlc]
    STLCExtended.ST_Pred [in PLF.MoreStlc]
    STLCExtended.ST_PredNat [in PLF.MoreStlc]
    STLCExtended.ST_SuccNat [in PLF.MoreStlc]
    STLCExtended.ST_Succ1 [in PLF.MoreStlc]
    -STLCExtended.tabs [in PLF.MoreStlc]
    -STLCExtended.tapp [in PLF.MoreStlc]
    -STLCExtended.TArrow [in PLF.MoreStlc]
    +STLCExtended.ST_Test0Nonzero [in PLF.MoreStlc]
    +STLCExtended.ST_Test0Zero [in PLF.MoreStlc]
    +STLCExtended.ST_Test01 [in PLF.MoreStlc]
    +STLCExtended.Sum [in PLF.MoreStlc]
    STLCExtended.tcase [in PLF.MoreStlc]
    STLCExtended.tcons [in PLF.MoreStlc]
    +STLCExtended.test0 [in PLF.MoreStlc]
    STLCExtended.tfix [in PLF.MoreStlc]
    -STLCExtended.tfst [in PLF.MoreStlc]
    -STLCExtended.tif0 [in PLF.MoreStlc]
    STLCExtended.tinl [in PLF.MoreStlc]
    STLCExtended.tinr [in PLF.MoreStlc]
    STLCExtended.tlcase [in PLF.MoreStlc]
    STLCExtended.tlet [in PLF.MoreStlc]
    -STLCExtended.TList [in PLF.MoreStlc]
    -STLCExtended.tmult [in PLF.MoreStlc]
    -STLCExtended.tnat [in PLF.MoreStlc]
    -STLCExtended.TNat [in PLF.MoreStlc]
    STLCExtended.tnil [in PLF.MoreStlc]
    -STLCExtended.tpair [in PLF.MoreStlc]
    -STLCExtended.tpred [in PLF.MoreStlc]
    -STLCExtended.TProd [in PLF.MoreStlc]
    -STLCExtended.tsnd [in PLF.MoreStlc]
    -STLCExtended.tsucc [in PLF.MoreStlc]
    -STLCExtended.TSum [in PLF.MoreStlc]
    -STLCExtended.TUnit [in PLF.MoreStlc]
    -STLCExtended.tunit [in PLF.MoreStlc]
    -STLCExtended.tvar [in PLF.MoreStlc]
    STLCExtended.T_Abs [in PLF.MoreStlc]
    STLCExtended.T_App [in PLF.MoreStlc]
    STLCExtended.T_Case [in PLF.MoreStlc]
    STLCExtended.T_Cons [in PLF.MoreStlc]
    -STLCExtended.T_If0 [in PLF.MoreStlc]
    STLCExtended.T_Inl [in PLF.MoreStlc]
    STLCExtended.T_Inr [in PLF.MoreStlc]
    STLCExtended.T_Lcase [in PLF.MoreStlc]
    @@ -2949,8 +3033,12 @@

    Constructor Index

    STLCExtended.T_Nil [in PLF.MoreStlc]
    STLCExtended.T_Pred [in PLF.MoreStlc]
    STLCExtended.T_Succ [in PLF.MoreStlc]
    +STLCExtended.T_Test0 [in PLF.MoreStlc]
    STLCExtended.T_Unit [in PLF.MoreStlc]
    STLCExtended.T_Var [in PLF.MoreStlc]
    +STLCExtended.unit [in PLF.MoreStlc]
    +STLCExtended.Unit [in PLF.MoreStlc]
    +STLCExtended.var [in PLF.MoreStlc]
    STLCExtended.v_abs [in PLF.MoreStlc]
    STLCExtended.v_inl [in PLF.MoreStlc]
    STLCExtended.v_inr [in PLF.MoreStlc]
    @@ -2962,10 +3050,11 @@

    Constructor Index

    STLCProp.afi_abs [in PLF.StlcProp]
    STLCProp.afi_app1 [in PLF.StlcProp]
    STLCProp.afi_app2 [in PLF.StlcProp]
    -STLCProp.afi_if1 [in PLF.StlcProp]
    -STLCProp.afi_if2 [in PLF.StlcProp]
    -STLCProp.afi_if3 [in PLF.StlcProp]
    +STLCProp.afi_test1 [in PLF.StlcProp]
    +STLCProp.afi_test2 [in PLF.StlcProp]
    +STLCProp.afi_test3 [in PLF.StlcProp]
    STLCProp.afi_var [in PLF.StlcProp]
    +STLCRef.abs [in PLF.References]
    STLCRef.afi_abs [in PLF.References]
    STLCRef.afi_app1 [in PLF.References]
    STLCRef.afi_app2 [in PLF.References]
    @@ -2981,10 +3070,22 @@

    Constructor Index

    STLCRef.afi_ref [in PLF.References]
    STLCRef.afi_succ [in PLF.References]
    STLCRef.afi_var [in PLF.References]
    +STLCRef.app [in PLF.References]
    +STLCRef.Arrow [in PLF.References]
    +STLCRef.assign [in PLF.References]
    +STLCRef.const [in PLF.References]
    +STLCRef.deref [in PLF.References]
    STLCRef.extends_cons [in PLF.References]
    STLCRef.extends_nil [in PLF.References]
    +STLCRef.loc [in PLF.References]
    +STLCRef.mlt [in PLF.References]
    +STLCRef.Nat [in PLF.References]
    +STLCRef.prd [in PLF.References]
    +STLCRef.ref [in PLF.References]
    +STLCRef.Ref [in PLF.References]
    STLCRef.RefsAndNontermination.sc_one [in PLF.References]
    STLCRef.RefsAndNontermination.sc_step [in PLF.References]
    +STLCRef.scc [in PLF.References]
    STLCRef.ST_AppAbs [in PLF.References]
    STLCRef.ST_App1 [in PLF.References]
    STLCRef.ST_App2 [in PLF.References]
    @@ -3005,23 +3106,7 @@

    Constructor Index

    STLCRef.ST_RefValue [in PLF.References]
    STLCRef.ST_Succ [in PLF.References]
    STLCRef.ST_SuccNat [in PLF.References]
    -STLCRef.tabs [in PLF.References]
    -STLCRef.tapp [in PLF.References]
    -STLCRef.TArrow [in PLF.References]
    -STLCRef.tassign [in PLF.References]
    -STLCRef.tderef [in PLF.References]
    -STLCRef.tif0 [in PLF.References]
    -STLCRef.tloc [in PLF.References]
    -STLCRef.tmult [in PLF.References]
    -STLCRef.TNat [in PLF.References]
    -STLCRef.tnat [in PLF.References]
    -STLCRef.tpred [in PLF.References]
    -STLCRef.TRef [in PLF.References]
    -STLCRef.tref [in PLF.References]
    -STLCRef.tsucc [in PLF.References]
    -STLCRef.tunit [in PLF.References]
    -STLCRef.TUnit [in PLF.References]
    -STLCRef.tvar [in PLF.References]
    +STLCRef.test0 [in PLF.References]
    STLCRef.T_Abs [in PLF.References]
    STLCRef.T_App [in PLF.References]
    STLCRef.T_Assign [in PLF.References]
    @@ -3035,72 +3120,75 @@

    Constructor Index

    STLCRef.T_Succ [in PLF.References]
    STLCRef.T_Unit [in PLF.References]
    STLCRef.T_Var [in PLF.References]
    +STLCRef.unit [in PLF.References]
    +STLCRef.Unit [in PLF.References]
    +STLCRef.var [in PLF.References]
    STLCRef.v_abs [in PLF.References]
    STLCRef.v_loc [in PLF.References]
    STLCRef.v_nat [in PLF.References]
    STLCRef.v_unit [in PLF.References]
    +STLC.abs [in PLF.Stlc]
    +STLC.app [in PLF.Stlc]
    +STLC.Arrow [in PLF.Stlc]
    +STLC.Bool [in PLF.Stlc]
    +STLC.fls [in PLF.Stlc]
    STLC.ST_AppAbs [in PLF.Stlc]
    STLC.ST_App1 [in PLF.Stlc]
    STLC.ST_App2 [in PLF.Stlc]
    -STLC.ST_If [in PLF.Stlc]
    -STLC.ST_IfFalse [in PLF.Stlc]
    -STLC.ST_IfTrue [in PLF.Stlc]
    +STLC.ST_Test [in PLF.Stlc]
    +STLC.ST_TestFls [in PLF.Stlc]
    +STLC.ST_TestTru [in PLF.Stlc]
    STLC.s_var1 [in PLF.Stlc]
    -STLC.tabs [in PLF.Stlc]
    -STLC.tapp [in PLF.Stlc]
    -STLC.TArrow [in PLF.Stlc]
    -STLC.TBool [in PLF.Stlc]
    -STLC.tfalse [in PLF.Stlc]
    -STLC.tif [in PLF.Stlc]
    -STLC.ttrue [in PLF.Stlc]
    -STLC.tvar [in PLF.Stlc]
    +STLC.test [in PLF.Stlc]
    +STLC.tru [in PLF.Stlc]
    STLC.T_Abs [in PLF.Stlc]
    STLC.T_App [in PLF.Stlc]
    -STLC.T_False [in PLF.Stlc]
    -STLC.T_If [in PLF.Stlc]
    -STLC.T_True [in PLF.Stlc]
    +STLC.T_Fls [in PLF.Stlc]
    +STLC.T_Test [in PLF.Stlc]
    +STLC.T_Tru [in PLF.Stlc]
    STLC.T_Var [in PLF.Stlc]
    +STLC.var [in PLF.Stlc]
    STLC.v_abs [in PLF.Stlc]
    -STLC.v_false [in PLF.Stlc]
    -STLC.v_true [in PLF.Stlc]
    -ST_AppAbs [in PLF.Norm]
    +STLC.v_fls [in PLF.Stlc]
    +STLC.v_tru [in PLF.Stlc]
    ST_AppAbs [in PLF.Sub]
    +ST_AppAbs [in PLF.Norm]
    ST_AppAbs [in PLF.RecordSub]
    -ST_App1 [in PLF.Sub]
    ST_App1 [in PLF.Norm]
    ST_App1 [in PLF.RecordSub]
    -ST_App2 [in PLF.RecordSub]
    +ST_App1 [in PLF.Sub]
    ST_App2 [in PLF.Norm]
    +ST_App2 [in PLF.RecordSub]
    ST_App2 [in PLF.Sub]
    ST_Fst [in PLF.Norm]
    ST_FstPair [in PLF.Norm]
    -ST_If [in PLF.Norm]
    -ST_If [in PLF.Sub]
    -ST_If [in PLF.Types]
    -ST_IfFalse [in PLF.Norm]
    -ST_IfFalse [in PLF.Sub]
    -ST_IfFalse [in PLF.Types]
    -ST_IfTrue [in PLF.Sub]
    -ST_IfTrue [in PLF.Norm]
    -ST_IfTrue [in PLF.Types]
    -ST_Iszero [in PLF.Types]
    -ST_IszeroSucc [in PLF.Types]
    -ST_IszeroZero [in PLF.Types]
    +ST_Iszro [in PLF.Types]
    +ST_IszroScc [in PLF.Types]
    +ST_IszroZro [in PLF.Types]
    ST_Pair1 [in PLF.Norm]
    ST_Pair2 [in PLF.Norm]
    ST_PlusConstConst [in PLF.Smallstep]
    ST_Plus1 [in PLF.Smallstep]
    ST_Plus2 [in PLF.Smallstep]
    -ST_Pred [in PLF.Types]
    -ST_PredSucc [in PLF.Types]
    -ST_PredZero [in PLF.Types]
    +ST_Prd [in PLF.Types]
    +ST_PrdScc [in PLF.Types]
    +ST_PrdZro [in PLF.Types]
    ST_ProjRcd [in PLF.RecordSub]
    ST_Proj1 [in PLF.RecordSub]
    ST_Rcd_Head [in PLF.RecordSub]
    ST_Rcd_Tail [in PLF.RecordSub]
    +ST_Scc [in PLF.Types]
    ST_Snd [in PLF.Norm]
    ST_SndPair [in PLF.Norm]
    -ST_Succ [in PLF.Types]
    +ST_Test [in PLF.Sub]
    +ST_Test [in PLF.Types]
    +ST_Test [in PLF.Norm]
    +ST_TestFalse [in PLF.Sub]
    +ST_TestFalse [in PLF.Norm]
    +ST_TestFls [in PLF.Types]
    +ST_TestTru [in PLF.Types]
    +ST_TestTrue [in PLF.Sub]
    +ST_TestTrue [in PLF.Norm]
    S_Arrow [in PLF.Sub]
    S_Arrow [in PLF.RecordSub]
    S_RcdDepth [in PLF.RecordSub]
    @@ -3108,25 +3196,11 @@

    Constructor Index

    S_RcdWidth [in PLF.RecordSub]
    S_Refl [in PLF.Sub]
    S_Refl [in PLF.RecordSub]
    -S_Top [in PLF.Sub]
    S_Top [in PLF.RecordSub]
    -S_Trans [in PLF.RecordSub]
    +S_Top [in PLF.Sub]
    S_Trans [in PLF.Sub]
    +S_Trans [in PLF.RecordSub]


    T

    -tabs [in PLF.Sub]
    -tabs [in PLF.RecordSub]
    -tabs [in PLF.Norm]
    -tapp [in PLF.Sub]
    -tapp [in PLF.RecordSub]
    -tapp [in PLF.Norm]
    -TArrow [in PLF.Norm]
    -TArrow [in PLF.Sub]
    -TArrow [in PLF.RecordSub]
    -TBase [in PLF.Sub]
    -TBase [in PLF.RecordSub]
    -TBool [in PLF.Sub]
    -TBool [in PLF.Types]
    -TBool [in PLF.Norm]
    Temp1.ST_PlusConstConst [in PLF.Smallstep]
    Temp1.ST_Plus1 [in PLF.Smallstep]
    Temp1.ST_Plus2 [in PLF.Smallstep]
    @@ -3140,104 +3214,90 @@

    Constructor Index

    Temp3.ST_PlusConstConst [in PLF.Smallstep]
    Temp3.ST_Plus1 [in PLF.Smallstep]
    Temp3.v_const [in PLF.Smallstep]
    +Temp4.fls [in PLF.Smallstep]
    Temp4.ST_If [in PLF.Smallstep]
    Temp4.ST_IfFalse [in PLF.Smallstep]
    Temp4.ST_IfTrue [in PLF.Smallstep]
    Temp4.Temp5.ST_If [in PLF.Smallstep]
    Temp4.Temp5.ST_IfFalse [in PLF.Smallstep]
    Temp4.Temp5.ST_IfTrue [in PLF.Smallstep]
    -Temp4.tfalse [in PLF.Smallstep]
    -Temp4.tif [in PLF.Smallstep]
    -Temp4.ttrue [in PLF.Smallstep]
    -Temp4.v_false [in PLF.Smallstep]
    -Temp4.v_true [in PLF.Smallstep]
    -tfalse [in PLF.Types]
    -tfalse [in PLF.Norm]
    -tfalse [in PLF.Sub]
    -tfst [in PLF.Norm]
    -tif [in PLF.Sub]
    -tif [in PLF.Norm]
    -tif [in PLF.Types]
    -tiszero [in PLF.Types]
    -TNat [in PLF.Types]
    -tpair [in PLF.Norm]
    -tpred [in PLF.Types]
    -TProd [in PLF.Norm]
    -tproj [in PLF.RecordSub]
    -TRCons [in PLF.RecordSub]
    -trcons [in PLF.RecordSub]
    -trnil [in PLF.RecordSub]
    -TRNil [in PLF.RecordSub]
    -tsnd [in PLF.Norm]
    -tsucc [in PLF.Types]
    -TTop [in PLF.RecordSub]
    -TTop [in PLF.Sub]
    -ttrue [in PLF.Norm]
    -ttrue [in PLF.Types]
    -ttrue [in PLF.Sub]
    -TUnit [in PLF.Sub]
    -tunit [in PLF.Sub]
    -tvar [in PLF.RecordSub]
    -tvar [in PLF.Sub]
    -tvar [in PLF.Norm]
    -tzero [in PLF.Types]
    +Temp4.test [in PLF.Smallstep]
    +Temp4.tru [in PLF.Smallstep]
    +Temp4.v_fls [in PLF.Smallstep]
    +Temp4.v_tru [in PLF.Smallstep]
    +test [in PLF.Types]
    +test [in PLF.Norm]
    +test [in PLF.Sub]
    +Top [in PLF.RecordSub]
    +Top [in PLF.Sub]
    +tru [in PLF.Norm]
    +tru [in PLF.Sub]
    +tru [in PLF.Types]
    T_Abs [in PLF.RecordSub]
    -T_Abs [in PLF.Norm]
    T_Abs [in PLF.Sub]
    -T_App [in PLF.Sub]
    +T_Abs [in PLF.Norm]
    T_App [in PLF.RecordSub]
    T_App [in PLF.Norm]
    +T_App [in PLF.Sub]
    T_False [in PLF.Norm]
    -T_False [in PLF.Types]
    T_False [in PLF.Sub]
    +T_Fls [in PLF.Types]
    T_Fst [in PLF.Norm]
    -T_If [in PLF.Types]
    -T_If [in PLF.Norm]
    -T_If [in PLF.Sub]
    -T_Iszero [in PLF.Types]
    +T_Iszro [in PLF.Types]
    T_Pair [in PLF.Norm]
    -T_Pred [in PLF.Types]
    +T_Prd [in PLF.Types]
    T_Proj [in PLF.RecordSub]
    T_RCons [in PLF.RecordSub]
    T_RNil [in PLF.RecordSub]
    +T_Scc [in PLF.Types]
    T_Snd [in PLF.Norm]
    T_Sub [in PLF.RecordSub]
    T_Sub [in PLF.Sub]
    -T_Succ [in PLF.Types]
    +T_Test [in PLF.Sub]
    +T_Test [in PLF.Norm]
    +T_Test [in PLF.Types]
    +T_Tru [in PLF.Types]
    T_True [in PLF.Norm]
    -T_True [in PLF.Types]
    T_True [in PLF.Sub]
    T_Unit [in PLF.Sub]
    T_Var [in PLF.Sub]
    -T_Var [in PLF.RecordSub]
    T_Var [in PLF.Norm]
    -T_Zero [in PLF.Types]
    +T_Var [in PLF.RecordSub]
    +T_Zro [in PLF.Types]
    +

    U

    +unit [in PLF.Sub]
    +Unit [in PLF.Sub]


    V

    +var [in PLF.Norm]
    +var [in PLF.Sub]
    +var [in PLF.RecordSub]
    VNUId [in PLF.Equiv]
    VNUMinus [in PLF.Equiv]
    VNUMult [in PLF.Equiv]
    VNUNum [in PLF.Equiv]
    VNUPlus [in PLF.Equiv]
    -v_abs [in PLF.RecordSub]
    v_abs [in PLF.Sub]
    +v_abs [in PLF.RecordSub]
    v_abs [in PLF.Norm]
    V_cons [in PLF.Norm]
    v_const [in PLF.Smallstep]
    -v_false [in PLF.Norm]
    v_false [in PLF.Sub]
    +v_fls [in PLF.Norm]
    V_nil [in PLF.Norm]
    v_pair [in PLF.Norm]
    v_rcons [in PLF.RecordSub]
    v_rnil [in PLF.RecordSub]
    -v_true [in PLF.Norm]
    +v_tru [in PLF.Norm]
    v_true [in PLF.Sub]
    v_unit [in PLF.Sub]


    W

    -wfTArrow [in PLF.RecordSub]
    -wfTBase [in PLF.RecordSub]
    -wfTRCons [in PLF.RecordSub]
    -wfTRNil [in PLF.RecordSub]
    -wfTTop [in PLF.RecordSub]
    +wfArrow [in PLF.RecordSub]
    +wfBase [in PLF.RecordSub]
    +wfRCons [in PLF.RecordSub]
    +wfRNil [in PLF.RecordSub]
    +wfTop [in PLF.RecordSub]
    +

    Z

    +zro [in PLF.Types]



    Lemma Index

    A

    @@ -3270,9 +3330,9 @@

    Lemma Index

    congruence_demo_2 [in PLF.UseAuto]
    congruence_demo_3 [in PLF.UseAuto]
    congruence_demo_4 [in PLF.UseAuto]
    -context_invariance [in PLF.Norm]
    context_invariance [in PLF.RecordSub]
    context_invariance [in PLF.Sub]
    +context_invariance [in PLF.Norm]
    CSeq_congruence [in PLF.Equiv]
    CWhile_congruence [in PLF.Equiv]
    c3_c4_different [in PLF.Equiv]
    @@ -3281,8 +3341,8 @@

    Lemma Index

    demo_auto_absurd_1 [in PLF.UseAuto]
    demo_auto_absurd_2 [in PLF.UseAuto]
    demo_clears_all_and_clears_but [in PLF.LibTactics]
    -demo_false [in PLF.UseAuto]
    demo_false [in PLF.UseTactics]
    +demo_false [in PLF.UseAuto]
    demo_false_arg [in PLF.UseTactics]
    demo_hint_unfold_context_1 [in PLF.UseAuto]
    demo_hint_unfold_context_2 [in PLF.UseAuto]
    @@ -3334,8 +3394,8 @@

    Lemma Index

    fold_constants_aexp_sound [in PLF.Equiv]
    fold_constants_bexp_sound [in PLF.Equiv]
    fold_constants_com_sound [in PLF.Equiv]
    -free_in_context [in PLF.Norm]
    free_in_context [in PLF.RecordSub]
    +free_in_context [in PLF.Norm]
    free_in_context [in PLF.Sub]


    G

    GenExample.substitution_preserves_typing [in PLF.UseTactics]
    @@ -3350,6 +3410,15 @@

    Lemma Index

    Himp.p3_p4_inequiv [in PLF.Equiv]
    Himp.p5_p6_equiv [in PLF.Equiv]
    Himp2.hoare_havoc_weakest [in PLF.Hoare2]
    +HoareAssertAssume.assert_assume_differ [in PLF.Hoare]
    +HoareAssertAssume.assert_implies_assume [in PLF.Hoare]
    +HoareAssertAssume.hoare_asgn [in PLF.Hoare]
    +HoareAssertAssume.hoare_consequence_post [in PLF.Hoare]
    +HoareAssertAssume.hoare_consequence_pre [in PLF.Hoare]
    +HoareAssertAssume.hoare_if [in PLF.Hoare]
    +HoareAssertAssume.hoare_seq [in PLF.Hoare]
    +HoareAssertAssume.hoare_skip [in PLF.Hoare]
    +HoareAssertAssume.hoare_while [in PLF.Hoare]
    hoare_asgn [in PLF.Hoare]
    hoare_asgn_fwd [in PLF.Hoare]
    hoare_asgn_fwd_exists [in PLF.Hoare]
    @@ -3371,9 +3440,6 @@

    Lemma Index

    H_Pre_False_deriv [in PLF.HoareAsLogic]


    I

    identity_assignment [in PLF.Equiv]
    -IFB_false [in PLF.Equiv]
    -IFB_true [in PLF.Equiv]
    -IFB_true_simple [in PLF.Equiv]
    iff_intro_swap [in PLF.LibTactics]
    iff_trans [in PLF.Equiv]
    If1.hoare_if1_good [in PLF.Hoare]
    @@ -3436,15 +3502,15 @@

    Lemma Index



    N

    NaryExamples.demo_branch [in PLF.UseTactics]
    NaryExamples.demo_splits [in PLF.UseTactics]
    -NaryExamples.progress [in PLF.UseTactics]
    nat_canonical [in PLF.Types]
    +nat_le_refl [in PLF.UseAuto]
    negation_study_1 [in PLF.UseAuto]
    negation_study_2 [in PLF.UseAuto]
    nf_is_value [in PLF.Smallstep]
    nf_same_as_value [in PLF.Smallstep]
    normalization [in PLF.Norm]
    -NormalizePlayground.normalize_ex [in PLF.Types]
    -NormalizePlayground.normalize_ex' [in PLF.Types]
    +normalize_ex [in PLF.Smallstep]
    +normalize_ex' [in PLF.Smallstep]
    normal_forms_unique [in PLF.Smallstep]


    O

    omega_demo_1 [in PLF.UseAuto]
    @@ -3482,10 +3548,9 @@

    Lemma Index

    pe_update_update_remove [in PLF.PE]
    pow2_le_1 [in PLF.Hoare2]
    pow2_plus_1 [in PLF.Hoare2]
    -preservation [in PLF.Norm]
    -preservation [in PLF.Sub]
    preservation [in PLF.Types]
    preservation [in PLF.RecordSub]
    +preservation [in PLF.Norm]
    PreservationProgressReferences.nth_eq_last' [in PLF.UseAuto]
    PreservationProgressReferences.preservation [in PLF.UseAuto]
    PreservationProgressReferences.preservation' [in PLF.UseAuto]
    @@ -3496,11 +3561,9 @@

    Lemma Index

    PreservationProgressStlc.progress [in PLF.UseAuto]
    PreservationProgressStlc.progress' [in PLF.UseAuto]
    preservation' [in PLF.Types]
    -ProductExtension.preservation [in PLF.Sub]
    -ProductExtension.progress [in PLF.Sub]
    -progress [in PLF.Types]
    progress [in PLF.RecordSub]
    progress [in PLF.Sub]
    +progress [in PLF.Types]


    R

    rcd_types_match [in PLF.RecordSub]
    reduce_to_zero_correct' [in PLF.Hoare2]
    @@ -3529,8 +3592,8 @@

    Lemma Index

    SimpleArith2.step_deterministic [in PLF.Smallstep]
    SimpleArith3.step_deterministic_alt [in PLF.Smallstep]
    SkipExample.ceval_deterministic [in PLF.UseTactics]
    -SkipExample.demo_skipH [in PLF.UseTactics]
    -SkipExample.mult_0_plus [in PLF.UseTactics]
    +SkipExample.demo_admits [in PLF.UseTactics]
    +SkipExample.mult_plus_0 [in PLF.UseTactics]
    skip_left [in PLF.Equiv]
    skip_right [in PLF.Equiv]
    slow_assignment_dec_correct [in PLF.Hoare2]
    @@ -3555,9 +3618,11 @@

    Lemma Index

    square_dec_correct [in PLF.Hoare2]
    square_simpler_dec_correct [in PLF.Hoare2]
    stack_step_deterministic [in PLF.Smallstep]
    +StepFunction.complete_stepf [in PLF.Typechecking]
    +StepFunction.sound_stepf [in PLF.Typechecking]
    +step_deterministic [in PLF.Norm]
    step_deterministic [in PLF.Types]
    step_deterministic [in PLF.Smallstep]
    -step_deterministic [in PLF.Norm]
    step_normalizing [in PLF.Smallstep]
    step_preserves_halting [in PLF.Norm]
    step_preserves_R [in PLF.Norm]
    @@ -3591,6 +3656,7 @@

    Lemma Index

    STLCProp.soundness [in PLF.StlcProp]
    STLCProp.substitution_preserves_typing [in PLF.StlcProp]
    STLCProp.typable_empty__closed [in PLF.StlcProp]
    +STLCProp.unique_types [in PLF.StlcProp]
    STLCRef.assign_pres_store_typing [in PLF.References]
    STLCRef.context_invariance [in PLF.References]
    STLCRef.extends_app [in PLF.References]
    @@ -3639,7 +3705,6 @@

    Lemma Index

    subtype__wf [in PLF.RecordSub]
    SubtypingInversion.abs_arrow [in PLF.UseAuto]
    SubtypingInversion.abs_arrow' [in PLF.UseAuto]
    -SubtypingInversion.substitution_preserves_typing [in PLF.UseAuto]
    sub_inversion_arrow [in PLF.RecordSub]
    sub_inversion_arrow [in PLF.Sub]
    sub_inversion_Bool [in PLF.Sub]
    @@ -3657,11 +3722,14 @@

    Lemma Index

    Temp3.value_not_same_as_normal_form [in PLF.Smallstep]
    Temp4.step_deterministic [in PLF.Smallstep]
    Temp4.strong_progress [in PLF.Smallstep]
    +TEST_false [in PLF.Equiv]
    test_multistep_1 [in PLF.Smallstep]
    test_multistep_1' [in PLF.Smallstep]
    test_multistep_2 [in PLF.Smallstep]
    test_multistep_3 [in PLF.Smallstep]
    test_multistep_4 [in PLF.Smallstep]
    +TEST_true [in PLF.Equiv]
    +TEST_true_simple [in PLF.Equiv]
    transitivity_bad_hint_1 [in PLF.UseAuto]
    transitivity_workaround_1 [in PLF.UseAuto]
    transitivity_workaround_2 [in PLF.UseAuto]
    @@ -3676,23 +3744,23 @@

    Lemma Index

    TypecheckerExtensions.type_checking_sound [in PLF.Typechecking]
    typing_inversion_abs [in PLF.RecordSub]
    typing_inversion_abs [in PLF.Sub]
    -typing_inversion_app [in PLF.Sub]
    typing_inversion_app [in PLF.RecordSub]
    +typing_inversion_app [in PLF.Sub]
    typing_inversion_false [in PLF.Sub]
    typing_inversion_if [in PLF.Sub]
    typing_inversion_proj [in PLF.RecordSub]
    typing_inversion_rcons [in PLF.RecordSub]
    typing_inversion_true [in PLF.Sub]
    typing_inversion_unit [in PLF.Sub]
    -typing_inversion_var [in PLF.Sub]
    typing_inversion_var [in PLF.RecordSub]
    +typing_inversion_var [in PLF.Sub]


    U

    UnfoldsExample.bexp_eval_true [in PLF.UseTactics]


    V

    vacuous_substitution [in PLF.Norm]
    value_halts [in PLF.Norm]
    -value_is_nf [in PLF.Types]
    value_is_nf [in PLF.Smallstep]
    +value_is_nf [in PLF.Types]
    value__normal [in PLF.Norm]
    verification_correct [in PLF.Hoare2]
    verification_correct_dec [in PLF.Hoare2]
    @@ -3722,7 +3790,6 @@

    Axiom Index



    P

    P [in PLF.UseAuto]


    S

    -skip_axiom [in PLF.LibTactics]
    subtype [in PLF.UseAuto]
    subtype_refl [in PLF.UseAuto]
    subtype_trans [in PLF.UseAuto]
    @@ -3731,9 +3798,9 @@

    Axiom Index




    Inductive Index

    A

    -appears_free_in [in PLF.Sub]
    -appears_free_in [in PLF.RecordSub]
    appears_free_in [in PLF.Norm]
    +appears_free_in [in PLF.RecordSub]
    +appears_free_in [in PLF.Sub]
    astep [in PLF.Smallstep]
    aval [in PLF.Smallstep]


    B

    @@ -3755,14 +3822,17 @@

    Inductive Index

    ev [in PLF.Hoare2]
    eval [in PLF.Smallstep]


    H

    -has_type [in PLF.RecordSub]
    has_type [in PLF.Sub]
    has_type [in PLF.Types]
    +has_type [in PLF.RecordSub]
    has_type [in PLF.Norm]
    Himp.ceval [in PLF.Hoare]
    Himp.ceval [in PLF.Equiv]
    Himp.com [in PLF.Hoare]
    Himp.com [in PLF.Equiv]
    +HoareAssertAssume.ceval [in PLF.Hoare]
    +HoareAssertAssume.com [in PLF.Hoare]
    +HoareAssertAssume.result [in PLF.Hoare]
    hoare_proof [in PLF.HoareAsLogic]


    I

    If1.ceval [in PLF.Hoare]
    @@ -3788,8 +3858,6 @@

    Inductive Index

    pe_ceval [in PLF.PE]
    pe_com [in PLF.PE]
    pe_peval [in PLF.PE]
    -ProductExtension.tm [in PLF.Sub]
    -ProductExtension.ty [in PLF.Sub]


    R

    record_tm [in PLF.RecordSub]
    record_ty [in PLF.RecordSub]
    @@ -3798,11 +3866,11 @@

    Inductive Index



    S

    SimpleArith1.step [in PLF.Smallstep]
    stack_step [in PLF.Smallstep]
    -step [in PLF.RecordSub]
    step [in PLF.Norm]
    +step [in PLF.Smallstep]
    +step [in PLF.RecordSub]
    step [in PLF.Types]
    step [in PLF.Sub]
    -step [in PLF.Smallstep]
    STLCArith.tm [in PLF.StlcProp]
    STLCArith.ty [in PLF.StlcProp]
    STLCExtendedRecords.appears_free_in [in PLF.Records]
    @@ -3849,20 +3917,20 @@

    Inductive Index

    Temp4.Temp5.step [in PLF.Smallstep]
    Temp4.tm [in PLF.Smallstep]
    Temp4.value [in PLF.Smallstep]
    -tm [in PLF.Smallstep]
    -tm [in PLF.Sub]
    tm [in PLF.Norm]
    tm [in PLF.Types]
    +tm [in PLF.Smallstep]
    tm [in PLF.RecordSub]
    +tm [in PLF.Sub]
    +ty [in PLF.Norm]
    ty [in PLF.RecordSub]
    ty [in PLF.Types]
    -ty [in PLF.Norm]
    ty [in PLF.Sub]


    V

    -value [in PLF.RecordSub]
    -value [in PLF.Sub]
    value [in PLF.Smallstep]
    +value [in PLF.RecordSub]
    value [in PLF.Norm]
    +value [in PLF.Sub]
    var_not_used_in_aexp [in PLF.Equiv]


    W

    well_formed_ty [in PLF.RecordSub]
    @@ -3877,24 +3945,24 @@

    Section Index




    Abbreviation Index

    E

    -Examples.A [in PLF.RecordSub]
    Examples.A [in PLF.Sub]
    -Examples.B [in PLF.RecordSub]
    +Examples.A [in PLF.RecordSub]
    Examples.B [in PLF.Sub]
    -Examples.C [in PLF.RecordSub]
    +Examples.B [in PLF.RecordSub]
    Examples.C [in PLF.Sub]
    +Examples.C [in PLF.RecordSub]
    Examples.Float [in PLF.Sub]
    Examples.i [in PLF.RecordSub]
    Examples.Integer [in PLF.Sub]
    Examples.j [in PLF.RecordSub]
    Examples.k [in PLF.RecordSub]
    Examples.String [in PLF.Sub]
    -Examples.x [in PLF.RecordSub]
    Examples.x [in PLF.Sub]
    +Examples.x [in PLF.RecordSub]
    Examples.y [in PLF.Sub]
    Examples.y [in PLF.RecordSub]
    -Examples.z [in PLF.RecordSub]
    Examples.z [in PLF.Sub]
    +Examples.z [in PLF.RecordSub]


    M

    multistep [in PLF.Norm]


    S

    @@ -3963,13 +4031,15 @@

    Definition Index

    COIND [in PLF.LibTactics]
    compiler_is_correct_statement [in PLF.Smallstep]
    congruence_example [in PLF.Equiv]
    -context [in PLF.Norm]
    context [in PLF.Sub]
    context [in PLF.RecordSub]
    +context [in PLF.Norm]
    ctrans_sound [in PLF.Equiv]
    c3 [in PLF.Equiv]
    c4 [in PLF.Equiv]


    D

    +dec0 [in PLF.Hoare2]
    +dec1 [in PLF.Hoare2]
    dec_correct [in PLF.Hoare2]
    dec_while [in PLF.Hoare2]
    deterministic [in PLF.Smallstep]
    @@ -3986,12 +4056,12 @@

    Definition Index

    Examples.Employee [in PLF.Sub]
    Examples.Person [in PLF.Sub]
    Examples.Student [in PLF.Sub]
    -Examples.subtyping_example_0 [in PLF.Sub]
    Examples.subtyping_example_0 [in PLF.RecordSub]
    -Examples.subtyping_example_1 [in PLF.Sub]
    +Examples.subtyping_example_0 [in PLF.Sub]
    Examples.subtyping_example_1 [in PLF.RecordSub]
    -Examples.subtyping_example_2 [in PLF.Sub]
    +Examples.subtyping_example_1 [in PLF.Sub]
    Examples.subtyping_example_2 [in PLF.RecordSub]
    +Examples.subtyping_example_2 [in PLF.Sub]
    Examples.subtyping_example_3 [in PLF.RecordSub]
    Examples.subtyping_example_4 [in PLF.RecordSub]
    Examples.sub_employee_person [in PLF.Sub]
    @@ -4044,6 +4114,8 @@

    Definition Index

    Himp.p4 [in PLF.Equiv]
    Himp.p5 [in PLF.Equiv]
    Himp.p6 [in PLF.Equiv]
    +HoareAssertAssume.assert_assume_example [in PLF.Hoare]
    +HoareAssertAssume.hoare_triple [in PLF.Hoare]
    hoare_asgn_example1 [in PLF.Hoare]
    hoare_asgn_example1' [in PLF.Hoare]
    hoare_asgn_example3 [in PLF.Hoare]
    @@ -4096,23 +4168,19 @@

    Definition Index

    manual_grade_for_norm [in PLF.Norm]
    manual_grade_for_norm_fail [in PLF.Norm]
    manual_grade_for_pair_permutation [in PLF.Sub]
    -manual_grade_for_preservation [in PLF.Sub]
    -manual_grade_for_progress [in PLF.Sub]
    manual_grade_for_prog_pres_bigstep [in PLF.Types]
    manual_grade_for_proper_subtypes [in PLF.Sub]
    manual_grade_for_rcd_types_match_informal [in PLF.RecordSub]
    -manual_grade_for_remove_predzero [in PLF.Types]
    +manual_grade_for_remove_predzro [in PLF.Types]
    manual_grade_for_smallest_1 [in PLF.Sub]
    manual_grade_for_smallest_2 [in PLF.Sub]
    manual_grade_for_small_large_1 [in PLF.Sub]
    manual_grade_for_small_large_2 [in PLF.Sub]
    manual_grade_for_small_large_4 [in PLF.Sub]
    -manual_grade_for_STLC_extensions [in PLF.MoreStlc]
    manual_grade_for_subject_expansion [in PLF.Types]
    manual_grade_for_subtype_concepts_tf [in PLF.Sub]
    manual_grade_for_subtype_instances_tf_2 [in PLF.Sub]
    manual_grade_for_subtype_order [in PLF.Sub]
    -manual_grade_for_variations [in PLF.Sub]
    manual_grade_for_variation1 [in PLF.Types]
    manual_grade_for_variation2 [in PLF.Types]
    msubst [in PLF.Norm]
    @@ -4120,10 +4188,6 @@

    Definition Index

    mupdate [in PLF.Norm]
    myFact [in PLF.UseAuto]


    N

    -NormalizePlayground.step_example1 [in PLF.Types]
    -NormalizePlayground.step_example1' [in PLF.Types]
    -NormalizePlayground.step_example1'' [in PLF.Types]
    -NormalizePlayground.step_example1''' [in PLF.Types]
    normalizing [in PLF.Smallstep]
    normal_form [in PLF.Smallstep]
    normal_form_of [in PLF.Smallstep]
    @@ -4176,9 +4240,9 @@

    Definition Index

    rm [in PLF.LibTactics]


    S

    sample_proof [in PLF.HoareAsLogic]
    +scc_hastype_nat__hastype_nat [in PLF.Types]
    SimpleArith1.test_step_1 [in PLF.Smallstep]
    SimpleArith1.test_step_2 [in PLF.Smallstep]
    -SkipExample.astep_example1 [in PLF.UseTactics]
    slow_assignment_dec [in PLF.Hoare2]
    some_term_is_stuck [in PLF.Types]
    sqrt_dec [in PLF.Hoare2]
    @@ -4187,6 +4251,11 @@

    Definition Index

    square_simpler_dec [in PLF.Hoare2]
    stack [in PLF.Smallstep]
    stack_multistep [in PLF.Smallstep]
    +StepFunction.stepf [in PLF.Typechecking]
    +step_example1 [in PLF.Smallstep]
    +step_example1' [in PLF.Smallstep]
    +step_example1'' [in PLF.Smallstep]
    +step_example1''' [in PLF.Smallstep]
    step_normal_form [in PLF.Smallstep]
    STLCArith.manual_grade_for_stlc_arith [in PLF.StlcProp]
    STLCChecker.type_check [in PLF.Typechecking]
    @@ -4200,15 +4269,41 @@

    Definition Index

    STLCExtendedRecords.weird_type [in PLF.Records]
    STLCExtended.context [in PLF.MoreStlc]
    STLCExtended.Examples.FixTest1.fact [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest1.reduces [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest1.typechecks [in PLF.MoreStlc]
    STLCExtended.Examples.FixTest2.map [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest2.reduces [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest2.typechecks [in PLF.MoreStlc]
    STLCExtended.Examples.FixTest3.equal [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest3.reduces [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest3.reduces2 [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest3.typechecks [in PLF.MoreStlc]
    STLCExtended.Examples.FixTest4.eotest [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest4.reduces [in PLF.MoreStlc]
    +STLCExtended.Examples.FixTest4.typechecks [in PLF.MoreStlc]
    +STLCExtended.Examples.LetTest.reduces [in PLF.MoreStlc]
    STLCExtended.Examples.LetTest.test [in PLF.MoreStlc]
    +STLCExtended.Examples.LetTest.typechecks [in PLF.MoreStlc]
    +STLCExtended.Examples.ListTest.reduces [in PLF.MoreStlc]
    STLCExtended.Examples.ListTest.test [in PLF.MoreStlc]
    +STLCExtended.Examples.ListTest.typechecks [in PLF.MoreStlc]
    +STLCExtended.Examples.Numtest.numtest_reduces [in PLF.MoreStlc]
    STLCExtended.Examples.Numtest.test [in PLF.MoreStlc]
    +STLCExtended.Examples.Numtest.typechecks [in PLF.MoreStlc]
    +STLCExtended.Examples.Prodtest.reduces [in PLF.MoreStlc]
    STLCExtended.Examples.Prodtest.test [in PLF.MoreStlc]
    +STLCExtended.Examples.Prodtest.typechecks [in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest1.reduces [in PLF.MoreStlc]
    STLCExtended.Examples.Sumtest1.test [in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest1.typechecks [in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest2.reduces [in PLF.MoreStlc]
    STLCExtended.Examples.Sumtest2.test [in PLF.MoreStlc]
    +STLCExtended.Examples.Sumtest2.typechecks [in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_context_invariance [in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_extensions_definition [in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_preservation [in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_progress [in PLF.MoreStlc]
    +STLCExtended.manual_grade_for_substitution_preserves_typing [in PLF.MoreStlc]
    STLCExtended.subst [in PLF.MoreStlc]
    STLCProp.closed [in PLF.StlcProp]
    STLCProp.manual_grade_for_afi [in PLF.StlcProp]
    @@ -4217,7 +4312,6 @@

    Definition Index

    STLCProp.manual_grade_for_stlc_variation2 [in PLF.StlcProp]
    STLCProp.manual_grade_for_stlc_variation3 [in PLF.StlcProp]
    STLCProp.manual_grade_for_subject_expansion_stlc [in PLF.StlcProp]
    -STLCProp.manual_grade_for_types_unique [in PLF.StlcProp]
    STLCProp.stuck [in PLF.StlcProp]
    STLCRef.context [in PLF.References]
    STLCRef.ExampleVariables.r [in PLF.References]
    @@ -4264,7 +4358,6 @@

    Definition Index

    subst_aexp_ex [in PLF.Equiv]
    subst_equiv_property [in PLF.Equiv]
    subtract_slowly_dec [in PLF.Hoare2]
    -succ_hastype_nat__hastype_nat [in PLF.Types]
    swap [in PLF.Hoare2]
    swap_dec [in PLF.Hoare2]
    swap_program [in PLF.Hoare]
    @@ -4282,8 +4375,8 @@

    Definition Index

    test_pe_bexp2 [in PLF.PE]
    test_pe_update [in PLF.PE]
    text_pe_aexp2 [in PLF.PE]
    -tlookup [in PLF.RecordSub]
    Tlookup [in PLF.RecordSub]
    +tlookup [in PLF.RecordSub]
    two_loops_dec [in PLF.Hoare2]
    TypecheckerExtensions.eqb_ty [in PLF.Typechecking]
    TypecheckerExtensions.manual_grade_for_type_checking_complete [in PLF.Typechecking]
    @@ -4329,7 +4422,7 @@

    Definition Index

    Z : _ -(1863 entries) +(1908 entries) Notation Index @@ -4361,7 +4454,7 @@

    Definition Index

    Z : _ -(124 entries) +(132 entries) Module Index @@ -4392,7 +4485,7 @@

    Definition Index

    Y Z _ -(66 entries) +(65 entries) Variable Index @@ -4463,7 +4556,7 @@

    Definition Index

    C D E -F +F G H I @@ -4478,14 +4571,14 @@

    Definition Index

    R S T -U +U V W X Y -Z +Z _ -(665 entries) +(670 entries) Lemma Index @@ -4516,7 +4609,7 @@

    Definition Index

    Y Z _ -(446 entries) +(454 entries) Axiom Index @@ -4547,7 +4640,7 @@

    Definition Index

    Y Z _ -(12 entries) +(11 entries) Inductive Index @@ -4578,7 +4671,7 @@

    Definition Index

    Y Z _ -(120 entries) +(121 entries) Section Index @@ -4671,7 +4764,7 @@

    Definition Index

    Y Z _ -(343 entries) +(368 entries)
    diff --git a/plf-current/index.html b/plf-current/index.html index 1c95cb6c..fabb11f6 100644 --- a/plf-current/index.html +++ b/plf-current/index.html @@ -63,6 +63,7 @@ Leonid Spesivtsev, Philip Wadler, Stephanie Weirich, + Li-Yao Xia, and Steve Zdancewic
    @@ -82,7 +83,7 @@

    -

    版本 5.6 (07 Dec 2018, Coq 8.8.0)

    +

    版本 5.7 (26 Jan 2019, Coq 8.8.1)

    diff --git a/plf-current/plf.tgz b/plf-current/plf.tgz index 7af12508..c6564755 100644 Binary files a/plf-current/plf.tgz and b/plf-current/plf.tgz differ diff --git a/plf-current/toc.html b/plf-current/toc.html index 4e653b54..cf7c4fd5 100644 --- a/plf-current/toc.html +++ b/plf-current/toc.html @@ -199,78 +199,78 @@

    Hoare Logic, Part II    (Hoare2
    @@ -126,15 +126,15 @@

    QuickChickInterfaceQuickChick Refere the maximum depth of the generated A) and a random seed.

    -Parameter run : {A : Type}, G AnatRandomSeedA.
    +Parameter run : {A : Type}, G AnatRandomSeedA.
    The semantics of a generator is its set of possible outcomes.
    -Parameter semGen : {A : Type} (g : G A), set A.
    -Parameter semGenSize : {A : Type} (g : G A) (size : nat), set A.
    +Parameter semGen : {A : Type} (g : G A), set A.
    +Parameter semGenSize : {A : Type} (g : G A) (size : nat), set A.
    @@ -160,8 +160,8 @@

    QuickChickInterfaceQuickChick Refere the first generator.

    -Parameter bindGen' : {A B : Type} (g : G A),
    -    ( (a : A), (asemGen g) → G B) → G B.
    +Parameter bindGen' : {A B : Type} (g : G A),
    +    ((a : A), (asemGen g) → G B) → G B.
    @@ -169,7 +169,7 @@

    QuickChickInterfaceQuickChick Refere chaining generators that can fail / backtrack.

    -Parameter bindGenOpt : {A B : Type},
    +Parameter bindGenOpt : {A B : Type},
        G (option A) → (AG (option B)) → G (option B).
    @@ -184,8 +184,8 @@

    QuickChickInterfaceQuickChick Refere g yields a list of fixed size n.

    -Parameter listOf : {A : Type}, G AG (list A).
    -Parameter vectorOf : {A : Type}, natG AG (list A).
    +Parameter listOf : {A : Type}, G AG (list A).
    +Parameter vectorOf : {A : Type}, natG AG (list A).
    @@ -194,7 +194,7 @@

    QuickChickInterfaceQuickChick Refere element from l uniformly; otherwise it always yields a.

    -Parameter elems_ : {A : Type}, Alist AG A.
    +Parameter elems_ : {A : Type}, Alist AG A.
    @@ -203,7 +203,7 @@

    QuickChickInterfaceQuickChick Refere picks a generator for A in l.

    -Parameter oneOf_ : {A : Type}, G Alist (G A) → G A.
    +Parameter oneOf_ : {A : Type}, G Alist (G A) → G A.
    @@ -216,7 +216,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter freq_ :
    -   {A : Type}, G Alist (nat * G A) → G A.
    +  {A : Type}, G Alist (nat * G A) → G A.
    @@ -226,7 +226,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter backtrack :
    -   {A : Type}, list (nat * G (option A)) → G (option A).
    +  {A : Type}, list (nat * G (option A)) → G (option A).
    @@ -235,8 +235,8 @@

    QuickChickInterfaceQuickChick Refere combinator sets it.

    -Parameter sized : {A: Type}, (natG A) → G A.
    -Parameter resize : {A: Type}, natG AG A.
    +Parameter sized : {A: Type}, (natG A) → G A.
    +Parameter resize : {A: Type}, natG AG A.
    @@ -244,9 +244,9 @@

    QuickChickInterfaceQuickChick Refere

    Parameter suchThatMaybe :
    -   {A : Type}, G A → (Abool) → G (option A).
    +  {A : Type}, G A → (Abool) → G (option A).
    Parameter suchThatMaybeOpt :
    -   {A : Type}, G (option A) → (Abool) → G (option A).

    +  {A : Type}, G (option A) → (Abool) → G (option A).

    @@ -361,7 +361,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter choose :
    -   {A : Type} `{ChoosableFromInterval A}, (A * A) → G A.
    +  {A : Type} `{ChoosableFromInterval A}, (A * A) → G A.
    @@ -398,15 +398,15 @@

    QuickChickInterfaceQuickChick Refere Declare Instance genNatSized : GenSized nat.
    Declare Instance genZSized : GenSized Z.

    Declare Instance genListSized :
    -   {A : Type} `{GenSized A}, GenSized (list A).
    +  {A : Type} `{GenSized A}, GenSized (list A).
    Declare Instance genList :
    -   {A : Type} `{Gen A}, Gen (list A).
    +  {A : Type} `{Gen A}, Gen (list A).
    Declare Instance genOption :
    -   {A : Type} `{Gen A}, Gen (option A).
    +  {A : Type} `{Gen A}, Gen (option A).
    Declare Instance genPairSized :
    -   {A B : Type} `{GenSized A} `{GenSized B}, GenSized (A*B).
    +  {A B : Type} `{GenSized A} `{GenSized B}, GenSized (A*B).
    Declare Instance genPair :
    -   {A B : Type} `{Gen A} `{Gen B}, Gen (A * B).
    +  {A B : Type} `{Gen A} `{Gen B}, Gen (A * B).

    @@ -548,7 +548,7 @@

    QuickChickInterfaceQuickChick Refere

    Declare Instance ArbitraryOfGenShrink :
    -   {A} `{Gen A} `{Shrink A}, Arbitrary A.
    +  {A} `{Gen A} `{Shrink A}, Arbitrary A.
    @@ -601,7 +601,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter forAll :
    -   {A prop : Type} `{Checkable prop} `{Show A}
    +  {A prop : Type} `{Checkable prop} `{Show A}
             (gen : G A) (pf : Aprop), Checker.
    @@ -613,8 +613,8 @@

    QuickChickInterfaceQuickChick Refere

    Parameter forAllProof :
    -   {A prop : Type} `{Checkable prop} `{Show A}
    -         (gen : G A) (pf : (x : A), semGen gen xprop), Checker.
    +  {A prop : Type} `{Checkable prop} `{Show A}
    +         (gen : G A) (pf : (x : A), semGen gen xprop), Checker.
    @@ -623,20 +623,20 @@

    QuickChickInterfaceQuickChick Refere

    Parameter forAllShrink :
    -   {A prop : Type} `{Checkable prop} `{Show A}
    +  {A prop : Type} `{Checkable prop} `{Show A}
             (gen : G A) (shrinker : Alist A) (pf : Aprop), Checker.
    Lift (Show, Gen, Shrink) instances for A - to a Checker for functions A -> prop. This is what makes it + to a Checker for functions A -> prop. This is what makes it possible to write (for some example property foo := fun x x >? 0, say) QuickChick foo instead of QuickChick (forAllShrink arbitrary shrink foo).
    Declare Instance testFun :
    -   {A prop : Type} `{Show A} `{Arbitrary A} `{Checkable prop},
    +  {A prop : Type} `{Show A} `{Arbitrary A} `{Checkable prop},
        Checkable (Aprop).
    @@ -645,9 +645,9 @@

    QuickChickInterfaceQuickChick Refere

    Declare Instance testProd :
    -   {A : Type} {prop : AType} `{Show A} `{Arbitrary A}
    -         `{ x : A, Checkable (prop x)},
    -    Checkable ( (x : A), prop x).
    +  {A : Type} {prop : AType} `{Show A} `{Arbitrary A}
    +         `{x : A, Checkable (prop x)},
    +    Checkable ((x : A), prop x).
    @@ -655,8 +655,8 @@

    QuickChickInterfaceQuickChick Refere

    Declare Instance testPolyFun :
    -   {prop : TypeType} `{Checkable (prop nat)},
    -    Checkable ( T, prop T).
    +  {prop : TypeType} `{Checkable (prop nat)},
    +    Checkable (T, prop T).
    @@ -668,7 +668,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter whenFail :
    -   {prop : Type} `{Checkable prop} (str : string), propChecker.
    +  {prop : Type} `{Checkable prop} (str : string), propChecker.
    @@ -677,7 +677,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter expectFailure :
    -   {prop: Type} `{Checkable prop} (p: prop), Checker.
    +  {prop: Type} `{Checkable prop} (p: prop), Checker.
    @@ -685,7 +685,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter collect :
    -   {A prop : Type} `{Show A} `{Checkable prop} (x : A),
    +  {A prop : Type} `{Show A} `{Checkable prop} (x : A),
        propChecker.
    @@ -695,15 +695,15 @@

    QuickChickInterfaceQuickChick Refere

    Parameter tag :
    -   {prop : Type} `{Checkable prop} (t : string), propChecker.
    +  {prop : Type} `{Checkable prop} (t : string), propChecker.
    Form the conjunction / disjunction of a list of checkers.
    -Parameter conjoin : (l : list Checker), Checker.
    -Parameter disjoin : (l : list Checker), Checker.
    +Parameter conjoin : (l : list Checker), Checker.
    +Parameter disjoin : (l : list Checker), Checker.
    @@ -712,7 +712,7 @@

    QuickChickInterfaceQuickChick Refere

    Parameter implication :
    -   {prop : Type} `{Checkable prop} (b : bool) (p : prop), Checker.
    +  {prop : Type} `{Checkable prop} (b : bool) (p : prop), Checker.
    @@ -758,7 +758,7 @@

    QuickChickInterfaceQuickChick Refere Logic Combinator instances.

    -Declare Instance Dec_neg {P} {H : Dec P} : DecP).
    +Declare Instance Dec_neg {P} {H : Dec P} : DecP).
    Declare Instance Dec_conj {P Q} {H : Dec P} {I : Dec Q} : Dec (PQ).
    Declare Instance Dec_disj {P Q} {H : Dec P} {I : Dec Q} : Dec (PQ).
    @@ -784,7 +784,7 @@

    QuickChickInterfaceQuickChick Refere
         Class Dec_Eq (A : Type) :=
           {
    -         dec_eq :  (x y : A), decidable (x = y)
    +         dec_eq : (x y : A), decidable (x = y)
           }.
    @@ -819,13 +819,13 @@

    QuickChickInterfaceQuickChick Refere Declare Instance Dec_eq_bool (x y : bool) : Dec (x = y).
    Declare Instance Dec_eq_nat (m n : nat) : Dec (m = n).
    Declare Instance Dec_eq_opt (A : Type) (m n : option A)
    -`{_ : (x y : A), Dec (x = y)} : Dec (m = n).
    +`{_ : (x y : A), Dec (x = y)} : Dec (m = n).
    Declare Instance Dec_eq_prod (A B : Type) (m n : A * B)
    -`{_ : (x y : A), Dec (x = y)}
    -`{_ : (x y : B), Dec (x = y)}
    +`{_ : (x y : A), Dec (x = y)}
    +`{_ : (x y : B), Dec (x = y)}
    : Dec (m = n).
    Declare Instance Dec_eq_list (A : Type) (m n : list A)
    -`{_ : (x y : A), Dec (x = y)} : Dec (m = n).

    +`{_ : (x y : A), Dec (x = y)} : Dec (m = n).

    Declare Instance Dec_ascii (m n : Ascii.ascii) : Dec (m = n).
    Declare Instance Dec_string (m n : string) : Dec (m = n).

    @@ -1172,7 +1172,8 @@

    QuickChickInterfaceQuickChick Refere     (bindGenOpt A (fun XB))
        (at level 200, X ident, A at level 100, B at level 200).
    End QcDoNotation.

    -End QuickChickSig.
    +End QuickChickSig.

    +(* Sat Jan 26 15:19:30 UTC 2019 *)

    diff --git a/qc-current/QuickChickInterface.v b/qc-current/QuickChickInterface.v index 6946d74e..e04cc5b0 100644 --- a/qc-current/QuickChickInterface.v +++ b/qc-current/QuickChickInterface.v @@ -15,8 +15,9 @@ Module Type QuickChickSig. (* ################################################################# *) (** * The [Show] Typeclass *) -(** [Show] typeclass allows the test case to be printed as a string. *) -(** +(** [Show] typeclass allows the test case to be printed as a string. + + Class Show (A : Type) : Type := { show : A -> string @@ -134,7 +135,6 @@ Parameter suchThatMaybe : Parameter suchThatMaybeOpt : forall {A : Type}, G (option A) -> (A -> bool) -> G (option A). - (** The [elems_], [oneOf_], and [freq_] combinators all take default values; these are only used if their list arguments are empty, which should not normally happen. The [QcDefaultNotation] @@ -220,8 +220,9 @@ Parameter choose : (** [GenSized] and [Gen] are typeclasses whose instances can be generated randomly. More specifically, [GenSized] depends on a generator for any given - natural number that indicate the size of output. *) -(** + natural number that indicate the size of output. + + Class GenSized (A : Type) := { arbitrarySized : nat -> G A }. Class Gen (A : Type) := { arbitrary : G A }. *) @@ -253,8 +254,9 @@ Declare Instance genPair : for generators of type [A], it provides constrained variants for generators of type [A] such that [P : A -> Prop] holds of all generated values. Since it is not guaranteed that any such [A] - exist, these generators are partial. *) -(** + exist, these generators are partial. + + Class GenSizedSuchThat (A : Type) (P : A -> Prop) := { arbitrarySizeST : nat -> G (option A) @@ -294,8 +296,9 @@ Notation "'genST' x" := (@arbitraryST _ x _) (at level 70). (** [Shrink] is a typeclass whose instances have an operation for shrinking larger elements to smaller ones, allowing QuickChick to - search for a minimal counter example when errors occur. *) -(** + search for a minimal counter example when errors occur. + + Class Shrink (A : Type) := { shrink : A -> list A @@ -314,8 +317,9 @@ Declare Instance shrinkOption {A : Type} `{Shrink A} : Shrink (option A). (* ================================================================= *) (** ** The [Arbitrary] Typeclass *) -(** The [Arbitrary] typeclass combines generation and shrinking. *) -(** +(** The [Arbitrary] typeclass combines generation and shrinking. + + Class Arbitrary (A : Type) `{Gen A} `{Shrink A}. *) @@ -332,7 +336,6 @@ Declare Instance shrinkOption {A : Type} `{Shrink A} : Shrink (option A). Arbitrary *) - (** If a type has a [Gen] and a [Shrink] instance, it automatically gets an [Arbitrary] one. *) Declare Instance ArbitraryOfGenShrink : @@ -347,8 +350,9 @@ Declare Instance ArbitraryOfGenShrink : (** [Checker] is the opaque type of QuickChick properties. *) Parameter Checker : Type. -(** The [Checkable] class indicates we can check a type A. *) -(** +(** The [Checkable] class indicates we can check a type A. + + Class Checkable (A : Type) : Type := { checker : A -> Checker @@ -450,9 +454,11 @@ End QcNotation. (** * Decidability *) (* ================================================================= *) -(** ** The [Dec] Typeclass *) -(** Decidability typeclass using ssreflect's 'decidable'. *) -(** +(** ** The [Dec] Typeclass + + Decidability typeclass using ssreflect's 'decidable'. + + Class Dec (P : Prop) : Type := { dec : decidable P }. *) @@ -486,8 +492,8 @@ Declare Instance Eq__Dec {A} `{H : Dec_Eq A} (x y : A) : Dec (x = y). (** Since deciding equalities is a very common requirement in testing, QuickChick provides a tactic that can define instances of the form [Dec (x = y)]. -*) -(** + + Ltac dec_eq. *) @@ -556,14 +562,16 @@ Declare Instance Dec_string (m n : string) : Dec (m = n). instances. *) (** The [Sample] command samples a generator. The argument [g] needs - to have type [G A] for some showable type [A]. *) -(** + to have type [G A] for some showable type [A]. + + Sample g. *) (** The main testing command, [QuickChick], runs a test. The argument - [prop] must belong to a type that is an instance of [Checkable]. *) -(** + [prop] must belong to a type that is an instance of [Checkable]. + + QuickChick prop. *) @@ -591,8 +599,9 @@ Record Args := chatty : bool }. -(** Instead of record updates, you should overwrite extraction constants. *) -(** +(** Instead of record updates, you should overwrite extraction constants. + + Extract Constant defNumTests => "10000". Extract Constant defNumDiscards => "(2 * defNumTests)". Extract Constant defNumShrinks => "1000". @@ -682,7 +691,6 @@ Record Args := - [-exclude ]: Specify files to be excluded from compilation. Must be the last argument passed. *) - (* ################################################################# *) (** * Deprecated Features *) @@ -704,3 +712,5 @@ Module QcDoNotation. End QcDoNotation. End QuickChickSig. + +(* Sat Jan 26 15:19:30 UTC 2019 *) diff --git a/qc-current/QuickChickTool.html b/qc-current/QuickChickTool.html index bf254c55..0db58863 100644 --- a/qc-current/QuickChickTool.html +++ b/qc-current/QuickChickTool.html @@ -752,6 +752,9 @@

    QuickChickToolThe QuickChick Command For more information on the tool's flags, look at the reference manual in QuickChickInterface. +

    +
    +(* Sat Jan 26 15:19:30 UTC 2019 *)

    diff --git a/qc-current/QuickChickTool.v b/qc-current/QuickChickTool.v index 5cd894fe..da3c5f5c 100644 --- a/qc-current/QuickChickTool.v +++ b/qc-current/QuickChickTool.v @@ -109,7 +109,6 @@ Set Bullet Behavior "Strict Subproofs". definitions and properties. After some [Import]s at the top, the [Exp] module begins with a _section declaration_: - (*! Section arithmetic_expressions *) @@ -169,8 +168,6 @@ Definition optimize_correct_prop (e : exp) := eval (optimize e) = eval e?. (** (*! QuickChick optimize_correct_prop. *) -*) -(** QuickChecking optimize_correct_prop +++ Passed 10000 tests (0 discards) @@ -249,7 +246,6 @@ Definition optimize_correct_prop (e : exp) := eval (optimize e) = eval e?. quickChick -color -top Stack -s optimizations - Testing base... make -f Makefile.coq make[1]: Entering directory '/home/lemonidas/sfdev/qc/_qc_stack-compiler.tmp' @@ -262,7 +258,6 @@ Definition optimize_correct_prop (e : exp) := eval (optimize e) = eval e?. +++ Passed 10000 tests (0 discards) ... etc ... - In addition to the standard arguments ([-color], [-top Stack]) we also specified that we only care about the [optimizations] section with the [-s] flag. Therefore this time, when testing the base @@ -329,7 +324,6 @@ Definition optimize_correct_prop (e : exp) := eval (optimize e) = eval e?. quickChick -color -top Stack -s optimizations - Testing mutant 0 (./Exp.v: line 35): Minus-Reverse make -f Makefile.coq make[1]: Entering directory '/home/lemonidas/sfdev/qc/_qc_stack-compiler.tmp' @@ -355,7 +349,6 @@ Definition optimize_correct_prop (e : exp) := eval (optimize e) = eval e?. *** Failed after 5 tests and 3 shrinks. (0 discards) All tests produced the expected results - After running all the tests for [base] (the unmutated artifact), the [quickChick] tool proceeds to run the single test in the [optimizations] section for each of the mutants it finds. Since the [optimizations] section @@ -435,12 +428,10 @@ Definition compiles_correctly (e : exp) := (execute [] (compile e)) = [eval e]?. AMinus (ANum 0) (ANum 1) *** Failed after 3 tests and 2 shrinks. (0 discards) - The problem is that subtraction is not associative and we have compiled the two operands in the wrong order! We can now log that mutant in our development as shown in the [Stack] module. - Fixpoint compile (e : exp) : list sinstr := match e with | ANum n => [SPush n] @@ -462,7 +453,6 @@ Definition compiles_correctly (e : exp) := (execute [] (compile e)) = [eval e]?. quickChick -color -top Stack -s stack - Testing base... make -f Makefile.coq make[1]: Entering directory '/home/lemonidas/sfdev/qc/_qc_stack-compiler.tmp' @@ -507,4 +497,5 @@ Definition compiles_correctly (e : exp) := (execute [] (compile e)) = [eval e]?. (** For more information on the tool's flags, look at the reference manual in [QuickChickInterface]. -*) \ No newline at end of file +*) +(* Sat Jan 26 15:19:30 UTC 2019 *) diff --git a/qc-current/TImp.html b/qc-current/TImp.html index 0e3f8a30..c65d202a 100644 --- a/qc-current/TImp.html +++ b/qc-current/TImp.html @@ -155,7 +155,7 @@

    TImpCase Study: a Typed Imperative L

    -

    练习:2 星 (genId)

    +

    练习:2 星, standard (genId)

    Write a Gen instance for id using the elems_ combinator and get_fresh_ids.
    @@ -331,7 +331,7 @@

    TImpCase Study: a Typed Imperative L
    Inductive bound_to {A} : Map AidAProp :=
    -  | Bind : x m a, map_get m x = Some abound_to m x a.
    +  | Bind : x m a, map_get m x = Some abound_to m x a.
    @@ -348,7 +348,7 @@

    TImpCase Study: a Typed Imperative L
    Instance dec_bound_to {A : Type} Gamma x (T : A)
    -         `{D : (x y : A), Dec (x = y)}
    +         `{D : (x y : A), Dec (x = y)}
              : Dec (bound_to Gamma x T).
    Proof.
      constructor. unfold ssrbool.decidable.
    @@ -431,7 +431,7 @@

    TImpCase Study: a Typed Imperative L
    Instance dec_bound_to {A : Type} Gamma x (T : A)
    -         `{D : (x y : A), Dec (x = y)}
    +         `{D : (x y : A), Dec (x = y)}
      : Dec (bound_to Gamma x T).
    @@ -547,36 +547,36 @@

    TImpCase Study: a Typed Imperative L

    -Reserved Notation "Gamma '||-' e '\IN' T" (at level 40).

    +Reserved Notation "Gamma '|⊢' e '\IN' T" (at level 40).

    Inductive has_type : contextexptyProp :=
    -| Ty_Var : x T Gamma,
    -    bound_to Gamma x TGamma ||- EVar x \IN T
    -| Ty_Num : Gamma n,
    -    Gamma ||- ENum n \IN TNat
    -| Ty_Plus : Gamma e1 e2,
    -    Gamma ||- e1 \IN TNatGamma ||- e2 \IN TNat
    -    Gamma ||- EPlus e1 e2 \IN TNat
    -| Ty_Minus : Gamma e1 e2,
    -    Gamma ||- e1 \IN TNatGamma ||- e2 \IN TNat
    -    Gamma ||- EMinus e1 e2 \IN TNat
    -| Ty_Mult : Gamma e1 e2,
    -    Gamma ||- e1 \IN TNatGamma ||- e2 \IN TNat
    -    Gamma ||- EMult e1 e2 \IN TNat
    -| Ty_True : Gamma, Gamma ||- ETrue \IN TBool
    -| Ty_False : Gamma, Gamma ||- EFalse \IN TBool
    -| Ty_Eq : Gamma e1 e2,
    -    Gamma ||- e1 \IN TNatGamma ||- e2 \IN TNat
    -    Gamma ||- EEq e1 e2 \IN TBool
    -| Ty_Le : Gamma e1 e2,
    -    Gamma ||- e1 \IN TNatGamma ||- e2 \IN TNat
    -    Gamma ||- ELe e1 e2 \IN TBool
    -| Ty_Not : Gamma e,
    -    Gamma ||- e \IN TBoolGamma ||- ENot e \IN TBool
    -| Ty_And : Gamma e1 e2,
    -    Gamma ||- e1 \IN TBoolGamma ||- e2 \IN TBool
    -    Gamma ||- EAnd e1 e2 \IN TBool
    +| Ty_Var : x T Gamma,
    +    bound_to Gamma x TGamma |⊢ EVar x \IN T
    +| Ty_Num : Gamma n,
    +    Gamma |⊢ ENum n \IN TNat
    +| Ty_Plus : Gamma e1 e2,
    +    Gamma |⊢ e1 \IN TNatGamma |⊢ e2 \IN TNat
    +    Gamma |⊢ EPlus e1 e2 \IN TNat
    +| Ty_Minus : Gamma e1 e2,
    +    Gamma |⊢ e1 \IN TNatGamma |⊢ e2 \IN TNat
    +    Gamma |⊢ EMinus e1 e2 \IN TNat
    +| Ty_Mult : Gamma e1 e2,
    +    Gamma |⊢ e1 \IN TNatGamma |⊢ e2 \IN TNat
    +    Gamma |⊢ EMult e1 e2 \IN TNat
    +| Ty_True : Gamma, Gamma |⊢ ETrue \IN TBool
    +| Ty_False : Gamma, Gamma |⊢ EFalse \IN TBool
    +| Ty_Eq : Gamma e1 e2,
    +    Gamma |⊢ e1 \IN TNatGamma |⊢ e2 \IN TNat
    +    Gamma |⊢ EEq e1 e2 \IN TBool
    +| Ty_Le : Gamma e1 e2,
    +    Gamma |⊢ e1 \IN TNatGamma |⊢ e2 \IN TNat
    +    Gamma |⊢ ELe e1 e2 \IN TBool
    +| Ty_Not : Gamma e,
    +    Gamma |⊢ e \IN TBoolGamma |⊢ ENot e \IN TBool
    +| Ty_And : Gamma e1 e2,
    +    Gamma |⊢ e1 \IN TBoolGamma |⊢ e2 \IN TBool
    +    Gamma |⊢ EAnd e1 e2 \IN TBool

    -where "Gamma '||-' e '\IN' T" := (has_type Gamma e T).
    +where "Gamma '|⊢' e '\IN' T" := (has_type Gamma e T).
    @@ -600,8 +600,8 @@

    TImpCase Study: a Typed Imperative L
    -   IH :  (T : ty) (Gamma : context),
    -          ssrbool.decidable (Gamma ||- e1 \IN T) +   IH : (T : ty) (Gamma : context),
    +          ssrbool.decidable (Gamma |⊢ e1 \IN T)
    @@ -624,7 +624,7 @@

    TImpCase Study: a Typed Imperative L Ltac solve_inductives Gamma :=
      repeat (match goal with
    -      [ IH : _ _, _ |- _ ] ⇒
    +      [ IH : _ _, __ ] ⇒
          let H1 := fresh "H1" in
          pose proof (IH TNat Gamma) as H1;
          let H2 := fresh "H2" in
    @@ -641,7 +641,7 @@

    TImpCase Study: a Typed Imperative L
    Instance dec_has_type (e : exp) (Gamma : context) (T : ty)
    -  : Dec (Gamma ||- e \IN T).
    +  : Dec (Gamma |⊢ e \IN T).
    Proof with solve_sum.
    @@ -658,7 +658,7 @@

    TImpCase Study: a Typed Imperative L

    -

    练习:3 星 (arbitraryExp)

    +

    练习:3 星, standard (arbitraryExp)

    Derive Arbitrary for expressions. To see how good it is at generating _well-typed_ expressions, write a conditional property cond_prop that is (trivially) always true, with the precondition @@ -733,7 +733,7 @@

    TImpCase Study: a Typed Imperative L
         GOpt = fun A : Type => G (option A)
    -         : Type -> Type
    +         : Type -> Type
     
    @@ -765,7 +765,7 @@

    TImpCase Study: a Typed Imperative L
    Inductive has_type_1 : contextexptyProp :=
    -  | Ty_Var1 : x T Gamma,
    +  | Ty_Var1 : x T Gamma,
          bound_to Gamma x Thas_type_1 Gamma (EVar x) T.
    @@ -796,12 +796,12 @@

    TImpCase Study: a Typed Imperative L
    Inductive has_type_2 : contextexptyProp :=
    -| Ty_Var2 : x T Gamma,
    +| Ty_Var2 : x T Gamma,
        bound_to Gamma x Thas_type_2 Gamma (EVar x) T
    -| Ty_Num2 : Gamma n,
    +| Ty_Num2 : Gamma n,
        has_type_2 Gamma (ENum n) TNat
    -| Ty_True2 : Gamma, has_type_2 Gamma ETrue TBool
    -| Ty_False2 : Gamma, has_type_2 Gamma EFalse TBool.
    +| Ty_True2 : Gamma, has_type_2 Gamma ETrue TBool
    +| Ty_False2 : Gamma, has_type_2 Gamma EFalse TBool.
    @@ -866,9 +866,9 @@

    TImpCase Study: a Typed Imperative L
    Inductive has_type_3 : contextexptyProp :=
    - | Ty_Var3 : x T Gamma,
    + | Ty_Var3 : x T Gamma,
         bound_to Gamma x Thas_type_3 Gamma (EVar x) T
    - | Ty_Plus3 : Gamma e1 e2,
    + | Ty_Plus3 : Gamma e1 e2,
        has_type_3 Gamma e1 TNathas_type_3 Gamma e2 TNat
        has_type_3 Gamma (EPlus e1 e2) TNat.
    @@ -996,8 +996,8 @@

    TImpCase Study: a Typed Imperative L
    Inductive has_type_value : valuetyProp :=
    -  | TyVNat : n, has_type_value (VNat n) TNat
    -  | TyVBool : b, has_type_value (VBool b) TBool.

    +  | TyVNat : n, has_type_value (VNat n) TNat
    +  | TyVBool : b, has_type_value (VBool b) TBool.

    Instance dec_has_type_value v T : Dec (has_type_value v T).
    @@ -1043,7 +1043,7 @@

    TImpCase Study: a Typed Imperative L Inductive well_typed_state : contextstateProp :=
    | TS_Empty : well_typed_state map_empty map_empty
    -| TS_Elem : x v T st Gamma,
    +| TS_Elem : x v T st Gamma,
        has_type_value v Twell_typed_state Gamma st
        well_typed_state ((x,T)::Gamma) ((x,v)::st).

    Instance dec_well_typed_state Gamma st : Dec (well_typed_state Gamma st).
    @@ -1142,8 +1142,8 @@

    TImpCase Study: a Typed Imperative L   | Nonetrue
      | Some _false
      end.

    -Conjecture expression_soundness : Gamma st e T,
    -    well_typed_state Gamma stGamma ||- e \IN T
    +Conjecture expression_soundness : Gamma st e T,
    +    well_typed_state Gamma stGamma |⊢ e \IN T
        isNone (eval st e) = false.

    @@ -1479,7 +1479,7 @@

    TImpCase Study: a Typed Imperative L   (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'" :=
    +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" :=
      (CIf c1 c2 c3) (at level 80, right associativity).

    Derive Show for com.

    @@ -1499,20 +1499,20 @@

    TImpCase Study: a Typed Imperative L
    Inductive well_typed_com : contextcomProp :=
    -  | TSkip : Gamma, well_typed_com Gamma CSkip
    -  | TAss : Gamma x e T,
    +  | TSkip : Gamma, well_typed_com Gamma CSkip
    +  | TAss : Gamma x e T,
          bound_to Gamma x T
    -      Gamma ||- e \IN T
    +      Gamma |⊢ e \IN T
          well_typed_com Gamma (CAss x e)
    -  | TSeq : Gamma c1 c2,
    +  | TSeq : Gamma c1 c2,
          well_typed_com Gamma c1well_typed_com Gamma c2
          well_typed_com Gamma (CSeq c1 c2)
    -  | TIf : Gamma b c1 c2,
    -      Gamma ||- b \IN TBool
    +  | TIf : Gamma b c1 c2,
    +      Gamma |⊢ b \IN TBool
          well_typed_com Gamma c1well_typed_com Gamma c2
          well_typed_com Gamma (CIf b c1 c2)
    -  | TWhile : Gamma b c,
    -      Gamma ||- b \IN TBoolwell_typed_com Gamma c
    +  | TWhile : Gamma b c,
    +      Gamma |⊢ b \IN TBoolwell_typed_com Gamma c
          well_typed_com Gamma (CWhile b c).
    @@ -1555,10 +1555,10 @@

    TImpCase Study: a Typed Imperative L Ltac solve_det :=
      match goal with
      | [ H1 : bound_to _ _ ?T1 ,
    -      H2 : bound_to _ _ ?T2 |- _ ] ⇒
    +      H2 : bound_to _ _ ?T2_ ] ⇒
        assert (T1 = T2) by (eapply bind_deterministic; eauto)
      | [ H1 : has_type _ _ ?T1 ,
    -      H2 : has_type _ _ ?T2 |- _ ] ⇒
    +      H2 : has_type _ _ ?T2_ ] ⇒
        assert (T1 = T2) by (eapply bind_deterministic; eauto)
      end.

    @@ -1594,7 +1594,7 @@

    TImpCase Study: a Typed Imperative L

    -

    练习:4 星 (arbitrary_well_typed_com)

    +

    练习:4 星, standard (arbitrary_well_typed_com)

    Write a generator and a shrinker for well_typed programs given some context Gamma. Write some appropriate sanity checks and make sure they give expected results. @@ -1638,7 +1638,7 @@

    TImpCase Study: a Typed Imperative L         | Success st'ceval fuel' st' c2
            | _Fail
            end
    -    | IFB b THEN c1 ELSE c2 FI
    +    | TEST b THEN c1 ELSE c2 FI
          match eval st b with
          | Some (VBool b) ⇒
            ceval fuel' st (if b then c1 else c2)
    @@ -1667,13 +1667,13 @@

    TImpCase Study: a Typed Imperative L
    Conjecture well_typed_state_never_stuck :
    -   Gamma st, well_typed_state Gamma st
    -   c, well_typed_com Gamma c
    -   fuel, isFail (ceval fuel st c) = false.
    +  Gamma st, well_typed_state Gamma st
    +  c, well_typed_com Gamma c
    +  fuel, isFail (ceval fuel st c) = false.
    -

    练习:4 星 (well_typed_state_never_stuck)

    +

    练习:4 星, standard (well_typed_state_never_stuck)

    Write a checker for the above property, find any bugs, and fix them.
    @@ -1682,7 +1682,7 @@

    TImpCase Study: a Typed Imperative L

    -

    练习:4 星 (ty_eq_polymorphic)

    +

    练习:4 星, standard (ty_eq_polymorphic)

    In the has_type relation we allowed equality checks between only arithmetic expressions. Introduce an additional typing rule that allows for equality checks between booleans. @@ -1690,9 +1690,9 @@

    TImpCase Study: a Typed Imperative L
    -    | Ty_Eq :  Gamma e1 e2
    -        Gamma ||- e1 \IN TBool → Gamma ||- e2 \IN TBool →
    -        Gamma ||- EEq e1 e2 \IN TBool +    | Ty_Eq : Gamma e1 e2
    +        Gamma |⊢ e1 \IN TBool → Gamma |⊢ e2 \IN TBool →
    +        Gamma |⊢ EEq e1 e2 \IN TBool
    @@ -1729,8 +1729,8 @@

    TImpCase Study: a Typed Imperative L
      Inductive has_type_value : value → ty → Prop :=
    -    | TyVNat  :  nhas_type_value (VNat  nTNat
    -    | TyVBool :  bhas_type_value (VBool bTBool.
    +    | TyVNat  : nhas_type_value (VNat  nTNat
    +    | TyVBool : bhas_type_value (VBool bTBool.

      Definition gen_typed_value (T : ty) : G value :=
        match T with 
    @@ -1865,7 +1865,7 @@

    TImpCase Study: a Typed Imperative L
    Conjecture conditional_prop_example :
    -   (x y : nat), x = yx = y.

    +  (x y : nat), x = yx = y.

    (* QuickChick conditional_prop_example. *)
    @@ -1889,6 +1889,10 @@

    TImpCase Study: a Typed Imperative L The first version of this material was developed in collaboration with Nicolas Koh.

    +
    + +(* Sat Jan 26 15:19:30 UTC 2019 *)
    +

    diff --git a/qc-current/TImp.v b/qc-current/TImp.v index 63b1bab1..44484de1 100644 --- a/qc-current/TImp.v +++ b/qc-current/TImp.v @@ -11,7 +11,6 @@ Set Bullet Behavior "Strict Subproofs". From QC Require Import QC. - (** Having covered the basics of QuickChick in the previous chapter, we are ready to dive into a more realistic case study: a typed variant of Imp, the simple imperative language introduced in @@ -103,14 +102,14 @@ Fixpoint get_fresh_ids n l := | S n' => get_fresh_ids n' ((fresh l) :: l) end. -(** **** 练习:2 星 (genId) *) -(** Write a [Gen] instance for [id] using the [elems_] +(** **** 练习:2 星, standard (genId) + + Write a [Gen] instance for [id] using the [elems_] combinator and [get_fresh_ids]. *) (* 请在此处解答 *) (** [] *) - (** There remains the question of how to [shrink] [id]s. We will answer that question when [id]s are used later in the chapter. For now, let's leave the [Shrink] instance @@ -179,7 +178,6 @@ Proof. dec_eq. Defined. - [set] : To update the binding of an element. - [dom] : To get the list of keys in the map. *) - (** The implementation of a map is a simple association list. If a @@ -231,7 +229,6 @@ Inductive bound_to {A} : Map A -> id -> A -> Prop := [Context] subsection), which deal with partially automating the proofs for such instances. *) - Instance dec_bound_to {A : Type} Gamma x (T : A) `{D : forall (x y : A), Dec (x = y)} : Dec (bound_to Gamma x T). @@ -406,7 +403,6 @@ where "Gamma '||-' e '\IN' T" := (has_type Gamma e T). have allowed for equality checks between booleans as well - that will become an exercise at the end of this chapter. *) - (** Once again, we need a decidable instance for the typing relation of TImp. You can skip to the next exercise if you are not interested in specific proof details. *) @@ -455,8 +451,9 @@ Proof with solve_sum. destruct (dec_bound_to Gamma i T); destruct dec; solve_sum. Defined. -(** **** 练习:3 星 (arbitraryExp) *) -(** Derive [Arbitrary] for expressions. To see how good it is at +(** **** 练习:3 星, standard (arbitraryExp) + + Derive [Arbitrary] for expressions. To see how good it is at generating _well-typed_ expressions, write a conditional property [cond_prop] that is (trivially) always true, with the precondition that some expression is well-typed. Try to check that property like @@ -470,8 +467,9 @@ Defined. increase the size until the maximum size is reached, and then start over. What happens when you vary the size bound? *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** Generating Typed Expressions *) @@ -509,8 +507,9 @@ Print GOpt. : Type -> Type *) -(* Check Monad_GOpt. *) -(** +(* Check Monad_GOpt. + + Monad_GOpt : Monad GOpt *) @@ -846,8 +845,9 @@ Definition expression_soundness_exec := | _ => true end)))). -(* QuickChick expression_soundness_exec. *) -(** +(* QuickChick expression_soundness_exec. + + ===> QuickChecking expression_soundness_exec @@ -856,8 +856,8 @@ Definition expression_soundness_exec := TBool Some EAnd (EAnd (EEq (EVar 4) (EVar 1)) (EEq (ENum 0) (EVar 4))) EFalse *** Failed after 8 tests and 0 shrinks. (0 discards) -*) -(** Where is the bug?? Looks like we need some shrinking! *) + + Where is the bug?? Looks like we need some shrinking! *) (* ================================================================= *) (** ** Shrinking for Expressions *) @@ -879,8 +879,9 @@ Definition expression_soundness_exec_firstshrink := | _ => true end)))). -(* QuickChick expression_soundness_exec_firstshrink. *) -(** +(* QuickChick expression_soundness_exec_firstshrink. + + << ===> QuickChecking expression_soundness_exec_firsttry @@ -1025,8 +1026,9 @@ Definition shrink_typed_has_type := (* QuickChick shrink_typed_has_type. *) (* ================================================================= *) -(** ** Back to Soundness *) -(** To lift the shrinker to optional expressions, QuickChick provides +(** ** Back to Soundness + + To lift the shrinker to optional expressions, QuickChick provides the following function. *) Definition lift_shrink {A} @@ -1054,8 +1056,9 @@ Definition expression_soundness_exec' := | _ => true end)))). -(* QuickChick expression_soundness_exec'. *) -(** +(* QuickChick expression_soundness_exec'. + + ===> QuickChecking expression_soundness_exec' @@ -1087,7 +1090,7 @@ 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'" := +Notation "'TEST' c1 'THEN' c2 'ELSE' c3 'FI'" := (CIf c1 c2 c3) (at level 80, right associativity). Derive Show for com. @@ -1176,13 +1179,15 @@ Proof with eauto. destruct (dec_has_type e Gamma TBool); destruct dec; solve_sum. Qed. -(** **** 练习:4 星 (arbitrary_well_typed_com) *) -(** Write a generator and a shrinker for well_typed programs given +(** **** 练习:4 星, standard (arbitrary_well_typed_com) + + Write a generator and a shrinker for well_typed programs given some context [Gamma]. Write some appropriate sanity checks and make sure they give expected results. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (** To complete the tour of testing for TImp, here is a (buggy??) evaluation function for commands given a state. To ensure @@ -1213,7 +1218,7 @@ Fixpoint ceval (fuel : nat) (st : state) (c : com) : result := | Success st' => ceval fuel' st' c2 | _ => Fail end - | IFB b THEN c1 ELSE c2 FI => + | TEST b THEN c1 ELSE c2 FI => match eval st b with | Some (VBool b) => ceval fuel' st (if b then c1 else c2) @@ -1243,13 +1248,15 @@ Conjecture well_typed_state_never_stuck : forall c, well_typed_com Gamma c -> forall fuel, isFail (ceval fuel st c) = false. -(** **** 练习:4 星 (well_typed_state_never_stuck) *) -(** Write a checker for the above property, find any bugs, and fix them. *) +(** **** 练习:4 星, standard (well_typed_state_never_stuck) + + Write a checker for the above property, find any bugs, and fix them. *) (* 请在此处解答 *) -(** **** 练习:4 星 (ty_eq_polymorphic) *) -(** In the [has_type] relation we allowed equality checks between +(** **** 练习:4 星, standard (ty_eq_polymorphic) + + In the [has_type] relation we allowed equality checks between only arithmetic expressions. Introduce an additional typing rule that allows for equality checks between booleans. @@ -1381,8 +1388,9 @@ End GenSTPlayground. Conjecture conditional_prop_example : forall (x y : nat), x = y -> x = y. -(* QuickChick conditional_prop_example. *) -(** +(* QuickChick conditional_prop_example. + + ==> QuickChecking conditional_prop_example +++ Passed 10000 tests (0 discards) @@ -1396,3 +1404,5 @@ Conjecture conditional_prop_example : (** The first version of this material was developed in collaboration with Nicolas Koh. *) + +(* Sat Jan 26 15:19:30 UTC 2019 *) diff --git a/qc-current/Typeclasses.html b/qc-current/Typeclasses.html index a3216df8..0de8de25 100644 --- a/qc-current/Typeclasses.html +++ b/qc-current/Typeclasses.html @@ -225,7 +225,7 @@

    TypeclassesA Tutorial on Typeclasses

    -

    练习:1 星 (showNatBool)

    +

    练习:1 星, standard (showNatBool)

    Write a Show instance for pairs of a nat and a bool.
    @@ -280,7 +280,7 @@

    TypeclassesA Tutorial on Typeclasses show functions (for A or B) gets invoked.
    -

    练习:1 星 (missingConstraint)

    +

    练习:1 星, standard (missingConstraint)

    What happens if we forget the class constraints in the definitions of showOne or showTwo? Try deleting them and see what happens. @@ -337,7 +337,7 @@

    TypeclassesA Tutorial on Typeclasses undecidable.
    -

    练习:3 星, optional (boolArrowBool)

    +

    练习:3 星, standard, optional (boolArrowBool)

    There are some function types, like boolbool, for which checking equality makes perfect sense. Write an Eq instance for this type. @@ -404,7 +404,7 @@

    TypeclassesA Tutorial on Typeclasses

    -

    练习:3 星 (eqEx)

    +

    练习:3 星, standard (eqEx)

    Write an Eq instance for lists and Show and Eq instances for the option type constructor.
    @@ -417,7 +417,7 @@

    TypeclassesA Tutorial on Typeclasses
    -

    练习:3 星, optional (boolArrowA)

    +

    练习:3 星, standard, optional (boolArrowA)

    Generalize your solution to the boolArrowBool exercise to build an equality instance for any type of the form boolA, where A itself is an Eq type. Show that it works for boolboolnat. @@ -505,12 +505,12 @@

    TypeclassesA Tutorial on Typeclasses

    -

    练习:1 星 (missingConstraintAgain)

    +

    练习:1 星, standard (missingConstraintAgain)

    What does Coq say if the Ord class constraint is left out of the definition of max? What about the Eq class constraint?
    -

    练习:3 星 (ordMisc)

    +

    练习:3 星, standard (ordMisc)

    Define Ord instances for options and pairs.
    @@ -522,7 +522,7 @@

    TypeclassesA Tutorial on Typeclasses
    -

    练习:3 星 (ordList)

    +

    练习:3 星, standard (ordList)

    For a little more practice, define an Ord instance for lists.
    @@ -602,7 +602,7 @@

    TypeclassesA Tutorial on Typeclasses (* ==>
        showOne1 = 
          fun (A : Type) (H : Show A) (a : A) => "The value is " ++ show a
    -           : forall A : Type, Show A -> A -> string
    +           : forall A : Type, Show A -> A -> string

        Arguments A, H are implicit and maximally inserted
    *)

    @@ -677,7 +677,7 @@

    TypeclassesA Tutorial on Typeclasses     showOne = 
            fun (A : Type) (H : Show A) (a : A) => 
              "The value is " ++ @show A H a
    -      : forall A : Type, Show A -> A -> string
    +      : forall A : Type, Show A -> A -> string
    *)

    Unset Printing Implicit.

    @@ -715,10 +715,10 @@

    TypeclassesA Tutorial on Typeclasses          if @le A H H0 x y then y else x

       : forall (A : Type) (H : Eq A), 
    -       @Ord A H -> A -> A -> A    
    +       @Ord A H -> A -> A -> A    
    *)


    Check Ord.
    -(* ==> Ord : forall A : Type, Eq A -> Type *)

    +(* ==> Ord : forall A : Type, Eq A -> Type *)

    Unset Printing Implicit.

    @@ -879,7 +879,7 @@

    TypeclassesA Tutorial on Typeclasses

    -

    练习:1 星 (rcdParens)

    +

    练习:1 星, standard (rcdParens)

    Note that the A parameter in the definition of LabeledPoint is bound with parens, not curly braces. Why is this a better choice?
    @@ -905,7 +905,7 @@

    TypeclassesA Tutorial on Typeclasses (* ==> 
        Record Show (A : Type) : Type := 
          Build_Show
    -        { show : A -> string } 
    +        { show : A -> string } 
    *)

    Unset Printing All.

    @@ -951,7 +951,7 @@

    TypeclassesA Tutorial on Typeclasses         match Show0 with
              | Build_Show _ show => show
            end
    -   : forall (A : Type), Show A -> A -> string 
    +   : forall (A : Type), Show A -> A -> string 

       Arguments A, Show are implicit and maximally inserted  *)

    Unset Printing All.
    @@ -996,7 +996,7 @@

    TypeclassesA Tutorial on Typeclasses refers to a "hint database" called typeclass_instances.
    -

    练习:1 星 (HintDb)

    +

    练习:1 星, standard (HintDb)

    Uncomment and execute the following command. Search for "For Show" in the output and have a look at the entries for showNat and showPair. @@ -1105,7 +1105,7 @@

    TypeclassesA Tutorial on Typeclasses Class EqDec (A : Type) {H : Eq A} :=
      {
    -    eqb_eq : x y, x =? y = truex = y
    +    eqb_eq : x y, x =? y = truex = y
      }.

    @@ -1162,7 +1162,7 @@

    TypeclassesA Tutorial on Typeclasses

    -Lemma eqb_fact `{EqDec A} : (x y z : A),
    +Lemma eqb_fact `{EqDec A} : (x y z : A),
      x =? y = truey =? z = truex = z.
    Proof.
      intros x y z Exy Eyz.
    @@ -1187,17 +1187,17 @@

    TypeclassesA Tutorial on Typeclasses

    -Require Import Coq.Relations.Relation_Definitions.

    +From Coq Require Import Relations.Relation_Definitions.

    Class Reflexive (A : Type) (R : relation A) :=
      {
    -    reflexivity : x, R x x
    +    reflexivity : x, R x x
      }.

    Class Transitive (A : Type) (R : relation A) :=
      {
    -    transitivity : x y z, R x yR y zR x z
    +    transitivity : x y z, R x yR y zR x z
      }.

    Generalizable Variables z w R.

    -Lemma trans3 : `{Transitive A R},
    +Lemma trans3 : `{Transitive A R},
        `{R x yR y zR z wR x w}.
    Proof.
      intros.
    @@ -1215,7 +1215,7 @@

    TypeclassesA Tutorial on Typeclasses

    -Lemma trans3_pre : `{PreOrder A R},
    +Lemma trans3_pre : `{PreOrder A R},
        `{R x yR y zR z wR x w}.
    Proof. intros. eapply trans3; eassumption. Defined.
    @@ -1292,7 +1292,7 @@

    TypeclassesA Tutorial on Typeclasses

    -

    练习:3 星 (dec_neg_disj)

    +

    练习:3 星, standard (dec_neg_disj)

    Give instance declarations showing that, if P and Q are decidable propositions, then so are ¬P and PQ.
    @@ -1305,7 +1305,7 @@

    TypeclassesA Tutorial on Typeclasses
    -

    练习:4 星 (Dec_All)

    +

    练习:4 星, standard (Dec_All)

    The following function converts a list into a proposition claiming that every element of that list satiesfies some proposition P: @@ -1453,8 +1453,8 @@

    TypeclassesA Tutorial on Typeclasses
        Class Monad (M : Type → Type) : Type :=
           { 
    -         ret :  {T : Type}, T → M T ;
    -         bind :  {T U : Type}, M T → (T → M U) → M U
    +         ret : {T : Type}, T → M T ;
    +         bind : {T U : Type}, M T → (T → M U) → M U
           }.
    @@ -1647,7 +1647,7 @@

    TypeclassesA Tutorial on Typeclasses Check @eqb.
    (* ==>
    -     @eqb : forall A : Type, Eq A -> A -> A -> bool    *)

    +     @eqb : forall A : Type, Eq A -> A -> A -> bool    *)

    @@ -1672,7 +1672,7 @@

    TypeclassesA Tutorial on Typeclasses (* ==>
         The command has indeed failed with message:
         The term "true" has type "bool" while it is expected 
    -       to have type "bool -> bool". *)

    +       to have type "bool -> bool". *)

    @@ -1700,7 +1700,7 @@

    TypeclassesA Tutorial on Typeclasses
  • The type calculated for foo was therefore - (boolbool)->(boolbool)→bool. + (boolbool)->(boolbool)→bool.
  • @@ -1711,7 +1711,7 @@

    TypeclassesA Tutorial on Typeclasses are posed to the instance search engine.
    -

    练习:1 星 (debugDefaulting)

    +

    练习:1 星, standard (debugDefaulting)

    Do Set Typeclasses Debug and verify that this is what happened.
    @@ -1924,9 +1924,9 @@

    TypeclassesA Tutorial on Typeclasses      The command has indeed failed with message:
         Unable to satisfy the following constraints:
         UNDEFINED EVARS:
    -      ?X354==A |- Type (type of Ord) {?T}
    -      ?X357==A0 Ord A x y |- Eq A (parameter H of @le) {?H}
    -      ?X358==A0 Ord A x y |- Ord A (parameter Ord of @le) {?Ord}  *)

    +      ?X354==A Type (type of Ord) {?T}
    +      ?X357==A0 Ord A x y Eq A (parameter H of @le) {?H}
    +      ?X358==A0 Ord A x y Ord A (parameter Ord of @le) {?Ord}  *)

    @@ -2024,7 +2024,7 @@

    TypeclassesA Tutorial on Typeclasses

    -

    练习:1 星 (nonterm)

    +

    练习:1 星, standard (nonterm)

    Why, exactly, did the search diverge? Enable typeclass debugging, uncomment the above Definition, and see what gets printed. (You may want to do this from the command line rather than from inside @@ -2210,7 +2210,7 @@

    TypeclassesA Tutorial on Typeclasses

    In Haskell this gives an error stating that no Functor is available. In Coq, it type checks using the highest priority - C --> D functor instance in scope. I typically discover that + C --> D functor instance in scope. I typically discover that this has happened when I try to use foo and find the Functor to be too specific, or by turning on Printing All and looking at the definition of `foo`. However, there are times when `foo` is deep @@ -2221,7 +2221,7 @@

    TypeclassesA Tutorial on Typeclasses The other way to solve this is to manually ensure there are no Instance definitions that might overlap, such as a generic - Instance for C --> D, but only instances from specific + Instance for C --> D, but only instances from specific categories to specific categories (though again, I might define several functors of that same type). It would be nice if I could make this situation into an error. @@ -2464,6 +2464,10 @@

    TypeclassesA Tutorial on Typeclasses +

    +
    + +(* Sat Jan 26 15:19:29 UTC 2019 *)

    diff --git a/qc-current/Typeclasses.v b/qc-current/Typeclasses.v index 00a52afa..290fae64 100644 --- a/qc-current/Typeclasses.v +++ b/qc-current/Typeclasses.v @@ -1,8 +1,8 @@ (** * Typeclasses: A Tutorial on Typeclasses in Coq *) -Require Import Coq.Bool.Bool. -Require Import Coq.Strings.String. -Require Import Coq.Arith.Arith. +From Coq Require Import Bool.Bool. +From Coq Require Import Strings.String. +From Coq Require Import Arith.Arith. Require Import Omega. Require Import List. Import ListNotations. Local Open Scope string. @@ -147,11 +147,13 @@ Instance showNat : Show nat := Compute (show 42). -(** **** 练习:1 星 (showNatBool) *) -(** Write a [Show] instance for pairs of a nat and a bool. *) +(** **** 练习:1 星, standard (showNatBool) -(* 请在此处解答 *) -(** [] *) + Write a [Show] instance for pairs of a nat and a bool. *) + +(* 请在此处解答 + + [] *) (** Next, we can define functions that use the overloaded function [show] like this: *) @@ -186,11 +188,13 @@ Compute (showTwo Red Green). instance of [show] determines which of the implicitly supplied show functions (for [A] or [B]) gets invoked. *) -(** **** 练习:1 星 (missingConstraint) *) -(** What happens if we forget the class constraints in the definitions +(** **** 练习:1 星, standard (missingConstraint) + + What happens if we forget the class constraints in the definitions of [showOne] or [showTwo]? Try deleting them and see what - happens. *) -(** [] *) + happens. + + [] *) (** Of course, [Show] is not the only interesting typeclass. There are many other situations where it is useful to be able to @@ -235,13 +239,15 @@ Instance eqNat : Eq nat := types. In particular, equality at types like [nat->nat] is undecidable. *) -(** **** 练习:3 星, optional (boolArrowBool) *) -(** There are some function types, like [bool->bool], for which +(** **** 练习:3 星, standard, optional (boolArrowBool) + + There are some function types, like [bool->bool], for which checking equality makes perfect sense. Write an [Eq] instance for this type. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** Parameterized Instances: New Typeclasses from Old *) @@ -285,20 +291,24 @@ Instance showList {A : Type} `{Show A} : Show (list A) := show l := append "[" (append (showListAux show l) "]") }. -(** **** 练习:3 星 (eqEx) *) -(** Write an [Eq] instance for lists and [Show] and [Eq] instances for +(** **** 练习:3 星, standard (eqEx) + + Write an [Eq] instance for lists and [Show] and [Eq] instances for the [option] type constructor. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) -(** **** 练习:3 星, optional (boolArrowA) *) -(** Generalize your solution to the [boolArrowBool] exercise to build +(** **** 练习:3 星, standard, optional (boolArrowA) + + Generalize your solution to the [boolArrowBool] exercise to build an equality instance for any type of the form [bool->A], where [A] itself is an [Eq] type. Show that it works for [bool->bool->nat]. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (* ================================================================= *) (** ** Class Hierarchies *) @@ -353,22 +363,28 @@ Instance natOrd : Ord nat := Definition max {A: Type} `{Eq A} `{Ord A} (x y : A) : A := if le x y then y else x. -(** **** 练习:1 星 (missingConstraintAgain) *) -(** What does Coq say if the [Ord] class constraint is left out of the - definition of [max]? What about the [Eq] class constraint? *) -(** [] *) +(** **** 练习:1 星, standard (missingConstraintAgain) + + What does Coq say if the [Ord] class constraint is left out of the + definition of [max]? What about the [Eq] class constraint? + + [] *) + +(** **** 练习:3 星, standard (ordMisc) -(** **** 练习:3 星 (ordMisc) *) -(** Define [Ord] instances for options and pairs. *) + Define [Ord] instances for options and pairs. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 -(** **** 练习:3 星 (ordList) *) -(** For a little more practice, define an [Ord] instance for lists. *) + [] *) -(* 请在此处解答 *) -(** [] *) +(** **** 练习:3 星, standard (ordList) + + For a little more practice, define an [Ord] instance for lists. *) + +(* 请在此处解答 + + [] *) (* ################################################################# *) (** * How It Works *) @@ -621,10 +637,12 @@ Check {| lx:=2; ly:=4; label:="hello" |}. : LabeledPoint string *) -(** **** 练习:1 星 (rcdParens) *) -(** Note that the [A] parameter in the definition of [LabeledPoint] is - bound with parens, not curly braces. Why is this a better choice? *) -(** [] *) +(** **** 练习:1 星, standard (rcdParens) + + Note that the [A] parameter in the definition of [LabeledPoint] is + bound with parens, not curly braces. Why is this a better choice? + + [] *) (* ================================================================= *) (** ** Typeclasses are Records *) @@ -711,13 +729,15 @@ Unset Printing Implicit. value using a variant of the [eauto] proof search procedure that refers to a "hint database" called [typeclass_instances]. *) -(** **** 练习:1 星 (HintDb) *) -(** Uncomment and execute the following command. Search for "For +(** **** 练习:1 星, standard (HintDb) + + Uncomment and execute the following command. Search for "For Show" in the output and have a look at the entries for [showNat] and [showPair]. *) -(* Print HintDb typeclass_instances. *) -(** [] *) +(* Print HintDb typeclass_instances. + + [] *) (** We can see what's happening during the instance inference process if we issue the [Set Typeclasses Debug] command. *) @@ -768,7 +788,6 @@ Unset Typeclasses Debug. @show nat showNat 42 *) - (* ################################################################# *) (** * Typeclasses and Proofs *) @@ -852,7 +871,7 @@ Proof. members of other typeclasses: these are called _substructures_. Here is an example adapted from the Coq Reference Manual. *) -Require Import Coq.Relations.Relation_Definitions. +From Coq Require Import Relations.Relation_Definitions. Class Reflexive (A : Type) (R : relation A) := { @@ -938,15 +957,18 @@ Proof. right; intro; destruct H; contradiction. Defined. -(** **** 练习:3 星 (dec_neg_disj) *) -(** Give instance declarations showing that, if [P] and [Q] are +(** **** 练习:3 星, standard (dec_neg_disj) + + Give instance declarations showing that, if [P] and [Q] are decidable propositions, then so are [~P] and [P\/Q]. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 -(** **** 练习:4 星 (Dec_All) *) -(** The following function converts a list into a proposition claiming + [] *) + +(** **** 练习:4 星, standard (Dec_All) + + The following function converts a list into a proposition claiming that every element of that list satiesfies some proposition [P]: *) @@ -959,8 +981,9 @@ Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop := (** Create an instance of [Dec] for [All P l], given that [P a] is decidable for every [a]. *) -(* 请在此处解答 *) -(** [] *) +(* 请在此处解答 + + [] *) (** One reason for doing all this is that it makes it easy to move back and forth between the boolean and propositional worlds, @@ -1039,10 +1062,11 @@ Open Scope monad_scope. ret : forall {T : Type}, T -> M T ; bind : forall {T U : Type}, M T -> (T -> M U) -> M U }. -*) -(** That is, a type family [M] is an instance of the [Monad] class if - we can define functions [ret] and [bind] of the appropriate types. *) -(** (If you [Print] the actual definition, you'll see something more + + That is, a type family [M] is an instance of the [Monad] class if + we can define functions [ret] and [bind] of the appropriate types. + + (If you [Print] the actual definition, you'll see something more complicated, involving [Polymorphic Record bla bla]... The [Polymorphic] part refers to Coq's "universe polymorphism," which does not concern us here.) *) @@ -1146,7 +1170,6 @@ Definition sum3opt' (n1 n2 : option nat) := repository (https://github.com/coq-ext-lib/coq-ext-lib) includes some further examples of using monads in Coq. *) - (* ================================================================= *) (** ** Others *) @@ -1163,7 +1186,6 @@ Definition sum3opt' (n1 n2 : option nat) := Weegen. https://arxiv.org/pdf/1102.1323.pdf *) - (* ################################################################# *) (** * Controlling Instantiation *) @@ -1209,9 +1231,11 @@ Fail Check (foo true). The lesson is that it matters a great deal _exactly_ what problems are posed to the instance search engine. *) -(** **** 练习:1 星 (debugDefaulting) *) -(** Do [Set Typeclasses Debug] and verify that this is what happened. *) -(** [] *) +(** **** 练习:1 星, standard (debugDefaulting) + + Do [Set Typeclasses Debug] and verify that this is what happened. + + [] *) (* ================================================================= *) (** ** Manipulating the Hint Database *) @@ -1317,7 +1341,6 @@ Compute (show (Baz 42)). = "Baz: 42" : string *) - (* ################################################################# *) (** * Debugging *) @@ -1447,8 +1470,9 @@ Compute e3. Definition e4 : list nat := mymap false. *) -(** **** 练习:1 星 (nonterm) *) -(** Why, exactly, did the search diverge? Enable typeclass debugging, +(** **** 练习:1 星, standard (nonterm) + + Why, exactly, did the search diverge? Enable typeclass debugging, uncomment the above [Definition], and see what gets printed. (You may want to do this from the command line rather than from inside an IDE, to make it easier to kill.) *) @@ -1719,7 +1743,6 @@ Definition e4 : list nat := mymap false. items of the interface they actually use, and not on a big bundle. *) - (* ################################################################# *) (** * Further Reading *) @@ -1748,3 +1771,4 @@ Definition e4 : list nat := mymap false. http://learnyouahaskell.com/making-our-own-types-and-typeclasses *) +(* Sat Jan 26 15:19:29 UTC 2019 *) diff --git a/qc-current/common/css/sf.css b/qc-current/common/css/sf.css index be9fcb10..12d4abc1 100644 --- a/qc-current/common/css/sf.css +++ b/qc-current/common/css/sf.css @@ -489,6 +489,9 @@ tr.infrulemiddle hr { color: rgb(0%,0%,0%); } +.nowrap { + white-space: nowrap; +} /* TOC */ diff --git a/qc-current/common/css/slides.css b/qc-current/common/css/slides.css index 0f1fc55a..b9d0327d 100644 --- a/qc-current/common/css/slides.css +++ b/qc-current/common/css/slides.css @@ -34,5 +34,7 @@ h1.libtitle { line-height: 34px; } - +body { + background: white; +} diff --git a/qc-current/coqindex.html b/qc-current/coqindex.html index 5b279a10..4942dac8 100644 --- a/qc-current/coqindex.html +++ b/qc-current/coqindex.html @@ -187,37 +187,6 @@ (36 entries) -Lemma Index -A -B -C -D -E -F -G -H -I -J -K -L -M -N -O -P -Q -R -S -T -U -V -W -X -Y -Z -_ -(6 entries) - - Constructor Index A B @@ -249,6 +218,37 @@ (84 entries) +Lemma Index +A +B +C +D +E +F +G +H +I +J +K +L +M +N +O +P +Q +R +S +T +U +V +W +X +Y +Z +_ +(6 entries) + + Projection Index A B @@ -444,12 +444,12 @@

    Global Index

    ANum [constructor, in QC.QuickChickTool]
    APlus [constructor, in QC.QuickChickTool]


    B

    -bar [inductive, in QC.Typeclasses]
    Bar [constructor, in QC.Typeclasses]
    +bar [inductive, in QC.Typeclasses]
    base [definition, in QC.TImp]
    base' [definition, in QC.TImp]
    -baz [inductive, in QC.Typeclasses]
    Baz [constructor, in QC.Typeclasses]
    +baz [inductive, in QC.Typeclasses]
    baz1 [instance, in QC.Typeclasses]
    baz2 [instance, in QC.Typeclasses]
    baz3 [instance, in QC.Typeclasses]
    @@ -458,8 +458,8 @@

    Global Index

    Bind [constructor, in QC.TImp]
    bindGenOpt [definition, in QC.TImp]
    bind_deterministic [lemma, in QC.TImp]
    -Blue [constructor, in QC.Typeclasses]
    Blue [constructor, in QC.QC]
    +Blue [constructor, in QC.Typeclasses]
    bound_to [inductive, in QC.TImp]
    Build_LabeledPoint [constructor, in QC.Typeclasses]
    Build_Point [constructor, in QC.Typeclasses]
    @@ -485,8 +485,8 @@

    Global Index

    CheckerPlayground4.Checkable [record, in QC.QC]
    CheckerPlayground4.checkableBool [instance, in QC.QC]
    CheckerPlayground4.checkableDec [instance, in QC.QC]
    -CheckerPlayground4.checker [projection, in QC.QC]
    CheckerPlayground4.Checker [definition, in QC.QC]
    +CheckerPlayground4.checker [projection, in QC.QC]
    CheckerPlayground4.Failure [constructor, in QC.QC]
    CheckerPlayground4.forAll [definition, in QC.QC]
    CheckerPlayground4.Result [inductive, in QC.QC]
    @@ -505,8 +505,8 @@

    Global Index

    CSkip [constructor, in QC.TImp]
    CWhile [constructor, in QC.TImp]


    D

    -dec [projection, in QC.Typeclasses]
    Dec [record, in QC.Typeclasses]
    +dec [projection, in QC.Typeclasses]
    dec_bound_to [instance, in QC.TImp]
    dec_bound_to [instance, in QC.TImp]
    Dec_conj [instance, in QC.Typeclasses]
    @@ -565,8 +565,8 @@

    Global Index

    EVar [constructor, in QC.TImp]
    every_color_is_red [axiom, in QC.QC]
    execute [definition, in QC.QuickChickTool]
    -exp [inductive, in QC.QuickChickTool]
    exp [inductive, in QC.TImp]
    +exp [inductive, in QC.QuickChickTool]
    expression_soundness [axiom, in QC.TImp]
    expression_soundness_exec [definition, in QC.TImp]
    expression_soundness_exec' [definition, in QC.TImp]
    @@ -623,8 +623,8 @@

    Global Index

    id [inductive, in QC.TImp]
    implicit_fun [definition, in QC.Typeclasses]
    implicit_fun1 [definition, in QC.Typeclasses]
    -insert [definition, in QC.Introduction]
    insert [definition, in QC.QC]
    +insert [definition, in QC.Introduction]
    insertBST [definition, in QC.QC]
    insertBST' [definition, in QC.QC]
    insertBST_spec [definition, in QC.QC]
    @@ -664,8 +664,8 @@

    Global Index

    Middle [constructor, in QC.QC]
    mirror [definition, in QC.QC]
    mirrorP [definition, in QC.QC]
    -MyMap [record, in QC.Typeclasses]
    mymap [projection, in QC.Typeclasses]
    +MyMap [record, in QC.Typeclasses]
    MyMap1 [instance, in QC.Typeclasses]
    MyMap2 [instance, in QC.Typeclasses]
    MyMap_trans [instance, in QC.Typeclasses]
    @@ -809,8 +809,8 @@

    Global Index

    QuickChickTool [library]


    R

    r [definition, in QC.Typeclasses]
    -Red [constructor, in QC.QC]
    Red [constructor, in QC.Typeclasses]
    +Red [constructor, in QC.QC]
    Reflexive [record, in QC.Typeclasses]
    reflexivity [projection, in QC.Typeclasses]
    remove [definition, in QC.Introduction]
    @@ -818,8 +818,8 @@

    Global Index

    result [inductive, in QC.TImp]
    Right [constructor, in QC.QC]


    S

    -show [projection, in QC.Typeclasses]
    Show [record, in QC.Typeclasses]
    +show [projection, in QC.Typeclasses]
    showBool [instance, in QC.Typeclasses]
    showDirection [instance, in QC.QC]
    showList [instance, in QC.Typeclasses]
    @@ -925,9 +925,9 @@

    Global Index

    ::x_';;;'_x [notation, in QC.TImp]
    ::x_'=?'_x [notation, in QC.Typeclasses]
    ::x_'?' [notation, in QC.Typeclasses]
    -::x_'||-'_x_'\IN'_x [notation, in QC.TImp]
    -::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in QC.TImp]
    +::x_'|⊢'_x_'\IN'_x [notation, in QC.TImp]
    ::'SKIP' [notation, in QC.TImp]
    +::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [notation, in QC.TImp]
    ::'WHILE'_x_'DO'_x_'END' [notation, in QC.TImp]



    Notation Index

    @@ -957,9 +957,9 @@

    Notation Index

    ::x_';;;'_x [in QC.TImp]
    ::x_'=?'_x [in QC.Typeclasses]
    ::x_'?' [in QC.Typeclasses]
    -::x_'||-'_x_'\IN'_x [in QC.TImp]
    -::'IFB'_x_'THEN'_x_'ELSE'_x_'FI' [in QC.TImp]
    +::x_'|⊢'_x_'\IN'_x [in QC.TImp]
    ::'SKIP' [in QC.TImp]
    +::'TEST'_x_'THEN'_x_'ELSE'_x_'FI' [in QC.TImp]
    ::'WHILE'_x_'DO'_x_'END' [in QC.TImp]



    Module Index

    @@ -1041,19 +1041,6 @@

    Axiom Index



    W

    well_typed_state_never_stuck [in QC.TImp]



    -

    Lemma Index

    -

    B

    -bind_deterministic [in QC.TImp]
    -

    C

    -commutativity_property [in QC.Typeclasses]
    -

    E

    -eqb_fact [in QC.Typeclasses]
    -

    H

    -has_type_deterministic [in QC.TImp]
    -

    T

    -trans3 [in QC.Typeclasses]
    -trans3_pre [in QC.Typeclasses]
    -


    Constructor Index

    A

    AMinus [in QC.QuickChickTool]
    @@ -1064,8 +1051,8 @@

    Constructor Index

    Bar [in QC.Typeclasses]
    Baz [in QC.Typeclasses]
    Bind [in QC.TImp]
    -Blue [in QC.Typeclasses]
    Blue [in QC.QC]
    +Blue [in QC.Typeclasses]
    Build_LabeledPoint [in QC.Typeclasses]
    Build_Point [in QC.Typeclasses]


    C

    @@ -1111,8 +1098,8 @@

    Constructor Index



    Q

    QuickChickSig.MkArgs [in QC.QuickChickInterface]


    R

    -Red [in QC.QC]
    Red [in QC.Typeclasses]
    +Red [in QC.QC]
    Right [in QC.QC]


    S

    SMinus [in QC.QuickChickTool]
    @@ -1158,6 +1145,19 @@

    Constructor Index



    Y

    Yellow [in QC.QC]



    +

    Lemma Index

    +

    B

    +bind_deterministic [in QC.TImp]
    +

    C

    +commutativity_property [in QC.Typeclasses]
    +

    E

    +eqb_fact [in QC.Typeclasses]
    +

    H

    +has_type_deterministic [in QC.TImp]
    +

    T

    +trans3 [in QC.Typeclasses]
    +trans3_pre [in QC.Typeclasses]
    +


    Projection Index

    C

    CheckerPlayground1.checker [in QC.QC]
    @@ -1214,8 +1214,8 @@

    Inductive Index

    DefineG.G [in QC.QC]
    direction [in QC.QC]


    E

    -exp [in QC.QuickChickTool]
    exp [in QC.TImp]
    +exp [in QC.QuickChickTool]


    H

    has_type [in QC.TImp]
    has_type_value [in QC.TImp]
    @@ -1417,8 +1417,8 @@

    Definition Index



    I

    implicit_fun [in QC.Typeclasses]
    implicit_fun1 [in QC.Typeclasses]
    -insert [in QC.Introduction]
    insert [in QC.QC]
    +insert [in QC.Introduction]
    insertBST [in QC.QC]
    insertBST' [in QC.QC]
    insertBST_spec [in QC.QC]
    @@ -1685,37 +1685,6 @@

    Record Index

    (36 entries) -Lemma Index -A -B -C -D -E -F -G -H -I -J -K -L -M -N -O -P -Q -R -S -T -U -V -W -X -Y -Z -_ -(6 entries) - - Constructor Index A B @@ -1747,6 +1716,37 @@

    Record Index

    (84 entries) +Lemma Index +A +B +C +D +E +F +G +H +I +J +K +L +M +N +O +P +Q +R +S +T +U +V +W +X +Y +Z +_ +(6 entries) + + Projection Index A B diff --git a/qc-current/index.html b/qc-current/index.html index ccbd4b9f..b7a93afc 100644 --- a/qc-current/index.html +++ b/qc-current/index.html @@ -42,7 +42,7 @@

    -

    版本 1.0 (07 Dec 2018, Coq 8.8.0)

    +

    版本 1.0 (26 Jan 2019, Coq 8.8.1)

    diff --git a/qc-current/qc.tgz b/qc-current/qc.tgz index 3a92daae..9cb71dce 100644 Binary files a/qc-current/qc.tgz and b/qc-current/qc.tgz differ diff --git a/vfa-current/ADT.html b/vfa-current/ADT.html index 18de154e..efb30eee 100644 --- a/vfa-current/ADT.html +++ b/vfa-current/ADT.html @@ -52,11 +52,11 @@

    ADTAbstract Data Types

     Parameter empty: table.
     Parameter get: keytableV.
     Parameter set: keyVtabletable.
    Axiom gempty: k, (* get-empty *)
    Axiom gempty: k, (* get-empty *)
           get k empty = default.
    Axiom gss: k v t, (* get-set-same *)
    Axiom gss: k v t, (* get-set-same *)
          get k (set k v t) = v.
    Axiom gso: j k v t, (* get-set-other *)
    Axiom gso: j k v t, (* get-set-other *)
          jkget j (set k v t) = get j t.
    End TABLE.
    @@ -84,11 +84,11 @@

    ADTAbstract Data Types

     Definition get (k: key) (m: table) : V := m k.
     Definition set (k: key) (v: V) (m: table) : table :=
        t_update m k v.
    Theorem gempty: k, get k empty = default.
    Theorem gempty: k, get k empty = default.
       Proof. intros. reflexivity. Qed.
    Theorem gss: k v t, get k (set k v t) = v.
    Theorem gss: k v t, get k (set k v t) = v.
       Proof. intros. unfold get, set. apply t_update_eq. Qed.
    Theorem gso: j k v t, jkget j (set k v t) = get j t.
    Theorem gso: j k v t, jkget j (set k v t) = get j t.
       Proof. intros. unfold get, set. apply t_update_neq.
           congruence.
       Qed.
    @@ -150,9 +150,9 @@

    ADTAbstract Data Types

     Definition get (k: key) (m: table) : V := lookup V default k m.
     Definition set (k: key) (v: V) (m: table) : table :=
         insert V k v m.
    Theorem gempty: k, get k empty = default.
    Theorem gempty: k, get k empty = default.
       Proof. intros. reflexivity. Qed.

    Theorem gss: k v t, get k (set k v t) = v.
    Theorem gss: k v t, get k (set k v t) = v.
       Proof. intros. unfold get, set.
         destruct (unrealistically_strong_can_relate V default t)
            as [cts H].
    @@ -163,12 +163,12 @@

    ADTAbstract Data Types

    -

    练习:3 星 (TreeTable_gso)

    +

    练习:3 星, standard (TreeTable_gso)

    Prove this using techniques similar to the proof of gss just above.
    Theorem gso: j k v t, jkget j (set k v t) = get j t.
    Theorem gso: j k v t, jkget j (set k v t) = get j t.
       Proof.
     (* 请在此处解答 *) Admitted.
    @@ -186,7 +186,7 @@

    ADTAbstract Data Types

    Check can_relate.
      (*  : forall (V : Type) (default : V) (t : tree V),
    -       SearchTree V t ->
    +       SearchTree V t ->
           exists cts : total_map V, Abs V default t cts *)

    @@ -211,16 +211,16 @@

    ADTAbstract Data Types

    on type A, that is, P: A Prop. Suppose x is a value of type A, and proof: P x is the name of the theorem that x satisfies P. Then (exist x, proof) is a "package" of two things: x, along with the - proof of P(x). The type of (x, proof) is written as {x | P x}. + proof of P(x). The type of ( x, proof) is written as {x | P x}.
    -Check exist. (* forall {A : Type} (P : A -> Prop) (x : A),
    -                 P x -> {x | P x}  *)

    -Check proj1_sig. (* forall {A : Type} {P : A -> Prop},
    -                 {x | P x} -> A *)

    -Check proj2_sig. (* forall (A : Type) {P : A -> Prop}
    +Check exist. (* forall {A : Type} (P : A -> Prop) (x : A),
    +                 P x -> {x | P x}  *)

    +Check proj1_sig. (* forall {A : Type} {P : A -> Prop},
    +                 {x | P x} -> A *)

    +Check proj2_sig. (* forall (A : Type) {P : A -> Prop}
                     (e : {x | P x}),
                     P (proj1_sig e) *)

    @@ -243,9 +243,9 @@

    ADTAbstract Data Types

     Definition set (k: key) (v: V) (m: table) : table :=
       exist (SearchTree V) (insert V k v (proj1_sig m))
              (insert_SearchTree _ _ _ _ (proj2_sig m)).

    Theorem gempty: k, get k empty = default.
    Theorem gempty: k, get k empty = default.
       Proof. intros. reflexivity. Qed.

    Theorem gss: k v t, get k (set k v t) = v.
    Theorem gss: k v t, get k (set k v t) = v.
      Proof. intros. unfold get, set.
        unfold table in t.
    @@ -270,13 +270,13 @@

    ADTAbstract Data Types

    -

    练习:3 星 (TreeTable_gso)

    +

    练习:3 星, standard (TreeTable_gso)

    Prove this using techniques similar to the proof of gss just above; don't use unrealistically_strong_can_relate.
    Theorem gso: j k v t, jkget j (set k v t) = get j t.
    Theorem gso: j k v t, jkget j (set k v t) = get j t.
       Proof.
     (* 请在此处解答 *) Admitted.
    @@ -314,7 +314,7 @@

    ADTAbstract Data Types

      (*  SearchTree V (empty_tree V) *)
    Check (insert_SearchTree V).
      (* forall (k : key) (v : V) (t : tree V),
    -       SearchTree V t -> SearchTree V (insert V k v t) *)

    +       SearchTree V t -> SearchTree V (insert V k v t) *)
    @@ -346,7 +346,7 @@

    ADTAbstract Data Types

    -Check (Abs V default). (* tree V -> total_map V -> Prop *)
    +Check (Abs V default). (* tree V -> total_map V -> Prop *)
    @@ -359,12 +359,12 @@

    ADTAbstract Data Types

    Check (empty_tree_relate V default). (*
           Abs V default (empty_tree V) (t_empty default)    *)

    Check (lookup_relate' V default). (* forall k t cts,
    -       SearchTree V t ->
    -       Abs V default t cts ->
    +       SearchTree V t ->
    +       Abs V default t cts ->
           lookup V default k t = cts (Id k)  *)

    Check (insert_relate' V default). (*     : forall k v t cts,
    -       SearchTree V t ->
    -       Abs V default t cts ->
    +       SearchTree V t ->
    +       Abs V default t cts ->
           Abs V default (insert V k v t) (t_update cts (Id k) v) *)

    @@ -377,7 +377,7 @@

    ADTAbstract Data Types

    Check TreeTable2.gso. (*
          : forall (j k : TreeTable2.key) (v : TreeTable2.V)
             (t : TreeTable2.table),
    -       j <> k ->
    +       j <> k ->
           TreeTable2.get j (TreeTable2.set k v t) = TreeTable2.get j t  *)


    End ADT_SUMMARY.
    @@ -465,7 +465,7 @@

    ADTAbstract Data Types

    Lemma nth_firstn:
    -   A d i j (al: list A), i<jnth i (firstn j al) d = nth i al d.
    +  A d i j (al: list A), i<jnth i (firstn j al) d = nth i al d.
    Proof.
    @@ -476,7 +476,7 @@

    ADTAbstract Data Types

    -

    练习:4 星, optional (listish_abstraction)

    +

    练习:4 星, standard, optional (listish_abstraction)

    In this exercise we will not need a _representation invariant_. Define an abstraction relation:
    @@ -509,18 +509,18 @@

    ADTAbstract Data Types

    Opaque L.nth.
    Opaque O_Abs.

    Lemma step_relate:
    -   al al',
    +  al al',
       O_Abs al al'
       O_Abs (stepish al) (step al').
    Proof.
    (* 请在此处解答 *) Admitted.

    Lemma repeat_step_relate:
    n al al',
    n al al',
     O_Abs al al'
     O_Abs (repeat stepish al n) (repeat step al' n).
    Proof.
    (* 请在此处解答 *) Admitted.

    -Lemma fibish_correct: n, fibish n = fib n.
    +Lemma fibish_correct: n, fibish n = fib n.
    Proof. (* No induction needed in this proof! *)
    (* 请在此处解答 *) Admitted.
    @@ -529,7 +529,7 @@

    ADTAbstract Data Types

    -

    练习:2 星, optional (fib_time_complexity)

    +

    练习:2 星, standard, optional (fib_time_complexity)

    Suppose you run these three programs call-by-value, that is, as if they were ML programs. fibonacci N @@ -550,6 +550,10 @@

    ADTAbstract Data Types

    +
    + +(* Sat Jan 26 15:18:06 UTC 2019 *)
    +
    diff --git a/vfa-current/ADT.v b/vfa-current/ADT.v index 21617a0c..527017b6 100644 --- a/vfa-current/ADT.v +++ b/vfa-current/ADT.v @@ -97,8 +97,9 @@ Module TreeTable <: TABLE. rewrite H1. apply t_update_eq. Qed. -(** **** 练习:3 星 (TreeTable_gso) *) -(** Prove this using techniques similar to the proof of [gss] just above. *) +(** **** 练习:3 星, standard (TreeTable_gso) + + Prove this using techniques similar to the proof of [gss] just above. *) Theorem gso: forall j k v t, j<>k -> get j (set k v t) = get j t. Proof. @@ -125,8 +126,7 @@ Check can_relate. *) (* ################################################################# *) -(** * A Brief Excursion into Dependent Types *) -(** +(** * A Brief Excursion into Dependent Types We can enforce the representation invariant in Coq using dependent types. Suppose [P] is a predicate on type [A], that is, [P: A -> Prop]. Suppose [x] is a value of type [A], @@ -181,8 +181,9 @@ Module TreeTable2 <: TABLE. rewrite H1. apply t_update_eq. Qed. -(** **** 练习:3 星 (TreeTable_gso) *) -(** Prove this using techniques similar to the proof of [gss] just above; +(** **** 练习:3 星, standard (TreeTable_gso) + + Prove this using techniques similar to the proof of [gss] just above; don't use [unrealistically_strong_can_relate]. *) Theorem gso: forall j k v t, j<>k -> get j (set k v t) = get j t. @@ -336,8 +337,9 @@ induction i; destruct j,al; simpl; intros; auto; try omega. apply IHi. omega. Qed. -(** **** 练习:4 星, optional (listish_abstraction) *) -(** In this exercise we will not need a _representation invariant_. +(** **** 练习:4 星, standard, optional (listish_abstraction) + + In this exercise we will not need a _representation invariant_. Define an abstraction relation: *) Inductive L_Abs: L.list -> List.list nat -> Prop := @@ -386,8 +388,9 @@ Proof. (* No induction needed in this proof! *) (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (fib_time_complexity) *) -(** Suppose you run these three programs call-by-value, that is, +(** **** 练习:2 星, standard, optional (fib_time_complexity) + + Suppose you run these three programs call-by-value, that is, as if they were ML programs. [fibonacci N] [fib N] @@ -401,7 +404,6 @@ Proof. (* No induction needed in this proof! *) fib: (* fill in here *) fibish: (* fill in here *) - [] *) @@ -410,6 +412,4 @@ Proof. (* No induction needed in this proof! *) - - - +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/ADTTest.v b/vfa-current/ADTTest.v index 41521b3c..a8e91b89 100644 --- a/vfa-current/ADTTest.v +++ b/vfa-current/ADTTest.v @@ -75,3 +75,5 @@ Print Assumptions TreeTable2.gso. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:15 UTC 2019 *) diff --git a/vfa-current/Binom.html b/vfa-current/Binom.html index 9b1153ea..c6ac2920 100644 --- a/vfa-current/Binom.html +++ b/vfa-current/Binom.html @@ -68,7 +68,7 @@

    BinomBinomial Queues


    -Require Import Coq.Strings.String.
    +From Coq Require Import Strings.String.
    From VFA Require Import Perm.
    From VFA Require Import Priqueue.

    Module BinomQueue <: PRIQUEUE.

    @@ -244,7 +244,7 @@

    BinomBinomial Queues

    -

    练习:1 星 (empty_priq)

    +

    练习:1 星, standard (empty_priq)

    @@ -256,12 +256,12 @@

    BinomBinomial Queues

    -

    练习:2 星 (smash_valid)

    +

    练习:2 星, standard (smash_valid)

    Theorem smash_valid:
    -        n t u, pow2heap n tpow2heap n upow2heap (S n) (smash t u).
    +       n t u, pow2heap n tpow2heap n upow2heap (S n) (smash t u).
    (* 请在此处解答 *) Admitted.
    @@ -269,13 +269,13 @@

    BinomBinomial Queues

    -

    练习:3 星 (carry_valid)

    +

    练习:3 星, standard (carry_valid)

    Theorem carry_valid:
    -            n q, priq' n q
    -            t, (t=Leafpow2heap n t) → priq' n (carry q t).
    +           n q, priq' n q
    +           t, (t=Leafpow2heap n t) → priq' n (carry q t).
    (* 请在此处解答 *) Admitted.
    @@ -283,11 +283,11 @@

    BinomBinomial Queues

    -

    练习:2 星, optional (insert_valid)

    +

    练习:2 星, standard, optional (insert_valid)

    -Theorem insert_priq: x q, priq qpriq (insert x q).
    +Theorem insert_priq: x q, priq qpriq (insert x q).
    (* 请在此处解答 *) Admitted.
    @@ -295,32 +295,32 @@

    BinomBinomial Queues

    -

    练习:3 星, optional (join_valid)

    +

    练习:3 星, standard, optional (join_valid)

    (* This proof is rather long, but each step is reasonably straightforward.
        There's just one induction to do, right at the beginning. *)

    -Theorem join_valid: p q c n, priq' n ppriq' n q → (c=Leafpow2heap n c) → priq' n (join p q c).
    +Theorem join_valid: p q c n, priq' n ppriq' n q → (c=Leafpow2heap n c) → priq' n (join p q c).
    (* 请在此处解答 *) Admitted.
    -Theorem merge_priq: p q, priq ppriq qpriq (merge p q).
    +Theorem merge_priq: p q, priq ppriq qpriq (merge p q).
    Proof.
     intros. unfold merge. apply join_valid; auto.
    Qed.
    -

    练习:5 星, optional (delete_max_Some_priq)

    +

    练习:5 星, standard, optional (delete_max_Some_priq)

    Theorem delete_max_Some_priq:
    -       p q k, priq pdelete_max p = Some(k,q) → priq q.
    +      p q k, priq pdelete_max p = Some(k,q) → priq q.
    (* 请在此处解答 *) Admitted.
    @@ -339,7 +339,7 @@

    BinomBinomial Queues

    Inductive tree_elems: treelist keyProp :=
    | tree_elems_leaf: tree_elems Leaf nil
    -| tree_elems_node: bl br v tl tr b,
    +| tree_elems_node: bl br v tl tr b,
               tree_elems tl bl
               tree_elems tr br
               Permutation b (v::bl++br) →
    @@ -347,7 +347,7 @@

    BinomBinomial Queues

    -

    练习:3 星 (priqueue_elems)

    +

    练习:3 星, standard (priqueue_elems)

    Make an inductive definition, similar to tree_elems, to relate a priority queue "l" to a list of all its elements. @@ -379,12 +379,12 @@

    BinomBinomial Queues

    -

    练习:2 星 (tree_elems_ext)

    +

    练习:2 星, standard (tree_elems_ext)

    Extensionality theorem for the tree_elems relation
    -Theorem tree_elems_ext: t e1 e2,
    +Theorem tree_elems_ext: t e1 e2,
      Permutation e1 e2tree_elems t e1tree_elems t e2.
    (* 请在此处解答 *) Admitted.
    @@ -393,11 +393,11 @@

    BinomBinomial Queues

    -

    练习:2 星 (tree_perm)

    +

    练习:2 星, standard (tree_perm)

    -Theorem tree_perm: t e1 e2,
    +Theorem tree_perm: t e1 e2,
      tree_elems t e1tree_elems t e2Permutation e1 e2.
    (* 请在此处解答 *) Admitted.
    @@ -406,13 +406,13 @@

    BinomBinomial Queues

    -

    练习:2 星 (priqueue_elems_ext)

    +

    练习:2 星, standard (priqueue_elems_ext)

    To prove priqueue_elems_ext, you should almost be able to cut-and-paste the proof of tree_elems_ext, with just a few edits.
    -Theorem priqueue_elems_ext: q e1 e2,
    +Theorem priqueue_elems_ext: q e1 e2,
      Permutation e1 e2priqueue_elems q e1priqueue_elems q e2.
    (* 请在此处解答 *) Admitted.
    @@ -421,11 +421,11 @@

    BinomBinomial Queues

    -

    练习:2 星 (abs_perm)

    +

    练习:2 星, standard (abs_perm)

    -Theorem abs_perm: p al bl,
    +Theorem abs_perm: p al bl,
       priq pAbs p alAbs p blPermutation al bl.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -435,14 +435,14 @@

    BinomBinomial Queues

    -

    练习:2 星 (can_relate)

    +

    练习:2 星, standard (can_relate)

    -Lemma tree_can_relate: t, al, tree_elems t al.
    +Lemma tree_can_relate: t, al, tree_elems t al.
    Proof.
    (* 请在此处解答 *) Admitted.

    -Theorem can_relate: p, priq p al, Abs p al.
    +Theorem can_relate: p, priq pal, Abs p al.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -452,7 +452,7 @@

    BinomBinomial Queues

    Various Functions Preserve the Abstraction Relation

    -

    练习:1 星 (empty_relate)

    +

    练习:1 星, standard (empty_relate)

    @@ -465,12 +465,12 @@

    BinomBinomial Queues

    -

    练习:3 星 (smash_elems)

    +

    练习:3 星, standard (smash_elems)

    Warning: This proof is rather long.
    -Theorem smash_elems: n t u bt bu,
    +Theorem smash_elems: n t u bt bu,
                         pow2heap n tpow2heap n u
                         tree_elems t bttree_elems u bu
                         tree_elems (smash t u) (bt ++ bu).
    @@ -488,14 +488,14 @@

    BinomBinomial Queues

    Some of these proofs are quite long, but they're not especially tricky.
    -

    练习:4 星, optional (carry_elems)

    +

    练习:4 星, standard, optional (carry_elems)

    Theorem carry_elems:
    -       n q, priq' n q
    -       t, (t=Leafpow2heap n t) →
    -       eq et, priqueue_elems q eq
    +      n q, priq' n q
    +      t, (t=Leafpow2heap n t) →
    +      eq et, priqueue_elems q eq
                              tree_elems t et
                              priqueue_elems (carry q t) (eq++et).
    (* 请在此处解答 *) Admitted.
    @@ -505,12 +505,12 @@

    BinomBinomial Queues

    -

    练习:2 星, optional (insert_elems)

    +

    练习:2 星, standard, optional (insert_elems)

    Theorem insert_relate:
    -         p al k, priq pAbs p alAbs (insert k p) (k::al).
    +        p al k, priq pAbs p alAbs (insert k p) (k::al).
    (* 请在此处解答 *) Admitted.
    @@ -518,16 +518,16 @@

    BinomBinomial Queues

    -

    练习:4 星, optional (join_elems)

    +

    练习:4 星, standard, optional (join_elems)

    Theorem join_elems:
    -                 p q c n,
    +                p q c n,
                          priq' n p
                          priq' n q
                          (c=Leafpow2heap n c) →
    -                   pe qe ce,
    +                  pe qe ce,
                                 priqueue_elems p pe
                                 priqueue_elems q qe
                                 tree_elems c ce
    @@ -539,12 +539,12 @@

    BinomBinomial Queues

    -

    练习:2 星, optional (merge_relate)

    +

    练习:2 星, standard, optional (merge_relate)

    Theorem merge_relate:
    -     p q pl ql al,
    +    p q pl ql al,
           priq ppriq q
           Abs p plAbs q qlAbs (merge p q) al
           Permutation al (pl++ql).
    @@ -556,12 +556,12 @@

    BinomBinomial Queues

    -

    练习:5 星, optional (delete_max_None_relate)

    +

    练习:5 星, standard, optional (delete_max_None_relate)

    Theorem delete_max_None_relate:
    -         p, priq p → (Abs p nildelete_max p = None).
    +        p, priq p → (Abs p nildelete_max p = None).
    (* 请在此处解答 *) Admitted.
    @@ -569,12 +569,12 @@

    BinomBinomial Queues

    -

    练习:5 星, optional (delete_max_Some_relate)

    +

    练习:5 星, standard, optional (delete_max_Some_relate)

    Theorem delete_max_Some_relate:
    -   (p q: priqueue) k (pl ql: list key), priq p
    +  (p q: priqueue) k (pl ql: list key), priq p
       Abs p pl
       delete_max p = Some (k,q) →
       Abs q ql
    @@ -601,13 +601,17 @@

    BinomBinomial Queues

    -

    练习:5 星, optional (binom_measurement)

    +

    练习:5 星, standard, optional (binom_measurement)

    Adapt the program (but not necessarily the proof) to use Ocaml integers as keys, in the style shown in Extract. Write an ML program to exercise it with random inputs. Compare the runtime to the implementation from Priqueue, also adapted for Ocaml integers.
    +
    + +(* Sat Jan 26 15:18:06 UTC 2019 *)
    +
    diff --git a/vfa-current/Binom.v b/vfa-current/Binom.v index 9a7fff7a..9b3e0d9e 100644 --- a/vfa-current/Binom.v +++ b/vfa-current/Binom.v @@ -8,8 +8,7 @@ Read the [Extract] chapter to see what can be done about that.) *) (* ################################################################# *) -(** * Required Reading *) -(** +(** * Required Reading Binomial Queues http://www.cs.princeton.edu/~appel/Binom.pdf by Andrew W. Appel, 2016. @@ -22,7 +21,7 @@ (* ################################################################# *) (** * The Program *) -Require Import Coq.Strings.String. +From Coq Require Import Strings.String. From VFA Require Import Perm. From VFA Require Import Priqueue. @@ -179,30 +178,30 @@ Definition priq (q: priqueue) : Prop := priq' 0 q. (** ...that is, the [priq] property, or the closely related property [pow2heap]. *) -(** **** 练习:1 星 (empty_priq) *) +(** **** 练习:1 星, standard (empty_priq) *) Theorem empty_priq: priq empty. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (smash_valid) *) +(** **** 练习:2 星, standard (smash_valid) *) Theorem smash_valid: forall n t u, pow2heap n t -> pow2heap n u -> pow2heap (S n) (smash t u). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (carry_valid) *) +(** **** 练习:3 星, standard (carry_valid) *) Theorem carry_valid: forall n q, priq' n q -> forall t, (t=Leaf \/ pow2heap n t) -> priq' n (carry q t). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (insert_valid) *) +(** **** 练习:2 星, standard, optional (insert_valid) *) Theorem insert_priq: forall x q, priq q -> priq (insert x q). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (join_valid) *) +(** **** 练习:3 星, standard, optional (join_valid) *) (* This proof is rather long, but each step is reasonably straightforward. There's just one [induction] to do, right at the beginning. *) Theorem join_valid: forall p q c n, priq' n p -> priq' n q -> (c=Leaf \/ pow2heap n c) -> priq' n (join p q c). @@ -214,7 +213,7 @@ Proof. intros. unfold merge. apply join_valid; auto. Qed. -(** **** 练习:5 星, optional (delete_max_Some_priq) *) +(** **** 练习:5 星, standard, optional (delete_max_Some_priq) *) Theorem delete_max_Some_priq: forall p q k, priq p -> delete_max p = Some(k,q) -> priq q. (* 请在此处解答 *) Admitted. @@ -234,8 +233,9 @@ Inductive tree_elems: tree -> list key -> Prop := Permutation b (v::bl++br) -> tree_elems (Node v tl tr) b. -(** **** 练习:3 星 (priqueue_elems) *) -(** Make an inductive definition, similar to [tree_elems], to relate +(** **** 练习:3 星, standard (priqueue_elems) + + Make an inductive definition, similar to [tree_elems], to relate a priority queue "l" to a list of all its elements. As you can see in the definition of [tree_elems], a [tree] relates to @@ -256,22 +256,24 @@ Definition Abs (p: priqueue) (al: list key) := priqueue_elems p al. (* ================================================================= *) (** ** Sanity Checks on the Abstraction Relation *) -(** **** 练习:2 星 (tree_elems_ext) *) -(** Extensionality theorem for the tree_elems relation *) +(** **** 练习:2 星, standard (tree_elems_ext) + + Extensionality theorem for the tree_elems relation *) Theorem tree_elems_ext: forall t e1 e2, Permutation e1 e2 -> tree_elems t e1 -> tree_elems t e2. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (tree_perm) *) +(** **** 练习:2 星, standard (tree_perm) *) Theorem tree_perm: forall t e1 e2, tree_elems t e1 -> tree_elems t e2 -> Permutation e1 e2. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (priqueue_elems_ext) *) -(** To prove [priqueue_elems_ext], you should almost be able to cut-and-paste the +(** **** 练习:2 星, standard (priqueue_elems_ext) + + To prove [priqueue_elems_ext], you should almost be able to cut-and-paste the proof of [tree_elems_ext], with just a few edits. *) Theorem priqueue_elems_ext: forall q e1 e2, @@ -279,14 +281,14 @@ Theorem priqueue_elems_ext: forall q e1 e2, (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (abs_perm) *) +(** **** 练习:2 星, standard (abs_perm) *) Theorem abs_perm: forall p al bl, priq p -> Abs p al -> Abs p bl -> Permutation al bl. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (can_relate) *) +(** **** 练习:2 星, standard (can_relate) *) Lemma tree_can_relate: forall t, exists al, tree_elems t al. Proof. (* 请在此处解答 *) Admitted. @@ -298,14 +300,15 @@ Proof. (* ================================================================= *) (** ** Various Functions Preserve the Abstraction Relation *) -(** **** 练习:1 星 (empty_relate) *) +(** **** 练习:1 星, standard (empty_relate) *) Theorem empty_relate: Abs empty nil. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (smash_elems) *) -(** Warning: This proof is rather long. *) +(** **** 练习:3 星, standard (smash_elems) + + Warning: This proof is rather long. *) Theorem smash_elems: forall n t u bt bu, pow2heap n t -> pow2heap n u -> @@ -319,7 +322,7 @@ Theorem smash_elems: forall n t u bt bu, (** Some of these proofs are quite long, but they're not especially tricky. *) -(** **** 练习:4 星, optional (carry_elems) *) +(** **** 练习:4 星, standard, optional (carry_elems) *) Theorem carry_elems: forall n q, priq' n q -> forall t, (t=Leaf \/ pow2heap n t) -> @@ -329,13 +332,13 @@ Theorem carry_elems: (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (insert_elems) *) +(** **** 练习:2 星, standard, optional (insert_elems) *) Theorem insert_relate: forall p al k, priq p -> Abs p al -> Abs (insert k p) (k::al). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, optional (join_elems) *) +(** **** 练习:4 星, standard, optional (join_elems) *) Theorem join_elems: forall p q c n, priq' n p -> @@ -349,7 +352,7 @@ Theorem join_elems: (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (merge_relate) *) +(** **** 练习:2 星, standard, optional (merge_relate) *) Theorem merge_relate: forall p q pl ql al, priq p -> priq q -> @@ -359,13 +362,13 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, optional (delete_max_None_relate) *) +(** **** 练习:5 星, standard, optional (delete_max_None_relate) *) Theorem delete_max_None_relate: forall p, priq p -> (Abs p nil <-> delete_max p = None). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:5 星, optional (delete_max_Some_relate) *) +(** **** 练习:5 星, standard, optional (delete_max_Some_relate) *) Theorem delete_max_Some_relate: forall (p q: priqueue) k (pl ql: list key), priq p -> Abs p pl -> @@ -382,14 +385,16 @@ Theorem delete_max_Some_relate: End BinomQueue. - (* ################################################################# *) (** * Measurement. *) -(** **** 练习:5 星, optional (binom_measurement) *) -(** Adapt the program (but not necessarily the proof) to use Ocaml integers +(** **** 练习:5 星, standard, optional (binom_measurement) + + Adapt the program (but not necessarily the proof) to use Ocaml integers as keys, in the style shown in [Extract]. Write an ML program to exercise it with random inputs. Compare the runtime to the implementation from [Priqueue], also adapted for Ocaml integers. -*) -(** [] *) + + [] *) + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/BinomTest.v b/vfa-current/BinomTest.v index d358d62d..aa29f54d 100644 --- a/vfa-current/BinomTest.v +++ b/vfa-current/BinomTest.v @@ -223,3 +223,5 @@ Print Assumptions BinomQueue.smash_elems. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:47 UTC 2019 *) diff --git a/vfa-current/Color.html b/vfa-current/Color.html index d84879e9..0c4d48ce 100644 --- a/vfa-current/Color.html +++ b/vfa-current/Color.html @@ -161,7 +161,7 @@

    ColorGraph Coloring

    In order to reason about a graph coloring algorithm, we need to - prove lemmas such as, "if you remove an element (one domain->range binding) + prove lemmas such as, "if you remove an element (one domain->range binding) from a finite map, then the result is a new finite map whose domain has fewer elements." (Duh!) But to prove this, we need to build up some definitions and lemmas. We start by importing some modules @@ -173,7 +173,7 @@

    ColorGraph Coloring

    Module WP := WProperties_fun E M. (* More useful stuff about maps *)
    Print Module WF.
    Print Module WP.

    -Check E.lt. (*   : positive -> positive -> Prop *)
    +Check E.lt. (*   : positive -> positive -> Prop *)
    @@ -236,14 +236,14 @@

    ColorGraph Coloring


    Print equivlistA. (* 
    -   fun {A : Type} (eqA : A -> A -> Prop) (l l' : list A) =>
    -            forall x : A, InA eqA x l <-> InA eqA x l'
    -   : forall {A:Type}, (A->A->Prop) -> list A -> list A -> Prop *)

    +   fun {A : Type} (eqA : A -> A -> Prop) (l l' : list A) =>
    +            forall x : A, InA eqA x l <-> InA eqA x l'
    +   : forall {A:Type}, (A->A->Prop) -> list A -> list A -> Prop *)
    Suppose two lists al,bl both contain the same elements, not necessarily in the same - order. That is, x:A, In x al In x bl. In fact from this definition you can + order. That is, x:A, In x al In x bl. In fact from this definition you can see that al or bl might even have different numbers of repetitions of certain elements. Then we say the lists are "equivalent." @@ -306,14 +306,14 @@

    ColorGraph Coloring

    Check SortA_equivlistA_eqlistA. (*
    -     : forall (A : Type) (eqA : A -> A -> Prop),
    -       Equivalence eqA ->
    -       forall ltA : A -> A -> Prop,
    -       StrictOrder ltA ->
    -       Proper (eqA ==> eqA ==> iff) ltA ->
    +     : forall (A : Type) (eqA : A -> A -> Prop),
    +       Equivalence eqA ->
    +       forall ltA : A -> A -> Prop,
    +       StrictOrder ltA ->
    +       Proper (eqA ==> eqA ==> iff) ltA ->
           forall l l' : list A,
    -       Sorted ltA l ->
    -       Sorted ltA l' -> equivlistA eqA l l' -> eqlistA eqA l l'  *)

    +       Sorted ltA l ->
    +       Sorted ltA l' -> equivlistA eqA l l' -> eqlistA eqA l l'  *)
    @@ -343,7 +343,7 @@

    ColorGraph Coloring

    -Lemma eqlistA_Eeq_eq: al bl, eqlistA E.eq al blal=bl.
    +Lemma eqlistA_Eeq_eq: al bl, eqlistA E.eq al blal=bl.
    Proof.
    split; intro.
    * induction H. reflexivity. unfold E.eq in H. subst. reflexivity.
    @@ -359,7 +359,7 @@

    ColorGraph Coloring

    Lemma SortE_equivlistE_eqlistE:
    al bl, Sorted E.lt al
    al bl, Sorted E.lt al
                       Sorted E.lt bl
                       equivlistA E.eq al bleqlistA E.eq al bl.
    Proof.
    @@ -375,7 +375,7 @@

    ColorGraph Coloring

    -Lemma filter_sortE: f l,
    +Lemma filter_sortE: f l,
         Sorted E.lt lSorted E.lt (List.filter f l).
    Proof.
      apply filter_sort with E.eq; auto.
    @@ -390,8 +390,8 @@

    ColorGraph Coloring

    -Check S.remove. (* : S.elt -> S.t -> S.t *)
    -Check S.elements. (* : S.t -> list S.elt *)
    +Check S.remove. (* : S.elt -> S.t -> S.t *)
    +Check S.elements. (* : S.t -> list S.elt *)
    @@ -403,7 +403,7 @@

    ColorGraph Coloring

    -Lemma Sremove_elements: (i: E.t) (s: S.t),
    +Lemma Sremove_elements: (i: E.t) (s: S.t),
      S.In i s
         S.elements (S.remove i s) =
             List.filter (fun xif E.eq_dec x i then false else true) (S.elements s).
    @@ -415,16 +415,16 @@

    ColorGraph Coloring

    list that you get by filtering i out of S.elements s. Go ahead and prove it!
    -

    练习:3 星 (Sremove_elements)

    +

    练习:3 星, standard (Sremove_elements)

    Lemma Proper_eq_eq:
    -   f, Proper (E.eq ==> @eq bool) f.
    +  f, Proper (E.eq ==> @eq bool) f.
    Proof.
    unfold Proper. unfold respectful.
    (* 请在此处解答 *) Admitted.

    -Lemma Sremove_elements: (i: E.t) (s: S.t),
    +Lemma Sremove_elements: (i: E.t) (s: S.t),
      S.In i s
         S.elements (S.remove i s) =
             List.filter (fun xif E.eq_dec x i then false else true) (S.elements s).
    @@ -462,7 +462,7 @@

    ColorGraph Coloring

    -Check M.elements. (*  : forall A : Type, M.t A -> list (positive * A) *)
    +Check M.elements. (*  : forall A : Type, M.t A -> list (positive * A) *)
    @@ -470,13 +470,13 @@

    ColorGraph Coloring

    Then j is in map fst l iff there is some e such that (j,e) is in l.
    -

    练习:2 星 (InA_map_fst_key)

    +

    练习:2 星, standard (InA_map_fst_key)

    Lemma InA_map_fst_key:
    A j l,
    InA E.eq j (map (@fst M.E.t A) l) ↔ e, InA (@M.eq_key_elt A) (j,e) l.
    A j l,
    InA E.eq j (map (@fst M.E.t A) l) ↔ e, InA (@M.eq_key_elt A) (j,e) l.
    (* 请在此处解答 *) Admitted.
    @@ -484,7 +484,7 @@

    ColorGraph Coloring

    -

    练习:3 星 (Sorted_lt_key)

    +

    练习:3 星, standard (Sorted_lt_key)

    The function M.lt_key compares two elements of an M.elements list, that is, two pairs of type positive*A, by just comparing their first elements using E.lt. Therefore, an elements list (of type list(positive*A) is Sorted @@ -493,7 +493,7 @@

    ColorGraph Coloring

    Lemma Sorted_lt_key:
    -   A (al: list (positive*A)),
    +  A (al: list (positive*A)),
       Sorted (@M.lt_key A) alSorted E.lt (map (@fst positive A) al).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -512,11 +512,11 @@

    ColorGraph Coloring

    its domain set.
    -

    练习:4 星 (cardinal_map)

    +

    练习:4 星, standard (cardinal_map)

    -Lemma cardinal_map: A B (f: AB) g,
    +Lemma cardinal_map: A B (f: AB) g,
         M.cardinal (M.map f g) = M.cardinal g.
    @@ -543,11 +543,11 @@

    ColorGraph Coloring

    -

    练习:4 星 (Sremove_cardinal_less)

    +

    练习:4 星, standard (Sremove_cardinal_less)

    -Lemma Sremove_cardinal_less: i s,
    +Lemma Sremove_cardinal_less: i s,
            S.In i sS.cardinal (S.remove i s) < S.cardinal s.
    Proof.
    intros.
    @@ -569,7 +569,7 @@

    ColorGraph Coloring

    Lemma specialize_SortA_equivlistA_eqlistA:
    -   A al bl,
    +  A al bl,
      Sorted (@M.lt_key A) al
      Sorted (@M.lt_key A) bl
      equivlistA (@M.eq_key_elt A) al bl
    @@ -585,7 +585,7 @@

    ColorGraph Coloring

    destruct H, H0. rewrite H,H0. split; auto.
    Qed.

    Lemma Proper_eq_key_elt:
    A,
    A,
       Proper (@M.eq_key_elt A ==> @M.eq_key_elt A ==> iff)
                    (fun x y : E.t * AE.lt (fst x) (fst y)).
    Proof.
    @@ -594,11 +594,11 @@

    ColorGraph Coloring

    -

    练习:4 星 (Mremove_elements)

    +

    练习:4 星, standard (Mremove_elements)

    -Lemma Mremove_elements: A i s,
    +Lemma Mremove_elements: A i s,
      M.In i s
         eqlistA (@M.eq_key_elt A) (M.elements (M.remove i s))
                  (List.filter (fun xif E.eq_dec (fst x) i then false else true) (M.elements s)).

    @@ -619,11 +619,11 @@

    ColorGraph Coloring

    -

    练习:3 星 (Mremove_cardinal_less)

    +

    练习:3 星, standard (Mremove_cardinal_less)

    -Lemma Mremove_cardinal_less: A i (s: M.t A), M.In i s
    +Lemma Mremove_cardinal_less: A i (s: M.t A), M.In i s
            M.cardinal (M.remove i s) < M.cardinal s.
    @@ -640,17 +640,17 @@

    ColorGraph Coloring

    -

    练习:2 星 (two_little_lemmas)

    +

    练习:2 星, standard (two_little_lemmas)


    Lemma fold_right_rev_left:
    -   (A B: Type) (f: ABA) (l: list B) (i: A),
    +  (A B: Type) (f: ABA) (l: list B) (i: A),
      fold_left f l i = fold_right (fun x yf y x) i (rev l).
    (* 请在此处解答 *) Admitted.

    -Lemma Snot_in_empty: n, ¬ S.In n S.empty.
    +Lemma Snot_in_empty: n, ¬S.In n S.empty.
    (* 请在此处解答 *) Admitted.
    @@ -658,11 +658,11 @@

    ColorGraph Coloring

    -

    练习:3 星 (Sin_domain)

    +

    练习:3 星, standard (Sin_domain)

    -Lemma Sin_domain: A n (g: M.t A), S.In n (Mdomain g) ↔ M.In n g.
    +Lemma Sin_domain: A n (g: M.t A), S.In n (Mdomain g) ↔ M.In n g.
    @@ -690,8 +690,8 @@

    ColorGraph Coloring

    Definition adj (g: graph) (i: node) : nodeset :=
      match M.find i g with Some aa | NoneS.empty end.

    Definition undirected (g: graph) :=
    -    i j, S.In j (adj g i) → S.In i (adj g j).

    -Definition no_selfloop (g: graph) := i, ¬ S.In i (adj g i).

    +   i j, S.In j (adj g i) → S.In i (adj g j).

    +Definition no_selfloop (g: graph) := i, ¬S.In i (adj g i).

    Definition nodes (g: graph) := Mdomain g.

    Definition subset_nodes
                        (P: nodenodesetbool)
    @@ -715,11 +715,11 @@

    ColorGraph Coloring

    before we can actually define the Function.
    -

    练习:3 星 (subset_nodes_sub)

    +

    练习:3 星, standard (subset_nodes_sub)

    -Lemma subset_nodes_sub: P g, S.Subset (subset_nodes P g) (nodes g).
    +Lemma subset_nodes_sub: P g, S.Subset (subset_nodes P g) (nodes g).
    (* 请在此处解答 *) Admitted.
    @@ -727,12 +727,12 @@

    ColorGraph Coloring

    -

    练习:3 星 (select_terminates)

    +

    练习:3 星, standard (select_terminates)

    Lemma select_terminates:
    -   (K: nat) (g : graph) (n : S.elt),
    +  (K: nat) (g : graph) (n : S.elt),
       S.choose (subset_nodes (low_deg K) g) = Some n
       M.cardinal (remove_node n g) < M.cardinal g.
    (* 请在此处解答 *) Admitted.
    @@ -778,17 +778,17 @@

    ColorGraph Coloring

    Definition coloring_ok (palette: S.t) (g: graph) (f: coloring) :=
    i j, S.In j (adj g i) →
    -     ( ci, M.find i f = Some ciS.In ci palette) ∧
    -     ( ci cj, M.find i f = Some ciM.find j f = Some cjcicj).
    i j, S.In j (adj g i) →
    +     (ci, M.find i f = Some ciS.In ci palette) ∧
    +     (ci cj, M.find i f = Some ciM.find j f = Some cjcicj).
    -

    练习:2 星 (adj_ext)

    +

    练习:2 星, standard (adj_ext)

    -Lemma adj_ext: g i j, E.eq i jS.eq (adj g i) (adj g j).
    +Lemma adj_ext: g i j, E.eq i jS.eq (adj g i) (adj g j).
    (* 请在此处解答 *) Admitted.
    @@ -796,12 +796,12 @@

    ColorGraph Coloring

    -

    练习:3 星 (in_colors_of_1)

    +

    练习:3 星, standard (in_colors_of_1)

    Lemma in_colors_of_1:
    -   i s f c, S.In i sM.find i f = Some cS.In c (colors_of f s).
    +  i s f c, S.In i sM.find i f = Some cS.In c (colors_of f s).
    (* 请在此处解答 *) Admitted.
    @@ -809,12 +809,12 @@

    ColorGraph Coloring

    -

    练习:4 星 (color_correct)

    +

    练习:4 星, standard (color_correct)

    Theorem color_correct:
    -   palette g,
    +  palette g,
           no_selfloop g
           undirected g
           coloring_ok palette g (color palette g).
    @@ -853,6 +853,10 @@

    ColorGraph Coloring

    That is our graph coloring: Node 4 is colored with color 1, node 2 with color 3, nodes 6 and 1 with 2, and node 5 with color 1.
    +
    + +(* Sat Jan 26 15:18:07 UTC 2019 *)
    +
    diff --git a/vfa-current/Color.v b/vfa-current/Color.v index e52ded81..5d5f6a41 100644 --- a/vfa-current/Color.v +++ b/vfa-current/Color.v @@ -181,8 +181,9 @@ inv H1. Qed. (* ================================================================= *) -(** ** SortA_equivlistA_eqlistA *) -(** Suppose two lists [al,bl] are "equivalent:" they contain the same set of elements +(** ** SortA_equivlistA_eqlistA + + Suppose two lists [al,bl] are "equivalent:" they contain the same set of elements (modulo an equivalence relation [eqA] on elements, perhaps in different orders, and perhaps with different numbers of repetitions). That is, suppose [equivlistA eqA al bl]. @@ -258,8 +259,9 @@ Proof. Qed. (* ================================================================= *) -(** ** S.remove and S.elements *) -(** The [FSets] interface (and therefore our [Module S]) provides these two functions: *) +(** ** S.remove and S.elements + + The [FSets] interface (and therefore our [Module S]) provides these two functions: *) Check S.remove. (* : S.elt -> S.t -> S.t *) Check S.elements. (* : S.t -> list S.elt *) @@ -277,7 +279,7 @@ Abort. (* Before we prove that, there is some preliminary work to do. *) (** That is, if [i] is in the set [s], then the elements of [S.remove i s] is the list that you get by filtering [i] out of [S.elements s]. Go ahead and prove it! *) -(** **** 练习:3 星 (Sremove_elements) *) +(** **** 练习:3 星, standard (Sremove_elements) *) Lemma Proper_eq_eq: forall f, Proper (E.eq ==> @eq bool) f. Proof. @@ -320,16 +322,16 @@ Check M.elements. (* : forall A : Type, M.t A -> list (positive * A) *) (** Let's start with a little lemma about lists of pairs: Suppose [l: list (positive*A)]. Then [j] is in [map fst l] iff there is some e such that (j,e) is in l. *) -(** **** 练习:2 星 (InA_map_fst_key) *) +(** **** 练习:2 星, standard (InA_map_fst_key) *) Lemma InA_map_fst_key: forall A j l, InA E.eq j (map (@fst M.E.t A) l) <-> exists e, InA (@M.eq_key_elt A) (j,e) l. (* 请在此处解答 *) Admitted. (** [] *) +(** **** 练习:3 星, standard (Sorted_lt_key) -(** **** 练习:3 星 (Sorted_lt_key) *) -(** The function [M.lt_key] compares two elements of an [M.elements] list, + The function [M.lt_key] compares two elements of an [M.elements] list, that is, two pairs of type [positive*A], by just comparing their first elements using [E.lt]. Therefore, an elements list (of type [list(positive*A)] is [Sorted] by [M.lt_key] iff its list-of-first-elements is [Sorted] by [E.lt]. *) @@ -348,7 +350,7 @@ Proof. The cardinality of a finite map is, essentially, the cardinality of its domain set. *) -(** **** 练习:4 星 (cardinal_map) *) +(** **** 练习:4 星, standard (cardinal_map) *) Lemma cardinal_map: forall A B (f: A -> B) g, M.cardinal (M.map f g) = M.cardinal g. @@ -369,7 +371,7 @@ Check Sorted_lt_key. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (Sremove_cardinal_less) *) +(** **** 练习:4 星, standard (Sremove_cardinal_less) *) Lemma Sremove_cardinal_less: forall i s, S.In i s -> S.cardinal (S.remove i s) < S.cardinal s. Proof. @@ -380,7 +382,6 @@ rewrite H0; clear H0. (* 请在此处解答 *) Admitted. (** [] *) - (** We have a lemma [SortA_equivlistA_eqlistA] that talks about arbitrary equivalence relations and arbitrary total-order relations (as long as they are compatible. Here is a specialization to @@ -411,7 +412,7 @@ Proof. repeat intro. destruct H,H0. rewrite H,H0. split; auto. Qed. -(** **** 练习:4 星 (Mremove_elements) *) +(** **** 练习:4 星, standard (Mremove_elements) *) Lemma Mremove_elements: forall A i s, M.In i s -> eqlistA (@M.eq_key_elt A) (M.elements (M.remove i s)) @@ -431,7 +432,7 @@ Check filter_InA. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (Mremove_cardinal_less) *) +(** **** 练习:3 星, standard (Mremove_cardinal_less) *) Lemma Mremove_cardinal_less: forall A i (s: M.t A), M.In i s -> M.cardinal (M.remove i s) < M.cardinal s. @@ -441,7 +442,7 @@ Lemma Mremove_cardinal_less: forall A i (s: M.t A), M.In i s -> (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (two_little_lemmas) *) +(** **** 练习:2 星, standard (two_little_lemmas) *) Lemma fold_right_rev_left: forall (A B: Type) (f: A -> B -> A) (l: list B) (i: A), @@ -452,7 +453,7 @@ Lemma Snot_in_empty: forall n, ~ S.In n S.empty. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (Sin_domain) *) +(** **** 练习:3 星, standard (Sin_domain) *) Lemma Sin_domain: forall A n (g: M.t A), S.In n (Mdomain g) <-> M.In n g. (** This seems so obvious! But I didn't find a really simple proof of it. *) @@ -491,16 +492,17 @@ Definition remove_node (n: node) (g: graph) : graph := M.map (S.remove n) (M.remove n g). (* ================================================================= *) -(** ** Some Proofs in Support of Termination *) -(** We need to prove some lemmas related to the termination of the algorithm +(** ** Some Proofs in Support of Termination + + We need to prove some lemmas related to the termination of the algorithm before we can actually define the [Function]. *) -(** **** 练习:3 星 (subset_nodes_sub) *) +(** **** 练习:3 星, standard (subset_nodes_sub) *) Lemma subset_nodes_sub: forall P g, S.Subset (subset_nodes P g) (nodes g). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (select_terminates) *) +(** **** 练习:3 星, standard (select_terminates) *) Lemma select_terminates: forall (K: nat) (g : graph) (n : S.elt), S.choose (subset_nodes (low_deg K) g) = Some n -> @@ -546,18 +548,18 @@ Definition coloring_ok (palette: S.t) (g: graph) (f: coloring) := (forall ci, M.find i f = Some ci -> S.In ci palette) /\ (forall ci cj, M.find i f = Some ci -> M.find j f = Some cj -> ci<>cj). -(** **** 练习:2 星 (adj_ext) *) +(** **** 练习:2 星, standard (adj_ext) *) Lemma adj_ext: forall g i j, E.eq i j -> S.eq (adj g i) (adj g j). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (in_colors_of_1) *) +(** **** 练习:3 星, standard (in_colors_of_1) *) Lemma in_colors_of_1: forall i s f c, S.In i s -> M.find i f = Some c -> S.In c (colors_of f s). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (color_correct) *) +(** **** 练习:4 星, standard (color_correct) *) Theorem color_correct: forall palette g, no_selfloop g -> @@ -594,3 +596,4 @@ Compute (M.elements (color palette G)). (* = [(4, 1); (2, 3); (6, 2); (1, 2); (5 nodes [6] and [1] with [2], and node [5] with color [1]. *) +(* Sat Jan 26 15:18:07 UTC 2019 *) diff --git a/vfa-current/ColorTest.v b/vfa-current/ColorTest.v index ce391ad1..c72fc15a 100644 --- a/vfa-current/ColorTest.v +++ b/vfa-current/ColorTest.v @@ -294,3 +294,5 @@ Print Assumptions color_correct. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:50 UTC 2019 *) diff --git a/vfa-current/Decide.html b/vfa-current/Decide.html index 2e50e033..2a753b0a 100644 --- a/vfa-current/Decide.html +++ b/vfa-current/Decide.html @@ -58,8 +58,8 @@

    DecideProgramming with Decision Proc

    -Check Nat.lt. (* : nat -> nat -> Prop *)
    -Check Nat.ltb. (* : nat -> nat -> bool *)
    +Check Nat.lt. (* : nat -> nat -> Prop *)
    +Check Nat.ltb. (* : nat -> nat -> bool *)
    @@ -71,9 +71,9 @@

    DecideProgramming with Decision Proc
    Print reflect.
    -(* Inductive reflect (P : Prop) : bool -> Set :=
    -    | ReflectT : P -> reflect P true 
    -    | ReflectF : ~ P -> reflect P false  *)


    +(* Inductive reflect (P : Prop) : bool -> Set :=
    +    | ReflectT : P -> reflect P true 
    +    | ReflectF : ~ P -> reflect P false  *)


    Check ltb_reflect. (* : forall x y, reflect (x<y) (x <? y) *)
    @@ -203,7 +203,7 @@

    DecideProgramming with Decision Proc _decidable_ if there is an algorithm for computing a proof of Q or ¬Q. More generally, when P is a predicate (a function from some type T to Prop), we say P is decidable when - x:T, decidable(P). + x:T, decidable(P).
    @@ -282,11 +282,11 @@

    DecideProgramming with Decision Proc

    -Definition t4 := a b, {a<b}+{~(a<b)}.
    +Definition t4 := a b, {a<b}+{~(a<b)}.
    -That expression, a b, {a<b}+{~(a<b)}, says that for any +That expression, a b, {a<b}+{~(a<b)}, says that for any natural numbers a and b, either a<b or ab. But it is _more_ than that! Because sumbool is an Inductive type with two constructors left and right, then given the {3<7}+{~(3<7)} you can pattern-match @@ -330,8 +330,8 @@

    DecideProgramming with Decision Proc Definition lt_dec (a: nat) (b: nat) : {a<b}+{~(a<b)} :=
    match ltb_reflect a b with
    -| ReflectT _ Pleft (a < b) (¬ a < b) P
    -| ReflectF _ Qright (a < b) (¬ a < b) Q
    +| ReflectT _ Pleft (a < b) (¬a < b) P
    +| ReflectF _ Qright (a < b) (¬a < b) Q
    end.

    @@ -346,7 +346,7 @@

    DecideProgramming with Decision Proc Defined.

    Print lt_dec.
    Print lt_dec'.

    -Theorem lt_dec_equivalent: a b, lt_dec a b = lt_dec' a b.
    +Theorem lt_dec_equivalent: a b, lt_dec a b = lt_dec' a b.
    Proof.
    intros.
    unfold lt_dec, lt_dec'.
    @@ -414,19 +414,19 @@

    DecideProgramming with Decision Proc Inductive sorted: list natProp :=
    | sorted_nil:
        sorted nil
    -| sorted_1: x,
    +| sorted_1: x,
        sorted (x::nil)
    -| sorted_cons: x y l,
    +| sorted_cons: x y l,
       xysorted (y::l) → sorted (x::y::l).

    -

    练习:2 星 (insert_sorted_le_dec)

    +

    练习:2 星, standard (insert_sorted_le_dec)

    Lemma insert_sorted:
    -   a l, sorted lsorted (insert a l).
    +  a l, sorted lsorted (insert a l).
    Proof.
      intros a l H.
      induction H.
    @@ -474,7 +474,7 @@

    DecideProgramming with Decision Proc
    - Classical logic contains the axiom P, P ¬P. This is not provable + Classical logic contains the axiom P, P ¬P. This is not provable in core Coq, that is, in the bare Calculus of Inductive Constructions. But its negation is not provable either. You could add this axiom to Coq and the system would still be consistent (i.e., no way to prove False). @@ -506,7 +506,7 @@

    DecideProgramming with Decision Proc

    -Axiom lt_dec_axiom_1: i j: nat, i<j ∨ ~(i<j).
    +Axiom lt_dec_axiom_1: i j: nat, i<j ∨ ~(i<j).
    @@ -527,7 +527,7 @@

    DecideProgramming with Decision Proc

    -Axiom lt_dec_axiom_2: i j: nat, {i<j} + {~(i<j)}.

    +Axiom lt_dec_axiom_2: i j: nat, {i<j} + {~(i<j)}.

    Definition max_with_axiom (i j: nat) : nat :=
       if lt_dec_axiom_2 i j then j else i.
    @@ -636,16 +636,16 @@

    DecideProgramming with Decision Proc Search ({_}+{~_}).
    (*
    -reflect_dec: forall (P : Prop) (b : bool), reflect P b -> {P} + {~ P}
    +reflect_dec: forall (P : Prop) (b : bool), reflect P b -> {P} + {~ P}
    lt_dec: forall n m : nat, {n < m} + {~ n < m}
    list_eq_dec:
      forall A : Type,
    -  (forall x y : A, {x = y} + {x <> y}) ->
    +  (forall x y : A, {x = y} + {x <> y}) ->
      forall l l' : list A, {l = l'} + {l <> l'}
    le_dec: forall n m : nat, {n <= m} + {~ n <= m}
    in_dec:
      forall A : Type,
    -  (forall x y : A, {x = y} + {x <> y}) ->
    +  (forall x y : A, {x = y} + {x <> y}) ->
      forall (a : A) (l : list A), {In a l} + {~ In a l}
    gt_dec: forall n m : nat, {n > m} + {~ n > m}
    ge_dec: forall n m : nat, {n >= m} + {~ n >= m}
    @@ -671,7 +671,7 @@

    DecideProgramming with Decision Proc
    Definition list_nat_eq_dec:
    -    ( al bl : list nat, {al=bl}+{albl}) :=
    +    (al bl : list nat, {al=bl}+{albl}) :=
      list_eq_dec eq_nat_dec.

    Eval compute in if list_nat_eq_dec [1;3;4] [1;4;3] then true else false.
     (* = false : bool *)

    @@ -680,12 +680,12 @@

    DecideProgramming with Decision Proc

    -

    练习:2 星 (list_nat_in)

    +

    练习:2 星, standard (list_nat_in)

    Use in_dec to build this function.
    -Definition list_nat_in: (i: nat) (al: list nat), {In i al}+{~ In i al}
    +Definition list_nat_in: (i: nat) (al: list nat), {In i al}+{~ In i al}
     (* 将本行替换成 ":= _你的_定义_ ." *). Admitted.

    Example in_4_pi: (if list_nat_in 4 [3;1;4;1;5;9;2;6] then true else false) = true.
    Proof.
    @@ -715,7 +715,7 @@

    DecideProgramming with Decision Proc
    • With sumbool, you define _two_ things: the operator in Prop such as lt: nat nat Prop and the decidability "theorem" - in sumbool, such as lt_dec: i j, {lt i j}+{~ lt i j}. I say + in sumbool, such as lt_dec: i j, {lt i j}+{~ lt i j}. I say "theorem" in quotes because it's not _just_ a theorem, it's also a (nonopaque) computable function. @@ -743,6 +743,10 @@

      DecideProgramming with Decision Proc it does. Either of these two methods is a reasonable way of programming with proof.

    +
    + +(* Sat Jan 26 15:18:06 UTC 2019 *)
    +

    diff --git a/vfa-current/Decide.v b/vfa-current/Decide.v index 457e4768..6657065f 100644 --- a/vfa-current/Decide.v +++ b/vfa-current/Decide.v @@ -264,7 +264,7 @@ Inductive sorted: list nat -> Prop := | sorted_cons: forall x y l, x <= y -> sorted (y::l) -> sorted (x::y::l). -(** **** 练习:2 星 (insert_sorted_le_dec) *) +(** **** 练习:2 星, standard (insert_sorted_le_dec) *) Lemma insert_sorted: forall a l, sorted l -> sorted (insert a l). Proof. @@ -378,7 +378,6 @@ Qed. End ScratchPad2. - (* ################################################################# *) (** * Opacity of [Qed] *) @@ -458,8 +457,9 @@ Eval compute in if list_nat_eq_dec [1;3;4] [1;4;3] then true else false. Eval compute in if list_nat_eq_dec [1;3;4] [1;3;4] then true else false. (* = true : bool *) -(** **** 练习:2 星 (list_nat_in) *) -(** Use [in_dec] to build this function. *) +(** **** 练习:2 星, standard (list_nat_in) + + Use [in_dec] to build this function. *) Definition list_nat_in: forall (i: nat) (al: list nat), {In i al}+{~ In i al} (* 将本行替换成 ":= _你的_定义_ ." *). Admitted. @@ -503,3 +503,4 @@ simpl. it does. Either of these two methods is a reasonable way of programming with proof. *) +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/DecideTest.v b/vfa-current/DecideTest.v index b2680716..0f5b5302 100644 --- a/vfa-current/DecideTest.v +++ b/vfa-current/DecideTest.v @@ -75,3 +75,5 @@ Print Assumptions list_nat_in. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:48 UTC 2019 *) diff --git a/vfa-current/Extract.html b/vfa-current/Extract.html index ce802655..97a361f5 100644 --- a/vfa-current/Extract.html +++ b/vfa-current/Extract.html @@ -194,7 +194,7 @@

    ExtractRunning Coq programs in ML Parameter int2Z: intZ.
    -Axiom ltb_lt : n m : int, ltb n m = trueint2Z n < int2Z m.
    +Axiom ltb_lt : n m : int, ltb n m = trueint2Z n < int2Z m.

    @@ -224,7 +224,7 @@

    ExtractRunning Coq programs in ML

    Axiom ocaml_plus_plus: - a b c: int, + a b c: int, ocaml_plus a b = c int2Z a + int2Z b = int2Z c.
    @@ -258,17 +258,17 @@

    ExtractRunning Coq programs in ML
    -Lemma int_ltb_reflect : x y, reflect (int2Z x < int2Z y) (ltb x y).
    +Lemma int_ltb_reflect : x y, reflect (int2Z x < int2Z y) (ltb x y).
    Proof.
      intros x y.
      apply iff_reflect. symmetry. apply ltb_lt.
    Qed.

    -Lemma Z_eqb_reflect : x y, reflect (x=y) (Z.eqb x y).
    +Lemma Z_eqb_reflect : x y, reflect (x=y) (Z.eqb x y).
    Proof.
      intros x y.
      apply iff_reflect. symmetry. apply Z.eqb_eq.
    Qed.

    -Lemma Z_ltb_reflect : x y, reflect (x<y) (Z.ltb x y).
    +Lemma Z_ltb_reflect : x y, reflect (x<y) (Z.ltb x y).
    Proof.
      intros x y.
      apply iff_reflect. symmetry. apply Z.ltb_lt.
    @@ -293,13 +293,13 @@

    ExtractRunning Coq programs in ML
    -Require Import Coq.Logic.FunctionalExtensionality.

    +From Coq Require Import Logic.FunctionalExtensionality.

    Module IntMaps.
    Definition total_map (A:Type) := ZA.
    Definition t_empty {A:Type} (v : A) : total_map A := (fun _v).
    Definition t_update {A:Type} (m : total_map A) (x : Z) (v : A) :=
      fun x'if Z.eqb x x' then v else m x'.
    -Lemma t_update_eq : A (m: total_map A) x v, (t_update m x v) x = v.
    +Lemma t_update_eq : A (m: total_map A) x v, (t_update m x v) x = v.
    Proof.
    @@ -310,7 +310,7 @@

    ExtractRunning Coq programs in ML
    -Theorem t_update_neq : (X:Type) v x1 x2 (m : total_map X),
    +Theorem t_update_neq : (X:Type) v x1 x2 (m : total_map X),
      x1x2 → (t_update m x1 v) x2 = m x2.
    @@ -322,7 +322,7 @@

    ExtractRunning Coq programs in ML
    -Lemma t_update_shadow : A (m: total_map A) v1 v2 x,
    +Lemma t_update_shadow : A (m: total_map A) v1 v2 x,
        t_update (t_update m x v1) x v2 = t_update m x v2.
    @@ -378,7 +378,7 @@

    ExtractRunning Coq programs in MLfun xif Z.ltb x pivot then m1 x else m2 x.

    Inductive Abs: treetotal_map VProp :=
    | Abs_E: Abs E (t_empty default)
    -| Abs_T: a b l k v r,
    +| Abs_T: a b l k v r,
          Abs l a
          Abs r b
          Abs (T l k v r) (t_update (combine (int2Z k) a b) (int2Z k) v).

    @@ -389,12 +389,12 @@

    ExtractRunning Coq programs in ML
    -

    练习:3 星 (lookup_relate)

    +

    练习:3 星, standard (lookup_relate)

    Theorem lookup_relate:
    -   k t cts , Abs t ctslookup k t = cts (int2Z k).
    +  k t cts , Abs t ctslookup k t = cts (int2Z k).
    Proof. (* Copy your proof from SearchTree.v, and adapt it. *)
    (* 请在此处解答 *) Admitted.
    @@ -403,12 +403,12 @@

    ExtractRunning Coq programs in ML
    -

    练习:3 星 (insert_relate)

    +

    练习:3 星, standard (insert_relate)

    Theorem insert_relate:
    k v t cts,
    k v t cts,
        Abs t cts
        Abs (insert k v t) (t_update cts (int2Z k) v).
    Proof. (* Copy your proof from SearchTree.v, and adapt it. *)
    @@ -419,12 +419,12 @@

    ExtractRunning Coq programs in ML
    -

    练习:1 星 (unrealistically_strong_can_relate)

    +

    练习:1 星, standard (unrealistically_strong_can_relate)

    Lemma unrealistically_strong_can_relate:
    t, cts, Abs t cts.
    t, cts, Abs t cts.
    Proof. (* Copy-paste your proof from SearchTree.v; it should work as is. *)
    (* 请在此处解答 *) Admitted.
    @@ -470,7 +470,7 @@

    ExtractRunning Coq programs in ML -let test (f: int -> int) (n: int) = +let test (f: int -> int) (n: int) = let rec build (j, t) = if j=0 then t else build(j-1, insert (f j) 1 t) in let t1 = build(n,empty_tree) @@ -482,14 +482,14 @@

    ExtractRunning Coq programs in ML-> int) n = let (answer, time) = test f n in (print_string "Insert and lookup "; print_int n; print_string " "; print_string name; print_string " integers in "; print_float time; print_endline " seconds.") -let test_random n = print_test "random" (fun _ -> Random.int n) n -let test_consec n = print_test "consecutive" (fun i -> n-i) n +let test_random n = print_test "random" (fun _ -> Random.int n) n +let test_consec n = print_test "consecutive" (fun i -> n-i) n let run_tests() = (test_random 1000000; test_random 20000; test_consec 20000) @@ -584,7 +584,8 @@

    ExtractRunning Coq programs in ML
    -End Experiments.
    +End Experiments.

    +(* Sat Jan 26 15:18:06 UTC 2019 *)

    diff --git a/vfa-current/Extract.v b/vfa-current/Extract.v index b2a64ba9..5fa2fc17 100644 --- a/vfa-current/Extract.v +++ b/vfa-current/Extract.v @@ -182,12 +182,13 @@ Hint Resolve int_ltb_reflect Z_eqb_reflect Z_ltb_reflect : bdestruct. (** Let us re-do binary search trees, but with Ocaml integers instead of Coq nats. *) (* ================================================================= *) -(** ** Maps, on [Z] Instead of [nat] *) -(** Our original proof with nats used [Maps.total_map] in its abstraction relation, +(** ** Maps, on [Z] Instead of [nat] + + Our original proof with nats used [Maps.total_map] in its abstraction relation, but that won't work here because we need maps over [Z] rather than [nat]. So, we copy-paste-edit to make [total_map] over [Z]. *) -Require Import Coq.Logic.FunctionalExtensionality. +From Coq Require Import Logic.FunctionalExtensionality. Module IntMaps. Definition total_map (A:Type) := Z -> A. @@ -276,14 +277,14 @@ Proof. constructor. Qed. -(** **** 练习:3 星 (lookup_relate) *) +(** **** 练习:3 星, standard (lookup_relate) *) Theorem lookup_relate: forall k t cts , Abs t cts -> lookup k t = cts (int2Z k). Proof. (* Copy your proof from SearchTree.v, and adapt it. *) (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (insert_relate) *) +(** **** 练习:3 星, standard (insert_relate) *) Theorem insert_relate: forall k v t cts, Abs t cts -> @@ -292,7 +293,7 @@ Proof. (* Copy your proof from SearchTree.v, and adapt it. *) (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (unrealistically_strong_can_relate) *) +(** **** 练习:1 星, standard (unrealistically_strong_can_relate) *) Lemma unrealistically_strong_can_relate: forall t, exists cts, Abs t cts. Proof. (* Copy-paste your proof from SearchTree.v; it should work as is. *) @@ -353,21 +354,17 @@ let _ = run_tests () #use "test_searchtree.ml";; run_tests();; - On my machine, in the byte-code interpreter this prints, - Insert and lookup 1000000 random integers in 1.076 seconds. Insert and lookup 20000 random integers in 0.015 seconds. Insert and lookup 20000 consecutive integers in 5.054 seconds. - You can compile and run this with the ocaml native-code compiler by: ocamlopt searchtree.mli searchtree.ml -open Searchtree test_searchtree.ml -o test_searchtree ./test_searchtree - On my machine this prints, Insert and lookup 1000000 random integers in 0.468 seconds. @@ -376,8 +373,9 @@ Insert and lookup 20000 consecutive integers in 0.374 seconds. *) (* ################################################################# *) -(** * Unbalanced Binary Search Trees *) -(** Why is the performance of the algorithm so much worse when the +(** * Unbalanced Binary Search Trees + + Why is the performance of the algorithm so much worse when the keys are all inserted consecutively? To examine this, let's compute with some searchtrees inside Coq. We cannot do this with the search trees defined thus far in this file, because they use a key-comparison @@ -413,3 +411,5 @@ Abort. implements that idea. *) End Experiments. + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/ExtractTest.v b/vfa-current/ExtractTest.v index 053105cb..d9b4d750 100644 --- a/vfa-current/ExtractTest.v +++ b/vfa-current/ExtractTest.v @@ -96,3 +96,5 @@ Print Assumptions SearchTree2.unrealistically_strong_can_relate. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:16 UTC 2019 *) diff --git a/vfa-current/LICENSE b/vfa-current/LICENSE index 15ebac8e..568f5c1d 100644 --- a/vfa-current/LICENSE +++ b/vfa-current/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2018 +Copyright (c) 2019 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/vfa-current/Makefile b/vfa-current/Makefile index af5940f2..e66550b2 100644 --- a/vfa-current/Makefile +++ b/vfa-current/Makefile @@ -797,4 +797,3 @@ debug: .PHONY: debug .DEFAULT_GOAL := all -include .depend diff --git a/vfa-current/Maps.v b/vfa-current/Maps.v index 25f7257d..384d9871 100644 --- a/vfa-current/Maps.v +++ b/vfa-current/Maps.v @@ -1,8 +1,10 @@ (** * Maps: Total and Partial Maps *) (** This file is almost identical to the [Maps] chapter of Software - Foundations volume 1 (Logical Foundations), except that it implements - functions from [nat] to [A] rather than functions from [id] to [A]. + Foundations volume 1 (Logical Foundations), except that it + implements functions from [nat] to [A] rather than functions from + [id] to [A] and the concrete notations for writing down maps are + somewhat different. Maps (or dictionaries) are ubiquitous data structures, both in software construction generally and in the theory of programming @@ -33,9 +35,9 @@ own definitions and theorems the same as their counterparts in the standard library, wherever they overlap. *) -Require Import Coq.Arith.Arith. -Require Import Coq.Bool.Bool. -Require Import Coq.Logic.FunctionalExtensionality. +From Coq Require Import Arith.Arith. +From Coq Require Import Bool.Bool. +From Coq Require Import Logic.FunctionalExtensionality. (** Documentation for the standard library can be found at http://coq.inria.fr/library/. @@ -43,7 +45,6 @@ Require Import Coq.Logic.FunctionalExtensionality. The [Search] command is a good way to look for theorems involving objects of specific types. *) - (* ################################################################# *) (** * Total Maps *) @@ -117,15 +118,17 @@ Proof. reflexivity. Qed. extensionality axiom, which is discussed in the [Logic] chapter and included in the Coq standard library.) *) -(** **** 练习:1 星, optional (t_apply_empty) *) -(** First, the empty map returns its default element for all keys: *) +(** **** 练习:1 星, standard, optional (t_apply_empty) + + First, the empty map returns its default element for all keys: *) Lemma t_apply_empty: forall A x v, @t_empty A v x = v. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_eq) *) -(** Next, if we update a map [m] at a key [x] with a new value [v] +(** **** 练习:2 星, standard, optional (t_update_eq) + + Next, if we update a map [m] at a key [x] with a new value [v] and then look up [x] in the map resulting from the [update], we get back [v]: *) @@ -135,8 +138,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_neq) *) -(** On the other hand, if we update a map [m] at a key [x1] and then +(** **** 练习:2 星, standard, optional (t_update_neq) + + On the other hand, if we update a map [m] at a key [x1] and then look up a _different_ key [x2] in the resulting map, we get the same result that [m] would have given: *) @@ -148,8 +152,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星, optional (t_update_shadow) *) -(** If we update a map [m] at a key [x] with a value [v1] and then +(** **** 练习:2 星, standard, optional (t_update_shadow) + + If we update a map [m] at a key [x] with a value [v1] and then update again with the same key [x] and another value [v2], the resulting map behaves the same (gives the same result when applied to any key) as the simpler map obtained by performing just @@ -167,8 +172,9 @@ Proof. by proving a fundamental _reflection lemma_ relating the equality proposition on [id]s with the boolean function [eqb_id]. *) -(** **** 练习:2 星 (eqb_idP) *) -(** Use the proof of [eqb_natP] in chapter [IndProp] as a template to +(** **** 练习:2 星, standard (eqb_idP) + + Use the proof of [eqb_natP] in chapter [IndProp] as a template to prove the following: *) Lemma eqb_idP : forall x y, reflect (x = y) (x =? y). @@ -181,8 +187,9 @@ Proof. [eqb_id x1 x2] and generate hypotheses about the equality (in the sense of [=]) of [x1] and [x2]. *) -(** **** 练习:2 星 (t_update_same) *) -(** Using the example in chapter [IndProp] as a template, use +(** **** 练习:2 星, standard (t_update_same) + + Using the example in chapter [IndProp] as a template, use [eqb_idP] to prove the following theorem, which states that if we update a map to assign key [x] the same value as it already has in [m], then the result is equal to [m]: *) @@ -193,8 +200,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, recommended (t_update_permute) *) -(** Use [eqb_idP] to prove one final property of the [update] +(** **** 练习:3 星, standard, recommended (t_update_permute) + + Use [eqb_idP] to prove one final property of the [update] function: If we update a map [m] at two distinct keys, it doesn't matter in which order we do the updates. *) @@ -273,5 +281,4 @@ Proof. apply t_update_permute. Qed. -(** $Date$ *) - +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/MapsTest.v b/vfa-current/MapsTest.v index e1f1628a..c751f3f6 100644 --- a/vfa-current/MapsTest.v +++ b/vfa-current/MapsTest.v @@ -90,3 +90,5 @@ Print Assumptions t_update_permute. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:07 UTC 2019 *) diff --git a/vfa-current/Multiset.html b/vfa-current/Multiset.html index 76815987..f1cc879e 100644 --- a/vfa-current/Multiset.html +++ b/vfa-current/Multiset.html @@ -46,7 +46,7 @@

    MultisetInsertion Sort With Multiset

    -Require Import Coq.Strings.String.
    +From Coq Require Import Strings.String.
    From VFA Require Import Perm.
    From VFA Require Import Sort.
    Require Export FunctionalExtensionality.
    @@ -80,14 +80,14 @@

    MultisetInsertion Sort With Multiset

    -

    练习:1 星 (union_assoc)

    +

    练习:1 星, standard (union_assoc)

    Since multisets are represented as functions, to prove that one multiset equals another we must use the axiom of functional extensionality.
    -Lemma union_assoc: a b c : multiset, (* assoc stands for "associative" *)
    +Lemma union_assoc: a b c : multiset, (* assoc stands for "associative" *)
       union a (union b c) = union (union a b) c.
    Proof.
      intros.
    @@ -99,11 +99,11 @@

    MultisetInsertion Sort With Multiset
    -

    练习:1 星 (union_comm)

    +

    练习:1 星, standard (union_comm)

    -Lemma union_comm: a b : multiset, (* comm stands for "commutative" *)
    +Lemma union_comm: a b : multiset, (* comm stands for "commutative" *)
       union a b = union b a.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -168,18 +168,18 @@

    MultisetInsertion Sort With Multiset
    Definition is_a_sorting_algorithm' (f: list natlist nat) :=
    -   al, contents al = contents (f al) ∧ sorted (f al).
    +  al, contents al = contents (f al) ∧ sorted (f al).
    -

    练习:3 星 (insert_contents)

    +

    练习:3 星, standard (insert_contents)

    First, prove the auxiliary lemma insert_contents, which will be useful for proving sort_contents below. Your proof will be by induction. You do not need to use extensionality.
    -Lemma insert_contents: x l, contents (x::l) = contents (insert x l).
    +Lemma insert_contents: x l, contents (x::l) = contents (insert x l).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -188,12 +188,12 @@

    MultisetInsertion Sort With Multiset
    -

    练习:3 星 (sort_contents)

    +

    练习:3 星, standard (sort_contents)

    Now prove that sort preserves contents.
    -Theorem sort_contents: l, contents l = contents (sort l).
    +Theorem sort_contents: l, contents l = contents (sort l).
    (* 请在此处解答 *) Admitted.
    @@ -213,7 +213,7 @@

    MultisetInsertion Sort With Multiset

    -

    练习:1 星 (permutations_vs_multiset)

    +

    练习:1 星, standard (permutations_vs_multiset)

    Compare your proofs of insert_perm, sort_perm with your proofs of insert_contents, sort_contents. Which proofs are simpler? @@ -273,14 +273,14 @@

    MultisetInsertion Sort With Multiset Permutation al bl contents al = contents bl.
    -

    练习:3 星 (perm_contents)

    +

    练习:3 星, standard (perm_contents)

    The forward direction is easy, by induction on the evidence for Permutation:

    Lemma perm_contents:
    -   al bl : list nat,
    +  al bl : list nat,
       Permutation al blcontents al = contents bl.
    (* 请在此处解答 *) Admitted.
    @@ -306,12 +306,12 @@

    MultisetInsertion Sort With Multiset

    -

    练习:3 星 (delete_contents)

    +

    练习:3 星, standard (delete_contents)

    Lemma delete_contents:
    -   v al,
    +  v al,
       contents (list_delete al v) = multiset_delete (contents al) v.
    Proof.
      intros.
    @@ -328,12 +328,12 @@

    MultisetInsertion Sort With Multiset
    -

    练习:2 星 (contents_perm_aux)

    +

    练习:2 星, standard (contents_perm_aux)

    Lemma contents_perm_aux:
    v b, empty = union (singleton v) bFalse.
    v b, empty = union (singleton v) bFalse.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -342,12 +342,12 @@

    MultisetInsertion Sort With Multiset
    -

    练习:2 星 (contents_in)

    +

    练习:2 星, standard (contents_in)

    Lemma contents_in:
    -   (a: value) (bl: list value) , contents bl a > 0 → In a bl.
    +  (a: value) (bl: list value) , contents bl a > 0 → In a bl.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -356,12 +356,12 @@

    MultisetInsertion Sort With Multiset
    -

    练习:2 星 (in_perm_delete)

    +

    练习:2 星, standard (in_perm_delete)

    Lemma in_perm_delete:
    -   a bl,
    +  a bl,
      In a blPermutation (a :: list_delete bl a) bl.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -371,12 +371,12 @@

    MultisetInsertion Sort With Multiset
    -

    练习:4 星 (contents_perm)

    +

    练习:4 星, standard (contents_perm)

    Lemma contents_perm:
    al bl, contents al = contents blPermutation al bl.
    al bl, contents al = contents blPermutation al bl.
    Proof.
      induction al; destruct bl; intro.
      auto.
    @@ -410,7 +410,7 @@

    MultisetInsertion Sort With Multiset

    Theorem same_contents_iff_perm:
    -   al bl, contents al = contents blPermutation al bl.
    +  al bl, contents al = contents blPermutation al bl.
    Proof.
      intros. split. apply contents_perm. apply perm_contents.
    Qed.
    @@ -423,13 +423,14 @@

    MultisetInsertion Sort With Multiset
    Corollary sort_specifications_equivalent:
    -     sort, is_a_sorting_algorithm sortis_a_sorting_algorithm' sort.
    +    sort, is_a_sorting_algorithm sortis_a_sorting_algorithm' sort.
    Proof.
      unfold is_a_sorting_algorithm, is_a_sorting_algorithm'.
      split; intros;
      destruct (H al); split; auto;
      apply same_contents_iff_perm; auto.
    -Qed.
    +Qed.

    +(* Sat Jan 26 15:18:06 UTC 2019 *)

    diff --git a/vfa-current/Multiset.v b/vfa-current/Multiset.v index fd305d94..d9bb2f89 100644 --- a/vfa-current/Multiset.v +++ b/vfa-current/Multiset.v @@ -8,7 +8,7 @@ with repeats, where the order does not matter. One simple representation of a multiset is a function from values to [nat]. *) -Require Import Coq.Strings.String. +From Coq Require Import Strings.String. From VFA Require Import Perm. From VFA Require Import Sort. Require Export FunctionalExtensionality. @@ -35,8 +35,9 @@ Definition union (a b : multiset) : multiset := Definition singleton (v: value) : multiset := fun x => if x =? v then 1 else 0. -(** **** 练习:1 星 (union_assoc) *) -(** Since multisets are represented as functions, to prove that one +(** **** 练习:1 星, standard (union_assoc) + + Since multisets are represented as functions, to prove that one multiset equals another we must use the axiom of functional extensionality. *) @@ -48,7 +49,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (union_comm) *) +(** **** 练习:1 星, standard (union_comm) *) Lemma union_comm: forall a b : multiset, (* comm stands for "commutative" *) union a b = union b a. Proof. @@ -96,8 +97,9 @@ Qed. Definition is_a_sorting_algorithm' (f: list nat -> list nat) := forall al, contents al = contents (f al) /\ sorted (f al). -(** **** 练习:3 星 (insert_contents) *) -(** First, prove the auxiliary lemma [insert_contents], which will be +(** **** 练习:3 星, standard (insert_contents) + + First, prove the auxiliary lemma [insert_contents], which will be useful for proving [sort_contents] below. Your proof will be by induction. You do not need to use [extensionality]. *) @@ -106,8 +108,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (sort_contents) *) -(** Now prove that sort preserves contents. *) +(** **** 练习:3 星, standard (sort_contents) + + Now prove that sort preserves contents. *) Theorem sort_contents: forall l, contents l = contents (sort l). (* 请在此处解答 *) Admitted. @@ -121,8 +124,9 @@ Proof. split. apply sort_contents. apply sort_sorted. Qed. -(** **** 练习:1 星 (permutations_vs_multiset) *) -(** Compare your proofs of [insert_perm, sort_perm] with your proofs +(** **** 练习:1 星, standard (permutations_vs_multiset) + + Compare your proofs of [insert_perm, sort_perm] with your proofs of [insert_contents, sort_contents]. Which proofs are simpler? - [ ] easier with permutations, @@ -148,8 +152,9 @@ Definition manual_grade_for_permutations_vs_multiset : option (nat*string) := No [Permutation al bl <-> contents al = contents bl.] *) -(** **** 练习:3 星 (perm_contents) *) -(** The forward direction is easy, by induction on the evidence for +(** **** 练习:3 星, standard (perm_contents) + + The forward direction is easy, by induction on the evidence for [Permutation]: *) Lemma perm_contents: @@ -172,7 +177,7 @@ Fixpoint list_delete (al: list value) (v: value) := Definition multiset_delete (m: multiset) (v: value) := fun x => if x =? v then pred(m x) else m x. -(** **** 练习:3 星 (delete_contents) *) +(** **** 练习:3 星, standard (delete_contents) *) Lemma delete_contents: forall v al, contents (list_delete al v) = multiset_delete (contents al) v. @@ -187,21 +192,21 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (contents_perm_aux) *) +(** **** 练习:2 星, standard (contents_perm_aux) *) Lemma contents_perm_aux: forall v b, empty = union (singleton v) b -> False. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (contents_in) *) +(** **** 练习:2 星, standard (contents_in) *) Lemma contents_in: forall (a: value) (bl: list value) , contents bl a > 0 -> In a bl. Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (in_perm_delete) *) +(** **** 练习:2 星, standard (in_perm_delete) *) Lemma in_perm_delete: forall a bl, In a bl -> Permutation (a :: list_delete bl a) bl. @@ -209,7 +214,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (contents_perm) *) +(** **** 练习:4 星, standard (contents_perm) *) Lemma contents_perm: forall al bl, contents al = contents bl -> Permutation al bl. Proof. @@ -251,3 +256,5 @@ Proof. destruct (H al); split; auto; apply same_contents_iff_perm; auto. Qed. + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/MultisetTest.v b/vfa-current/MultisetTest.v index 7d991f58..7b1dfe7e 100644 --- a/vfa-current/MultisetTest.v +++ b/vfa-current/MultisetTest.v @@ -208,3 +208,5 @@ Print Assumptions contents_perm. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:11 UTC 2019 *) diff --git a/vfa-current/Perm.html b/vfa-current/Perm.html index abb7dd2a..15be0464 100644 --- a/vfa-current/Perm.html +++ b/vfa-current/Perm.html @@ -75,7 +75,7 @@

    PermBasic Techniques for Permutation

    -Require Import Coq.Strings.String.
    +From Coq Require Import Strings.String.
    Require Export Coq.Bool.Bool.
    Require Export Coq.Arith.Arith.
    Require Export Coq.Arith.EqNat.
    @@ -96,10 +96,10 @@

    PermBasic Techniques for Permutation

    -Check Nat.lt. (* : nat -> nat -> Prop *)
    -Check lt. (* : nat -> nat -> Prop *)
    +Check Nat.lt. (* : nat -> nat -> Prop *)
    +Check lt. (* : nat -> nat -> Prop *)
    Goal Nat.lt = lt. Proof. reflexivity. Qed. (* They are the same *)
    -Check Nat.ltb. (* : nat -> nat -> bool *)
    +Check Nat.ltb. (* : nat -> nat -> bool *)
    Locate "_ < _". (* "x < y" := lt x y *)
    Locate "<?". (* x <? y  := Nat.ltb x y *)
    @@ -113,7 +113,7 @@

    PermBasic Techniques for Permutation
    Check Nat.ltb_lt.
    -(* : forall n m : nat, (n <? m) = true <-> n < m *)
    +(* : forall n m : nat, (n <? m) = true <-> n < m *)
    @@ -148,17 +148,17 @@

    PermBasic Techniques for Permutation

    -Lemma eqb_reflect : x y, reflect (x = y) (x =? y).
    +Lemma eqb_reflect : x y, reflect (x = y) (x =? y).
    Proof.
      intros x y.
      apply iff_reflect. symmetry. apply Nat.eqb_eq.
    Qed.

    -Lemma ltb_reflect : x y, reflect (x < y) (x <? y).
    +Lemma ltb_reflect : x y, reflect (x < y) (x <? y).
    Proof.
      intros x y.
      apply iff_reflect. symmetry. apply Nat.ltb_lt.
    Qed.

    -Lemma leb_reflect : x y, reflect (xy) (x <=? y).
    +Lemma leb_reflect : x y, reflect (xy) (x <=? y).
    Proof.
      intros x y.
      apply iff_reflect. symmetry. apply Nat.leb_le.
    @@ -173,7 +173,7 @@

    PermBasic Techniques for Permutation

    -Example reflect_example1: a, (if a<?5 then a else 2) < 6.
    +Example reflect_example1: a, (if a<?5 then a else 2) < 6.
    Proof.
      intros.
      destruct (ltb_reflect a 5) as [H|H].
    @@ -231,7 +231,7 @@

    PermBasic Techniques for Permutation

    -Example reflect_example2: a, (if a<?5 then a else 2) < 6.
    +Example reflect_example2: a, (if a<?5 then a else 2) < 6.
    Proof.
      intros.
      bdestruct (a<?5). (* instead of: destruct (ltb_reflect a 5) as [H|H]. *)
    @@ -271,9 +271,9 @@

    PermBasic Techniques for Permutation Module Exploration1.

    Theorem omega_example1:
    i j k,
    i j k,
        i < j
    -    ¬ (k - 3 ≤ j) →
    +    ¬(k - 3 ≤ j) →
       k > i.
    Proof.
      intros.
    @@ -286,7 +286,7 @@

    PermBasic Techniques for Permutation
      (* try to remember the name of the lemma about negation and  *)
    -  Search___).
    +  Search___).
      apply not_le in H0.
      (* try to remember the name of the transitivity lemma about > *)
      Search (_ > __ > __ > _).
    @@ -296,7 +296,7 @@

    PermBasic Techniques for Permutation      this is not actually true, because we are talking about
         natural numbers with "bogus subtraction." *)

    Abort.

    -Theorem bogus_subtraction: ¬ ( k:nat, k > k - 3).
    +Theorem bogus_subtraction: ¬(k:nat, k > k - 3).
    Proof.
      (* intro introduces exactly one thing, like intros ? *)
      intro.
    @@ -313,9 +313,9 @@

    PermBasic Techniques for Permutation
    Theorem omega_example1:
    i j k,
    i j k,
        i < j
    -    ¬ (k - 3 ≤ j) →
    +    ¬(k - 3 ≤ j) →
       k > i.
    Proof. (* try again! *)
      intros.
    @@ -340,9 +340,9 @@

    PermBasic Techniques for Permutation
    Theorem omega_example2:
    i j k,
    i j k,
        i < j
    -    ¬ (k - 3 ≤ j) →
    +    ¬(k - 3 ≤ j) →
       k > i.
    Proof.
      intros.
    @@ -416,7 +416,7 @@

    PermBasic Techniques for Permutation
    Print Nat.ltb.
    -(* =  fun n m : nat => S n <=? m : nat -> nat -> bool  *)
    +(* =  fun n m : nat => S n <=? m : nat -> nat -> bool  *)
    Locate ">=?".
    @@ -439,7 +439,7 @@

    PermBasic Techniques for Permutation
    Theorem maybe_swap_idempotent:
    -   al, maybe_swap (maybe_swap al) = maybe_swap al.
    +  al, maybe_swap (maybe_swap al) = maybe_swap al.
    Proof.
      intros.
      destruct al as [ | a al].
    @@ -496,7 +496,7 @@

    PermBasic Techniques for Permutation
    Theorem maybe_swap_idempotent:
    -   al, maybe_swap (maybe_swap al) = maybe_swap al.
    +  al, maybe_swap (maybe_swap al) = maybe_swap al.
    Proof.
      intros.
      destruct al as [ | a al].
    @@ -550,7 +550,7 @@

    PermBasic Techniques for Permutation
    Theorem maybe_swap_idempotent':
    -   al, maybe_swap (maybe_swap al) = maybe_swap al.
    +  al, maybe_swap (maybe_swap al) = maybe_swap al.
    Proof.
      intros.
      destruct al as [ | a al].
    @@ -588,7 +588,7 @@

    PermBasic Techniques for Permutation
    Locate Permutation. (* Inductive Coq.Sorting.Permutation.Permutation *)
    -Check Permutation. (*  : forall {A : Type}, list A -> list A -> Prop *)
    +Check Permutation. (*  : forall {A : Type}, list A -> list A -> Prop *)
    @@ -600,16 +600,16 @@

    PermBasic Techniques for Permutation Print Permutation.
    (*
    - Inductive Permutation {A : Type} : list A -> list A -> Prop :=
    + Inductive Permutation {A : Type} : list A -> list A -> Prop :=
        perm_nil : Permutation  
      | perm_skip : forall (x : A) (l l' : list A),
    -                Permutation l l' ->
    +                Permutation l l' ->
                    Permutation (x :: l) (x :: l')
      | perm_swap : forall (x y : A) (l : list A),
                    Permutation (y :: x :: l) (x :: y :: l)
      | perm_trans : forall l l' l'' : list A,
    -                 Permutation l l' ->
    -                 Permutation l' l'' ->
    +                 Permutation l l' ->
    +                 Permutation l' l'' ->
                     Permutation l l''.
    *)

    @@ -631,7 +631,7 @@

    PermBasic Techniques for Permutation think permutations ought to have.
    -

    练习:2 星 (Permutation_properties)

    +

    练习:2 星, standard (Permutation_properties)

    Think of some properties of the Permutation relation and write them down informally in English, or a mix of Coq and English. Here are four to get you started: @@ -689,7 +689,7 @@

    PermBasic Techniques for Permutation

    -Example butterfly: b u t e r f l y : nat,
    +Example butterfly: b u t e r f l y : nat,
      Permutation ([b;u;t;t;e;r]++[f;l;y]) ([f;l;u;t;t;e;r]++[b;y]).
    Proof.
     intros.
    @@ -736,7 +736,7 @@

    PermBasic Techniques for Permutation to cancel an append-chunk.
    -

    练习:3 星 (permut_example)

    +

    练习:3 星, standard (permut_example)

    Use the permutation rules in the library (see the Search, above) to prove the following theorem. These Check commands are a hint about what lemmas you'll need. @@ -747,7 +747,7 @@

    PermBasic Techniques for Permutation Check Permutation_refl.
    Check Permutation_app_comm.
    Check app_assoc.

    -Example permut_example: (a b: list nat),
    +Example permut_example: (a b: list nat),
      Permutation (5::6::a++b) ((5::b)++(6::a++[])).
    Proof.
     (* After you cancel the 5, then bring the 6 to the front... *)
    @@ -758,7 +758,7 @@

    PermBasic Techniques for Permutation
    -

    练习:1 星 (not_a_permutation)

    +

    练习:1 星, standard (not_a_permutation)

    Prove that [1;1] is not a permutation of [1;2]. Hints are given as Check commands.
    @@ -767,7 +767,7 @@

    PermBasic Techniques for Permutation Check Permutation_cons_inv.
    Check Permutation_length_1_inv.

    Example not_a_permutation:
    -  ¬ Permutation [1;1] [1;2].
    +  ¬Permutation [1;1] [1;2].
    Proof.
    (* 请在此处解答 *) Admitted.

    @@ -781,7 +781,7 @@

    PermBasic Techniques for Permutation

    -Theorem maybe_swap_perm: al,
    +Theorem maybe_swap_perm: al,
      Permutation al (maybe_swap al).
    Proof.
      (* 课上已完成 *)
    @@ -809,7 +809,7 @@

    PermBasic Techniques for Permutation   | a::b::_ ⇒ ab
      | _True
      end.

    -Theorem maybe_swap_correct: al,
    +Theorem maybe_swap_correct: al,
        Permutation al (maybe_swap al)
        ∧ first_le_second (maybe_swap al).
    Proof.
    @@ -844,14 +844,14 @@

    PermBasic Techniques for Permutation the next few chapters.
    -

    练习:2 星 (Forall_perm)

    +

    练习:2 星, standard (Forall_perm)

    To close, a useful utility lemma. Prove this by induction; but is it induction on al, or on bl, or on Permutation al bl, or on Forall f al ?

    -Theorem Forall_perm: {A} (f: AProp) al bl,
    +Theorem Forall_perm: {A} (f: AProp) al bl,
      Permutation al bl
      Forall f alForall f bl.
    Proof.
    @@ -859,10 +859,9 @@

    PermBasic Techniques for Permutation

    -
    -
    +
    - +(* Sat Jan 26 15:18:06 UTC 2019 *)
    diff --git a/vfa-current/Perm.v b/vfa-current/Perm.v index 6531a27f..48cd4dcb 100644 --- a/vfa-current/Perm.v +++ b/vfa-current/Perm.v @@ -16,7 +16,7 @@ to reasoning about algorithms and data structures. *) -Require Import Coq.Strings.String. +From Coq Require Import Strings.String. Require Export Coq.Bool.Bool. Require Export Coq.Arith.Arith. Require Export Coq.Arith.EqNat. @@ -107,8 +107,9 @@ Qed. (** But there's another way to use [ltb_reflect], etc: read on. *) (* ================================================================= *) -(** ** Some Advanced Tactical Hacking *) -(** You may skip ahead to "Inversion/clear/subst". +(** ** Some Advanced Tactical Hacking + + You may skip ahead to "Inversion/clear/subst". Right here, we build some machinery that you'll want to _use_, but you won't need to know how to _build_ it. @@ -145,8 +146,9 @@ Proof. Qed. (* ================================================================= *) -(** ** [inversion] / [clear] / [subst] *) -(** Coq's [inversion H] tactic is so good at extracting information +(** ** [inversion] / [clear] / [subst] + + Coq's [inversion H] tactic is so good at extracting information from the hypothesis [H] that [H] becomes completely redundant, and one might as well [clear] it from the goal. Then, since the [inversion] typically creates some equality facts, why not then @@ -443,8 +445,9 @@ Print Permutation. should use this specification to prove some properties that we think permutations ought to have. *) -(** **** 练习:2 星 (Permutation_properties) *) -(** Think of some properties of the [Permutation] relation and write +(** **** 练习:2 星, standard (Permutation_properties) + + Think of some properties of the [Permutation] relation and write them down informally in English, or a mix of Coq and English. Here are four to get you started: - 1. If [Permutation al bl], then [length al = length bl]. @@ -515,8 +518,9 @@ Qed. [perm_skip] to cancel a single element, or [Permutation_app_head] to cancel an append-chunk. *) -(** **** 练习:3 星 (permut_example) *) -(** Use the permutation rules in the library (see the [Search], +(** **** 练习:3 星, standard (permut_example) + + Use the permutation rules in the library (see the [Search], above) to prove the following theorem. These [Check] commands are a hint about what lemmas you'll need. *) @@ -532,8 +536,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:1 星 (not_a_permutation) *) -(** Prove that [[1;1]] is not a permutation of [[1;2]]. +(** **** 练习:1 星, standard (not_a_permutation) + + Prove that [[1;1]] is not a permutation of [[1;2]]. Hints are given as [Check] commands. *) Check Permutation_cons_inv. @@ -605,8 +610,9 @@ End Exploration1. [maybe_swap_correct] will be applied (at a larger scale) in the next few chapters. *) -(** **** 练习:2 星 (Forall_perm) *) -(** To close, a useful utility lemma. Prove this by induction; +(** **** 练习:2 星, standard (Forall_perm) + + To close, a useful utility lemma. Prove this by induction; but is it induction on [al], or on [bl], or on [Permutation al bl], or on [Forall f al] ? *) @@ -617,4 +623,5 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** $Date$ *) + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/PermTest.v b/vfa-current/PermTest.v index 0c072ee3..ee2cb2e9 100644 --- a/vfa-current/PermTest.v +++ b/vfa-current/PermTest.v @@ -99,3 +99,5 @@ Print Assumptions Forall_perm. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:09 UTC 2019 *) diff --git a/vfa-current/Preface.html b/vfa-current/Preface.html index d2af455d..e358945d 100644 --- a/vfa-current/Preface.html +++ b/vfa-current/Preface.html @@ -110,7 +110,7 @@

    Preface

    - Preface -> Perm -> Sort -> SearchTree -> Redblack + Preface -> Perm -> Sort -> SearchTree -> Redblack
    @@ -119,16 +119,16 @@

    Preface

    @@ -144,7 +144,7 @@

    Preface

    Coq runs on Windows, Linux, and OS X. The Preface of Volume 1 describes the Coq installation you will need. This edition was - built with Coq 8.8.0. + built with Coq 8.8.1.
    @@ -256,6 +256,10 @@

    Preface

    NSF Expeditions grant 1521523, _The Science of Deep Specification_.

    +
    + +(* Sat Jan 26 15:18:06 UTC 2019 *)
    +

    diff --git a/vfa-current/Preface.v b/vfa-current/Preface.v index 5806d759..aea255b6 100644 --- a/vfa-current/Preface.v +++ b/vfa-current/Preface.v @@ -69,7 +69,7 @@ (** Coq runs on Windows, Linux, and OS X. The Preface of Volume 1 describes the Coq installation you will need. This edition was - built with Coq 8.8.0. + built with Coq 8.8.1. In addition, two of the chapters ask you to compile and run an OCaml program; having OCaml installed on your computer is helpful, @@ -144,3 +144,4 @@ NSF Expeditions grant 1521523, _The Science of Deep Specification_. *) +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/PrefaceTest.v b/vfa-current/PrefaceTest.v index 0fb4e1af..53f9d03a 100644 --- a/vfa-current/PrefaceTest.v +++ b/vfa-current/PrefaceTest.v @@ -43,3 +43,5 @@ idtac "********** Standard **********". idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:08 UTC 2019 *) diff --git a/vfa-current/Priqueue.html b/vfa-current/Priqueue.html index 9f947e41..5fd59ea9 100644 --- a/vfa-current/Priqueue.html +++ b/vfa-current/Priqueue.html @@ -155,27 +155,27 @@

    PriqueuePriority Queues

      Parameter merge: priqueuepriqueuepriqueue.

      Parameter priq: priqueueProp.
      Parameter Abs: priqueuelist keyProp.
    -  Axiom can_relate: p, priq p al, Abs p al.
    -  Axiom abs_perm: p al bl,
    +  Axiom can_relate: p, priq pal, Abs p al.
    +  Axiom abs_perm: p al bl,
       priq pAbs p alAbs p blPermutation al bl.
      Axiom empty_priq: priq empty.
      Axiom empty_relate: Abs empty nil.
    -  Axiom insert_priq: k p, priq ppriq (insert k p).
    +  Axiom insert_priq: k p, priq ppriq (insert k p).
      Axiom insert_relate:
    -         p al k, priq pAbs p alAbs (insert k p) (k::al).
    +        p al k, priq pAbs p alAbs (insert k p) (k::al).
      Axiom delete_max_None_relate:
    -         p, priq p → (Abs p nildelete_max p = None).
    +        p, priq p → (Abs p nildelete_max p = None).
      Axiom delete_max_Some_priq:
    -       p q k, priq pdelete_max p = Some(k,q) → priq q.
    +      p q k, priq pdelete_max p = Some(k,q) → priq q.
      Axiom delete_max_Some_relate:
    -   (p q: priqueue) k (pl ql: list key), priq p
    +  (p q: priqueue) k (pl ql: list key), priq p
       Abs p pl
       delete_max p = Some (k,q) →
       Abs q ql
       Permutation pl (k::ql) ∧ Forall (ge k) ql.
    -  Axiom merge_priq: p q, priq ppriq qpriq (merge p q).
    +  Axiom merge_priq: p q, priq ppriq qpriq (merge p q).
      Axiom merge_relate:
    -     p q pl ql al,
    +    p q pl ql al,
           priq ppriq q
           Abs p plAbs q qlAbs (merge p q) al
           Permutation al (pl++ql).
    @@ -232,13 +232,13 @@

    PriqueuePriority Queues

    -

    练习:3 星 (select_perm_and_friends)

    +

    练习:3 星, standard (select_perm_and_friends)


    -Lemma select_perm: i l,
    +Lemma select_perm: i l,
      let (j,r) := select i l in
       Permutation (i::l) (j::r).
    Proof. (* Copy your proof from Selection.v, and change one character. *)
    @@ -246,14 +246,14 @@

    PriqueuePriority Queues

    induction l; intros; simpl in *.
    (* 请在此处解答 *) Admitted.

    Lemma select_biggest_aux:
    -   i al j bl,
    +  i al j bl,
        Forall (fun xjx) bl
        select i al = (j,bl) →
        ji.
    Proof. (* Copy your proof of select_smallest_aux from Selection.v, and edit. *)
    (* 请在此处解答 *) Admitted.

    Theorem select_biggest:
    -   i al j bl, select i al = (j,bl) →
    +  i al j bl, select i al = (j,bl) →
         Forall (fun xjx) bl.
    Proof. (* Copy your proof of select_smallest from Selection.v, and edit. *)
    intros i al; revert i; induction al; intros; simpl in *.
    @@ -309,7 +309,7 @@

    PriqueuePriority Queues

    Inductive Abs': priqueuelist keyProp :=
    -Abs_intro: p, Abs' p p.

    +Abs_intro: p, Abs' p p.

    Definition Abs := Abs'.
    @@ -320,9 +320,9 @@

    PriqueuePriority Queues


    -Lemma can_relate : p, priq p al, Abs p al.
    +Lemma can_relate : p, priq pal, Abs p al.
    Proof.
    -  intros. p; constructor.
    +  intros. p; constructor.
    Qed.
    @@ -334,7 +334,7 @@

    PriqueuePriority Queues

    -Lemma abs_perm: p al bl,
    +Lemma abs_perm: p al bl,
       priq pAbs p alAbs p blPermutation al bl.
    Proof.
    intros.
    @@ -353,30 +353,30 @@

    PriqueuePriority Queues

    Proof. constructor. Qed.

    Lemma empty_relate: Abs empty nil.
    Proof. constructor. Qed.

    -Lemma insert_priq: k p, priq ppriq (insert k p).
    +Lemma insert_priq: k p, priq ppriq (insert k p).
    Proof. intros; constructor. Qed.

    Lemma insert_relate:
    -     p al k, priq pAbs p alAbs (insert k p) (k::al).
    +    p al k, priq pAbs p alAbs (insert k p) (k::al).
    Proof. intros. unfold insert. inv H0. constructor. Qed.

    Lemma delete_max_Some_priq:
    -       p q k, priq pdelete_max p = Some(k,q) → priq q.
    +      p q k, priq pdelete_max p = Some(k,q) → priq q.
    Proof. constructor. Qed.
    -

    练习:2 星 (simple_priq_proofs)

    +

    练习:2 星, standard (simple_priq_proofs)


    Lemma delete_max_None_relate:
    -   p, priq p
    +  p, priq p
          (Abs p nildelete_max p = None).
    Proof.
    (* 请在此处解答 *) Admitted.

    Lemma delete_max_Some_relate:
    -   (p q: priqueue) k (pl ql: list key), priq p
    +  (p q: priqueue) k (pl ql: list key), priq p
       Abs p pl
       delete_max p = Some (k,q) →
       Abs q ql
    @@ -384,10 +384,10 @@

    PriqueuePriority Queues

    Proof.
    (* 请在此处解答 *) Admitted.

    Lemma merge_priq:
    -   p q, priq ppriq qpriq (merge p q).
    +  p q, priq ppriq qpriq (merge p q).
    Proof. intros. constructor. Qed.

    Lemma merge_relate:
    -     p q pl ql al,
    +    p q pl ql al,
           priq ppriq q
           Abs p plAbs q qlAbs (merge p q) al
           Permutation al (pl++ql).
    @@ -398,7 +398,8 @@

    PriqueuePriority Queues

    -End List_Priqueue.
    +End List_Priqueue.

    +(* Sat Jan 26 15:18:06 UTC 2019 *)
    diff --git a/vfa-current/Priqueue.v b/vfa-current/Priqueue.v index a0d26a4d..194abad1 100644 --- a/vfa-current/Priqueue.v +++ b/vfa-current/Priqueue.v @@ -49,10 +49,10 @@ *) - (* ################################################################# *) -(** * Module Signature *) -(** This is the "signature" of a correct implementation of priority queues +(** * Module Signature + + This is the "signature" of a correct implementation of priority queues where the keys are natural numbers. Using [nat] for the key type is a bit silly, since the comparison function Nat.ltb takes linear time in the value of the numbers! But you have already seen in the @@ -134,7 +134,7 @@ match l with else let (j,l') := select h t in (j, i::l') end. -(** **** 练习:3 星 (select_perm_and_friends) *) +(** **** 练习:3 星, standard (select_perm_and_friends) *) Lemma select_perm: forall i l, let (j,r) := select i l in @@ -238,7 +238,7 @@ Lemma delete_max_Some_priq: forall p q k, priq p -> delete_max p = Some(k,q) -> priq q. Proof. constructor. Qed. -(** **** 练习:2 星 (simple_priq_proofs) *) +(** **** 练习:2 星, standard (simple_priq_proofs) *) Lemma delete_max_None_relate: forall p, priq p -> @@ -270,3 +270,4 @@ Proof. End List_Priqueue. +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/PriqueueTest.v b/vfa-current/PriqueueTest.v index 9ebdfbb2..c5557eaa 100644 --- a/vfa-current/PriqueueTest.v +++ b/vfa-current/PriqueueTest.v @@ -144,3 +144,5 @@ Print Assumptions List_Priqueue.delete_max_Some_relate. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:45 UTC 2019 *) diff --git a/vfa-current/Redblack.html b/vfa-current/Redblack.html index 35517bc2..ba07a18d 100644 --- a/vfa-current/Redblack.html +++ b/vfa-current/Redblack.html @@ -109,9 +109,9 @@

    RedblackImplementation and Proof of From VFA Require Import Perm.
    From VFA Require Import Extract.
    -Require Import Coq.Lists.List.
    +From Coq Require Import Lists.List.
    Export ListNotations.
    -Require Import Coq.Logic.FunctionalExtensionality.
    +From Coq Require Import Logic.FunctionalExtensionality.
    Require Import ZArith.
    Open Scope Z_scope.

    Definition key := int.

    @@ -218,7 +218,7 @@

    RedblackImplementation and Proof of
    Lemma T_neq_E:
    -   c l k v r, T c l k v rE.
    +  c l k v r, T c l k v rE.
    Proof.
    intros. intro Hx. inversion Hx.
    Qed.
    @@ -231,7 +231,7 @@

    RedblackImplementation and Proof of

    -Lemma ins_not_E: x vx s, ins x vx sE.
    +Lemma ins_not_E: x vx s, ins x vx sE.
    Proof.
    intros. destruct s; simpl.
    apply T_neq_E.
    @@ -269,7 +269,7 @@

    RedblackImplementation and Proof of
    match goal with
    -| |- match ?c with Red_ | Black_ end_destruct c
    +| ⊢ match ?c with Red_ | Black_ end_destruct c
    end.
    @@ -287,7 +287,7 @@

    RedblackImplementation and Proof of
    match goal with
    -    | |- match ?s with E_ | T _ _ _ _ __ end_destruct s
    +    | ⊢ match ?s with E_ | T _ _ _ _ __ end_destruct s
    end.
    @@ -298,10 +298,10 @@

    RedblackImplementation and Proof of
    repeat match goal with
    -    | |- match ?s with E_ | T _ _ _ _ __ end_destruct s
    +    | ⊢ match ?s with E_ | T _ _ _ _ __ end_destruct s
    end.
    match goal with
    -  | |- T _ _ _ _ _Eapply T_neq_E
    +  | ⊢ T _ _ _ _ _Eapply T_neq_E
    end.
    @@ -311,7 +311,7 @@

    RedblackImplementation and Proof of
    Abort.

    -Lemma ins_not_E: x vx s, ins x vx sE.
    +Lemma ins_not_E: x vx s, ins x vx sE.
    Proof.
    intros. destruct s; simpl.
    apply T_neq_E.
    @@ -326,9 +326,9 @@

    RedblackImplementation and Proof of
    repeat match goal with
    -  | |- (if ?x then _ else _) ≠ _destruct x
    -  | |- match ?c with Red_ | Black_ end_destruct c
    -  | |- match ?s with E_ | T _ _ _ _ __ end_destruct s
    +  | ⊢ (if ?x then _ else _) ≠ _destruct x
    +  | ⊢ match ?c with Red_ | Black_ end_destruct c
    +  | ⊢ match ?s with E_ | T _ _ _ _ __ end_destruct s
    end.
    @@ -351,7 +351,7 @@

    RedblackImplementation and Proof of apply T_neq_E.
    (* Only 107 cases to go... *)
    Abort.

    -Lemma ins_not_E: x vx s, ins x vx sE.
    +Lemma ins_not_E: x vx s, ins x vx sE.
    Proof.
    intros. destruct s; simpl.
    apply T_neq_E.
    @@ -366,10 +366,10 @@

    RedblackImplementation and Proof of
    repeat match goal with
    -  | |- (if ?x then _ else _) ≠ _destruct x
    -  | |- match ?c with Red_ | Black_ end_destruct c
    -  | |- match ?s with E_ | T _ _ _ _ __ end_destruct s
    -  | |- T _ _ _ _ _Eapply T_neq_E
    +  | ⊢ (if ?x then _ else _) ≠ _destruct x
    +  | ⊢ match ?c with Red_ | Black_ end_destruct c
    +  | ⊢ match ?s with E_ | T _ _ _ _ __ end_destruct s
    +  | ⊢ T _ _ _ _ _Eapply T_neq_E
     end.
    Qed.
    @@ -386,13 +386,13 @@

    RedblackImplementation and Proof of
    Inductive SearchTree' : ZtreeZProp :=
    -| ST_E : lo hi, lohiSearchTree' lo E hi
    -| ST_T: lo c l k v r hi,
    +| ST_E : lo hi, lohiSearchTree' lo E hi
    +| ST_T: lo c l k v r hi,
        SearchTree' lo l (int2Z k) →
        SearchTree' (int2Z k + 1) r hi
        SearchTree' lo (T c l k v r) hi.

    Inductive SearchTree: treeProp :=
    -| ST_intro: t lo hi, SearchTree' lo t hiSearchTree t.
    +| ST_intro: t lo hi, SearchTree' lo t hiSearchTree t.
    @@ -401,7 +401,7 @@

    RedblackImplementation and Proof of

    Lemma balance_SearchTree:
    c s1 k kv s2 lo hi,
    c s1 k kv s2 lo hi,
       SearchTree' lo s1 (int2Z k) →
       SearchTree' (int2Z k + 1) s2 hi
       SearchTree' lo (balance c s1 k kv s2) hi.
    @@ -416,8 +416,8 @@

    RedblackImplementation and Proof of
    repeat match goal with
    -  | |- SearchTree' _ (match ?c with Red_ | Black_ end) _destruct c
    -  | |- SearchTree' _ (match ?s with E_ | T _ _ _ _ __ end) _destruct s
    +  | ⊢ SearchTree' _ (match ?c with Red_ | Black_ end) _destruct c
    +  | ⊢ SearchTree' _ (match ?s with E_ | T _ _ _ _ __ end) _destruct s
      end.
    @@ -461,7 +461,7 @@

    RedblackImplementation and Proof of Abort.

    Lemma balance_SearchTree:
    c s1 k kv s2 lo hi,
    c s1 k kv s2 lo hi,
       SearchTree' lo s1 (int2Z k) →
       SearchTree' (int2Z k + 1) s2 hi
       SearchTree' lo (balance c s1 k kv s2) hi.
    @@ -476,12 +476,12 @@

    RedblackImplementation and Proof of
    repeat match goal with
    -  | |- SearchTree' _ (match ?c with Red_ | Black_ end) _
    +  | ⊢ SearchTree' _ (match ?c with Red_ | Black_ end) _
                 destruct c
    -  | |- SearchTree' _ (match ?s with E_ | T _ _ _ _ __ end) _
    +  | ⊢ SearchTree' _ (match ?s with E_ | T _ _ _ _ __ end) _
                 destruct s
    -  | H: SearchTree' _ E _ |- _inv H
    -  | H: SearchTree' _ (T _ _ _ _ _) _ |- _inv H
    +  | H: SearchTree' _ E __inv H
    +  | H: SearchTree' _ (T _ _ _ _ _) __inv H
      end.
    @@ -504,7 +504,7 @@

    RedblackImplementation and Proof of Abort.

    Lemma balance_SearchTree:
    c s1 k kv s2 lo hi,
    c s1 k kv s2 lo hi,
       SearchTree' lo s1 (int2Z k) →
       SearchTree' (int2Z k + 1) s2 hi
       SearchTree' lo (balance c s1 k kv s2) hi.
    @@ -519,19 +519,19 @@

    RedblackImplementation and Proof of
    repeat match goal with
    -  | |- SearchTree' _ (match ?c with Red_ | Black_ end) _
    +  | ⊢ SearchTree' _ (match ?c with Red_ | Black_ end) _
                  destruct c
    -  | |- SearchTree' _ (match ?s with E_ | T _ _ _ _ __ end) _
    +  | ⊢ SearchTree' _ (match ?s with E_ | T _ _ _ _ __ end) _
                  destruct s
    -  | H: SearchTree' _ E _ |- _inv H
    -  | H: SearchTree' _ (T _ _ _ _ _) _ |- _inv H
    +  | H: SearchTree' _ E __inv H
    +  | H: SearchTree' _ (T _ _ _ _ _) __inv H
      end;
     repeat (constructor; auto).
    Qed.
    -

    练习:2 星 (ins_SearchTree)

    +

    练习:2 星, standard (ins_SearchTree)

    This one is pretty easy, even without proof automation. Copy-paste your proof of insert_SearchTree from Extract.v. You will need to apply balance_SearchTree in two places. @@ -539,7 +539,7 @@

    RedblackImplementation and Proof of

    Lemma ins_SearchTree:
    -    x vx s lo hi,
    +   x vx s lo hi,
                        loint2Z x
                        int2Z x < hi
                        SearchTree' lo s hi
    @@ -552,7 +552,7 @@

    RedblackImplementation and Proof of
    -

    练习:2 星 (valid)

    +

    练习:2 星, standard (valid)

    @@ -561,14 +561,14 @@

    RedblackImplementation and Proof of Lemma empty_tree_SearchTree: SearchTree empty_tree.
    (* 请在此处解答 *) Admitted.

    Lemma SearchTree'_le:
    -   lo t hi, SearchTree' lo t hilohi.
    +  lo t hi, SearchTree' lo t hilohi.
    Proof.
    induction 1; omega.
    Qed.

    Lemma expand_range_SearchTree':
    -   s lo hi,
    +  s lo hi,
       SearchTree' lo s hi
    -    lo' hi',
    +   lo' hi',
       lo'lohihi'
       SearchTree' lo' s hi'.
    Proof.
    @@ -579,7 +579,7 @@

    RedblackImplementation and Proof of apply IHSearchTree'1; omega.
    apply IHSearchTree'2; omega.
    Qed.

    -Lemma insert_SearchTree: x vx s,
    +Lemma insert_SearchTree: x vx s,
        SearchTree sSearchTree (insert x vx s).
    (* 请在此处解答 *) Admitted.

    @@ -592,7 +592,7 @@

    RedblackImplementation and Proof of   fun xif Z.ltb x pivot then m1 x else m2 x.

    Inductive Abs: treetotal_map VProp :=
    | Abs_E: Abs E (t_empty default)
    -| Abs_T: a b c l k vk r,
    +| Abs_T: a b c l k vk r,
          Abs l a
          Abs r b
          Abs (T c l k vk r) (t_update (combine (int2Z k) a b) (int2Z k) vk).

    @@ -603,12 +603,12 @@

    RedblackImplementation and Proof of

    -

    练习:3 星 (lookup_relate)

    +

    练习:3 星, standard (lookup_relate)

    Theorem lookup_relate:
    -   k t cts , Abs t ctslookup k t = cts (int2Z k).
    +  k t cts , Abs t ctslookup k t = cts (int2Z k).
    Proof. (* Copy your proof from Extract.v, and adapt it. *)
    (* 请在此处解答 *) Admitted.
    @@ -617,21 +617,21 @@

    RedblackImplementation and Proof of
    Lemma Abs_helper:
    -   m' t m, Abs t m'm' = mAbs t m.
    +  m' t m, Abs t m'm' = mAbs t m.
    Proof.
       intros. subst. auto.
    Qed.

    Ltac contents_equivalent_prover :=
     extensionality x; unfold t_update, combine, t_empty;
     repeat match goal with
    -  | |- context [if ?A then _ else _] ⇒ bdestruct A
    +  | ⊢ context [if ?A then _ else _] ⇒ bdestruct A
     end;
     auto;
     omega.
    -

    练习:4 星 (balance_relate)

    +

    练习:4 星, standard (balance_relate)

    You will need proof automation for this one. Study the methods used in ins_not_E and balance_SearchTree, and try them here. Add one clause at a time to your match goal. @@ -639,7 +639,7 @@

    RedblackImplementation and Proof of
    Theorem balance_relate:
    -   c l k vk r m,
    +  c l k vk r m,
        SearchTree (T c l k vk r) →
        Abs (T c l k vk r) m
        Abs (balance c l k vk r) m.
    @@ -648,7 +648,7 @@

    RedblackImplementation and Proof of inv H.
    unfold balance.
    repeat match goal with
    - | H: Abs E _ |- _inv H
    + | H: Abs E __inv H
    end.

    @@ -695,7 +695,7 @@

    RedblackImplementation and Proof of
  • 9. Whenever the current proof goal matches a hypothesis above the line, just use it. That is, just add this clause: - | |- _ => assumption + | ⊢ _ => assumption
  • 10. At this point, if all has gone well, you should have exactly 21 subgoals. @@ -712,7 +712,7 @@

    RedblackImplementation and Proof of repeat econstructor; eassumption. That solves the subgoal in exactly the same way. Now, wrap this all up, by adding this clause to your match goal: - | |- _ => eapply Abs_helper; repeat econstructor; eassumption | + | ⊢ _ => eapply Abs_helper; repeat econstructor; eassumption |

  • 11. You should still have exactly 21 subgoals, each one of the form, @@ -760,12 +760,12 @@

    RedblackImplementation and Proof of
    -

    练习:3 星 (ins_relate)

    +

    练习:3 星, standard (ins_relate)

    Theorem ins_relate:
    k v t cts,
    k v t cts,
        SearchTree t
        Abs t cts
        Abs (ins k v t) (t_update cts (int2Z k) v).
    @@ -778,7 +778,7 @@

    RedblackImplementation and Proof of
    Lemma makeBlack_relate:
    t cts,
    t cts,
        Abs t cts
        Abs (makeBlack t) cts.
    Proof.
    @@ -787,7 +787,7 @@

    RedblackImplementation and Proof of inv H; constructor; auto.
    Qed.

    Theorem insert_relate:
    k v t cts,
    k v t cts,
        SearchTree t
        Abs t cts
        Abs (insert k v t) (t_update cts (int2Z k) v).
    @@ -817,7 +817,7 @@

    RedblackImplementation and Proof of (2) respects the abstraction relation.
    -

    练习:4 星, optional (elements)

    +

    练习:4 星, standard, optional (elements)

    Prove the correctness of the elements function. Because elements does not pay attention to colors, and does not rebalance the tree, then its proof should be a simple copy-paste from SearchTree.v, @@ -832,12 +832,12 @@

    RedblackImplementation and Proof of  end.

    Definition elements (s: tree) : list (key * V) := elements' s nil.

    Definition elements_property (t: tree) (cts: total_map V) : Prop :=
    -    k v,
    +   k v,
         (In (k,v) (elements t) → cts (int2Z k) = v) ∧
         (cts (int2Z k) ≠ default
    -       k', int2Z k = int2Z k'In (k', cts (int2Z k)) (elements t)).

    +      k', int2Z k = int2Z k'In (k', cts (int2Z k)) (elements t)).

    Theorem elements_relate:
    -   t cts,
    +  t cts,
      SearchTree t
      Abs t cts
      elements_property t cts.
    @@ -869,7 +869,7 @@

    RedblackImplementation and Proof of their efficiency.
    -

    练习:4 星 (is_redblack_properties)

    +

    练习:4 星, standard (is_redblack_properties)

    The relation is_redblack ensures that there are exactly n black nodes in every path from the root to a leaf, and that there are never two red nodes in a row. @@ -877,22 +877,22 @@

    RedblackImplementation and Proof of
     Inductive is_redblack : treecolornatProp :=
    - | IsRB_leaf: c, is_redblack E c 0
    - | IsRB_r: tl k kv tr n,
    + | IsRB_leaf: c, is_redblack E c 0
    + | IsRB_r: tl k kv tr n,
              is_redblack tl Red n
              is_redblack tr Red n
              is_redblack (T Red tl k kv tr) Black n
    - | IsRB_b: c tl k kv tr n,
    + | IsRB_b: c tl k kv tr n,
              is_redblack tl Black n
              is_redblack tr Black n
              is_redblack (T Black tl k kv tr) c (S n).

    Lemma is_redblack_toblack:
    -   s n, is_redblack s Red nis_redblack s Black n.
    +  s n, is_redblack s Red nis_redblack s Black n.
    Proof.
    (* 请在此处解答 *) Admitted.

    Lemma makeblack_fiddle:
    -   s n, is_redblack s Black n
    -             n, is_redblack (makeBlack s) Red n.
    +  s n, is_redblack s Black n
    +            n, is_redblack (makeBlack s) Red n.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -905,16 +905,16 @@

    RedblackImplementation and Proof of
    Inductive nearly_redblack : treenatProp :=
    -| nrRB_r: tl k kv tr n,
    +| nrRB_r: tl k kv tr n,
             is_redblack tl Black n
             is_redblack tr Black n
             nearly_redblack (T Red tl k kv tr) n
    -| nrRB_b: tl k kv tr n,
    +| nrRB_b: tl k kv tr n,
             is_redblack tl Black n
             is_redblack tr Black n
             nearly_redblack (T Black tl k kv tr) (S n).

    Lemma ins_is_redblack:
    -   x vx s n,
    +  x vx s n,
        (is_redblack s Black nnearly_redblack (ins x vx s) n) ∧
        (is_redblack s Red nis_redblack (ins x vx s) Black n).
    Proof.
    @@ -936,8 +936,8 @@

    RedblackImplementation and Proof of (* 请在此处解答 *) Admitted.

    Lemma insert_is_redblack:
    -   x xv s n, is_redblack s Red n
    -                     n', is_redblack (insert x xv s) Red n'.
    +  x xv s n, is_redblack s Red n
    +                    n', is_redblack (insert x xv s) Red n'.
    Proof.
      (* Just apply a couple of lemmas: 
         ins_is_redblack and makeblack_fiddle *)

    @@ -1014,6 +1014,10 @@

    RedblackImplementation and Proof of In particular, red-black trees are almost exactly as fast on the consecutive insertions (0.015 seconds) as on the random (0.016 seconds). +

    +
    + +(* Sat Jan 26 15:18:06 UTC 2019 *)

    diff --git a/vfa-current/Redblack.v b/vfa-current/Redblack.v index fc6cd6ba..6fc8de42 100644 --- a/vfa-current/Redblack.v +++ b/vfa-current/Redblack.v @@ -47,9 +47,9 @@ _Journal of Functional Programming_, 9(4):471-477, July 1999. From VFA Require Import Perm. From VFA Require Import Extract. -Require Import Coq.Lists.List. +From Coq Require Import Lists.List. Export ListNotations. -Require Import Coq.Logic.FunctionalExtensionality. +From Coq Require Import Logic.FunctionalExtensionality. Require Import ZArith. Open Scope Z_scope. @@ -369,8 +369,9 @@ repeat match goal with repeat (constructor; auto). Qed. -(** **** 练习:2 星 (ins_SearchTree) *) -(** This one is pretty easy, even without proof automation. +(** **** 练习:2 星, standard (ins_SearchTree) + + This one is pretty easy, even without proof automation. Copy-paste your proof of insert_SearchTree from Extract.v. You will need to apply [balance_SearchTree] in two places. *) @@ -384,7 +385,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (valid) *) +(** **** 练习:2 星, standard (valid) *) Lemma empty_tree_SearchTree: SearchTree empty_tree. (* 请在此处解答 *) Admitted. @@ -432,7 +433,7 @@ Proof. constructor. Qed. -(** **** 练习:3 星 (lookup_relate) *) +(** **** 练习:3 星, standard (lookup_relate) *) Theorem lookup_relate: forall k t cts , Abs t cts -> lookup k t = cts (int2Z k). Proof. (* Copy your proof from Extract.v, and adapt it. *) @@ -453,8 +454,9 @@ Ltac contents_equivalent_prover := auto; omega. -(** **** 练习:4 星 (balance_relate) *) -(** You will need proof automation for this one. Study the methods used +(** **** 练习:4 星, standard (balance_relate) + + You will need proof automation for this one. Study the methods used in [ins_not_E] and [balance_SearchTree], and try them here. Add one clause at a time to your [match goal]. *) @@ -534,7 +536,7 @@ Definition how_many_subgoals_remaining := ]. (** [] *) -(** **** 练习:3 星 (ins_relate) *) +(** **** 练习:3 星, standard (ins_relate) *) Theorem ins_relate: forall k v t cts, SearchTree t -> @@ -579,8 +581,9 @@ Check insert_relate. (1) preserves the representation invariant, and (2) respects the abstraction relation. *) -(** **** 练习:4 星, optional (elements) *) -(** Prove the correctness of the [elements] function. Because [elements] +(** **** 练习:4 星, standard, optional (elements) + + Prove the correctness of the [elements] function. Because [elements] does not pay attention to colors, and does not rebalance the tree, then its proof should be a simple copy-paste from SearchTree.v, with only minor edits. *) @@ -624,8 +627,9 @@ Proof. stay approximately balanced; this tells us important information about their efficiency. *) -(** **** 练习:4 星 (is_redblack_properties) *) -(** The relation [is_redblack] ensures that there are exactly [n] black +(** **** 练习:4 星, standard (is_redblack_properties) + + The relation [is_redblack] ensures that there are exactly [n] black nodes in every path from the root to a leaf, and that there are never two red nodes in a row. *) @@ -665,7 +669,6 @@ Inductive nearly_redblack : tree -> nat -> Prop := is_redblack tr Black n -> nearly_redblack (T Black tl k kv tr) (S n). - Lemma ins_is_redblack: forall x vx s n, (is_redblack s Black n -> nearly_redblack (ins x vx s) n) /\ @@ -707,20 +710,17 @@ Extraction "redblack.ml" empty_tree insert lookup elements. #use "test_searchtree.ml";; run_tests();; - On my machine, in the byte-code interpreter this prints, Insert and lookup 1000000 random integers in 0.889 seconds. Insert and lookup 20000 random integers in 0.016 seconds. Insert and lookup 20000 consecutive integers in 0.015 seconds. - You can compile and run this with the ocaml native-code compiler by: ocamlopt redblack.mli redblack.ml -open Redblack test_searchtree.ml -o test_redblack ./test_redblack - On my machine this prints, Insert and lookup 1000000 random integers in 0.436 seconds. @@ -729,8 +729,9 @@ Insert and lookup 20000 consecutive integers in 0. seconds. *) (* ################################################################# *) -(** * Success! *) -(** The benchmark measurements above (and in Extract.v) demonstrate that: +(** * Success! + + The benchmark measurements above (and in Extract.v) demonstrate that: - On random insertions, red-black trees are slightly faster than ordinary BSTs (red-black 0.436 seconds, vs ordinary 0.468 seconds) - On consecutive insertions, red-black trees are _much_ faster than ordinary BSTs @@ -739,3 +740,4 @@ Insert and lookup 20000 consecutive integers in 0. seconds. consecutive insertions (0.015 seconds) as on the random (0.016 seconds). *) +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/RedblackTest.v b/vfa-current/RedblackTest.v index 65c624e2..e0eadd33 100644 --- a/vfa-current/RedblackTest.v +++ b/vfa-current/RedblackTest.v @@ -202,3 +202,5 @@ Print Assumptions insert_is_redblack. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:43 UTC 2019 *) diff --git a/vfa-current/SearchTree.html b/vfa-current/SearchTree.html index d48c90aa..124a7990 100644 --- a/vfa-current/SearchTree.html +++ b/vfa-current/SearchTree.html @@ -68,7 +68,7 @@

    SearchTreeBinary Search Trees

    -Require Import Coq.Strings.String.
    +From Coq Require Import Strings.String.
    From VFA Require Import Perm.
    Require Import FunctionalExtensionality.
    @@ -108,7 +108,7 @@

    SearchTreeBinary Search Trees     | nildefault
        end.
      Theorem lookup_empty (V: Type) (default: V):
    -        x, lookup V default x (empty V) = default.
    +       x, lookup V default x (empty V) = default.
       Proof. reflexivity. Qed.
    End SectionExample1.

  • @@ -133,7 +133,7 @@

    SearchTreeBinary Search Trees     | nildefault
        end.
      Theorem lookup_empty:
    -        x, lookup x empty = default.
    +       x, lookup x empty = default.
       Proof. reflexivity. Qed.
      End MAPS.
    End SectionExample2.
    @@ -275,13 +275,13 @@

    SearchTreeBinary Search Trees Check t_update_eq. (*  : forall (A : Type) (m : total_map A) (x : id) (v : A),
           t_update m x v x = v   *)

    Check t_update_neq. (* : forall (X : Type) (v : X) (x1 x2 : id) (m : total_map X),
    -       x1 <> x2 -> t_update m x1 v x2 = m x2    *)

    +       x1 <> x2 -> t_update m x1 v x2 = m x2    *)
    Check t_update_shadow. (* : forall (A : Type) (m : total_map A) (v1 v2 : A) (x : id),
           t_update (t_update m x v1) x v2 = t_update m x v2    *)

    Check t_update_same. (* : forall (X : Type) (x : id) (m : total_map X),
            t_update m x (m x) = m    *)

    Check t_update_permute. (* forall (X : Type) (v1 v2 : X) (x1 x2 : id) (m : total_map X),
    -       x2 <> x1 ->
    +       x2 <> x1 ->
           t_update (t_update m x2 v2) x1 v1 =
             t_update (t_update m x1 v1) x2 v2    *)

    Check t_apply_empty. (* : forall (A : Type) (x : id) (v : A),
    @@ -393,7 +393,7 @@

    SearchTreeBinary Search Trees

    -

    练习:2 星 (example_map)

    +

    练习:2 星, standard (example_map)

    @@ -425,14 +425,14 @@

    SearchTreeBinary Search Trees Inductive Abs: treetotal_map VProp :=
    | Abs_E: Abs E (t_empty default)
    -| Abs_T: a b l k v r,
    +| Abs_T: a b l k v r,
          Abs l a
          Abs r b
          Abs (T l k v r) (t_update (combine k a b) k v).

    -

    练习:3 星 (check_example_map)

    +

    练习:3 星, standard (check_example_map)

    Prove that your example_map is the right one. If it isn't, go back and fix your definition of example_map. You will probably need the bdestruct tactic, and omega. @@ -440,7 +440,7 @@

    SearchTreeBinary Search Trees
    Lemma check_example_map:
    -   v2 v4 v5, Abs (example_tree v2 v4 v5) (example_map v2 v4 v5).
    +  v2 v4 v5, Abs (example_tree v2 v4 v5) (example_map v2 v4 v5).
    Proof.
    intros.
    unfold example_tree.
    @@ -466,7 +466,7 @@

    SearchTreeBinary Search Trees You can ignore this lemma, unless it fails.

    -Lemma check_too_clever: v2 v4 v5: V, True.
    +Lemma check_too_clever: v2 v4 v5: V, True.
    Proof.
    @@ -492,12 +492,12 @@

    SearchTreeBinary Search Trees

    -

    练习:3 星 (lookup_relate)

    +

    练习:3 星, standard (lookup_relate)

    Theorem lookup_relate:
    -   k t cts ,
    +  k t cts ,
        Abs t ctslookup k t = cts k.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -507,12 +507,12 @@

    SearchTreeBinary Search Trees
    -

    练习:4 星 (insert_relate)

    +

    练习:4 星, standard (insert_relate)

    Theorem insert_relate:
    k v t cts,
    k v t cts,
        Abs t cts
        Abs (insert k v t) (t_update cts k v).
    Proof.
    @@ -547,12 +547,12 @@

    SearchTreeBinary Search Trees

    -

    练习:3 星 (elements_relate_informal)

    +

    练习:3 星, standard (elements_relate_informal)

    Theorem elements_relate:
    -   t cts, Abs t ctslist2map (elements t) = cts.
    +  t cts, Abs t ctslist2map (elements t) = cts.
    Proof.
    @@ -579,13 +579,13 @@

    SearchTreeBinary Search Trees least two distinct values.
    -

    练习:4 星 (not_elements_relate)

    +

    练习:4 星, standard (not_elements_relate)

    Theorem not_elements_relate:
    -   v, vdefault
    -  ¬ ( t cts, Abs t ctslist2map (elements t) = cts).
    +  v, vdefault
    +  ¬(t cts, Abs t ctslist2map (elements t) = cts).
    Proof.
    intros.
    intro.
    @@ -668,14 +668,14 @@

    SearchTreeBinary Search Trees       forall_nodes l (fun _ j _ _j<k) ∧
          forall_nodes r (fun _ j _ _j>k)).

    Lemma example_SearchTree_good:
    -    v2 v4 v5, SearchTreeX (example_tree v2 v4 v5).
    +   v2 v4 v5, SearchTreeX (example_tree v2 v4 v5).
    Proof.
    intros.
    hnf. simpl.
    repeat split; auto.
    Qed.

    Lemma example_SearchTree_bad:
    -    v, ¬SearchTreeX (T (T E 3 v E) 2 v E).
    +   v, ¬SearchTreeX (T (T E 3 v E) 2 v E).
    Proof.
    intros.
    intro.
    @@ -684,7 +684,7 @@

    SearchTreeBinary Search Trees omega.
    Qed.

    Theorem elements_relate_second_attempt:
    -   t cts,
    +  t cts,
      SearchTreeX t
      Abs t cts
      list2map (elements t) = cts.
    @@ -702,15 +702,15 @@

    SearchTreeBinary Search Trees Abort.

    Inductive SearchTree' : keytreekeyProp :=
    -| ST_E : lo hi, lohiSearchTree' lo E hi
    -| ST_T: lo l k v r hi,
    +| ST_E : lo hi, lohiSearchTree' lo E hi
    +| ST_T: lo l k v r hi,
        SearchTree' lo l k
        SearchTree' (S k) r hi
        SearchTree' lo (T l k v r) hi.

    Inductive SearchTree: treeProp :=
    -| ST_intro: t hi, SearchTree' 0 t hiSearchTree t.

    +| ST_intro: t hi, SearchTree' 0 t hiSearchTree t.

    Lemma SearchTree'_le:
    -   lo t hi, @SearchTree' lo t hilohi.
    +  lo t hi, @SearchTree' lo t hilohi.
    Proof.
    induction 1; omega.
    Qed.
    @@ -745,7 +745,7 @@

    SearchTreeBinary Search Trees there to support the proof.
    -

    练习:3 星, optional (elements_slow_elements)

    +

    练习:3 星, standard, optional (elements_slow_elements)

    @@ -753,7 +753,7 @@

    SearchTreeBinary Search Trees Proof.
    extensionality s.
    unfold elements.
    -assert ( base, elements' s base = slow_elements s ++ base).
    +assert (base, elements' s base = slow_elements s ++ base).
    (* 请在此处解答 *) Admitted.

    @@ -761,12 +761,12 @@

    SearchTreeBinary Search Trees
    -

    练习:3 星, optional (slow_elements_range)

    +

    练习:3 星, standard, optional (slow_elements_range)

    Lemma slow_elements_range:
    k v lo t hi,
    k v lo t hi,
      SearchTree' lo t hi
      In (k,v) (slow_elements t) →
      lok < hi.
    @@ -785,8 +785,8 @@

    SearchTreeBinary Search Trees
    Lemma In_decidable:
    -   (al: list (key*V)) (i: key),
    -  ( v, In (i,v) al) ∨ (¬ v, In (i,v) al).
    +  (al: list (key*V)) (i: key),
    +  (v, In (i,v) al) ∨ (¬v, In (i,v) al).
    Proof.
    @@ -794,11 +794,11 @@

    SearchTreeBinary Search Trees induction al as [ | [k v]].
    right; intros [w H]; inv H.
    destruct IHal as [[w H] | H].
    -left; w; right; auto.
    +left; w; right; auto.
    bdestruct (k =? i).
    subst k.
    left; eauto.
    - v; left; auto.
    +v; left; auto.
    right. intros [w H1].
    destruct H1. inv H1. omega.
    apply H; eauto.
    @@ -807,7 +807,7 @@

    SearchTreeBinary Search Trees
    Lemma list2map_app_left:
    -   (al bl: list (key*V)) (i: key) v,
    +  (al bl: list (key*V)) (i: key) v,
         In (i,v) allist2map (al++bl) i = list2map al i.
    @@ -826,8 +826,8 @@

    SearchTreeBinary Search Trees
    Lemma list2map_app_right:
    -   (al bl: list (key*V)) (i: key),
    -     ~( v, In (i,v) al) → list2map (al++bl) i = list2map bl i.
    +  (al bl: list (key*V)) (i: key),
    +     ~(v, In (i,v) al) → list2map (al++bl) i = list2map bl i.
    Proof.
    @@ -837,18 +837,18 @@

    SearchTreeBinary Search Trees bdestruct (j=?i).
    subst j.
    contradiction H.
    - w; left; auto.
    +w; left; auto.
    apply IHal.
    contradict H.
    destruct H as [u ?].
    - u; right; auto.
    +u; right; auto.
    Qed.


    Lemma list2map_not_in_default:
    (al: list (key*V)) (i: key),
    -   ~( v, In (i,v) al) → list2map al i = default.
    (al: list (key*V)) (i: key),
    +   ~(v, In (i,v) al) → list2map al i = default.
    Proof.
    @@ -860,21 +860,21 @@

    SearchTreeBinary Search Trees bdestruct (j=?i).
    subst.
    contradiction H.
    - w; left; auto.
    +w; left; auto.
    apply IHal.
    intros [v ?].
    -apply H. v; right; auto.
    +apply H. v; right; auto.
    Qed.

    -

    练习:3 星, optional (elements_relate)

    +

    练习:3 星, standard, optional (elements_relate)

    Theorem elements_relate:
    -   t cts,
    +  t cts,
      SearchTree t
      Abs t cts
      list2map (elements t) = cts.
    @@ -918,7 +918,7 @@

    SearchTreeBinary Search Trees build trees. So we need to prove those two theorems.
    -

    练习:1 星 (empty_tree_SearchTree)

    +

    练习:1 星, standard (empty_tree_SearchTree)

    @@ -934,12 +934,12 @@

    SearchTreeBinary Search Trees
    -

    练习:3 星 (insert_SearchTree)

    +

    练习:3 星, standard (insert_SearchTree)

    Theorem insert_SearchTree:
    -   k v t,
    +  k v t,
       SearchTree tSearchTree (insert k v t).
    Proof.
    clear default. (* This is here to avoid a nasty interaction between Admitted and Section/Variable *)
    @@ -960,7 +960,7 @@

    SearchTreeBinary Search Trees Check lookup_relate.
    (*  forall (k : key) (t : tree) (cts : total_map V),
    -       Abs t cts -> lookup k t = cts (Id k)  *)

    +       Abs t cts -> lookup k t = cts (Id k)  *)

    @@ -972,7 +972,7 @@

    SearchTreeBinary Search Trees Check elements_relate.
    (*  : forall (t : tree) (cts : total_map V),
    -       SearchTree t -> Abs t cts -> elements_property t cts   *)

    +       SearchTree t -> Abs t cts -> elements_property t cts   *)

    @@ -981,7 +981,7 @@

    SearchTreeBinary Search Trees
    Lemma lookup_relate':
    -   (k : key) (t : tree) (cts : total_map V),
    +  (k : key) (t : tree) (cts : total_map V),
         SearchTree tAbs t ctslookup k t = cts k.
    @@ -996,7 +996,7 @@

    SearchTreeBinary Search Trees apply H0.
    Qed.

    Theorem insert_relate':
    k v t cts,
    k v t cts,
        SearchTree t
        Abs t cts
        Abs (insert k v t) (t_update cts k v).
    @@ -1012,11 +1012,11 @@

    SearchTreeBinary Search Trees
    Print Abs.
    -(* Inductive Abs : tree -> total_map V -> Prop :=
    +(* Inductive Abs : tree -> total_map V -> Prop :=
        Abs_E : Abs E (t_empty default)
      | Abs_T : forall (a b: total_map V) (l: tree) (k: key) (v: V) (r: tree),
    -            Abs l a ->
    -            Abs r b ->
    +            Abs l a ->
    +            Abs r b ->
                Abs (T l k v r) (t_update (combine k a b) (Id k) v)
    *)

    @@ -1028,7 +1028,7 @@

    SearchTreeBinary Search Trees
    Remark abstraction_of_bogus_tree:
    v2 v3,
    v2 v3,
       Abs (T (T E 3 v3 E) 2 v2 E) (t_update (t_empty default) 2 v2).
    Proof.
    intros.
    @@ -1088,12 +1088,12 @@

    SearchTreeBinary Search Trees So as a general sanity check, we need the following theorem:
    -

    练习:2 星 (can_relate)

    +

    练习:2 星, standard (can_relate)

    Lemma can_relate:
    t, SearchTree t cts, Abs t cts.
    t, SearchTree tcts, Abs t cts.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -1106,12 +1106,12 @@

    SearchTreeBinary Search Trees even works on bogus trees, we can prove a super-strong can_relate function:
    -

    练习:2 星 (unrealistically_strong_can_relate)

    +

    练习:2 星, standard (unrealistically_strong_can_relate)

    Lemma unrealistically_strong_can_relate:
    t, cts, Abs t cts.
    t, cts, Abs t cts.
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -1144,7 +1144,7 @@

    SearchTreeBinary Search Trees
    Theorem elements_relateX:
    -   t cts,
    +  t cts,
      SearchTree t
      AbsX t cts
      list2map (elements t) = cts.
    @@ -1161,7 +1161,7 @@

    SearchTreeBinary Search Trees
    Theorem naive_lookup_relateX:
    -   k t cts ,
    +  k t cts ,
        AbsX t ctslookup k t = cts k.
    Abort. (* Not true *)
    @@ -1173,8 +1173,8 @@

    SearchTreeBinary Search Trees
    Theorem not_naive_lookup_relateX:
    -    v, defaultv
    -    ¬ ( k t cts , AbsX t ctslookup k t = cts k).
    +   v, defaultv
    +    ¬(k t cts , AbsX t ctslookup k t = cts k).
    Proof.
    unfold AbsX.
    intros v H.
    @@ -1183,7 +1183,7 @@

    SearchTreeBinary Search Trees pose (m := t_update (t_update (t_empty default) 2 v) 3 v).
    assert (list2map (elements bogus) = m).
      reflexivity.
    -assertlookup 3 bogus = m 3). {
    +assertlookup 3 bogus = m 3). {
      unfold bogus, m, t_update, t_empty.
      simpl.
      apply H.
    @@ -1201,12 +1201,12 @@

    SearchTreeBinary Search Trees

    -

    练习:4 星, optional (lookup_relateX)

    +

    练习:4 星, standard, optional (lookup_relateX)

    Theorem lookup_relateX:
    -   k t cts ,
    +  k t cts ,
        SearchTree tAbsX t ctslookup k t = cts k.
    Proof.
    intros.
    @@ -1254,7 +1254,8 @@

    SearchTreeBinary Search Trees

    -End TREES.
    +End TREES.

    +(* Sat Jan 26 15:18:06 UTC 2019 *)

    diff --git a/vfa-current/SearchTree.v b/vfa-current/SearchTree.v index 4c7539c9..b37e6937 100644 --- a/vfa-current/SearchTree.v +++ b/vfa-current/SearchTree.v @@ -20,7 +20,7 @@ Our focus here is to _prove the correctness of an implementation_ of binary search trees. *) -Require Import Coq.Strings.String. +From Coq Require Import Strings.String. From VFA Require Import Perm. Require Import FunctionalExtensionality. @@ -272,7 +272,7 @@ Check t_apply_empty. (* : forall (A : Type) (x : id) (v : A), Definition example_tree (v2 v4 v5 : V) := T (T E 2 v2 E) 4 v4 (T E 5 v5 E). -(** **** 练习:2 星 (example_map) *) +(** **** 练习:2 星, standard (example_map) *) (* Fill in the definition of example_map with a total_map that you think example_tree should correspond to. Use [t_update] and [(t_empty default)]. *) @@ -297,8 +297,9 @@ Inductive Abs: tree -> total_map V -> Prop := Abs r b -> Abs (T l k v r) (t_update (combine k a b) k v). -(** **** 练习:3 星 (check_example_map) *) -(** Prove that your [example_map] is the right one. +(** **** 练习:3 星, standard (check_example_map) + + Prove that your [example_map] is the right one. If it isn't, go back and fix your definition of [example_map]. You will probably need the [bdestruct] tactic, and [omega]. *) @@ -343,7 +344,7 @@ Proof. constructor. Qed. -(** **** 练习:3 星 (lookup_relate) *) +(** **** 练习:3 星, standard (lookup_relate) *) Theorem lookup_relate: forall k t cts , Abs t cts -> lookup k t = cts k. @@ -351,7 +352,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (insert_relate) *) +(** **** 练习:4 星, standard (insert_relate) *) Theorem insert_relate: forall k v t cts, Abs t cts -> @@ -377,7 +378,7 @@ Fixpoint list2map (el: list (key*V)) : total_map V := | (i,v)::el' => t_update (list2map el') i v end. -(** **** 练习:3 星 (elements_relate_informal) *) +(** **** 练习:3 星, standard (elements_relate_informal) *) Theorem elements_relate: forall t cts, Abs t cts -> list2map (elements t) = cts. Proof. @@ -396,7 +397,7 @@ Definition manual_grade_for_elements_relate_informal : option (nat*string) := No prove that it's false! That is, as long as type [V] contains at least two distinct values. *) -(** **** 练习:4 星 (not_elements_relate) *) +(** **** 练习:4 星, standard (not_elements_relate) *) Theorem not_elements_relate: forall v, v <> default -> ~ (forall t cts, Abs t cts -> list2map (elements t) = cts). @@ -532,7 +533,7 @@ Fixpoint slow_elements (s: tree) : list (key * V) := is quadratic, because we're never going to really run it; it's just there to support the proof. *) -(** **** 练习:3 星, optional (elements_slow_elements) *) +(** **** 练习:3 星, standard, optional (elements_slow_elements) *) Theorem elements_slow_elements: elements = slow_elements. Proof. extensionality s. @@ -541,8 +542,7 @@ assert (forall base, elements' s base = slow_elements s ++ base). (* 请在此处解答 *) Admitted. (** [] *) - -(** **** 练习:3 星, optional (slow_elements_range) *) +(** **** 练习:3 星, standard, optional (slow_elements_range) *) Lemma slow_elements_range: forall k v lo t hi, SearchTree' lo t hi -> @@ -555,7 +555,6 @@ Proof. (* ================================================================= *) (** ** Auxiliary Lemmas About [In] and [list2map] *) - Lemma In_decidable: forall (al: list (key*V)) (i: key), (exists v, In (i,v) al) \/ (~exists v, In (i,v) al). @@ -624,7 +623,7 @@ intros [v ?]. apply H. exists v; right; auto. Qed. -(** **** 练习:3 星, optional (elements_relate) *) +(** **** 练习:3 星, standard, optional (elements_relate) *) Theorem elements_relate: forall t cts, SearchTree t -> @@ -664,7 +663,7 @@ auto. [SearchTree]; and these are the only ways that you're supposed to build trees. So we need to prove those two theorems. *) -(** **** 练习:1 星 (empty_tree_SearchTree) *) +(** **** 练习:1 星, standard (empty_tree_SearchTree) *) Theorem empty_tree_SearchTree: SearchTree empty_tree. Proof. clear default. (* This is here to avoid a nasty interaction between Admitted @@ -673,7 +672,7 @@ clear default. (* This is here to avoid a nasty interaction between Admitted (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (insert_SearchTree) *) +(** **** 练习:3 星, standard (insert_SearchTree) *) Theorem insert_SearchTree: forall k v t, SearchTree t -> SearchTree (insert k v t). @@ -732,8 +731,8 @@ Print Abs. Abs l a -> Abs r b -> Abs (T l k v r) (t_update (combine k a b) (Id k) v) -*) -(** Because the [combine] function is chosen very carefully, it turns out + + Because the [combine] function is chosen very carefully, it turns out that this abstraction relation even works on bogus trees! *) Remark abstraction_of_bogus_tree: @@ -786,7 +785,7 @@ Qed. So as a general sanity check, we need the following theorem: *) -(** **** 练习:2 星 (can_relate) *) +(** **** 练习:2 星, standard (can_relate) *) Lemma can_relate: forall t, SearchTree t -> exists cts, Abs t cts. Proof. @@ -796,7 +795,7 @@ Proof. (** Now, because we happen to have a super-strong abstraction relation, that even works on bogus trees, we can prove a super-strong can_relate function: *) -(** **** 练习:2 星 (unrealistically_strong_can_relate) *) +(** **** 练习:2 星, standard (unrealistically_strong_can_relate) *) Lemma unrealistically_strong_can_relate: forall t, exists cts, Abs t cts. Proof. @@ -865,7 +864,7 @@ apply H0. apply H1. Qed. -(** **** 练习:4 星, optional (lookup_relateX) *) +(** **** 练习:4 星, standard, optional (lookup_relateX) *) Theorem lookup_relateX: forall k t cts , SearchTree t -> AbsX t cts -> lookup k t = cts k. @@ -884,8 +883,9 @@ rewrite elements_slow_elements. (** [] *) (* ================================================================= *) -(** ** Coherence With [elements] Instead of [lookup] *) -(** The first definition of the abstraction relation, [Abs], is "coherent" +(** ** Coherence With [elements] Instead of [lookup] + + The first definition of the abstraction relation, [Abs], is "coherent" with the [lookup] operation, but not very coherent with the [elements] operation. That is, [Abs] treats all trees, including ill-formed ones, much the way [lookup] does, so it was easy to prove [lookup_relate]. @@ -902,3 +902,5 @@ rewrite elements_slow_elements. your abstraction relation. *) End TREES. + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/SearchTreeTest.v b/vfa-current/SearchTreeTest.v index 1b9869bd..9d554b85 100644 --- a/vfa-current/SearchTreeTest.v +++ b/vfa-current/SearchTreeTest.v @@ -199,3 +199,5 @@ Print Assumptions unrealistically_strong_can_relate. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:14 UTC 2019 *) diff --git a/vfa-current/Selection.html b/vfa-current/Selection.html index a3b332aa..b1e2ebec 100644 --- a/vfa-current/Selection.html +++ b/vfa-current/Selection.html @@ -174,10 +174,10 @@

    SelectionSelection Sort, With Specif Inductive sorted: list natProp :=
     | sorted_nil: sorted nil
    - | sorted_1: i, sorted (i::nil)
    - | sorted_cons: i j l, ijsorted (j::l) → sorted (i::j::l).

    + | sorted_1: i, sorted (i::nil)
    + | sorted_cons: i j l, ijsorted (j::l) → sorted (i::j::l).

    Definition is_a_sorting_algorithm (f: list natlist nat) :=
    -   al, Permutation al (f al) ∧ sorted (f al).
    +  al, Permutation al (f al) ∧ sorted (f al).

    @@ -197,11 +197,11 @@

    SelectionSelection Sort, With Specif We'll start by working on part 1, permutations.
    -

    练习:3 星 (select_perm)

    +

    练习:3 星, standard (select_perm)

    -Lemma select_perm: x l,
    +Lemma select_perm: x l,
      let (y,r) := select x l in
       Permutation (x::l) (y::r).
    Proof.
    @@ -223,13 +223,13 @@

    SelectionSelection Sort, With Specif
    -

    练习:3 星 (selection_sort_perm)

    +

    练习:3 星, standard (selection_sort_perm)

    Lemma selsort_perm:
    -   n,
    -   l, length l = nPermutation l (selsort l n).
    +  n,
    +  l, length l = nPermutation l (selsort l n).
    Proof.
    @@ -241,7 +241,7 @@

    SelectionSelection Sort, With Specif (* 请在此处解答 *) Admitted.

    Theorem selection_sort_perm:
    -   l, Permutation l (selection_sort l).
    +  l, Permutation l (selection_sort l).
    Proof.
    (* 请在此处解答 *) Admitted.

    @@ -250,12 +250,12 @@

    SelectionSelection Sort, With Specif
    -

    练习:3 星 (select_smallest)

    +

    练习:3 星, standard (select_smallest)

    Lemma select_smallest_aux:
    -   x al y bl,
    +  x al y bl,
        Forall (fun zyz) bl
        select x al = (y,bl) →
        yx.
    @@ -264,7 +264,7 @@

    SelectionSelection Sort, With Specif    Just use existing lemmas about select, along with Forall_perm *)
    (* 请在此处解答 *) Admitted.

    Theorem select_smallest:
    -   x al y bl, select x al = (y,bl) →
    +  x al y bl, select x al = (y,bl) →
         Forall (fun zyz) bl.
    Proof.
    intros x al; revert x; induction al; intros; simpl in *.
    @@ -279,19 +279,19 @@

    SelectionSelection Sort, With Specif
    -

    练习:3 星 (selection_sort_sorted)

    +

    练习:3 星, standard (selection_sort_sorted)

    Lemma selection_sort_sorted_aux:
    -   y bl,
    +   y bl,
       sorted (selsort bl (length bl)) →
       Forall (fun z : natyz) bl
       sorted (y :: selsort bl (length bl)).
    Proof.
     (* Hint: no induction needed.  Use lemmas selsort_perm and Forall_perm.*)
     (* 请在此处解答 *) Admitted.

    -Theorem selection_sort_sorted: al, sorted (selection_sort al).
    +Theorem selection_sort_sorted: al, sorted (selection_sort al).
    Proof.
    intros.
    unfold selection_sort.
    @@ -357,13 +357,13 @@

    SelectionSelection Sort, With Specif

    -

    练习:3 星 (selsortperm)

    +

    练习:3 星, standard (selsortperm)

    Lemma selsort'_perm:
    -   n,
    -   l, length l = nPermutation l (selsort' l).
    +  n,
    +  l, length l = nPermutation l (selsort' l).
    Proof.
    @@ -386,9 +386,9 @@

    SelectionSelection Sort, With Specif
    -Eval compute in selsort' [3;1;4;1;5;9;2;6;5].
    +Eval compute in selsort' [3;1;4;1;5;9;2;6;5].

    +(* Sat Jan 26 15:18:06 UTC 2019 *)
    -

    diff --git a/vfa-current/Selection.v b/vfa-current/Selection.v index e273980e..99c59002 100644 --- a/vfa-current/Selection.v +++ b/vfa-current/Selection.v @@ -1,5 +1,4 @@ -(** * Selection: Selection Sort, With Specification and Proof of Correctness*) -(** +(** * Selection: Selection Sort, With Specification and Proof of Correctness This sorting algorithm works by choosing (and deleting) the smallest element, then doing it again, and so on. It takes O(N^2) time. @@ -115,7 +114,7 @@ Definition selection_sort_correct : Prop := (** We'll start by working on part 1, permutations. *) -(** **** 练习:3 星 (select_perm) *) +(** **** 练习:3 星, standard (select_perm) *) Lemma select_perm: forall x l, let (y,r) := select x l in Permutation (x::l) (y::r). @@ -130,7 +129,7 @@ induction l; intros; simpl in *. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (selection_sort_perm) *) +(** **** 练习:3 星, standard (selection_sort_perm) *) Lemma selsort_perm: forall n, forall l, length l = n -> Permutation l (selsort l n). @@ -147,7 +146,7 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (select_smallest) *) +(** **** 练习:3 星, standard (select_smallest) *) Lemma select_smallest_aux: forall x al y bl, Forall (fun z => y <= z) bl -> @@ -170,7 +169,7 @@ destruct (select x al) eqn:?H. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (selection_sort_sorted) *) +(** **** 练习:3 星, standard (selection_sort_sorted) *) Lemma selection_sort_sorted_aux: forall y bl, sorted (selsort bl (length bl)) -> @@ -230,7 +229,7 @@ simpl in *; omega. Defined. (* Use [Defined] instead of [Qed], otherwise you can't compute with the function in Coq. *) -(** **** 练习:3 星 (selsort'_perm) *) +(** **** 练习:3 星, standard (selsort'_perm) *) Lemma selsort'_perm: forall n, forall l, length l = n -> Permutation l (selsort' l). @@ -250,4 +249,5 @@ Proof. Eval compute in selsort' [3;1;4;1;5;9;2;6;5]. -(** $Date$ *) + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/SelectionTest.v b/vfa-current/SelectionTest.v index 4b4738f4..82be6658 100644 --- a/vfa-current/SelectionTest.v +++ b/vfa-current/SelectionTest.v @@ -120,3 +120,5 @@ Print Assumptions selsort'_perm. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:13 UTC 2019 *) diff --git a/vfa-current/Sort.html b/vfa-current/Sort.html index 1a4418c2..900386b9 100644 --- a/vfa-current/Sort.html +++ b/vfa-current/Sort.html @@ -157,9 +157,9 @@

    SortInsertion Sort

    Inductive sorted: list natProp :=
    | sorted_nil:
        sorted nil
    -| sorted_1: x,
    +| sorted_1: x,
        sorted (x::nil)
    -| sorted_cons: x y l,
    +| sorted_cons: x y l,
       xysorted (y::l) → sorted (x::y::l).

    @@ -170,7 +170,7 @@

    SortInsertion Sort

    Definition sorted' (al: list nat) :=
    i j, i < j < length alnth i al 0 ≤ nth j al 0.
    i j, i < j < length alnth i al 0 ≤ nth j al 0.
    @@ -182,7 +182,7 @@

    SortInsertion Sort

    Definition is_a_sorting_algorithm (f: list natlist nat) :=
    -   al, Permutation al (f al) ∧ sorted (f al).
    +  al, Permutation al (f al) ∧ sorted (f al).
    @@ -195,7 +195,7 @@

    SortInsertion Sort

    -

    练习:3 星 (insert_perm)

    +

    练习:3 星, standard (insert_perm)

    Prove the following auxiliary lemma, insert_perm, which will be useful for proving sort_perm below. Your proof will be by induction, but you'll need some of the permutation facts from the @@ -204,7 +204,7 @@

    SortInsertion Sort

    Search Permutation.

    -Lemma insert_perm: x l, Permutation (x::l) (insert x l).
    +Lemma insert_perm: x l, Permutation (x::l) (insert x l).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -213,12 +213,12 @@

    SortInsertion Sort

    -

    练习:3 星 (sort_perm)

    +

    练习:3 星, standard (sort_perm)

    Now prove that sort is a permutation.
    -Theorem sort_perm: l, Permutation l (sort l).
    +Theorem sort_perm: l, Permutation l (sort l).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -227,7 +227,7 @@

    SortInsertion Sort

    -

    练习:4 星 (insert_sorted)

    +

    练习:4 星, standard (insert_sorted)

    This one is a bit tricky. However, there just a single induction right at the beginning, and you do _not_ need to use insert_perm or sort_perm. @@ -235,7 +235,7 @@

    SortInsertion Sort

    Lemma insert_sorted:
    -   a l, sorted lsorted (insert a l).
    +  a l, sorted lsorted (insert a l).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -244,12 +244,12 @@

    SortInsertion Sort

    -

    练习:2 星 (sort_sorted)

    +

    练习:2 星, standard (sort_sorted)

    This one is easy.
    -Theorem sort_sorted: l, sorted (sort l).
    +Theorem sort_sorted: l, sorted (sort l).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -284,11 +284,11 @@

    SortInsertion Sort

    it doesn't _prove_ that we do.
    -

    练习:4 星, optional (sorted_sorted')

    +

    练习:4 星, standard, optional (sorted_sorted')

    -Lemma sorted_sorted': al, sorted alsorted' al.
    +Lemma sorted_sorted': al, sorted alsorted' al.
    @@ -306,11 +306,11 @@

    SortInsertion Sort

    -

    练习:3 星, optional (sortedsorted)

    +

    练习:3 星, standard, optional (sortedsorted)

    -Lemma sorted'_sorted: al, sorted' alsorted al.
    +Lemma sorted'_sorted: al, sorted' alsorted al.
    @@ -366,13 +366,13 @@

    SortInsertion Sort

    sort_sorted in these proofs!
    -

    练习:3 星, optional (Forall_nth)

    +

    练习:3 星, standard, optional (Forall_nth)

    Lemma Forall_nth:
    -   {A: Type} (P: AProp) d (al: list A),
    -     Forall P al ↔ ( i, i < length alP (nth i al d)).
    +  {A: Type} (P: AProp) d (al: list A),
    +     Forall P al ↔ (i, i < length alP (nth i al d)).
    Proof.
      (* 请在此处解答 *) Admitted.
    @@ -381,12 +381,12 @@

    SortInsertion Sort

    -

    练习:4 星, optional (insert_sorted')

    +

    练习:4 星, standard, optional (insert_sorted')

    Lemma insert_sorted':
    -   a l, sorted' lsorted' (insert a l).
    +  a l, sorted' lsorted' (insert a l).
    (* 请在此处解答 *) Admitted.
    @@ -394,11 +394,11 @@

    SortInsertion Sort

    -

    练习:4 星, optional (insert_sorted')

    +

    练习:4 星, standard, optional (insert_sorted')

    -Theorem sort_sorted': l, sorted' (sort l).
    +Theorem sort_sorted': l, sorted' (sort l).
    (* 请在此处解答 *) Admitted.
    @@ -423,9 +423,10 @@

    SortInsertion Sort

    sort_sorted' directly, it would be much easier to design a new predicate (sorted), and then prove sort_sorted and sorted_sorted'. -
    +
    +
    - +(* Sat Jan 26 15:18:06 UTC 2019 *)
    diff --git a/vfa-current/Sort.v b/vfa-current/Sort.v index 93d074f0..72be6095 100644 --- a/vfa-current/Sort.v +++ b/vfa-current/Sort.v @@ -108,8 +108,9 @@ Definition is_a_sorting_algorithm (f: list nat -> list nat) := (* ################################################################# *) (** * Proof of Correctness *) -(** **** 练习:3 星 (insert_perm) *) -(** Prove the following auxiliary lemma, [insert_perm], which will be +(** **** 练习:3 星, standard (insert_perm) + + Prove the following auxiliary lemma, [insert_perm], which will be useful for proving [sort_perm] below. Your proof will be by induction, but you'll need some of the permutation facts from the library, so first remind yourself by doing [Search]. *) @@ -121,16 +122,18 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (sort_perm) *) -(** Now prove that sort is a permutation. *) +(** **** 练习:3 星, standard (sort_perm) + + Now prove that sort is a permutation. *) Theorem sort_perm: forall l, Permutation l (sort l). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星 (insert_sorted) *) -(** This one is a bit tricky. However, there just a single induction +(** **** 练习:4 星, standard (insert_sorted) + + This one is a bit tricky. However, there just a single induction right at the beginning, and you do _not_ need to use [insert_perm] or [sort_perm]. *) @@ -140,8 +143,9 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (sort_sorted) *) -(** This one is easy. *) +(** **** 练习:2 星, standard (sort_sorted) + + This one is easy. *) Theorem sort_sorted: forall l, sorted (sort l). Proof. @@ -168,7 +172,7 @@ Qed. confidence that we have the right specification, though of course it doesn't _prove_ that we do. *) -(** **** 练习:4 星, optional (sorted_sorted') *) +(** **** 练习:4 星, standard, optional (sorted_sorted') *) Lemma sorted_sorted': forall al, sorted al -> sorted' al. (** Hint: Instead of doing induction on the list [al], do induction @@ -179,7 +183,7 @@ Lemma sorted_sorted': forall al, sorted al -> sorted' al. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星, optional (sorted'_sorted) *) +(** **** 练习:3 星, standard, optional (sorted'_sorted) *) Lemma sorted'_sorted: forall al, sorted' al -> sorted al. (** Here, you can't do induction on the sorted'-ness of the list, @@ -210,7 +214,7 @@ Proof. DO NOT USE [sorted_sorted'], [sorted'_sorted], [insert_sorted], or [sort_sorted] in these proofs! *) -(** **** 练习:3 星, optional (Forall_nth) *) +(** **** 练习:3 星, standard, optional (Forall_nth) *) Lemma Forall_nth: forall {A: Type} (P: A -> Prop) d (al: list A), Forall P al <-> (forall i, i < length al -> P (nth i al d)). @@ -218,14 +222,13 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) - -(** **** 练习:4 星, optional (insert_sorted') *) +(** **** 练习:4 星, standard, optional (insert_sorted') *) Lemma insert_sorted': forall a l, sorted' l -> sorted' (insert a l). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:4 星, optional (insert_sorted') *) +(** **** 练习:4 星, standard, optional (insert_sorted') *) Theorem sort_sorted': forall l, sorted' (sort l). (* 请在此处解答 *) Admitted. (** [] *) @@ -245,4 +248,5 @@ Theorem sort_sorted': forall l, sorted' (sort l). predicate ([sorted]), and then prove [sort_sorted] and [sorted_sorted']. *) -(** $Date$ *) + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/SortTest.v b/vfa-current/SortTest.v index 76e04edd..d3d3a9c4 100644 --- a/vfa-current/SortTest.v +++ b/vfa-current/SortTest.v @@ -102,3 +102,5 @@ Print Assumptions sort_sorted. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:10 UTC 2019 *) diff --git a/vfa-current/Trie.html b/vfa-current/Trie.html index afca699f..6164f484 100644 --- a/vfa-current/Trie.html +++ b/vfa-current/Trie.html @@ -123,7 +123,7 @@

    TrieNumber Representations and Effic

    -Require Import Coq.Strings.String.
    +From Coq Require Import Strings.String.
    From VFA Require Import Perm.
    From VFA Require Import Maps.
    Import FunctionalExtensionality.

    @@ -260,9 +260,9 @@

    TrieNumber Representations and Effic

    -Notation "p ¬ 1" := (xI p)
    +Notation "p ¬1" := (xI p)
     (at level 7, left associativity, format "p '¬' '1'").
    -Notation "p ¬ 0" := (xO p)
    +Notation "p ¬0" := (xO p)
     (at level 7, left associativity, format "p '¬' '0'").

    Print ten. (* = xH~0~1~0 : positive *)
    @@ -325,11 +325,11 @@

    TrieNumber Representations and Effic

    -

    练习:2 星 (succ_correct)

    +

    练习:2 星, standard (succ_correct)

    -Lemma succ_correct: p,
    +Lemma succ_correct: p,
       positive2nat (succ p) = S (positive2nat p).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -339,7 +339,7 @@

    TrieNumber Representations and Effic
    -

    练习:3 星 (addc_correct)

    +

    练习:3 星, standard (addc_correct)

    You may use omega in this proof if you want, along with induction of course. But really, using omega is an anachronism in a sense: Coq's omega uses theorems about Z that are proved from theorems about @@ -350,12 +350,12 @@

    TrieNumber Representations and Effic

    -Lemma addc_correct: (c: bool) (p q: positive),
    +Lemma addc_correct: (c: bool) (p q: positive),
       positive2nat (addc c p q) =
            (if c then 1 else 0) + positive2nat p + positive2nat q.
    Proof.
    (* 请在此处解答 *) Admitted.

    -Theorem add_correct: (p q: positive),
    +Theorem add_correct: (p q: positive),
       positive2nat (add p q) = positive2nat p + positive2nat q.
    Proof.
    intros.
    @@ -395,7 +395,7 @@

    TrieNumber Representations and Effic

    -

    练习:5 星 (compare_correct)

    +

    练习:5 星, standard (compare_correct)

    @@ -409,13 +409,13 @@

    TrieNumber Representations and Effic     | _, _Lt
      end.

    Lemma positive2nat_pos:
    p, positive2nat p > 0.
    p, positive2nat p > 0.
    Proof.
    intros.
    induction p; simpl; omega.
    Qed.

    Theorem compare_correct:
    x y,
    x y,
      match compare x y with
      | Ltpositive2nat x < positive2nat y
      | Eqpositive2nat x = positive2nat y
    @@ -469,12 +469,12 @@

    TrieNumber Representations and Effic Print positive. (* from the Coq standard library:
      Inductive positive : Set :=
    -  |  xI : positive -> positive
    -  | xO : positive -> positive
    +  |  xI : positive -> positive
    +  | xO : positive -> positive
      | xH : positive *)


    -Check Pos.compare. (*   : positive -> positive -> comparison *)
    -Check Pos.add. (* : positive -> positive -> positive *)

    -Check Z.add. (* : Z -> Z -> Z *)
    +Check Pos.compare. (*   : positive -> positive -> comparison *)
    +Check Pos.add. (* : positive -> positive -> positive *)

    +Check Z.add. (* : Z -> Z -> Z *)

    @@ -556,8 +556,8 @@

    TrieNumber Representations and Effic Print positive.
    (* Inductive positive : Set :=
    -    xI : positive -> positive
    - | xO : positive -> positive
    +    xI : positive -> positive
    + | xO : positive -> positive
     | xH : positive *)


    Goal 10%positive = xO (xI (xO xH)).
    Proof. reflexivity. Qed.
    @@ -654,7 +654,7 @@

    TrieNumber Representations and Effic constant time.
    -

    练习:2 星 (successor_of_Z_constant_time)

    +

    练习:2 星, standard (successor_of_Z_constant_time)

    Explain why the average-case time for successor of a binary integer, with carry, is constant time. Assume that the input integer is random (uniform distribution from 1 to N), or assume that @@ -696,12 +696,12 @@

    TrieNumber Representations and Effic
    -

    练习:1 星 (look_leaf)

    +

    练习:1 星, standard (look_leaf)

    Lemma look_leaf:
    A (a:A) j, look a j Leaf = a.
    A (a:A) j, look a j Leaf = a.
    (* 请在此处解答 *) Admitted.
    @@ -709,12 +709,12 @@

    TrieNumber Representations and Effic
    -

    练习:2 星 (look_ins_same)

    +

    练习:2 星, standard (look_ins_same)

    This is a rather simple induction.
    -Lemma look_ins_same: {A} a k (v:A) t, look a k (ins a k v t) = v.
    +Lemma look_ins_same: {A} a k (v:A) t, look a k (ins a k v t) = v.
    (* 请在此处解答 *) Admitted.
    @@ -722,12 +722,12 @@

    TrieNumber Representations and Effic
    -

    练习:3 星 (look_ins_same)

    +

    练习:3 星, standard (look_ins_same)

    Induction on j? Induction on t? Do you feel lucky?
    -Lemma look_ins_other: {A} a j k (v:A) t,
    +Lemma look_ins_other: {A} a j k (v:A) t,
       jklook a j (ins a k v t) = look a j t.
    (* 请在此处解答 *) Admitted.
    @@ -748,7 +748,7 @@

    TrieNumber Representations and Effic Definition nat2pos (n: nat) : positive := Pos.of_succ_nat n.
    Definition pos2nat (n: positive) : nat := pred (Pos.to_nat n).

    -Lemma pos2nat2pos: p, nat2pos (pos2nat p) = p.
    +Lemma pos2nat2pos: p, nat2pos (pos2nat p) = p.
    Proof. (* You don't need to read this proof! *)
    intro. unfold nat2pos, pos2nat.
    rewrite <- (Pos2Nat.id p) at 2.
    @@ -757,7 +757,7 @@

    TrieNumber Representations and Effic rewrite <- Pos.of_nat_succ.
    reflexivity.
    Qed.

    -Lemma nat2pos2nat: i, pos2nat (nat2pos i) = i.
    +Lemma nat2pos2nat: i, pos2nat (nat2pos i) = i.
    Proof. (* You don't need to read this proof! *)
    intro. unfold nat2pos, pos2nat.
    rewrite SuccNat2Pos.id_succ.
    @@ -769,13 +769,13 @@

    TrieNumber Representations and Effic Now, use those two lemmas to prove that it's really a bijection!
    -

    练习:2 星 (pos2nat_bijective)

    +

    练习:2 星, standard (pos2nat_bijective)

    -Lemma pos2nat_injective: p q, pos2nat p = pos2nat qp=q.
    +Lemma pos2nat_injective: p q, pos2nat p = pos2nat qp=q.
    (* 请在此处解答 *) Admitted.

    -Lemma nat2pos_injective: i j, nat2pos i = nat2pos ji=j.
    +Lemma nat2pos_injective: i j, nat2pos i = nat2pos ji=j.
    (* 请在此处解答 *) Admitted.
    @@ -814,16 +814,16 @@

    TrieNumber Representations and Effic

    -

    练习:2 星 (is_trie)

    +

    练习:2 星, standard (is_trie)

    If you picked a _really simple_ representation invariant, these should be easy. Later, if you need to change the representation invariant in order to get the _relate proofs to work, then you'll need to fix these proofs.
    -Theorem empty_is_trie: {A} (default: A), is_trie (empty default).
    +Theorem empty_is_trie: {A} (default: A), is_trie (empty default).
    (* 请在此处解答 *) Admitted.

    -Theorem insert_is_trie: {A} i x (t: trie_table A),
    +Theorem insert_is_trie: {A} i x (t: trie_table A),
       is_trie tis_trie (insert i x t).
    (* 请在此处解答 *) Admitted.
    @@ -832,14 +832,14 @@

    TrieNumber Representations and Effic
    -

    练习:2 星 (empty_relate)

    +

    练习:2 星, standard (empty_relate)

    Just unfold a bunch of definitions, use extensionality, and use one of the lemmas you proved above, in the section "Lemmas about the relation between lookup and insert."
    -Theorem empty_relate: {A} (default: A),
    +Theorem empty_relate: {A} (default: A),
        Abs (empty default) (t_empty default).
    Proof.
    (* 请在此处解答 *) Admitted.
    @@ -849,12 +849,12 @@

    TrieNumber Representations and Effic
    -

    练习:2 星 (lookup_relate)

    +

    练习:2 星, standard (lookup_relate)

    Given the abstraction relation we've chosen, this one should be really simple.
    -Theorem lookup_relate: {A} i (t: trie_table A) m,
    +Theorem lookup_relate: {A} i (t: trie_table A) m,
        is_trie tAbs t mlookup i t = m (pos2nat i).
    (* 请在此处解答 *) Admitted.
    @@ -863,7 +863,7 @@

    TrieNumber Representations and Effic
    -

    练习:3 星 (insert_relate)

    +

    练习:3 星, standard (insert_relate)

    Given the abstraction relation we've chosen, this one should NOT be simple. However, you've already done the heavy lifting, with the lemmas look_ins_same and look_ins_other. You will not need induction here. @@ -873,7 +873,7 @@

    TrieNumber Representations and Effic

    -Theorem insert_relate: {A} k (v: A) t cts,
    +Theorem insert_relate: {A} k (v: A) t cts,
        is_trie t
        Abs t cts
        Abs (insert k v t) (t_update cts (pos2nat k) v).
    @@ -920,6 +920,10 @@

    TrieNumber Representations and Effic but FMaps uses different names for the functions insert and lookup, and also provides several other operations on maps.

    +
    + +(* Sat Jan 26 15:18:06 UTC 2019 *)
    +

    diff --git a/vfa-current/Trie.v b/vfa-current/Trie.v index fb47f852..23288736 100644 --- a/vfa-current/Trie.v +++ b/vfa-current/Trie.v @@ -23,7 +23,6 @@ } return collisions; - In a functional program, we must replace [a[i]=1] with the update of a finite map. If we use the inefficient maps in [Maps.v], each lookup and update will take (worst-case) linear time, and the whole @@ -68,7 +67,7 @@ (* ################################################################# *) (** * A Simple Program That's Waaaaay Too Slow. *) -Require Import Coq.Strings.String. +From Coq Require Import Strings.String. From VFA Require Import Perm. From VFA Require Import Maps. Import FunctionalExtensionality. @@ -115,8 +114,9 @@ Print eqb. End VerySlow. (* ################################################################# *) -(** * Efficient Positive Numbers *) -(** We can do better; we _must_ do better. In fact, Coq's integer type, +(** * Efficient Positive Numbers + + We can do better; we _must_ do better. In fact, Coq's integer type, called [Z], is a binary representation (not unary), so that operations such as [plus] and [leq] take time linear in the number of bits, that is, logarithmic in the value of the numbers. Here we will explore how [Z] @@ -221,15 +221,16 @@ Fixpoint addc (carry: bool) (x y: positive) {struct x} : positive := Definition add (x y: positive) : positive := addc false x y. -(** **** 练习:2 星 (succ_correct) *) +(** **** 练习:2 星, standard (succ_correct) *) Lemma succ_correct: forall p, positive2nat (succ p) = S (positive2nat p). Proof. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (addc_correct) *) -(** You may use [omega] in this proof if you want, along with induction +(** **** 练习:3 星, standard (addc_correct) + + You may use [omega] in this proof if you want, along with induction of course. But really, using [omega] is an anachronism in a sense: Coq's [omega] uses theorems about [Z] that are proved from theorems about Coq's standard-library [positive] that, in turn, rely on a theorem much @@ -272,7 +273,7 @@ Qed. Inductive comparison : Set := Eq : comparison | Lt : comparison | Gt : comparison. -(** **** 练习:5 星 (compare_correct) *) +(** **** 练习:5 星, standard (compare_correct) *) Fixpoint compare x y {struct x}:= match x, y with | p~1, q~1 => compare p q @@ -306,8 +307,9 @@ induction x; destruct y; simpl. Proof: it's structurally inductive on the height of [x]. *) (* ================================================================= *) -(** ** Coq's Integer Type, [Z] *) -(** Coq's integer type is constructed from positive numbers: *) +(** ** Coq's Integer Type, [Z] + + Coq's integer type is constructed from positive numbers: *) Inductive Z : Set := | Z0 : Z @@ -504,8 +506,9 @@ End FastEnough. in which case, [1+c] takes worst-case [log N], and average-case constant time. *) -(** **** 练习:2 星 (successor_of_Z_constant_time) *) -(** Explain why the average-case time for successor of a binary +(** **** 练习:2 星, standard (successor_of_Z_constant_time) + + Explain why the average-case time for successor of a binary integer, with carry, is constant time. Assume that the input integer is random (uniform distribution from 1 to N), or assume that we are iterating successor starting at 1, so that each number @@ -535,22 +538,23 @@ Definition manual_grade_for_successor_of_Z_constant_time : option (nat*string) : (* ================================================================= *) (** ** Lemmas About the Relation Between [lookup] and [insert] *) -(** **** 练习:1 星 (look_leaf) *) +(** **** 练习:1 星, standard (look_leaf) *) Lemma look_leaf: forall A (a:A) j, look a j Leaf = a. (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (look_ins_same) *) -(** This is a rather simple induction. *) +(** **** 练习:2 星, standard (look_ins_same) + + This is a rather simple induction. *) Lemma look_ins_same: forall {A} a k (v:A) t, look a k (ins a k v t) = v. (* 请在此处解答 *) Admitted. (** [] *) +(** **** 练习:3 星, standard (look_ins_same) -(** **** 练习:3 星 (look_ins_same) *) -(** Induction on j? Induction on t? Do you feel lucky? *) + Induction on j? Induction on t? Do you feel lucky? *) Lemma look_ins_other: forall {A} a j k (v:A) t, j <> k -> look a j (ins a k v t) = look a j t. @@ -586,7 +590,7 @@ Qed. (** Now, use those two lemmas to prove that it's really a bijection! *) -(** **** 练习:2 星 (pos2nat_bijective) *) +(** **** 练习:2 星, standard (pos2nat_bijective) *) Lemma pos2nat_injective: forall p q, pos2nat p = pos2nat q -> p=q. (* 请在此处解答 *) Admitted. @@ -617,8 +621,9 @@ Definition abstract {A: Type} (t: trie_table A) (n: nat) : A := Definition Abs {A: Type} (t: trie_table A) (m: total_map A) := abstract t = m. -(** **** 练习:2 星 (is_trie) *) -(** If you picked a _really simple_ representation invariant, these should be easy. +(** **** 练习:2 星, standard (is_trie) + + If you picked a _really simple_ representation invariant, these should be easy. Later, if you need to change the representation invariant in order to get the [_relate] proofs to work, then you'll need to fix these proofs. *) @@ -630,8 +635,9 @@ Theorem insert_is_trie: forall {A} i x (t: trie_table A), (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:2 星 (empty_relate) *) -(** Just unfold a bunch of definitions, use [extensionality], and +(** **** 练习:2 星, standard (empty_relate) + + Just unfold a bunch of definitions, use [extensionality], and use one of the lemmas you proved above, in the section "Lemmas about the relation between [lookup] and [insert]." *) @@ -641,17 +647,18 @@ Proof. (* 请在此处解答 *) Admitted. (** [] *) +(** **** 练习:2 星, standard (lookup_relate) -(** **** 练习:2 星 (lookup_relate) *) -(** Given the abstraction relation we've chosen, this one should be really simple. *) + Given the abstraction relation we've chosen, this one should be really simple. *) Theorem lookup_relate: forall {A} i (t: trie_table A) m, is_trie t -> Abs t m -> lookup i t = m (pos2nat i). (* 请在此处解答 *) Admitted. (** [] *) -(** **** 练习:3 星 (insert_relate) *) -(** Given the abstraction relation we've chosen, this one should NOT be simple. +(** **** 练习:3 星, standard (insert_relate) + + Given the abstraction relation we've chosen, this one should NOT be simple. However, you've already done the heavy lifting, with the lemmas [look_ins_same] and [look_ins_other]. You will not need induction here. Instead, unfold a bunch of things, use extensionality, and get to a case analysis @@ -680,8 +687,9 @@ try (apply empty_relate). (* 请在此处解答 *) Admitted. (* ################################################################# *) -(** * Conclusion *) -(** Efficient functional maps with (positive) integer keys are one of the most +(** * Conclusion + + Efficient functional maps with (positive) integer keys are one of the most important data structures in functional programming. They are used for symbol tables in compilers and static analyzers; to represent directed graphs (the mapping from node-ID to edge-list); and (in general) anywhere that @@ -694,3 +702,5 @@ try (apply empty_relate). The core implementation of [PositiveMap] is just as shown in this chapter, but [FMaps] uses different names for the functions [insert] and [lookup], and also provides several other operations on maps. *) + +(* Sat Jan 26 15:18:06 UTC 2019 *) diff --git a/vfa-current/TrieTest.v b/vfa-current/TrieTest.v index d0eef6ab..cb445bab 100644 --- a/vfa-current/TrieTest.v +++ b/vfa-current/TrieTest.v @@ -245,3 +245,5 @@ Print Assumptions insert_relate. idtac "". idtac "********** Advanced **********". Abort. + +(* Sat Jan 26 15:18:44 UTC 2019 *) diff --git a/vfa-current/common/css/sf.css b/vfa-current/common/css/sf.css index be9fcb10..12d4abc1 100644 --- a/vfa-current/common/css/sf.css +++ b/vfa-current/common/css/sf.css @@ -489,6 +489,9 @@ tr.infrulemiddle hr { color: rgb(0%,0%,0%); } +.nowrap { + white-space: nowrap; +} /* TOC */ diff --git a/vfa-current/common/css/slides.css b/vfa-current/common/css/slides.css index 0f1fc55a..b9d0327d 100644 --- a/vfa-current/common/css/slides.css +++ b/vfa-current/common/css/slides.css @@ -34,5 +34,7 @@ h1.libtitle { line-height: 34px; } - +body { + background: white; +} diff --git a/vfa-current/coqindex.html b/vfa-current/coqindex.html index f23b6226..e3aa3531 100644 --- a/vfa-current/coqindex.html +++ b/vfa-current/coqindex.html @@ -188,37 +188,6 @@ (14 entries) -Lemma Index -A -B -C -D -E -F -G -H -I -J -K -L -M -N -O -P -Q -R -S -T -U -V -W -X -Y -Z -_ -(211 entries) - - Constructor Index A B @@ -250,6 +219,37 @@ (52 entries) +Lemma Index +A +B +C +D +E +F +G +H +I +J +K +L +M +N +O +P +Q +R +S +T +U +V +W +X +Y +Z +_ +(211 entries) + + Axiom Index A B @@ -377,17 +377,17 @@

    Global Index

    A

    +Abs [inductive, in VFA.SearchTree]
    Abs [definition, in VFA.Trie]
    Abs [inductive, in VFA.Redblack]
    -Abs [inductive, in VFA.SearchTree]
    abstract [definition, in VFA.Trie]
    abstraction_of_bogus_tree [lemma, in VFA.SearchTree]
    AbsX [definition, in VFA.SearchTree]
    Abs_E [constructor, in VFA.Redblack]
    Abs_E [constructor, in VFA.SearchTree]
    Abs_helper [lemma, in VFA.Redblack]
    -Abs_T [constructor, in VFA.SearchTree]
    Abs_T [constructor, in VFA.Redblack]
    +Abs_T [constructor, in VFA.SearchTree]
    Abs_three_ten [definition, in VFA.Trie]
    add_edge [definition, in VFA.Color]
    adj [definition, in VFA.Color]
    @@ -466,8 +466,8 @@

    Global Index

    colors_of [definition, in VFA.Color]
    color1 [definition, in VFA.Color]
    color_correct [lemma, in VFA.Color]
    -combine [definition, in VFA.Redblack]
    combine [definition, in VFA.SearchTree]
    +combine [definition, in VFA.Redblack]
    compute_with_lt_dec [lemma, in VFA.Decide]
    compute_with_StdLib_lt_dec [lemma, in VFA.Decide]
    cons_relate [lemma, in VFA.ADT]
    @@ -482,10 +482,10 @@

    Global Index

    domain_example_map [definition, in VFA.Color]


    E

    E [constructor, in VFA.Redblack]
    -E [constructor, in VFA.SearchTree]
    E [module, in VFA.Color]
    -elements [definition, in VFA.Redblack]
    +E [constructor, in VFA.SearchTree]
    elements [definition, in VFA.SearchTree]
    +elements [definition, in VFA.Redblack]
    elements' [definition, in VFA.SearchTree]
    elements' [definition, in VFA.Redblack]
    elements_property [definition, in VFA.Redblack]
    @@ -499,12 +499,12 @@

    Global Index

    empty [definition, in VFA.Multiset]
    empty_is_trie [lemma, in VFA.Trie]
    empty_relate [lemma, in VFA.Trie]
    -empty_tree [definition, in VFA.Redblack]
    empty_tree [definition, in VFA.SearchTree]
    +empty_tree [definition, in VFA.Redblack]
    empty_tree_relate [lemma, in VFA.SearchTree]
    empty_tree_relate [lemma, in VFA.Redblack]
    -empty_tree_SearchTree [lemma, in VFA.SearchTree]
    empty_tree_SearchTree [lemma, in VFA.Redblack]
    +empty_tree_SearchTree [lemma, in VFA.SearchTree]
    eqb_reflect [lemma, in VFA.Perm]
    eqlistA_Eeq_eq [lemma, in VFA.Color]
    equivlistA_example [definition, in VFA.Color]
    @@ -563,9 +563,9 @@

    Global Index

    InA_map_fst_key [lemma, in VFA.Color]
    ins [definition, in VFA.Redblack]
    ins [definition, in VFA.Trie]
    -insert [definition, in VFA.Redblack]
    insert [definition, in VFA.SearchTree]
    insert [definition, in VFA.Trie]
    +insert [definition, in VFA.Redblack]
    insert [definition, in VFA.Sort]
    insertion_sort_correct [lemma, in VFA.Multiset]
    insertion_sort_correct [lemma, in VFA.Sort]
    @@ -574,11 +574,11 @@

    Global Index

    insert_is_trie [lemma, in VFA.Trie]
    insert_perm [lemma, in VFA.Sort]
    insert_relate [lemma, in VFA.Trie]
    -insert_relate [lemma, in VFA.Redblack]
    insert_relate [lemma, in VFA.SearchTree]
    +insert_relate [lemma, in VFA.Redblack]
    insert_relate' [lemma, in VFA.SearchTree]
    -insert_SearchTree [lemma, in VFA.SearchTree]
    insert_SearchTree [lemma, in VFA.Redblack]
    +insert_SearchTree [lemma, in VFA.SearchTree]
    insert_sorted [lemma, in VFA.Sort]
    insert_sorted' [lemma, in VFA.Sort]
    ins_is_redblack [lemma, in VFA.Redblack]
    @@ -683,9 +683,9 @@

    Global Index

    List_Priqueue.select_biggest_aux [lemma, in VFA.Priqueue]
    List_Priqueue.select_perm [lemma, in VFA.Priqueue]
    look [definition, in VFA.Trie]
    -lookup [definition, in VFA.Trie]
    -lookup [definition, in VFA.SearchTree]
    lookup [definition, in VFA.Redblack]
    +lookup [definition, in VFA.SearchTree]
    +lookup [definition, in VFA.Trie]
    lookup_relate [lemma, in VFA.Trie]
    lookup_relate [lemma, in VFA.SearchTree]
    lookup_relate [lemma, in VFA.Redblack]
    @@ -834,14 +834,14 @@

    Global Index

    ScratchPad2.sorted_cons [constructor, in VFA.Decide]
    ScratchPad2.sorted_nil [constructor, in VFA.Decide]
    ScratchPad2.sorted_1 [constructor, in VFA.Decide]
    -SearchTree [inductive, in VFA.Redblack]
    SearchTree [inductive, in VFA.SearchTree]
    +SearchTree [inductive, in VFA.Redblack]
    SearchTree [library]
    SearchTreeX [definition, in VFA.SearchTree]
    SearchTree' [inductive, in VFA.Redblack]
    SearchTree' [inductive, in VFA.SearchTree]
    -SearchTree'_le [lemma, in VFA.SearchTree]
    SearchTree'_le [lemma, in VFA.Redblack]
    +SearchTree'_le [lemma, in VFA.SearchTree]
    SearchTree2 [module, in VFA.Extract]
    SearchTree2.Abs [inductive, in VFA.Extract]
    SearchTree2.Abs_E [constructor, in VFA.Extract]
    @@ -918,8 +918,8 @@

    Global Index

    sort_contents [lemma, in VFA.Multiset]
    sort_perm [lemma, in VFA.Sort]
    sort_pi [definition, in VFA.Selection]
    -sort_pi [definition, in VFA.Sort]
    sort_pi [definition, in VFA.Multiset]
    +sort_pi [definition, in VFA.Sort]
    sort_pi_same_contents [definition, in VFA.Multiset]
    sort_sorted [lemma, in VFA.Sort]
    sort_sorted' [lemma, in VFA.Sort]
    @@ -933,8 +933,8 @@

    Global Index

    step_relate [lemma, in VFA.ADT]
    ST_E [constructor, in VFA.Redblack]
    ST_E [constructor, in VFA.SearchTree]
    -ST_intro [constructor, in VFA.SearchTree]
    ST_intro [constructor, in VFA.Redblack]
    +ST_intro [constructor, in VFA.SearchTree]
    ST_T [constructor, in VFA.Redblack]
    ST_T [constructor, in VFA.SearchTree]
    subset_nodes [definition, in VFA.Color]
    @@ -961,14 +961,14 @@

    Global Index

    tree [inductive, in VFA.Redblack]
    TREES [section, in VFA.SearchTree]
    TREES [section, in VFA.Redblack]
    -TREES.default [variable, in VFA.SearchTree]
    TREES.default [variable, in VFA.Redblack]
    +TREES.default [variable, in VFA.SearchTree]
    TREES.EXAMPLES [section, in VFA.SearchTree]
    TREES.EXAMPLES.v2 [variable, in VFA.SearchTree]
    TREES.EXAMPLES.v4 [variable, in VFA.SearchTree]
    TREES.EXAMPLES.v5 [variable, in VFA.SearchTree]
    -TREES.V [variable, in VFA.SearchTree]
    TREES.V [variable, in VFA.Redblack]
    +TREES.V [variable, in VFA.SearchTree]
    TreeTable [module, in VFA.ADT]
    TreeTable.default [definition, in VFA.ADT]
    TreeTable.empty [definition, in VFA.ADT]
    @@ -1078,13 +1078,13 @@

    Variable Index

    SectionExample2.MAPS.default [in VFA.SearchTree]
    SectionExample2.MAPS.V [in VFA.SearchTree]


    T

    -TREES.default [in VFA.SearchTree]
    TREES.default [in VFA.Redblack]
    +TREES.default [in VFA.SearchTree]
    TREES.EXAMPLES.v2 [in VFA.SearchTree]
    TREES.EXAMPLES.v4 [in VFA.SearchTree]
    TREES.EXAMPLES.v5 [in VFA.SearchTree]
    -TREES.V [in VFA.SearchTree]
    TREES.V [in VFA.Redblack]
    +TREES.V [in VFA.SearchTree]



    Library Index

    A

    @@ -1112,6 +1112,69 @@

    Library Index



    T

    Trie



    +

    Constructor Index

    +

    A

    +Abs_E [in VFA.Redblack]
    +Abs_E [in VFA.SearchTree]
    +Abs_T [in VFA.Redblack]
    +Abs_T [in VFA.SearchTree]
    +

    B

    +BinomQueue.Leaf [in VFA.Binom]
    +BinomQueue.Node [in VFA.Binom]
    +BinomQueue.tree_elems_leaf [in VFA.Binom]
    +BinomQueue.tree_elems_node [in VFA.Binom]
    +Black [in VFA.Redblack]
    +

    E

    +E [in VFA.Redblack]
    +E [in VFA.SearchTree]
    +

    I

    +Integers.Eq [in VFA.Trie]
    +Integers.Gt [in VFA.Trie]
    +Integers.Lt [in VFA.Trie]
    +Integers.xH [in VFA.Trie]
    +Integers.xI [in VFA.Trie]
    +Integers.xO [in VFA.Trie]
    +Integers.Zneg [in VFA.Trie]
    +Integers.Zpos [in VFA.Trie]
    +Integers.Z0 [in VFA.Trie]
    +IsRB_b [in VFA.Redblack]
    +IsRB_leaf [in VFA.Redblack]
    +IsRB_r [in VFA.Redblack]
    +

    L

    +Leaf [in VFA.Trie]
    +List_Priqueue.Abs_intro [in VFA.Priqueue]
    +

    N

    +Node [in VFA.Trie]
    +nrRB_b [in VFA.Redblack]
    +nrRB_r [in VFA.Redblack]
    +

    R

    +Red [in VFA.Redblack]
    +

    S

    +ScratchPad.left [in VFA.Decide]
    +ScratchPad.right [in VFA.Decide]
    +ScratchPad2.sorted_cons [in VFA.Decide]
    +ScratchPad2.sorted_nil [in VFA.Decide]
    +ScratchPad2.sorted_1 [in VFA.Decide]
    +SearchTree2.Abs_E [in VFA.Extract]
    +SearchTree2.Abs_T [in VFA.Extract]
    +SearchTree2.E [in VFA.Extract]
    +SearchTree2.T [in VFA.Extract]
    +sorted_cons [in VFA.Selection]
    +sorted_cons [in VFA.Sort]
    +sorted_nil [in VFA.Sort]
    +sorted_nil [in VFA.Selection]
    +sorted_1 [in VFA.Sort]
    +sorted_1 [in VFA.Selection]
    +ST_E [in VFA.Redblack]
    +ST_E [in VFA.SearchTree]
    +ST_intro [in VFA.Redblack]
    +ST_intro [in VFA.SearchTree]
    +ST_T [in VFA.Redblack]
    +ST_T [in VFA.SearchTree]
    +

    T

    +T [in VFA.SearchTree]
    +T [in VFA.Redblack]
    +


    Lemma Index

    A

    abstraction_of_bogus_tree [in VFA.SearchTree]
    @@ -1169,8 +1232,8 @@

    Lemma Index

    empty_relate [in VFA.Trie]
    empty_tree_relate [in VFA.SearchTree]
    empty_tree_relate [in VFA.Redblack]
    -empty_tree_SearchTree [in VFA.SearchTree]
    empty_tree_SearchTree [in VFA.Redblack]
    +empty_tree_SearchTree [in VFA.SearchTree]
    eqb_reflect [in VFA.Perm]
    eqlistA_Eeq_eq [in VFA.Color]
    example_SearchTree_bad [in VFA.SearchTree]
    @@ -1200,11 +1263,11 @@

    Lemma Index

    insert_is_trie [in VFA.Trie]
    insert_perm [in VFA.Sort]
    insert_relate [in VFA.Trie]
    -insert_relate [in VFA.Redblack]
    insert_relate [in VFA.SearchTree]
    +insert_relate [in VFA.Redblack]
    insert_relate' [in VFA.SearchTree]
    -insert_SearchTree [in VFA.SearchTree]
    insert_SearchTree [in VFA.Redblack]
    +insert_SearchTree [in VFA.SearchTree]
    insert_sorted [in VFA.Sort]
    insert_sorted' [in VFA.Sort]
    ins_is_redblack [in VFA.Redblack]
    @@ -1287,8 +1350,8 @@

    Lemma Index

    ScratchPad.lt_dec_equivalent [in VFA.Decide]
    ScratchPad2.insert_sorted [in VFA.Decide]
    ScratchPad2.prove_with_max_axiom [in VFA.Decide]
    -SearchTree'_le [in VFA.SearchTree]
    SearchTree'_le [in VFA.Redblack]
    +SearchTree'_le [in VFA.SearchTree]
    SearchTree2.empty_tree_relate [in VFA.Extract]
    SearchTree2.insert_relate [in VFA.Extract]
    SearchTree2.lookup_relate [in VFA.Extract]
    @@ -1341,69 +1404,6 @@

    Lemma Index

    Z_eqb_reflect [in VFA.Extract]
    Z_ltb_reflect [in VFA.Extract]



    -

    Constructor Index

    -

    A

    -Abs_E [in VFA.Redblack]
    -Abs_E [in VFA.SearchTree]
    -Abs_T [in VFA.SearchTree]
    -Abs_T [in VFA.Redblack]
    -

    B

    -BinomQueue.Leaf [in VFA.Binom]
    -BinomQueue.Node [in VFA.Binom]
    -BinomQueue.tree_elems_leaf [in VFA.Binom]
    -BinomQueue.tree_elems_node [in VFA.Binom]
    -Black [in VFA.Redblack]
    -

    E

    -E [in VFA.Redblack]
    -E [in VFA.SearchTree]
    -

    I

    -Integers.Eq [in VFA.Trie]
    -Integers.Gt [in VFA.Trie]
    -Integers.Lt [in VFA.Trie]
    -Integers.xH [in VFA.Trie]
    -Integers.xI [in VFA.Trie]
    -Integers.xO [in VFA.Trie]
    -Integers.Zneg [in VFA.Trie]
    -Integers.Zpos [in VFA.Trie]
    -Integers.Z0 [in VFA.Trie]
    -IsRB_b [in VFA.Redblack]
    -IsRB_leaf [in VFA.Redblack]
    -IsRB_r [in VFA.Redblack]
    -

    L

    -Leaf [in VFA.Trie]
    -List_Priqueue.Abs_intro [in VFA.Priqueue]
    -

    N

    -Node [in VFA.Trie]
    -nrRB_b [in VFA.Redblack]
    -nrRB_r [in VFA.Redblack]
    -

    R

    -Red [in VFA.Redblack]
    -

    S

    -ScratchPad.left [in VFA.Decide]
    -ScratchPad.right [in VFA.Decide]
    -ScratchPad2.sorted_cons [in VFA.Decide]
    -ScratchPad2.sorted_nil [in VFA.Decide]
    -ScratchPad2.sorted_1 [in VFA.Decide]
    -SearchTree2.Abs_E [in VFA.Extract]
    -SearchTree2.Abs_T [in VFA.Extract]
    -SearchTree2.E [in VFA.Extract]
    -SearchTree2.T [in VFA.Extract]
    -sorted_cons [in VFA.Selection]
    -sorted_cons [in VFA.Sort]
    -sorted_nil [in VFA.Sort]
    -sorted_nil [in VFA.Selection]
    -sorted_1 [in VFA.Sort]
    -sorted_1 [in VFA.Selection]
    -ST_E [in VFA.Redblack]
    -ST_E [in VFA.SearchTree]
    -ST_intro [in VFA.SearchTree]
    -ST_intro [in VFA.Redblack]
    -ST_T [in VFA.Redblack]
    -ST_T [in VFA.SearchTree]
    -

    T

    -T [in VFA.SearchTree]
    -T [in VFA.Redblack]
    -


    Axiom Index

    I

    int [in VFA.Extract]
    @@ -1450,8 +1450,8 @@

    Axiom Index




    Inductive Index

    A

    -Abs [in VFA.Redblack]
    Abs [in VFA.SearchTree]
    +Abs [in VFA.Redblack]


    B

    BinomQueue.priqueue_elems [in VFA.Binom]
    BinomQueue.tree [in VFA.Binom]
    @@ -1471,8 +1471,8 @@

    Inductive Index



    S

    ScratchPad.sumbool [in VFA.Decide]
    ScratchPad2.sorted [in VFA.Decide]
    -SearchTree [in VFA.Redblack]
    SearchTree [in VFA.SearchTree]
    +SearchTree [in VFA.Redblack]
    SearchTree' [in VFA.Redblack]
    SearchTree' [in VFA.SearchTree]
    SearchTree2.Abs [in VFA.Extract]
    @@ -1531,21 +1531,21 @@

    Definition Index

    coloring_ok [in VFA.Color]
    colors_of [in VFA.Color]
    color1 [in VFA.Color]
    -combine [in VFA.Redblack]
    combine [in VFA.SearchTree]
    +combine [in VFA.Redblack]
    contents [in VFA.Multiset]


    D

    domain_example_map [in VFA.Color]


    E

    -elements [in VFA.Redblack]
    elements [in VFA.SearchTree]
    +elements [in VFA.Redblack]
    elements' [in VFA.SearchTree]
    elements' [in VFA.Redblack]
    elements_property [in VFA.Redblack]
    empty [in VFA.Trie]
    empty [in VFA.Multiset]
    -empty_tree [in VFA.Redblack]
    empty_tree [in VFA.SearchTree]
    +empty_tree [in VFA.Redblack]
    equivlistA_example [in VFA.Color]
    example_map [in VFA.Color]
    example_map [in VFA.SearchTree]
    @@ -1580,9 +1580,9 @@

    Definition Index

    InA_example [in VFA.Color]
    ins [in VFA.Redblack]
    ins [in VFA.Trie]
    -insert [in VFA.Redblack]
    insert [in VFA.SearchTree]
    insert [in VFA.Trie]
    +insert [in VFA.Redblack]
    insert [in VFA.Sort]
    Integers.add [in VFA.Trie]
    Integers.addc [in VFA.Trie]
    @@ -1617,9 +1617,9 @@

    Definition Index

    List_Priqueue.priqueue [in VFA.Priqueue]
    List_Priqueue.select [in VFA.Priqueue]
    look [in VFA.Trie]
    -lookup [in VFA.Trie]
    -lookup [in VFA.SearchTree]
    lookup [in VFA.Redblack]
    +lookup [in VFA.SearchTree]
    +lookup [in VFA.Trie]
    low_deg [in VFA.Color]
    L.cons [in VFA.ADT]
    L.create [in VFA.ADT]
    @@ -1709,8 +1709,8 @@

    Definition Index

    Sort1.insert [in VFA.Extract]
    Sort1.sort [in VFA.Extract]
    sort_pi [in VFA.Selection]
    -sort_pi [in VFA.Sort]
    sort_pi [in VFA.Multiset]
    +sort_pi [in VFA.Sort]
    sort_pi_same_contents [in VFA.Multiset]
    step [in VFA.ADT]
    stepish [in VFA.ADT]
    @@ -1901,37 +1901,6 @@

    Definition Index

    (14 entries) -Lemma Index -A -B -C -D -E -F -G -H -I -J -K -L -M -N -O -P -Q -R -S -T -U -V -W -X -Y -Z -_ -(211 entries) - - Constructor Index A B @@ -1963,6 +1932,37 @@

    Definition Index

    (52 entries) +Lemma Index +A +B +C +D +E +F +G +H +I +J +K +L +M +N +O +P +Q +R +S +T +U +V +W +X +Y +Z +_ +(211 entries) + + Axiom Index A B diff --git a/vfa-current/index.html b/vfa-current/index.html index 87de3fa1..0a9cebc6 100644 --- a/vfa-current/index.html +++ b/vfa-current/index.html @@ -43,7 +43,7 @@

    -

    Version 1.4 (07 Dec 2018, Coq 8.8.0)

    +

    Version 1.4 (26 Jan 2019, Coq 8.8.1)

    diff --git a/vfa-current/vfa.tgz b/vfa-current/vfa.tgz index 372cd45d..f4a68311 100644 Binary files a/vfa-current/vfa.tgz and b/vfa-current/vfa.tgz differ