RE: Declaration reordering
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? You sent your original message to ghc-users; perhaps you'd like to summarise for the TH list. 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. Simon | -----Original Message----- | From: Ian Lynagh [mailto:igloo@earth.li] | Sent: 14 February 2003 03:11 | To: Simon Peyton-Jones | Subject: Re: Declaration reordering | | On Thu, Feb 13, 2003 at 09:16:46AM -0000, Simon Peyton-Jones wrote: | > | > The renamer performs a strongly-connected component analysis of | > declarations. Reason: it's the standard way to get maximal | > polymorphism. It's even part of the language specification. | > | > It'd be quite tricky to un-do that stuff before doing the quotation | > part. So I'm really not sure how to tackle your problem. | | Do you agree that it is worthwhile? | | The possibilities that spring to mind are: | | * tagging each declaration with its position in the list and sorting | them before returning them. The only arguments against this are it | adds a bit of code and will have a time/space impact (but I'd have | thought negligible, especially if the tagging was done strictly). | | * Keeping a copy of the original input around to pass back. Doubles | space used by declaration lists and I suspect will have problems with | right infix operators. | | * Doing the SCC analysis and type checking on a copy and throwing it | away afterwards. Would also have the problems of the above and is | probably more complicated to implement. | | | Thanks | Ian
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
participants (2)
-
Ian Lynagh -
Simon Peyton-Jones