[Template-haskell] "contexts differ in length" fires when using splices in non-recursive bindings?

Simon Peyton-Jones simonpj at microsoft.com
Fri Jul 18 17:09:21 EDT 2008


Ian has this exactly right.  Yes, it is confusing, but because splices are run (and must be run) during typechecking, I don't see a reasonably easy way to fix it.

A radical version would be: do a complete pass of the typechecker to run any splices; then re-dependency analyse the whole program; then do another complete typechecker pass.  But I'm reluctant to do this.

Meanwhile, as Claus says -XRelaxedPolyRec will help a lot.

Simon

| -----Original Message-----
| From: template-haskell-bounces at haskell.org [mailto:template-haskell-
| bounces at haskell.org] On Behalf Of Ian Lynagh
| Sent: 12 July 2008 12:34
| To: template-haskell at haskell.org
| Subject: Re: [Template-haskell] "contexts differ in length" fires when using
| splices in non-recursive bindings?
|
| On Sat, Jul 12, 2008 at 12:50:50AM +0100, Claus Reinke wrote:
| >
| > 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
|
| I think the problem is that the SCC analysis is done before the splices
| are run (which is during type checking), so GHC doesn't know that you
| haven't written something like
|
|     {-# LANGUAGE TemplateHaskell #-}
|     module Main where
|
|     main = putStrLn $ take 10 x
|
|     y :: String
|     y = $( [| 'b':x |] )
|
|     x :: String
|     x = $( [| 'a':y |] )
|
| in which the functions /are/ recursive.
|
| If you put
|
|     $( [d| |] )
|
| between the two definitions then that forces GHC to consider them as
| separate binding groups (as it type checks the first binding, then runs
| the splice, then type checks the second one).
|
|
| Thanks
| Ian
|
| _______________________________________________
| template-haskell mailing list
| template-haskell at haskell.org
| http://www.haskell.org/mailman/listinfo/template-haskell



More information about the template-haskell mailing list