0

所以我有一棵树，我想在节点类型的地方折叠

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类型进行操作的函数。

有没有办法强制问题中的值是正确的类型，或者可能是另一个更宽松的 map 函数？

额外信息：

上述函数的实际代码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)
4

2 回答 2

4

做你想做的事情的直接方法是将你的特殊情况validate写成：

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

这使用mkQ来自Data.Generics.Aliases. 的重点mkQ是创建forall d. Data d => d -> u可以在不同Data实例上以不同方式操作的类型的查询。顺便说一句，这里没有魔法。您可以按照以下方式手动定义它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
                                   _ -> []

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

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

它神奇地定义children :: Ast -> [Ast]了返回节点的所有直接后代。然后，您可以将默认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"))))
于 2017-10-05T20:43:30.457 回答
1

Data很抱歉，在 KA Buhr 跳上之前，我写的基于答案的速度太慢了。这是另一种方法，基于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)

然后它还会创建几个实例。我们将使用两个自动生成的实例：Recursive递归Ast验证树的实例，以及Foldable在AstF默认情况下连接子级结果的实例。

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

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)

现在我们可以开始做正事了，使用免费获取的Recursive实例。Astcata

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
于 2017-10-05T22:11:18.697 回答