如何摺疊特殊情況下的構造函數？

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.AliasesmkQ。 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 
            _ -> [] 

不過，我一般發現它更清晰的使用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")))) 

Answer 2

對不起，我太遲鈍獲得在KA 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) 

然後它也創建了幾個實例。我們將使用兩個自動生成的實例：RecursiveAst的實例遞歸驗證該樹，並使用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) 

現在我們言歸正傳，使用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