如何减少Trees That Grow实现Haskell可扩展AST的样板代码？

背景 #

我正在用Haskell定义一门编程语言，需要实现可扩展的抽象语法树（AST）：AST的使用者（格式化工具、解释器、编译器、类型系统、语言服务器等）既能给现有节点添加额外字段，也能扩展新的语法节点类型。

我尝试用**Trees That Grow（TTG）**实现，但它产生了大量难以维护的样板代码：原本10行的简单AST模块，扩展后变成了100多行；如果语言包含几十个类型、上百个构造器，加上多个扩展，代码量会爆炸到上万行，修改一处细节要改动多处，维护成本极高。

原始不可扩展AST #

module AST ( KeyValue(..), Data(..) ) where

data KeyValue = KV String Data deriving (Show, Eq, Ord)

data Data =
    Null |
    Int Int |
    Num Double |
    Bool Bool |
    String String |
    Array [Data] |
    Object [KeyValue] deriving (Show, Eq, Ord)

TTG版可扩展AST（样板代码示例） #

TTG改造后的数据类型、type family、约束定义：

data KeyValueX x =
    KVX (XKV x) String (DataX x) |
    KeyValueX (XKeyValue x)
 
data DataX x =
    NullX (XNull x) |
    IntX (XInt x) Int |
    NumX (XNum x) Double |
    BoolX (XBool x) Bool |
    StringX (XString x) String |
    ArrayX (XArray x) [DataX x] |
    ObjectX (XObject x) [KeyValueX x] |
    DataX (XData x)

-- 每个构造器对应一个type family
type family XKV x
type family XKeyValue x
type family XNull x
type family XInt x
type family XNum x
type family XBool x
type family XString x
type family XArray x
type family XObject x
type family XData x

-- 手动维护的约束集合
type ForallX (c :: Type -> Constraint) x = (
    c (XKV x), c (XKeyValue x),
    c (XNull x), c (XInt x), c (XNum x), c (XBool x),
    c (XString x), c (XArray x), c (XObject x), c (XData x)
    )

-- 推导类实例
deriving instance ForallX Show x => Show (KeyValueX x)
deriving instance ForallX Show x => Show (DataX x)
deriving instance ForallX Eq x => Eq (KeyValueX x)
deriving instance ForallX Eq x => Eq (DataX x)
deriving instance ForallX Ord x => Ord (KeyValueX x)
deriving instance ForallX Ord x => Ord (DataX x)

TTG扩展示例（UD标识扩展） #

即使是最基础的无装饰扩展，也要手动写大量实例和模式别名：

data UD  -- 无装饰标识扩展
 
type instance XKV UD = ()
type instance XKeyValue UD = Void
 
type instance XData UD = Void
type instance XNull UD = ()
type instance XInt UD = ()
type instance XNum UD = ()
type instance XBool UD = ()
type instance XString UD = ()
type instance XArray UD = ()
type instance XObject UD = ()

-- 为了兼容原始用法，定义类型别名和模式
type KeyValue = KeyValueX UD
pattern KV :: String -> Data -> KeyValue
pattern KV x y <- KVX _ x y where KV x y = KVX () x y
 
type Data = DataX UD
pattern Null :: Data
pattern Null <- NullX _ where Null = NullX ()
pattern DInt :: Int -> Data
pattern DInt x <- IntX _ x where DInt x = IntX () x
-- ... 其余构造器的模式定义省略

优化TTG：减少样板代码的方法 #

1. 用模板Haskell（Template Haskell）自动生成代码 #

手写样板的本质是重复的机械劳动，可以用TH脚本从原始AST定义自动生成所有TTG相关代码：

• 遍历原始数据类型的构造器，自动生成对应的X... type family
• 自动构建ForallX约束集合，不用手动罗列每个type family
• 自动生成UD扩展的type instance和所有模式别名
• 自动推导Show/Eq/Ord等类实例

只需要维护原始的简洁AST定义，TH会帮你生成所有TTG所需的样板，修改AST时只需改动原始定义，TH自动更新所有相关代码。

2. 用泛型库简化约束推导 #

替换手动维护的ForallX约束，用generic-lens或generic-data这类泛型库，通过泛型自动遍历所有扩展字段并施加约束。比如利用Generic实例自动推导所有X...类型的Show/Eq约束，避免手动编写冗长的约束集合。

3. 合并冗余的type family #

如果多个构造器的扩展字段逻辑相似，可以用带类型标签的通用type family替代每个构造器单独的type family：

type family XExt x (tag :: Symbol)
-- 用类型标签区分不同构造器
type instance XExt UD "KV" = ()
type instance XExt UD "Null" = ()
-- ...

这样可以大幅减少type family的数量，降低维护成本。

替代方案：无需大量样板的可扩展AST实现 #

1. 模块化AST（基于compdata库） #

compdata库支持将AST拆分为多个独立模块，通过类型组合（:+:）拼接核心语法和扩展语法，自动处理递归遍历、折叠等操作。比如：

• 核心AST模块定义基础节点：data CoreAST a = Null | Int Int | ...
• 扩展模块定义新增节点：data ExtAST a = MyNode a | ...
• 组合后的AST：type FullAST = CoreAST :+: ExtAST

这种方式无需修改原始AST，扩展时只需添加新的模块，且库提供了通用的折叠、遍历函数，不用为每个扩展重新编写遍历逻辑。

2. 开放递归+类型类 #

将AST节点定义为类型类，每个节点是类的实例，扩展时添加新实例或重载现有实例：

class ASTNode a where
  eval :: a -> Value
  prettyPrint :: a -> String

-- 核心节点
data Null = Null deriving (Show)
instance ASTNode Null where
  eval Null = VNull
  prettyPrint Null = "null"

data DInt = DInt Int deriving (Show)
instance ASTNode DInt where
  eval (DInt n) = VInt n
  prettyPrint (DInt n) = show n

-- 扩展新节点
data MyExtNode = MyExtNode String DInt deriving (Show)
instance ASTNode MyExtNode where
  eval (MyExtNode s i) = VString (s ++ show (eval i))
  prettyPrint (MyExtNode s i) = s ++ "(" ++ prettyPrint i ++ ")"

对于递归结构（比如数组包含任意AST节点），可以用存在类型或GADT封装：

data AnyAST = forall a. ASTNode a => AnyAST a
data DArray = DArray [AnyAST] deriving (Show)
instance ASTNode DArray where
  eval (DArray xs) = VArray (map (eval . (\(AnyAST x) -> x)) xs)
  prettyPrint (DArray xs) = "[" ++ intercalate ", " (map (prettyPrint . (\(AnyAST x) -> x)) xs) ++ "]"

3. 基于记录的可扩展节点（Extensible Records） #

用vinyl或generic-data库，将每个AST节点定义为带可扩展字段的记录。核心数据放在固定字段，扩展字段通过类型级列表添加：

import Data.Vinyl

-- 核心字段定义
type CoreKV = '[ "key" ::: String, "value" ::: Data ]
-- 扩展后的KV节点
type KV ext = Record (CoreKV ++ ext)

-- 核心Data节点字段
type CoreNull = '[]
type CoreInt = '[ "value" ::: Int ]
-- ...

-- 创建核心KV节点
mkKV :: String -> Data -> KV '[]
mkKV k v = rec (Field k :& Field v :& RNil)

-- 扩展KV节点，添加位置信息
type KVWithPos = KV '[ "pos" ::: (Int, Int) ]
mkKVWithPos :: String -> Data -> (Int, Int) -> KVWithPos
mkKVWithPos k v pos = rec (Field k :& Field v :& Field pos :& RNil)

这种方式适合给现有节点添加额外元数据（比如位置、类型信息），无需修改原始节点定义。

4. GADT+扩展参数 #

用GADT统一核心节点和扩展节点，通过类型参数传递扩展信息：

data AST ext where
  NullAST :: AST ext
  IntAST :: Int -> AST ext
  StringAST :: String -> AST ext
  -- 扩展节点
  ExtAST :: ext -> AST ext

-- 定义扩展类型
data MyExt = MyExtNode Int String deriving (Show)
-- 使用扩展后的AST
type MyAST = AST MyExt

配合类型类，可以给扩展节点添加特定功能：

class EvalExt ext where
  evalExt :: ext -> Value

instance EvalExt MyExt where
  evalExt (MyExtNode n s) = VString (s ++ show n)

eval :: EvalExt ext => AST ext -> Value
eval NullAST = VNull
eval (IntAST n) = VInt n
eval (StringAST s) = VString s
eval (ExtAST e) = evalExt e

总结 #

• 如果坚持使用TTG：用模板Haskell自动生成所有样板代码，是最直接的优化方式，能把维护成本降到和原始AST相当。
• 如果想换方案：
  • 需要扩展新语法节点：优先选模块化AST（compdata），支持无缝拼接，且自带通用遍历工具。
  • 需要给现有节点添加字段：优先选可扩展记录或TTG+TH。
  • 轻量扩展或需要灵活重载行为：选开放递归+类型类。

内容的提问来源于stack exchange，提问作者Blue Nebula