使用Fix对Haskell AST进行注释

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 错误了？

此外，我担心如何将函数泛化。我怎样才能使我的函数通用于 Program、LabelProgram 和 TypeProgram？

- John Howard

---

Attr f a 只是 Mu (Ann f a) 的同义词，因此您可以使用 fixplate 中提供的各种遍历方式。toANF 本质上是 forget，但根据您的意图，您不想从 AST 中删除标签，对吗？https://hackage.haskell.org/package/fixplate-0.1.7/docs/Data-Generics-Fixplate-Traversals.html - Regis Kuckaertz

Answer 1

编辑：添加一个带有泛型注释的ProgramF函数的示例。

是的，在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 ()

"U"在ProgramU中代表"unit"。如果确实需要，你可以轻松地编写翻译器以将Program作为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分开成嵌套的具有单一绑定的Let（并因此打破了在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)

它可以应用于一个示例 程序：

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

- K. A. Buhr