Skip to content

Out-of-scope type variables when combining GeneralizedNewtypeDeriving with higher-rank type synonyms

I am getting this with ghc-8.10.2 (same with 8.8.4, 8.6.5, but works with 8.4.4, and with 9.0.0.20200925)

src/Control/Search/Memo.hs:38:20: error:
    The exact Name ‘a’ is not in scope
      Probable cause: you used a unique Template Haskell name (NameU),
      perhaps via newName, but did not bind it
      If that's it, then -ddump-splices might be useful
   |
38 |   deriving (MonadT,StateM MemoInfo,FMonadT)

The source does not use TemplateHaskell, but

newtype MemoT m a = MemoT { unMemoT :: SStateT MemoInfo m a }
  deriving (MonadT,StateM MemoInfo,FMonadT)

to reproduce (it's not my code, but I need it)

git clone https://github.com/jwaldmann/monadiccp
cd monadiccp/
git checkout 52846f5ca9aacbd7cb3da48467778c1aa8628a2a
cabal build

I tried to reduce the source, but the message does not appear for

{-# language FunctionalDependencies #-}
{-# language MultiParamTypeClasses #-}
{-# language FlexibleInstances #-}
{-# language GeneralizedNewtypeDeriving #-}

class Monad m => StateM z m | m -> z

data MemInfo = MemInfo

data Tup2 a b = Tup2 a !b

newtype SStateT s m a = SS { unSS :: s -> m (Tup2 a s) }
instance MonadT (SStateT s)  

class MonadT t where treturn :: Monad m => a -> t m a

instance (Monad m, MonadT t) => Monad (t m)
instance (Monad m, MonadT t) => Applicative (t m)
instance (Monad m, MonadT t) => Functor (t m)

class MonadT t => FMonadT t
instance FMonadT (SStateT s)

newtype MemoT m a = MemoT { unMemoT :: SStateT MemInfo m a }
  deriving (MonadT,StateM MemInfo,FMonadT)
Edited by Ryan Scott
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information