Coq提取到Haskell

时间:2019-04-28 19:47:47

标签: haskell coq

我具有整数除法的余数以下Coq实现。 当我将其提取到Haskell时,一切正常。我将Coq版本与生成的Haskell版本进行了比较,并试图了解发生了什么。似乎rewrite 仅在此处被删除, 实际引导提取的是inductiondestructexistsspecialize。在提取过程中是否使用了rewrite?另外,某些变量名称会保留(例如q0m0''),而其他变量会更改(r0h),是否有任何理由要更改名称?这是Coq代码,后跟提取的代码:

(***********)
(* IMPORTS *)
(***********)
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Structures.OrdersFacts.

Lemma Sn_eq_Sm: forall n m,
  (n = m) -> ((S n) = (S m)).
Proof.
  intros n m H.
  rewrite H.
  reflexivity.
Qed.

Lemma Sn_lt_Sm: forall n m,
  (n < m) -> ((S n) < (S m)).
Proof.
  intros n0 m0 H.
  unfold lt in H.
  apply Nat.lt_succ_r.
  apply H.
Qed.

Lemma add_nSm : forall (n m : nat),
  (n + (S m)) = S (n + m).
Proof.
  intros n m.
  induction n.
  - reflexivity.
  - simpl.
    apply Sn_eq_Sm.
    apply IHn.
Qed.

Lemma n_lt_m: forall n m,
  ((n <? m) = false) -> (m <= n).
Proof.
Admitted.

Lemma n_le_m_le_n: forall n m,
  (n <= m) -> ((m <= n) -> (m = n)).
Proof.
Admitted.

Lemma Sn_ge_0: forall n,
  0 <= (S n).
Proof.
  induction n as [|n' IHn'].
  - apply le_S. apply le_n.
  - apply le_S. apply IHn'.
Qed.

Lemma n_ge_0: forall n,
  0 <= n.
Proof.
  induction n as [|n' IHn'].
  - apply le_n.
  - apply le_S. apply IHn'.
Qed.

Lemma Sn_gt_0: forall n,
  0 < (S n).
Proof.
  induction n as [|n' IHn'].
  - apply le_n.
  - apply le_S. apply IHn'.
Qed.

Lemma n_le_m_implies_Sn_le_Sm: forall n m,
  (n <= m) -> ((S n) <= (S m)).
Proof.
  induction n as [|n' IHn'].
  - induction m as [|m' IHm'].
    + intros H1. apply le_n.
    + intros H1. apply le_S.
      apply IHm'. apply n_ge_0.
  - induction m as [|m' IHm'].
    + intros H1. inversion H1. 
    + intros H1. inversion H1. 
      apply le_n. apply IHm' in H0 as H2.
      apply le_S in H2. apply H2.
Qed.

(****************************************)
(* division with quotient and remainder *)
(****************************************)
Definition div_q_r: forall n m : nat,
   {     q:nat & {     r:nat | (n = q * (S m) + r) /\ (r < (S m))}}.
Proof.
  induction n as [|n' IHn'].
  - exists 0. exists 0. split. reflexivity. apply Sn_gt_0.
  - intros m0.
    destruct m0 as [|m0''] eqn:E1.
    + exists (S n'). exists 0. split.
      * rewrite Nat.add_0_r with (n:=(S n') * 1).
        rewrite Nat.mul_1_r with (n:=(S n')). reflexivity.
      * specialize Sn_gt_0 with (n:=0). intros H. apply H.
    + specialize IHn' with (m:=(S m0'')).
      destruct IHn' as [q0 H]. destruct H as [r0 H].
      destruct (r0 <? (S m0'')) eqn:E2.
      * exists q0. exists (S r0). split.
        -- rewrite add_nSm with (n:=q0 * S (S m0'')). 
           apply Sn_eq_Sm. apply proj1 in H as H1. apply H1.
        -- apply Nat.ltb_lt in E2. apply Sn_lt_Sm. apply E2.
      * exists (S q0). exists 0. split.
        -- apply proj2 in H as H2. rewrite Nat.lt_succ_r in H2.
           apply n_lt_m in E2. apply n_le_m_le_n in H2.
           apply proj1 in H as H1. rewrite H2 in H1. rewrite H1.
           rewrite <- add_nSm with (n:=q0 * S (S m0'')) (m:=S m0'').
           rewrite Nat.add_0_r.
           rewrite Nat.mul_succ_l with (n:=q0) (m:=S (S m0'')).
           reflexivity. apply E2.
        -- unfold "<". apply n_le_m_implies_Sn_le_Sm. apply Sn_ge_0.
Qed.

(********************************)
(* Extraction Language: Haskell *)
(********************************)
Extraction Language Haskell.

(***************************)
(* Use Haskell basic types *)
(***************************)
Require Import ExtrHaskellBasic.

(****************************************)
(* Use Haskell support for Nat handling *)
(****************************************)
Require Import ExtrHaskellNatNum.
Extract Inductive Datatypes.nat => "Prelude.Integer" ["0" "Prelude.succ"]
"(\fO fS n -> if n Prelude.== 0 then fO () else fS (n Prelude.- 1))".

(***************************)
(* Extract to Haskell file *)
(***************************)
Extraction "/home/oren/GIT/some_file_Haskell.hs" div_q_r.

这是提取的Haskell代码:

div_q_r :: Prelude.Integer -> Prelude.Integer -> SigT Prelude.Integer
           Prelude.Integer
div_q_r n =
  nat_rec (\_ -> ExistT 0 0) (\n' iHn' m0 ->
    (\fO fS n -> if n Prelude.== 0 then fO () else fS (n Prelude.- 1))
      (\_ -> ExistT (Prelude.succ n')
      0)
      (\m0'' ->
      let {iHn'0 = iHn' (Prelude.succ m0'')} in
      case iHn'0 of {
       ExistT q0 h ->
        let {b = ltb h (Prelude.succ m0'')} in
        case b of {
         Prelude.True -> ExistT q0 (Prelude.succ h);
         Prelude.False -> ExistT (Prelude.succ q0) 0}})
      m0) n

1 个答案:

答案 0 :(得分:1)

每次使用rewrite时,目标实际上是一个自己的类型为Prop的类型(公式)。因此,rewrite策略的效果将被丢弃,因为该术语发生的部分已被丢弃。

提取工具不考虑策略:它将从要执行的术语中删除类型为Prop的表达式。整个系统的设计方式使得这些表达式不会影响计算。

从某种意义上说,它是编译时验证和运行时验证之间的区别。您在Coq中所做的所有证明都是编译时验证,在运行时不需要重做,因此它们已从代码中删除。 Prop排序用于标记仅在编译时发生的计算,而不会在运行时对执行产生影响。

您可以通过查看Print div_q_r.的结果来以某种方式预测Haskell提取程序的内容

结果包含existTexist的实例。 existT的类型是:

forall (A : Type) (P : A -> Type) (x : A), P x -> {x : A & P x}

符号{x : A & P x}代表@sigT A P。反过来,sigT的类型是

forall A : Type, (A -> Type) -> Type

existT P xx pp的类型为@sigT A P,后者的类型为Type。因此,提取工具确定该术语包含在运行时很重要的数据。而且,sigT A P的第二个组件的类型为P xx,其本身的类型为Type,因此这在运行时也很重要:不会被丢弃。

现在,我们将注意力转移到exist _ _形式的表达式上。这样的表达式的类型为@sig A P,而sig的类型为:

forall A: Type, (A -> Prop) -> Type

因此,表达式exist Q y qq包含类型为y的{​​{1}}和类型为Type且类型为qq的{​​{1}}。有关如何计算Q y的信息将在运行时保留,但有关如何计算Prop的信息将被丢弃。

如果您想知道y在证明中的作用,则只需要在qq的结果中查找rewriteeq_ind的实例,将会看到这些实例是eq_ind_r语句的第三个参数的子项。这就是为什么它们没有出现在最终结果中的原因。这不是因为提取对重写有特殊的对待,而是因为它对类型Print div_q_r.的类型具有特殊的行为(我们也将其称为 sort exist

可以构造Prop在提取结果中留下痕迹的函数,但是我不确定这些函数在Haskell中的行为是否正确。

Prop