Haskell AST 注释与修复

Question

我正在努力在Haskell中创建AST。我想添加不同的注释，例如类型和位置信息，所以我最终使用了固定板。但是，我在网上找不到任何示例，并且遇到了一些困难。

我已经按照固定板的建议设置了我的 AST(一些条纹)：

data ProgramF a
= Unary a
Operator
| Number Int
| Let { bindings :: [(Identifier, a)]
, body :: a }
type Program = Mu ProgramF

接下来，我创建了一个标签，我创建了另一种类型，以及一个基于树遍历添加标签的函数。

type LabelProgram = Attr ProgramF PLabel
labelProgram :: Program -> LabelProgram
labelProgram =
annMap (PLabel . show . fst) . (snd . synthAccumL (i x -> (i + 1, (i, x))) 0)

但是，除此之外，我还遇到了一些问题。例如，我正在尝试编写一个在 AST 上进行一些转换的函数。因为它需要一个标签才能起作用，所以我已经将类型设为LabelProgram -> Program，但我认为我在这里做错了什么。下面是函数的一部分(更简单的部分之一)：

toANF :: LabelProgram -> Program
toANF (Fix (Ann label (Let {bindings, body}))) = Fix $ Let bindingANF nbody
where
bindingANF = map ((i, e) -> (i, toANF e)) bindings
nbody = toANF body

我觉得我在这里的抽象级别是错误的。我应该显式匹配Fix Ann ...并像这样返回Fix ...，还是我使用错误的固定板？

此外，我担心如何泛化函数。如何使我的函数通常适用于Programs、LabelPrograms 和TypeProgram？

Answer 1

编辑：添加带有通用注释的ProgramFs 函数示例。

是的，至少在toANF的情况下，你用错了。

在toANF中，请注意，您的Let bindingANF nbody以及bindingANF和nbody的配套定义只是特定构造函数Let的fmap toANF的重新实现。

也就是说，如果您为ProgramF派生了一个Functor实例，则可以将toANF代码段重写为：

toANF :: LabelProgram -> Program
toANF (Fix (Ann label l@(Let _ _))) = Fix (fmap toANF l)

如果toANF只是剥离标签，那么这个定义适用于所有构造函数，而不仅仅是Let，所以你可以删除模式：

toANF :: LabelProgram -> Program
toANF (Fix (Ann label l)) = Fix (fmap toANF l)

现在，根据@Regis_Kuckaertz的评论，您刚刚重新实现了forget定义为：

forget = Fix . fmap forget . unAnn . unFix

关于编写一般适用于Program、LabelProgram等的函数，我认为在(单个)注释中编写通用函数更有意义：

foo :: Attr ProgramF a -> Attr ProgramF a

并且，如果您确实需要将它们应用于未注释的程序，请定义：

type ProgramU = Attr ProgramF ()

其中ProgramU中的"U"代表"单位"。 显然，如果确实需要，您可以轻松地编写翻译器以ProgramUPrograms：

toU :: Functor f => Mu f -> Attr f ()
toU = synthetise (const ())
fromU :: Functor f => Attr f () -> Mu f
fromU = forget
mapU :: (Functor f) => (Attr f () -> Attr f ()) -> Mu f -> Mu f
mapU f = fromU . f . toU
foo' :: Mu ProgramF -> Mu ProgramF
foo' = mapU foo

作为一个具体的 - 如果愚蠢 - 示例，这里有一个函数，它将具有多个绑定的Let分隔为具有单例绑定的嵌套Let(因此会破坏Program语言中的相互递归绑定)。 它假定多绑定Let上的注释将复制到每个生成的单例Lets：

splitBindings :: Attr ProgramF a -> Attr ProgramF a
splitBindings (Fix (Ann a (Let (x:y:xs) e)))
= Fix (Ann a (Let [x] (splitBindings (Fix (Ann a (Let (y:xs) e))))))
splitBindings (Fix e) = Fix (fmap splitBindings e)

它可以应用于示例Program：

testprog :: Program
testprog = Fix $ Unary (Fix $ Let [(Identifier "x", Fix $ Number 1), 
(Identifier "y", Fix $ Number 2)] 
(Fix $ Unary (Fix $ Number 3) NegOp))
NegOp

这样：

> mapU splitBindings testprog
Fix (Unary (Fix (Let {bindings = [(Identifier "x",Fix (Number 1))],
body = Fix (Let {bindings = [(Identifier "y",Fix (Number 2))], 
body = Fix (Unary (Fix (Number 3)) NegOp)})})) NegOp)
>

这是我的完整工作示例：

{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wall #-}
import Data.Generics.Fixplate
data Identifier = Identifier String deriving (Show)
data PLabel = PLabel deriving (Show)
data Operator = NegOp deriving (Show)
data ProgramF a
= Unary a
Operator
| Number Int
| Let { bindings :: [(Identifier, a)]
, body :: a }
deriving (Show, Functor)
instance ShowF ProgramF where showsPrecF = showsPrec
type Program = Mu ProgramF
type LabelProgram = Attr ProgramF PLabel
splitBindings :: Attr ProgramF a -> Attr ProgramF a
splitBindings (Fix (Ann a (Let (x:y:xs) e)))
= Fix (Ann a (Let [x] (splitBindings (Fix (Ann a (Let (y:xs) e))))))
splitBindings (Fix e) = Fix (fmap splitBindings e)
toU :: Functor f => Mu f -> Attr f ()
toU = synthetise (const ())
fromU :: Functor f => Attr f () -> Mu f
fromU = forget
mapU :: (Functor f) => (Attr f () -> Attr f ()) -> Mu f -> Mu f
mapU f = fromU . f . toU
testprog :: Program
testprog = Fix $ Unary (Fix $ Let [(Identifier "x", Fix $ Number 1), 
(Identifier "y", Fix $ Number 2)] 
(Fix $ Unary (Fix $ Number 3) NegOp))
NegOp
main :: IO ()
main = print $ mapU splitBindings testprog