coq中归纳数据类型的广义折叠

Question

我发现自己一遍又一遍地重复一种模式，我想抽象它。我相当有信心coq足以表达捕捉模式，但我在弄清楚如何这样做时遇到了一些麻烦。我正在定义一种编程语言，它具有代表句法术语的相互递归的归纳数据类型：

Inductive Expr : Set :=
  | eLambda  (x:TermVar) (e:Expr)
  | eVar     (x:TermVar)
  | eAscribe (e:Expr)  (t:IFType)
  | ePlus    (e1:Expr) (e2:Expr)

  | ... many other forms ...

with DType : Set :=
  | tArrow (x:TermVar) (t:DType) (c:Constraint) (t':DType)
  | tInt

  | ... many other forms ...

with Constraint : Set :=
  | cEq (e1:Expr) (e2:Expr)
  | ...

现在，我需要在这些类型上定义许多功能。例如，我想要一个函数来查找所有的自由变量，一个执行替换的函数，以及一个拉出所有约束集的函数。这些功能都具有以下形式：

Fixpoint doExpr (e:Expr) := match e with
  (* one or two Interesting cases *)
  | ...

  (* lots and lots of boring cases,
  ** all of which just recurse on the subterms
  ** and then combine the results in the same way
  *)
  | ....

with doIFType (t:IFType) := match t with
  (* same structure as above *)

with doConstraint (c:Constraint) := match c with
  (* ditto *)

例如，为了找到自由变量，我需要在变量情况和绑定的情况下做一些有趣的事情，但对于其他所有事情我只是递归地找到子表达式的所有自由变量然后将这些列表联合在一起。类似地，对于生成所有约束的列表的函数。替换情况有点棘手，因为三个函数的结果类型不同，用于组合子表达式的构造函数也不同：

Variable x:TermVar, v:Expr.
Fixpoint substInExpr (e:Expr) : **Expr** := match e with
  (* interesting cases *)
  | eLambda y e' =>
      if x = y then eLambda y e' else eLambda y (substInExpr e')
  | eVar y =>
      if x = y then v else y

  (* boring cases *)
  | eAscribe e' t  => **eAscribe** (substInExpr e') (substInType t)
  | ePlus    e1 e2 => **ePlus**    (substInExpr e1) (substInExpr e2)
  | ...

with substInType       (t:Type)       : **Type** := match t with ...
with substInConstraint (c:Constraint) : **Constraint** := ...
.

编写这些函数很繁琐且容易出错，因为我必须为每个函数写出所有不感兴趣的情况，并且我需要确保我在所有子函数上进行递归。我想写的内容如下：

Fixpoint freeVars X:syntax := match X with
  | syntaxExpr eVar    x         => [x]
  | syntaxExpr eLambda x e       => remove x  (freeVars e)
  | syntaxType tArrow  x t1 c t2 => remove x  (freeVars t1)++(freeVars c)++(freeVars t2)
  | _          _       args      => fold (++) (map freeVars args)
end.

Variable x:TermVar, v:Expr.
Fixpoint subst X:syntax := match X with
  | syntaxExpr eVar y      => if y = x then v else eVar y
  | syntaxExpr eLambda y e => eLambda y (if y = x then e else (subst e))
  | syntaxType tArrow ...

  | _ cons args => cons (map subst args)
end.

这个想法的关键是能够通常将构造函数应用于某些参数，并具有某种“映射”，以保留参数的类型和数量。

显然，这个伪代码不起作用，因为_ case不正确。所以我的问题是，是否有可能编写以这种方式组织的代码，或者我注定只是手动列出所有无聊的案例？

Answer 1

这是一种方法，但它没有提供非常易读的代码：使用策略。

假设我有一种语言，其中包含许多各种arity的构造函数，我想仅将特定目标应用于构造函数aaa给出的情况，并且我想遍历所有其他构造函数，以便进入aaa的那个可能会出现在他们之下我可以做到以下几点：

假设你要定义一个函数A - ＆gt; B（A是语言的类型），你需要跟踪你所处的情况， 所以你应该在A上定义一个幻像类型，减少到B。

Definition phant (x : A) : Type := B.

我认为联合函数的类型为B - ＆gt; B - ＆gt; B并且您在B中有一个默认值，名为empty_B

Ltac generic_process f acc :=
  match goal with
    |- context [phan (aaa _)] => (* assume aaa has arith 1 *)
       intros val_of_aaa_component; exact process_this_value val_of_aaa_component
  | |- _ =>
  (* This should be used when the next argument of the current
     constructor is in type A, you want to process recursively
     down this argument, using the function f, and keep this result
     in the accumulator. *)
     let v := fresh "val_in_A" in
     intros v; generic_process f (union acc (f v))
     (* This clause will fail if val_in_A is not in type A *)
  | |- _ => let v := fresh "val_not_in_A" in
    (* This should be used when the next argument of the current
       constructor is not in type A, you want to ignore it *)
       intros v; generic_process f acc
  | |- phant _ =>
    (* this rule should be used at the end, when all
       the arguments of the constructor have been used. *)
    exact acc
  end.

现在，您可以通过证明来定义函数。假设该函数名为process_aaa。

Definition process_aaa (x : A) : phant x.
fix process_aaa 1.
  (* This adds process_add : forall x:A, phant x. in the context. *)
intros x; case x; generic_process process_aaa empty_B.
Defined.

请注意，generic_process的定义仅按名称提及一个构造函数，aaa，所有其他构造函数 有系统地对待。我们使用类型信息来检测我们想要执行递归下降的子组件。如果你有几个相互归纳的类型，你可以在generic_process函数中添加参数，以指示每个类型将使用哪个函数，并且有更多的子句，每个类型的每个参数都有一个。

这是对这个想法的测试，其中语言有4个构造函数，要处理的值是构造函数var中出现的值，而nat类型也用于另一个构造函数（{{1} }）。我们使用自然数列表的类型作为类型c2，当遇到变量时，B作为空和单例列表作为结果。该函数收集所有出现的nil。

var

最后一次计算返回一个包含0 4 2和3值的列表，但不是1，这在Require Import List. Inductive expr : Type := var : nat -> expr | c1 : expr -> expr -> expr -> expr | c2 : expr -> nat -> expr | c3 : expr -> expr -> expr | c4 : expr -> expr -> expr . Definition phant (x : expr) : Type := list nat. Definition union := (@List.app nat). Ltac generic_process f acc := match goal with |- context[phant (var _)] => exact (fun y => y::nil) | |- _ => let v := fresh "val_in_expr" in intros v; generic_process f (union acc (f v)) | |- _ => let v := fresh "val_not_in_expr" in intros v; generic_process f acc | |- phant _ => exact acc end. Definition collect_vars : forall x : expr, phant x. fix collect_vars 1. intros x; case x; generic_process collect_vars (@nil nat). Defined. Compute collect_vars (c1 (var 0) (c2 (var 4) 1) (c3 (var 2) (var 3))). 构造函数中没有出现。

Answer 2

这是另一种方式，虽然不是每个人都喝茶。

这个想法是将递归移出类型和赋值器，改为对其进行参数化，并将表达式值转换为折叠。这在某些方面提供了便利，但在其他方面提供了更多的努力 - 这真的是一个问题，即你最终花费的时间最多。好的方面是评估器易于编写，您不必处理相互递归的定义。然而，有些事情在另一方面变得更简单，可能会成为这种风格的大脑扭曲。

Require Import Ssreflect.ssreflect.
Require Import Ssreflect.ssrbool.
Require Import Ssreflect.eqtype.
Require Import Ssreflect.seq.
Require Import Ssreflect.ssrnat.

Inductive ExprF (d : (Type -> Type) -> Type -> Type)
                (c : Type -> Type) (e : Type) : Type :=
  | eLambda  (x:nat) (e':e)
  | eVar     (x:nat)
  | eAscribe (e':e)  (t:d c e)
  | ePlus    (e1:e) (e2:e).

Inductive DTypeF (c : Type -> Type) (e : Type) : Type :=
  | tArrow (x:nat) (t:e) (c':c e) (t':e)
  | tInt.

Inductive ConstraintF (e : Type) : Type :=
  | cEq (e1:e) (e2:e).

Definition Mu (f : Type -> Type) := forall a, (f a -> a) -> a.

Definition Constraint := Mu ConstraintF.
Definition DType      := Mu (DTypeF ConstraintF).
Definition Expr       := Mu (ExprF DTypeF ConstraintF).

Definition substInExpr (x:nat) (v:Expr) (e':Expr) : Expr := fun a phi =>
  e' a (fun e => match e return a with
    (* interesting cases *)
    | eLambda y e' =>
        if (x == y) then e' else phi e
    | eVar y =>
        if (x == y) then v _ phi else phi e

    (* boring cases *)
    | _ => phi e
    end).

Definition varNum (x:ExprF DTypeF ConstraintF nat) : nat :=
  match x with
  | eLambda _ e => e
  | eVar y => y
  | _ => 0
  end.

Compute (substInExpr 2 (fun a psi => psi (eVar _ _ _ 3))
                     (fun _ phi =>
                        phi (eLambda _ _ _ 1 (phi (eVar _ _ _ 2)))))
        nat varNum.

Compute (substInExpr 1 (fun a psi => psi (eVar _ _ _ 3))
                     (fun _ phi =>
                        phi (eLambda _ _ _ 1 (phi (eVar _ _ _ 2)))))
        nat varNum.