Question

我在HoTT世界工作，所以discriminate无法使用（还有！）

对于每对构造函数，我可以使用传输和类型族来构造一个定理，但我不知道如何推广这种模式。我想要创建一种与discriminate类似的策略，如果有的话更容易，而不是试图将其作为一个定理。

Lemma bool_discriminate (p : true = false) : Empty.
Proof.
    Fixpoint BoolFamily (b : Bool) : Type :=
        match b with
        |true => Unit
        |false => Empty
        end.
    exact (transport BoolFamily p tt).
Defined.

Lemma nat_discriminate (n : nat) (p : O = (S n)) : Empty.
Proof.
    Fixpoint NatFamily (x : nat) : Type :=
        match x with
        |O => Unit
        |(S _) => Empty
        end.
    exact (transport NatFamily p tt).
Defined.

Inductive threes : Type :=
    one | two | three.

Lemma threes_discriminate12 (p : one = two) : Empty.
Proof.
    Fixpoint ThreesFamily (x : threes) : Type :=
        match x with
        | one => Unit
        | two => Empty
        | three => Unit (* Could be anything *)
        end.
    exact (transport ThreesFamily p tt).
Defined.

Answer 1

这概括为HoTT的编码 - 解码模式。虽然您必须自己定义代码类型（FooFamily，在您的代码中），但它的大小在构造函数的数量上是线性的，并且您不必为每对构造函数单独执行它。对于所有枚举类型，您可以编写一个策略来证明您需要的编码 - 解码校样。

Inductive Empty := .
Inductive Unit := tt.
Inductive Bool := true | false.
Ltac prove_encode :=
  hnf in *;
  repeat match goal with
         | _ => progress subst
         | [ |- Unit ] => constructor
         | [ |- ?x = ?x ] => reflexivity
         | [ H : Empty |- _ ] => case H
         | [ H : Unit |- _ ] => destruct H
         | [ |- context[match ?x with _ => _ end] ]
           => is_var x; destruct x
         | [ H : context[match ?x with _ => _ end] |- _ ]
           => is_var x; destruct x
         | [ |- _ = _ ] => reflexivity
         | [ |- ?f _ _ (?g _ _ ?p) = ?p ] => unfold f, g
         end.
Definition Bool_code (x y : Bool)
  := match x, y with
     | true, true => Unit
     | true, _ => Empty
     | false, false => Unit
     | false, _ => Empty
     end.
Definition Bool_encode {x y} (p : x = y) : Bool_code x y.
Proof. prove_encode. Defined.
Definition Bool_decode {x y} (p : Bool_code x y) : x = y.
Proof. prove_encode. Defined.
Definition Bool_endecode {x y p} : @Bool_encode x y (Bool_decode p) = p.
Proof. prove_encode. Defined.
Definition Bool_deencode {x y p} : @Bool_decode x y (Bool_encode p) = p.
Proof. prove_encode. Defined.

Lemma bool_discriminate (p : true = false) : Empty.
Proof. exact (Bool_encode p). Qed.

Definition nat_code (x y : nat)
  := match x, y with
     | O, O => Unit
     | O, _ => Empty
     | S x', S y' => x' = y'
     | S _, _ => Empty
     end.
Definition nat_encode {x y} (p : x = y) : nat_code x y.
Proof. prove_encode. Defined.
Definition nat_decode {x y} (p : nat_code x y) : x = y.
Proof. prove_encode. Defined.
Definition nat_endecode {x y p} : @nat_encode x y (nat_decode p) = p.
Proof. prove_encode. Defined.
Definition nat_deencode {x y p} : @nat_decode x y (nat_encode p) = p.
Proof. prove_encode. Defined.

Lemma nat_discriminate (n : nat) (p : O = (S n)) : Empty.
Proof. exact (nat_encode p). Qed.

Inductive threes : Type :=
  one | two | three.

Definition threes_code (x y : threes)
  := match x, y with
     | one, one => Unit
     | one, _ => Empty
     | two, two => Unit
     | two, _ => Empty
     | three, three => Unit
     | three, _ => Empty
     end.
Definition threes_encode {x y} (p : x = y) : threes_code x y.
Proof. prove_encode. Defined.
Definition threes_decode {x y} (p : threes_code x y) : x = y.
Proof. prove_encode. Defined.
Definition threes_endecode {x y p} : @threes_encode x y (threes_decode p) = p.
Proof. prove_encode. Defined.
Definition threes_deencode {x y p} : @threes_decode x y (threes_encode p) = p.
Proof. prove_encode. Defined.

Lemma threes_discriminate12 (p : one = two) : Empty.
Proof. exact (threes_encode p). Qed.

在类型的构造函数上泛化代码匹配

1 个答案: