Haskell AST Annotation with Fix

Question

我正在努力在Haskell中创建一个AST.我想添加不同的注释,例如类型和位置信息,所以我最终使用了fixplate.但是,我在网上找不到任何例子,我遇到了一些困难.

我按照fixplate的推荐设置了我的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 ...像这样返回,还是我使用fixplate错了？

另外,我担心如何概括功能.如何让我的函数一般用于Programs,LabelPrograms和TypePrograms？

Answer 1

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

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

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

也就是说，如果您Functor为 派生一个实例ProgramF，那么您可以将代码片段重写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 ()

其中“U”ProgramU代表“单位”。显然，如果确实需要，您可以轻松编写翻译器来将 s 用作Programs ：ProgramU

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具有多个绑定的 s 分隔成Let具有单例绑定的嵌套 s（因此破坏了语言中的相互递归绑定Program）。它假设多重绑定上的注释Let将被复制到每个生成的单例中Let：

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