Как работать с AST с аннотацией Cofree?

Question

У меня есть это просто Expr АСТ, и я могу легко преобразовать его в String,

import Prelude hiding (Foldable)
import qualified Prelude
import Data.Foldable as F
import Data.Functor.Foldable
import Data.Monoid
import Control.Comonad.Cofree

data ExprF r = Const Int
              | Add   r r
                deriving ( Show, Eq, Ord, Functor, Prelude.Foldable )

type Expr = Fix ExprF

testExpr = Fix $ Add (Fix (Const 1)) (Fix (Const 2))

convertToString :: Expr -> String
convertToString = cata $ \case
  e@(Const x) -> show x
  e@(Add x y) -> unwords [x, "+", y]

Теперь я хочу добавить к нему дополнительные данные. Поэтому я пытаюсь использовать Cofree

type LineNumber = Int
type Expr2 = Cofree ExprF LineNumber

Я могу конвертировать Expr в Expr2

addLineNumbers :: Expr -> Expr2
addLineNumbers = cata $ \case
  e@(Const _) -> 1 :< e
  e -> 2 :< e

Но я не могу понять, как конвертировать Expr2 в String

convertToString2 :: Expr2 -> String
convertToString2 = cata $ \case
  e@(_ :< (Const x)) -> show x
  e@(_ :< (Add x y)) -> unwords [x, "+", y]

Кроме того, является ли Cofree лучшим способом решения этой проблемы с аннотациями?

Answer 1

Альтернативный способ аннотирования вашего синтаксического дерева - это создать аннотацию в базовом функторе.

-- constant functor
newtype K c a = K c
    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)

-- functor product
data (f :*: g) a = (:*:) { left :: f a, right :: g a }
    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)

Мы собираемся использовать продукт функтора, чтобы прикрепить аннотацию (внутри K) к каждому слою дерева.

type AnnExpr = Fix (K LineNumber :*: ExprF)

Если вы можете генерировать аннотации при проверке только одного слоя дерева (т. Е. Код, генерирующий аннотации, может быть выражен как естественное преобразование), вы можете использовать следующую часть механизма для изменения функтора, сохраняя структуру точки фиксации в место:

hoistFix :: Functor f => (forall a. f a -> g a) -> Fix f -> Fix g
hoistFix f = Fix . f . fmap (hoistFix f) . unFix

Это имеет ограниченную полезность, так как большинство интересных аннотаций, таких как проверка типов, требуют обхода синтаксического дерева.

Вы можете повторно использовать код, чтобы разрушить Expr просто игнорируя аннотации. Дана алгебра для ExprF...

-- instructions for a stack machine
data Inst = PUSH Int | ADD
type Prog = [Inst]

compile_ :: ExprF Prog -> Prog
compile_ (Const x) = [PUSH x]
compile_ (Add x y) = x ++ y ++ [ADD]

... вы можете использовать его, чтобы снести либо Expr или AnnExpr:

compileE :: Expr -> Prog 
compileE = cata compile_

compileA :: AnnExpr -> Prog
compileA = cata (compile_ . right)