haskell - AST の異なるタイプのアノテーションを持つ、アノテーション付きの再帰データ型

Question

私が書いているおもちゃのコンパイラでは、一般的な再帰データ型を使用して、おそらく何らかの属性で注釈が付けられた抽象構文ツリー (AST) を表現したいと考えています。

パーサーは式の AST を作成し、ソース コード内の場所で注釈を付けます。

セマンティック アナライザーは、場所で注釈が付けられた AST を受け取り、実行時に型情報で注釈が付けられた対応する AST を返すモナドを生成します。

セマンティック アナライザーの目的は、式を型チェックし、プロセスで検出されたエラーを報告することです。式の計算された型は、元のツリーで注釈として使用する必要があります。これにより、最後にすべてのツリー ノードにその型の注釈が付けられます。

セマンティック アナライザーが完全に実装されると、RWS モナドが使用されます。これには、let 式と変数をコンパイルするための環境が必要であり、検出されたエラーのログが生成され、式言語のいくつかの新しい構造は、状態をコンパイルする必要があります。 .

セマンティック アナライザーを作成しようとすると、Haskell 型システムに問題があります。次のコードは、私が抱えている問題の種類を示しています。

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}

module Lang0 where

import Prelude hiding (foldr1,mapM,exp)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
import Control.Monad.RWS (runRWS)

newtype Fix f = In { out :: f (Fix f) }

deriving instance Show (f (Fix f)) => Show (Fix f)


data Ann x f a = Ann { attr  :: x    -- ^ the annotation
                     , unAnn :: f a  -- ^ the original functor
                     }
                 deriving (Eq,Ord,Show,Functor,Foldable,Traversable)

data Range = Range Int Int

instance Show Range where
  show (Range a b) = show a ++ "-" ++ show b

type Name = String

data BinOp
  = Add | Sub | Mul | Div
  | Eq | Ne | Gt | Ge | Lt | Le
  | Con | Dis
  deriving (Eq,Show)

data ExpF r
  = Log Bool
  | Num Double
  | Var Name
  | Neg r
  | Bin BinOp r r
  | Let Name r r
  deriving (Eq,Show,Functor,Foldable,Traversable)

data Type = NUMERIC | LOGIC deriving (Eq,Show)

newtype Exp = Exp { runExp :: Fix ExpF } deriving (Show)
newtype ExpPos = ExpPos { runExpPos :: Fix (Ann Range ExpF) } deriving (Show)
newtype ExpType = ExpType { runExpType :: Fix (Ann ExpType ExpF) } deriving (Show)

type Env = [(Name, Type)]
type Log = [(Range, String)]

semantExp :: Monad m => Fix (Ann Range ExpF) -> m (Fix (Ann Type ExpF))
semantExp (In (Ann pos exp)) =
  case exp of
    Num _ -> return (In (Ann NUMERIC exp))
    _     -> error "unimplemented"

e1 :: ExpPos
e1 = ExpPos (In (Ann (Range 1 2) (Num 8)))

main :: IO ()
main = print (runRWS (semantExp (runExpPos e1)) [] ())

このコードを ghc コンパイラに渡すと、次のようになります。

$ ghc --make Lang0
[1 of 1] Compiling Lang0            ( Lang0.hs, Lang0.o )

Lang0.hs:60:38:
    Couldn't match type `Range' with `Type'
    Expected type: ExpF (Fix (Ann Type ExpF))
      Actual type: ExpF (Fix (Ann Range ExpF))
    In the second argument of `Ann', namely `exp'
    In the first argument of `In', namely `(Ann NUMERIC exp)'
    In the first argument of `return', namely `(In (Ann NUMERIC exp))'

コンパイラが引数の注釈と結果の AST を同じ型にする必要があるのはなぜですか?

この問題を解決する方法の手がかりはありますか?

追加の観察: の型注釈がないsemantExp場合、コンパイラは次の型を推測します。

semantExp
  :: Monad m => Fix (Ann Type ExpF) -> m (Fix (Ann Type ExpF))

推論された型が、結果モナドの引数の両方で、アノテーションに対して同じ型を持つのはなぜですか?