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