My TH is a bit rusty, so I'm probably doing something wrong here: {-# LANGUAGE TemplateHaskell #-} module TH where import Language.Haskell.TH monad qe = qe >>= return . AppE (VarE 'return) The symptom appears in the following module, when I replace the native 'return's with the spliced ones: {-# LANGUAGE TemplateHaskell #-} import TH y :: Monad m => a -> m a y a = return a -- $(monad [| a |]) x :: (Monad m,Eq a) => m a x = return undefined -- $(monad [| undefined |]) There is no recursion, at least no intended one, but where the native version compiles just fine, the spliced version yields: THtest.hs:10:0: Contexts differ in length (Use -XRelaxedPolyRec to allow this) When matching the contexts of the signatures for y :: forall (m :: * -> *) a. (Monad m) => a -> m a x :: forall (m :: * -> *) a. (Monad m, Eq a) => m a The signature contexts in a mutually recursive group should all be identical When generalising the type(s) for y, x Failed, modules loaded: TH. Could someone please tell me what is causing this? In the real code, the errors are even more confusing. Try removing the type signatures, for instance, or just remove the 'Eq a' constraint, then try evaluating '[y (),x]' in GHCi. Claus