编辑:ProgramF
为s 添加一个带有通用注释的函数示例。
是的,至少在 的情况下toANF
,你用错了。
在toANF
中,请注意您的Let bindingANF nbody
和伴随定义的bindingANF
andnbody
只是fmap toANF
特定构造函数的重新实现Let
。
也就是说,如果您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
代表“单位”。显然,如果真的需要,您可以轻松编写翻译器以使用Program
s as s: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