Аннотированные рекурсивные типы данных с другим типом аннотации в AST

В игрушечном компиляторе, который я пишу, я хочу использовать общие рекурсивные типы данных для представления абстрактных синтаксических деревьев (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))

Почему выведенный тип имеет один и тот же тип для аннотации, как в аргументе, так и в результирующей монаде?