Coq 匹配道具？或以任何其他方式定义；“双重否定翻译”；

我试图在Coq中定义所有命题的定义，这样我就可以证明在“直觉逻辑”中不可证明（或有很难证明）的经典事实，但我认为这不可能使用

归纳
或
不动点
关键字。对于
Fixpoint
，我需要匹配一个任意命题。（虽然我只需要一阶逻辑，即所有
和
存在
量词的连接、分离、条件、否定和
），但我也不能使用
归纳
。这是我失败的方法

Inductive NN (P : Prop) : Prop :=
  | nn_cond (P1 P2 : Prop) (Heq : P = P1 /\ P2) (H : NN P1 -> NN P2).

我需要证明一个类似于这个的
引理

Lemma NN__EM (P : Prop) : NN P <-> (excluded_middle -> P).

引理NN\u-EM（P:Prop）：NN-P（排除中间->P）。

你知道如何定义这样一个定义吗？
双重否定翻译涉及三个逻辑系统。有古典逻辑和直觉逻辑，但翻译不是这两种逻辑的一部分。毕竟，翻译是两个不同的逻辑世界之间的关系；它怎么可能属于其中一个？相反，这些逻辑需要被构造为其他逻辑（可能是你“相信”的逻辑，或者是“真实的”）中的对象，然后双重否定转换是描述两个内部逻辑的环境逻辑的一个定理。TL；DR：双重否定翻译是一个关于逻辑的过程/定理，而不是在逻辑中

由于这个原因，你不能在Coq逻辑中写双重否定翻译，比如引理。我的意思是，你当然可以定义

Inductive sentence : Set := ... . (* E.g. syntax of FOL *)
Definition NN : sentence -> sentence.
Definition classically_provable : sentence -> Prop.
Definition intuitionistically_provable : sentence -> Prop.
Theorem double_negation_translation (p : sentence) :
   classically_provable p <-> intuitionistically_provable (NN p).

实现校样的实际翻译似乎不那么容易，但应该是可行的。我已经实现了更简单的方向（对经典的双重否定）：

回顾这一点，我认为您可能能够使用
类
es和
实例
s实现这一方向（隐式值的类型导向查找是另一个Coq过程，它不属于Coq逻辑），因为转换完全由一个自包含的术语完成，但我不确定另一个方向（这将是分析实际证明术语
fun（excl:excluded_middle）=>…
用于
excl
）可以这样做。以下是酒徒悖论的证明：

Theorem nn_excluded_middle X : ~~(X \/ ~X).
Proof. tauto. Defined.

Theorem drinker's (P : Set) (x : P) (D : P -> Prop)
                : excluded_middle -> exists y, D y -> forall z, D z.
Proof.
  assert double negative (exists y, D y -> forall z, D z) as prf.
  {
    intros no.
    apply (nn_excluded_middle (forall y, D y)).
    intros [everyone | someone].
    - apply no with x.
      intros prf_x y prf_y.
      apply prf_y, everyone.
    - apply (nn_excluded_middle (exists y, ~D y)).
      intros [[y sober] | drunk].
      + apply no with y.
        intros drunk.
        contradiction (drunk sober).
      + contradict someone.
        intros y.
        specialize (no y).
        contradict no.
        intros drunk_y z sober_z.
        apply drunk.
        exists z.
        exact sober_z.
  }
  nn_int_to_class (exists y, D y -> forall z, D z) prf.
  exact class_prf.
Defined.

我不认为你可以在内部进行翻译。你可以手工证明经典事实的双重否定。问题是双重否定对一阶逻辑不起作用。我认为除了对命题进行编码之外没有其他方法。也许可以使用metacoq编写插件为你做翻译。哦，这没那么简单！谢谢你的帮助。F首先，感谢你的精彩回答。我认为可能有一些棘手的方法，但正如你正确描述的，不可能在与Coq相同的级别上谈论Coq。但我正在寻找一种方法，可以更高一步，因为你可以介绍Ltac语言，这很好。我还认为你的意思是经典可证明的
直观证明
属于
句子->道具类型
，不重要，但这个答案很好，所以我的意思是编辑使其完美。
Definition excluded_middle : Prop := forall x, x \/ ~x.

Tactic Notation "assert" "double" "negative" constr(P) "as" ident(H) :=
  let P' := nn_transl P in
  assert (H : P').


Ltac int_to_nn_class_gen' nn_int_to_class_gen P :=
  let x := fresh "x" in
  let excl := fresh "excl" in
  lazymatch P with
  | ?L /\ ?R =>
    let xl := fresh x "_l" in
    let xr := fresh x "_r" in
    let rec_L := int_to_nn_class_gen' nn_int_to_class_gen L in
    let rec_R := int_to_nn_class_gen' nn_int_to_class_gen R in
    uconstr:(
      fun (x : P) (excl : excluded_middle) =>
      let (xl, xr) := x in
      conj (rec_L xl excl) (rec_R xr excl))
  | ?L \/ ?R =>
    let L' := nn_transl L in
    let R' := nn_transl R in
    let arg := fresh x "_arg" in
    let arg_l := fresh arg "_l" in
    let arg_r := fresh arg "_r" in
    let rec_L := int_to_nn_class_gen' nn_int_to_class_gen L in
    let rec_R := int_to_nn_class_gen' nn_int_to_class_gen R in
    uconstr:(
      fun (x : P) (excl : excluded_middle) (arg : ~L' /\ ~R') =>
      let (arg_l, arg_r) := arg in
      match x with
      | or_introl x => arg (rec_L x excl)
      | or_intror x => arg (rec_R x excl)
      end)
  | not ?Q =>
    let Q' := nn_transl Q in
    let arg := fresh x "_arg" in
    let rec_Q := nn_int_to_class_gen Q in
    uconstr:(
      fun (x : P) (excl : excluded_middle) (arg : Q') => x (rec_Q arg excl))
  | ?L -> ?R =>
    let L' := nn_transl L in
    let arg := fresh x "_arg" in
    let rec_L := nn_int_to_class_gen L in
    let rec_R := int_to_nn_class_gen' nn_int_to_class_gen R in
    uconstr:(
      fun (x : P) (excl : excluded_middle) (arg : L') =>
      rec_R (x (rec_L arg excl)) excl)
  | forall t: ?T, @?Q t =>
    constr:(
      fun (x : P) (excl : excluded_middle) (t : T) =>
      ltac:(
        let Qt := eval hnf in (Q t) in
        let rec_Qt := int_to_nn_class_gen' nn_int_to_class_gen Qt in
        exact (rec_Qt (x t) excl)))
  | exists t: ?T, @?Q t =>
    let arg := fresh x "_arg" in
    let wit := fresh x "_wit" in
    constr:(
      fun
        (x : P) (excl : excluded_middle)
        (arg :
          forall t: T,
          ltac:(
            let Qt := eval hnf in (Q t) in
            let Qt' := nn_transl Qt in
            exact (~Qt'))) =>
      match x with ex_intro _ t wit =>
        ltac:(
          let Qt := eval hnf in (Q t) in
          let rec_Qt := int_to_nn_class_gen' nn_int_to_class_gen Qt in
          exact (arg t (rec_Qt wit excl)))
      end)
  | _ =>
    let arg := fresh x "_arg" in
    uconstr:(fun (x : P) (excl : excluded_middle) (arg : ~P) => arg x)
  end.

Ltac nn_int_to_class_gen' int_to_nn_class_gen P :=
  let NNP := nn_transl P in
  let nnx := fresh "nnx" in
  let excl := fresh "excl" in
  lazymatch P with
  | ?L /\ ?R =>
    let nnl := fresh nnx "_l" in
    let nnr := fresh nnx "_r" in
    let rec_L := nn_int_to_class_gen' int_to_nn_class_gen L in
    let rec_R := nn_int_to_class_gen' int_to_nn_class_gen R in
    uconstr:(
      fun (nnx : NNP) (excl : excluded_middle) =>
      let (nnl, nnr) := nnx in
      conj (rec_L nnl excl) (rec_R nnr excl))
  | ?L \/ ?R =>
    let L' := nn_transl L in
    let R' := nn_transl R in
    let prf := fresh nnx "_prf" in
    let arg := fresh nnx "_arg" in
    let arg_l := fresh arg "_l" in
    let arg_r := fresh arg "_r" in
    let rec_L := nn_int_to_class_gen' int_to_nn_class_gen L in
    let rec_R := nn_int_to_class_gen' int_to_nn_class_gen R in
    uconstr:(
      fun (nnx : NNP) (excl : excluded_middle) =>
      match excl P with
      | or_introl prf => prf
      | or_intror prf =>
        nnx (conj
          (fun arg : L' => prf (or_introl (rec_L arg)))
          (fun arg : R' => prf (or_intror (rec_R arg))))
      end)
  | not ?Q =>
    let arg := fresh nnx "_arg" in
    let rec_Q := int_to_nn_class_gen Q in
    uconstr:(
      fun (nnx : NNP) (excl : excluded_middle) (arg : Q) =>
      nnx (rec_Q arg excl))
  | ?L -> ?R =>
    let arg := fresh nnx "_arg" in
    let rec_L := int_to_nn_class_gen L in
    let rec_R := nn_int_to_class_gen' int_to_nn_class_gen R in
    uconstr:(
      fun (nnx : NNP) (excl : excluded_middle) (arg : L) =>
      rec_R (nnx (rec_L arg excl)) excl)
  | forall t: ?T, @?Q t =>
    constr:(
      fun (nnx : NNP) (excl : excluded_middle) (t : T) =>
      ltac:(
        let Qt := eval hnf in (Q t) in
        let rec_Qt := nn_int_to_class_gen' int_to_nn_class_gen Qt in
        exact (rec_Qt (nnx t) excl)))
  | exists t: ?T, @?Q t =>
    let prf := fresh nnx "_prf" in
    let wit := fresh nnx "_wit" in
    constr:(
      fun (nnx : NNP) (excl : excluded_middle) =>
      match excl P with
      | or_introl prf => prf
      | or_intror prf =>
        False_ind P
        ( nnx
          ( fun
              (t : T)
              (wit :
                ltac:(
                  let Qt := eval hnf in (Q t) in
                  let Q' := nn_transl Qt in
                  exact Q')) =>
            ltac:(
              let Qt := eval hnf in (Q t) in
              let rec_Qt := nn_int_to_class_gen' int_to_nn_class_gen Qt in
              exact (prf (ex_intro _ t (rec_Qt wit excl))))))
      end)
  | _ =>
    let prf := fresh nnx "_prf" in
    uconstr:(
      fun (nnx : NNP) (excl : excluded_middle) =>
      match excl P with
      | or_introl prf => prf
      | or_intror prf => False_ind P (nnx prf)
      end)
  end.

Ltac int_to_nn_class_gen :=
  let rec
    int_to_nn_class_gen :=
      fun P => int_to_nn_class_gen' nn_int_to_class_gen P
  with
    nn_int_to_class_gen :=
      fun P => nn_int_to_class_gen' int_to_nn_class_gen P
  in
  int_to_nn_class_gen.
Ltac nn_int_to_class_gen :=
  let rec
    int_to_nn_class_gen :=
      fun P => int_to_nn_class_gen' nn_int_to_class_gen P
  with
    nn_int_to_class_gen :=
      fun P => nn_int_to_class_gen' int_to_nn_class_gen P
  in
  nn_int_to_class_gen.

Tactic Notation "nn_int_to_class" constr(P) hyp(H) :=
  let new := fresh "class_" H in
  let transl := nn_int_to_class_gen P in
  refine (let new : excluded_middle -> P := transl H in _).

Theorem nn_excluded_middle X : ~~(X \/ ~X).
Proof. tauto. Defined.

Theorem drinker's (P : Set) (x : P) (D : P -> Prop)
                : excluded_middle -> exists y, D y -> forall z, D z.
Proof.
  assert double negative (exists y, D y -> forall z, D z) as prf.
  {
    intros no.
    apply (nn_excluded_middle (forall y, D y)).
    intros [everyone | someone].
    - apply no with x.
      intros prf_x y prf_y.
      apply prf_y, everyone.
    - apply (nn_excluded_middle (exists y, ~D y)).
      intros [[y sober] | drunk].
      + apply no with y.
        intros drunk.
        contradiction (drunk sober).
      + contradict someone.
        intros y.
        specialize (no y).
        contradict no.
        intros drunk_y z sober_z.
        apply drunk.
        exists z.
        exact sober_z.
  }
  nn_int_to_class (exists y, D y -> forall z, D z) prf.
  exact class_prf.
Defined.