[Template-haskell] RE: Declaration reordering

Ian Lynagh igloo@earth.li
Mon, 17 Feb 2003 14:22:22 +0000


On Fri, Feb 14, 2003 at 10:20:56AM -0000, Simon Peyton-Jones wrote:
> I'm not sure I do agree that it's worthwhile. At least, of course it
> would be nice but the question is whether it's worth the bother.  Why
> are you keen on it?

The case I have at the moment is:

#ifdef TEMPLATE_HASKELL
$(
  do
     [func, typ] <- [d| {
#endif
do_mb :: (C -> C -> C) -> T -> Iterations -> C -> C -> Colour;
do_mb f k i z xy 
 | i > 255 = (0, 0, 0)
 | otherwise = if (realPart z')^2 + (imagPart z')^2 > k^2
               then (0, 0, i) 
               else do_mb f k (i+10) z' xy
    where z' = f z xy;
#ifdef TEMPLATE_HASKELL 
                      } |]
     let func' = unroll (Just 30) 2 (Integer 0) func
     return [ typ, func' ]
 )
#endif

where [func, typ] has to be the wrong way round.

> You sent your original message to ghc-users; perhaps you'd like to
> summarise for the TH list.

The example I sent before was the following which shows it is not just a
reversal of the list (which would be much easier to fix!):

With the following module:

-----8<----------8<----------8<----------8<----------8<-----
module Main (main) where

import Language.Haskell.THSyntax
import Text.PrettyPrint.HughesPJ

main :: IO ()
main = do ds <- runQ [d| {x = x+y; y = x+y; z = z} |]
          putStrLn $ render $ vcat $ map pprDec ds
-----8<----------8<----------8<----------8<----------8<-----

the output looks like this:

-----8<----------8<----------8<----------8<----------8<-----
z = z
x = x GHC.Num:+ y
y = x GHC.Num:+ y
-----8<----------8<----------8<----------8<----------8<-----

(i.e. the declarations get reordered). I want to be able to have
[def_x, def_y, def_z] on the left hand side rather than ds.

> Your first option looks best.  Indeed, each decl has its SrcLoc which
> includes a line number, so perhaps you could unscramble them that way.
> You are welcome to have a go; if you need help figuring out where, I'll
> help.

This wouldn't be perfect (e.g. the above has them all on one line), but
it would solve my actual problem.

I've had a quick look and I think something called by one or both of
"tcMonoExpr (HsBracket brack loc) aes_ty" and "tcBracket"? Oh, but the
former calls the latter, so probably somewhere in tcTopSrcDecls? I'll
try following this through if so.


Thanks
Ian