遍历模板 Haskell AST

Traversing a Template Haskell AST

我发现 template-haskell 中的 Haskell 代码不是表示为单个 AST,而是 PatExpDecType。我还发现图书馆内或其他任何地方都没有遍历设施。

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

-- 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'
     

现在我逐渐相信以这种方式编写,除了耗时之外,也是一种浪费,因为 traversing/transforming AST 是常见的做法,我认为最好问问有什么可用的解决方案学员中有

一般来说,我不确定 TH 的一般遍历是否会经常出现。 (我正在努力想象在您不只是生成已经以这种方式转换的 TH 的情况下对 TH AST 进行有用的转换。)我想在某些情况下您想要执行用户提供的查询或转换不解析整个 AST 的准引号?

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

{-# 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

这是一个转换模式、表达式和类型中所有中缀运算符的转换(InfixT 的示例未显示):

{-# 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