遍历Haskell AST模板

我已经了解到，

模板Haskell

中的Haskell代码并不是表示为单个AST，而是表示为四种交叉引用类型的

Pat

、

Exp

、

Dec

和

Type

。我还没有在图书馆内或其他任何地方发现任何穿越设施

我最初是在寻找上述四种类型的统一表示：

-- The single representation for Haskell code
data HCode = HE Exp | HD Dec | HP Pat | HT Type

-- And common functions in tree traversal such as:
children :: HCode -> [HCode]
children (HE (VarE _)) = []
children (HE (AppTypeE e t)) = [HE e, HT t] 
children c = ...

-- Ultimately a transform function similar to:
-- (Not really arguing about this exact model of tree transformation)
preorder :: (HCode -> HCode) -> HCode -> HCode
preorder f h = 
  let h' = f h
   in rebuildWithChildren h' . fmap (preorder f) . children $ h'
     

---

现在我越来越相信这样写，除了费时，也是浪费，因为遍历/转换AST是常见的做法，我想最好问问从业者中有什么可用的解决方案。

一般来说，我不确定通用的TH遍历是否会经常出现。（我正在努力想象一个有用的转换，在这种情况下，你不会仅仅生成已经转换过的TH。）我猜在某些情况下，你想执行用户提供的准字节的查询或转换，而不解析整个AST

无论如何，如果你能找到它的用途，你可以使用SYB泛型。例如，这里有一个查询，用于从任意TH“thing”的模式和表达式中提取文本：

{-#语言模板haskell}
导入数据。泛型
导入语言.Haskell.TH
getLiterals:：数据d=>d->[Lit]
getLiterals=everything（++）（mkQ[]litE`extQ`litP）
其中litE（litE l）=[l]
litE=[]
litP（litP l）=[l]
litP[uU9=[]
main=do mydec关于您的问题，即在已经有效的TH AST上执行转换的动机，我可以想到引用的DSL，它将宿主语言中的一元理解转换为SQL查询，例如我们已经使用Microsoft LINQ。这不合理吗？
{-# LANGUAGE TemplateHaskell #-}

import Data.Generics
import Language.Haskell.TH

getLiterals :: Data d => d -> [Lit]
getLiterals = everything (++) (mkQ [] litE `extQ` litP)
  where litE (LitE l) = [l]
        litE _ = []
        litP (LitP l) = [l]
        litP _ = []

main = do mydec <- runQ [d| foo 4 = "hello" |]
          print mydec
          print $ getLiterals mydec
          myexp <- runQ [| '1' + "sixteen" |]
          print myexp
          print $ getLiterals myexp

{-# LANGUAGE TemplateHaskell #-}

import Data.Generics
import Language.Haskell.TH

causeChaos :: Data d => d -> d
causeChaos = everywhere (mkT destroyExpressions `extT` manglePatterns `extT` bludgeonTypes)
  where destroyExpressions (InfixE l x r) = InfixE r x l
        destroyExpressions (UInfixE l x r) = UInfixE r x l
        destroyExpressions e = e
        manglePatterns (InfixP l x r) = InfixP r x l
        manglePatterns (UInfixP l x r) = UInfixP r x l
        manglePatterns e = e
        bludgeonTypes (InfixT l x r) = InfixT r x l
        bludgeonTypes (UInfixT l x r) = UInfixT r x l
        bludgeonTypes e = e

main = do mydec <- runQ [d| append :: [a] -> [a] -> [a]
                            append (x:xs) ys = x : append xs ys
                            append [] ys = ys
                         |]
          print mydec
          print $ causeChaos mydec