如何折叠具有特殊情况的构造函数？

Question

所以我有一棵树，我想在节点类型为

的地方折叠

data Node = Node1 Node | Node2 Node Node | ... deriving Data

少数特殊情况除外。我想按照

的方式做一些事情

collapse SPECIALCASE1 = ...
collapse SPECIALCASE2 = ...
...
collapse node = foldl (++) $ gmapQ validate node

其中所有特殊情况都会生成结果列表，而最后一个情况只是递归折叠；但这不起作用，因为作为 gmapQ 的第一个参数的函数必须是 forall d. Data d => d -> u 而不是 Node -> u 类型，据我所知这只是限制你只能使用在Data类型。

是否有任何方法可以将问题中的值强制为正确的类型，或者可能是另一个更宽松的映射函数？

额外信息：

上面描述为 collapse 的函数的实际代码被命名为 validate 并且用于在抽象语法树（对于一种非常简单的语言）中遍历和查找未绑定变量，其中特殊案件是这样处理的

validate _ (Nr _) = []
validate env (Let var val expr) = validate env val ++ validate (var:env) expr
validate env (Var var) = if elem var env then [] else [var]

这本质上是字面量不带变量的规则，让表达式绑定一个变量，需要检查变量是否绑定。这种玩具语言中的每个其他结构都只是数字和变量（例如求和、乘法等）的组合，因此当我检查未绑定变量时，我只需要遍历它们的子树并组合结果；因此 gmapQ.

附加信息 2：

代替上面的 Node 示例实际使用的数据类型是

data Ast = Nr Int
         | Sum Ast Ast
         | Mul Ast Ast
         | Min Ast
         | If Ast Ast Ast
         | Let String Ast Ast
         | Var String
           deriving (Show, Eq, Data)

Answer 1

做你想做的事情的直接方法是将 validate 的特例写为：

validate env expr = concat $ gmapQ ([] `mkQ` (validate env)) expr

这使用了 Data.Generics.Aliases 中的 mkQ。 mkQ 的全部要点是创建可以在不同的 Data 实例上以不同方式操作的类型 forall d. Data d => d -> u 的查询。顺便说一句，这里没有魔法。您可以根据 cast 手动将其定义为：

validate env expr = concat $ gmapQ myQuery expr
  where myQuery :: Data d => d -> [String]
        myQuery d = case cast d of Just d -> validate env d
                                   _ -> []

不过，我通常发现使用 lens 库中的 uniplate 更清晰。这个想法是创建一个默认的 Plated 实例：

instance Plated Ast where
  plate = uniplate   -- uniplate from Data.Data.Lens

神奇地定义了 children :: Ast -> [Ast] 到 return 节点的所有直接后代。然后，您可以将默认的 validate 情况写为：

validate env expr = concatMap (validate env) (children expr)

带有打印 ["z"]:

测试的完整代码

{-# LANGUAGE DeriveDataTypeable #-}

module SpecialCase where

import Control.Lens.Plated
import Data.Data
import Data.Data.Lens (uniplate)

data Ast = Nr Int
         | Sum Ast Ast
         | Mul Ast Ast
         | Min Ast
         | If Ast Ast Ast
         | Let String Ast Ast
         | Var String
           deriving (Show, Eq, Data)

instance Plated Ast where
  plate = uniplate

validate env (Let var val expr) = validate env val ++ validate (var:env) expr
validate env (Var var) = if elem var env then [] else [var]
-- either use this uniplate version:
validate env expr = concatMap (validate env) (children expr)
-- or use the alternative, lens-free version:
-- validate env expr = concat $ gmapQ ([] `mkQ` (validate env)) expr

main = print $ validate [] (Let "x" (Nr 3) (Let "y" (Var "x") 
             (Sum (Mul (Var "x") (Var "z")) (Var "y"))))

Answer 2

很抱歉，我太慢了，没能在 K. A. Buhr 赶上之前写下基于 Data 的答案。这是另一种方法，基于 recursion-schemes.

首先，样板文件：

{-# LANGUAGE TemplateHaskell, TypeFamilies
           , DeriveTraversable #-}

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data Ast = Nr Int
         | Sum Ast Ast
         | Mul Ast Ast
         | Min Ast
         | If Ast Ast Ast
         | Let String Ast Ast
         | Var String
         deriving (Show, Eq)

makeBaseFunctor ''Ast

这将创建一个类型 AstF，它从 Ast 中取出递归。看起来像这样：

data AstF ast = NrF Int
              | SumF ast ast
              | MulF ast ast
              ....
              deriving (Functor,Foldable,Traversable)

然后它还会创建几个实例。我们将使用两个 auto-generated 实例：Ast 的 Recursive 实例递归验证树，AstF 的 Foldable 实例连接默认情况下 children 的结果。

我发现为环境创建一个单独的类型很有帮助；这是完全可选的。

newtype Env = Env {getEnv :: [String]}

emptyEnv :: Env
emptyEnv = Env []

extendEnv :: String -> Env -> Env
extendEnv a (Env as) = Env (a : as)

isFree :: String -> Env -> Bool
isFree a (Env as) = not (elem a as)

现在我们可以进入正题了，使用 Ast 的 Recursive 实例免费获得 cata。

validate :: Env -> Ast -> [String]
validate env0 ast0 = cata go ast0 env0
  where
    go :: AstF (Env -> [String]) -> Env -> [String]
    go (LetF var val expr) env = val env ++ expr (extendEnv var env)
    go (VarF var) env = [var | isFree var env]
    go expr env = foldMap id expr env

如何折叠具有特殊情况的构造函数？

How to fold over a constructor with special cases?

haskell

generics

scrap-your-boilerplate