New patches: [Add GADTs to the TH datastructures Ian Lynagh **20060811214402] { hunk ./compiler/deSugar/DsMeta.hs 165 +repCons :: [LConDecl Name] -> DsM (Core TH.ConsQ) +repCons cons@(L loc (ConDecl _ _ _ _ _ ResTyH98):_) + = do cons1 <- mapM repC cons + cons2 <- coreList conQTyConName cons1 + rep2 normalConsName [unC cons2] +repCons cons + = do cons1 <- mapM repGadtC cons + cons2 <- coreList gadtConQTyConName cons1 + rep2 gadtConsName [unC cons2] + hunk ./compiler/deSugar/DsMeta.hs 182 - cxt1 <- repLContext cxt ; - cons1 <- mapM repC cons ; - cons2 <- coreList conQTyConName cons1 ; - derivs1 <- repDerivs mb_derivs ; - bndrs1 <- coreList nameTyConName bndrs ; - repData cxt1 tc1 bndrs1 cons2 derivs1 } ; + cxt1 <- repLContext cxt ; + cons' <- repCons cons ; + derivs1 <- repDerivs mb_derivs ; + bndrs1 <- coreList nameTyConName bndrs ; + repData cxt1 tc1 bndrs1 cons' derivs1 } ; hunk ./compiler/deSugar/DsMeta.hs 300 - = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences] - repConstr con1 details } + = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences] + repConstr con1 details } hunk ./compiler/deSugar/DsMeta.hs 310 -repC (L loc con_decl) -- GADTs - = putSrcSpanDs loc $ - do { dsWarn (hang ds_msg 4 (ppr con_decl)) - ; return (panic "DsMeta:repC") } +repC (L loc con_decl@(ConDecl _ _ _ _ _ (ResTyGADT _))) + = putSrcSpanDs loc $ + do { dsWarn $ hang (ptext SLIT("Unexpected GADT constructor")) 4 + (ppr con_decl) + ; return (panic "DsMeta:repC") } + +repGadtC :: LConDecl Name -> DsM (Core TH.GadtConQ) +repGadtC (L loc (ConDecl con expl tvs (L cloc ctxt) (PrefixCon ps) (ResTyGADT ltype))) + = do { addTyVarBinds tvs $ \bndrs -> do { + ctxt' <- repContext ctxt; + bndrs' <- coreList nameTyConName bndrs; + con' <- lookupLOcc con; + arg_tys <- mapM repBangTy ps; + arg_tys' <- coreList strictTypeQTyConName arg_tys; + ty <- repLTy ltype; + rep2 gadtCName [unC bndrs', unC ctxt', unC con', + unC arg_tys', unC ty] + } + } +repGadtC (L loc con_decl@(ConDecl _ _ _ _ _ (ResTyGADT _))) + = putSrcSpanDs loc $ + do { dsWarn $ hang (ptext SLIT("Got an odd GADT constructor")) 4 + (ppr con_decl) + ; return (panic "DsMeta:repGadtC 1") } +repGadtC (L loc con_decl@(ConDecl _ _ _ _ _ ResTyH98)) + = putSrcSpanDs loc $ + do { dsWarn $ hang (ptext SLIT("Unexpected H98 (not GADT) constructor")) 4 + (ppr con_decl) + ; return (panic "DsMeta:repGadtC 2") } hunk ./compiler/deSugar/DsMeta.hs 1188 -repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ) +repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConsQ -> Core [TH.Name] -> DsM (Core TH.DecQ) hunk ./compiler/deSugar/DsMeta.hs 1399 + -- Cons + normalConsName, gadtConsName, hunk ./compiler/deSugar/DsMeta.hs 1403 + -- GadtCon + gadtCName, hunk ./compiler/deSugar/DsMeta.hs 1424 - decQTyConName, conQTyConName, strictTypeQTyConName, + decQTyConName, consQTyConName, conQTyConName, gadtConQTyConName, strictTypeQTyConName, hunk ./compiler/deSugar/DsMeta.hs 1563 +-- data Cons = ... +normalConsName = libFun FSLIT("normalCons") normalConsIdKey +gadtConsName = libFun FSLIT("gadtCons") gadtConsIdKey + hunk ./compiler/deSugar/DsMeta.hs 1571 -forallCName = libFun FSLIT("forallC") forallCIdKey - +forallCName = libFun FSLIT("forallC") forallCIdKey + +-- data GadtCon = ... +gadtCName = libFun FSLIT("gadtC") gadtCIdKey + hunk ./compiler/deSugar/DsMeta.hs 1608 +consQTyConName = libTc FSLIT("ConsQ") consQTyConKey hunk ./compiler/deSugar/DsMeta.hs 1610 +gadtConQTyConName = libTc FSLIT("GadtConQ") gadtConQTyConKey hunk ./compiler/deSugar/DsMeta.hs 1631 +consQTyConKey = mkPreludeTyConUnique 123 hunk ./compiler/deSugar/DsMeta.hs 1633 +gadtConQTyConKey = mkPreludeTyConUnique 124 hunk ./compiler/deSugar/DsMeta.hs 1753 +-- data Cons = ... +normalConsIdKey = mkPreludeMiscIdUnique 298 +gadtConsIdKey = mkPreludeMiscIdUnique 299 + hunk ./compiler/deSugar/DsMeta.hs 1763 +-- data GadtCon = ... +gadtCIdKey = mkPreludeMiscIdUnique 289 + hunk ./compiler/hsSyn/Convert.lhs 116 - ; cons' <- mapM cvtConstr constrs + ; cons' <- cvtCons constrs hunk ./compiler/hsSyn/Convert.lhs 120 - hunk ./compiler/hsSyn/Convert.lhs 149 --- Can't handle GADTs yet hunk ./compiler/hsSyn/Convert.lhs 151 +cvtCons (NormalCons cs) = mapM cvtConstr cs +cvtCons (GadtCons cs) = mapM cvtGadtConstr cs + hunk ./compiler/hsSyn/Convert.lhs 183 - c -> panic "ForallC: Can't happen" } + _ -> panic "ForallC: Can't happen" } + +cvtGadtConstr (GadtC tvs ctxt c strtys ty) + = do { tvs' <- cvtTvs tvs + ; ctxt' <- cvtContext ctxt + ; c' <- cNameL c + ; args' <- mapM cvt_arg strtys + ; ty' <- cvtType ty + ; returnL $ ConDecl c' Explicit tvs' ctxt' (PrefixCon args') + (ResTyGADT ty') } hunk ./compiler/typecheck/TcSplice.lhs 586 - | isFunTyCon tc = return (TH.PrimTyConI (reifyName tc) 2 False) + | isFunTyCon tc = return (TH.PrimTyConI (reifyName tc) 2 False) hunk ./compiler/typecheck/TcSplice.lhs 589 - = do { let (tvs, rhs) = synTyConDefn tc - ; rhs' <- reifyType rhs - ; return (TH.TyConI $ TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') } + = do { let (tvs, rhs) = synTyConDefn tc + ; rhs' <- reifyType rhs + ; return (TH.TyConI $ TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') } + | isNewTyCon tc + = do { cxt <- reifyCxt (tyConStupidTheta tc) + ; cons <- mapM reifyDataCon (tyConDataCons tc) + ; let name = reifyName tc + tvs = reifyTyVars (tyConTyVars tc) + deriv = [] -- Don't know about deriving + decl = TH.NewtypeD cxt name tvs (head cons) deriv + ; return (TH.TyConI decl) } + | otherwise + = do { cxt <- reifyCxt (tyConStupidTheta tc) + ; cons <- reifyDataCons (tyConDataCons tc) + ; let name = reifyName tc + tvs = reifyTyVars (tyConTyVars tc) + deriv = [] -- Don't know about deriving + decl = TH.DataD cxt name tvs cons deriv + ; return (TH.TyConI decl) } hunk ./compiler/typecheck/TcSplice.lhs 609 -reifyTyCon tc - = do { cxt <- reifyCxt (tyConStupidTheta tc) - ; cons <- mapM reifyDataCon (tyConDataCons tc) - ; let name = reifyName tc - tvs = reifyTyVars (tyConTyVars tc) - deriv = [] -- Don't know about deriving - decl | isNewTyCon tc = TH.NewtypeD cxt name tvs (head cons) deriv - | otherwise = TH.DataD cxt name tvs cons deriv - ; return (TH.TyConI decl) } +reifyDataCons :: [DataCon] -> TcM TH.Cons +reifyDataCons dcs@(dc:_) + | isVanillaDataCon dc + = do dcs' <- mapM reifyDataCon dcs + return $ TH.NormalCons dcs' +reifyDataCons dcs + = do dcs' <- mapM reifyGadtDataCon dcs + return $ TH.GadtCons dcs' hunk ./compiler/typecheck/TcSplice.lhs 637 - = failWithTc (ptext SLIT("Can't reify a non-Haskell-98 data constructor:") + = failWithTc (ptext SLIT("Unexpected non-Haskell-98 data constructor:") + <+> quotes (ppr dc)) + +reifyGadtDataCon :: DataCon -> TcM TH.GadtCon +reifyGadtDataCon dc + | isVanillaDataCon dc + = failWithTc (ptext SLIT("Unexpected Haskell-98 data constructor:") + <+> quotes (ppr dc)) +reifyGadtDataCon dc + = failWithTc (ptext SLIT("Can't reify a non-Haskell-98 data constructor:") } Context: [Warning police: Removed overlapped pattern warnings sven.panne@aedion.de**20060811151353] [Complete -fmono-pat-binds patch simonpj@microsoft.com**20060811142842 When adding the experimental -fmono-pat-binds, I forgot to check for type signatures of the now-monomorphic patterns. This patch completes the job. I documented the design too: http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/MonomorphicPatternBindings ] [Avoid warning about overlapped pattern for Linux target sven.panne@aedion.de**20060811140512] [Improve error message layouts simonpj@microsoft.com**20060811133317] [Add type signature simonpj@microsoft.com**20060811133302] [Improve the "could not find module" error message Simon Marlow **20060811132135 In particular, if we're searching for the profiling version of a module in another package, then suggest that perhaps it might not have been installed. ] [On FreeBSD, use -lthr instead of -pthread for now (see comments) Simon Marlow **20060811113453] [Two more error message indendations simonpj@microsoft.com**20060811110435] [Go back to calling type veriables t simonpj@microsoft.com**20060811110412] [Indent an error message simonpj@microsoft.com**20060811110347] [Improve error message (imported from Prelude at Implicit import declaration) simonpj@microsoft.com**20060811110301] [don't qualify module name for importedSrcLoc Simon Marlow **20060811101327] [use "Defined in" rather than "Imported from" when printing ImportedSrcLoc Simon Marlow **20060811101159] [Now that we have an "html" package, put the Haddock docs somewhere else sven.panne@aedion.de**20060811092609] [Nuked hschooks.h in favour of cutils.h, which has the prototypes we need sven.panne@aedion.de**20060810154225] [Match format strings and arguments for printf-like functions sven.panne@aedion.de**20060810153624] [Warning police: Make prototype for LDV_recordDead_FILL_SLOP_DYNAMIC visible sven.panne@aedion.de**20060810144837] [Warning police: Make strlen and friends known sven.panne@aedion.de**20060810144729] [Tweak GCC's inlining parameters to get thread_obj inlined sven.panne@aedion.de**20060810144505] [Add an IAmDead case to postInlineUnconditionally, and comments simonpj@microsoft.com**20060810142034] [Do not repeatedly simplify an argument more than once simonpj@microsoft.com**20060810141526 A very important invariant of the simplifier is that we do not simplify an arbitrarily large expression more than once in a single pass. If this can happen, then we can get exponential behaviour, when the large expression itself has a large sub-expression which is simplified twice, and so on. GHC has a long-standing bug which allows this repeated simplification to happen. It shows up when we have a function like this f d BIG where f's unfolding looks like \x -> case x of (a,b) -> a Of course this is v common for overloaded functions. Before this patch we simplified all the args (d and BIG) before deciding to unfold f. Then we push back the simplified BIG onto the continuation stack, inline f, so now we have (case d of (a,b) -> a) BIG After we reduce the case a bit, we'll simplify BIG a second time. And that's the problem. The quick-and-dirty solution is to keep a flag in the ApplyTo continuation to say whather the arg has already been simplified. An alternative would be to simplify it when first encountered, but that's a bigger change. ] [Do not call preInlineUnconditionally in simplNonRecX simonpj@microsoft.com**20060810141340 This looks to me like a long-standing bug. simplNonRecX was calling preInlineUnconditionally, even though it was given an already-simplified expression. Exponential behaviour beckons. ] [Make postInlineUnconditaionally more conservative simonpj@microsoft.com**20060810141145 I'm being more paranoid about repeatedly simplifying things (to avoid exponential behaviour.) postInlineUnconditionally looks as if it could repeated simplify the same expression; this patch stops it doing so. The extra lines are all comments! ] [Control.Exception.unblock wasn't unblocking exceptions Simon Marlow **20060810132307] [remove out of date comment Simon Marlow **20060810130154] [move html before network, for now Simon Marlow **20060810121930] [add html package Simon Marlow **20060810113719] [Egregious bug in tcLHsConResTy simonpj@microsoft.com**20060810120828 This terrible bug in tcLHsConTy is pretty much guaranteed to show up on an program involving a GADT with more than one type parameter. This bug isn't present in the STABLE branch. Manuel: it is *not* necesary to merge this patch into the FC branch; just ignore it. ] [Comments about improvements to SpecConstr simonpj@microsoft.com**20060810120759] [Remove HasBounds-instance and implement MArray.getBounds instead Esa Ilari Vuokko **20060809163012] [Fix Array imports Esa Ilari Vuokko **20060809161341] [Where we use $(GhcHcOpts), also add $(GhcStage1HcOpts) Simon Marlow **20060809144845 This fixes building the compiler with -prof in $(GhcStage1HcOpts) ] [fixes to the stage2 build following removal of old FFI syntax Simon Marlow **20060809143153] [fix bug in task freeing Simon Marlow **20060809141225] [add some more options to stage 2 Simon Marlow **20060809141058] [remove debugging code accidentally left in Simon Marlow **20060809102936] [remember that old FFI syntax has been dropped Simon Marlow **20060809101655] [only define GHCI if $(GhcWithInterpreter)=YES, also add -threaded Simon Marlow **20060809101634] [move altzone test to base package Ross Paterson **20060809124215] [remove unused FPTOOLS_CHECK_HTYPE macro Ross Paterson **20060809124036] [Remove the artifical cap on the number of workers Simon Marlow **20060809095908 See #805. This was here to catch bugs that resulted in an infinite number of worker threads being created. However, we can't put a reasonable bound on the number of worker threads, because legitimate programs may need to create large numbers of (probably blocked) worker threads. Furthermore, the OS probably has a bound on the number of threads that a process can create in any case. ] [Remove old FFI syntax Simon Marlow **20060809095201 See #815 ] [make exit() overridable, for use in DLLs Simon Marlow **20060809092439 See #753 ] [More fixes to pre-matching and pre-subsumption simonpj@microsoft.com**20060808224924 Actually this patch fixes two errors. one was a trivial typo in tha last patch (b_ty should be b_tau), which led to an infinite loop when compiling Data.Generic.Twins. Fixing that revealed a more serious error in the same function. I was sloppy about dealing robsutly with name-capture for nested quantifiers in pre-subsumption and pre-matching; and sure enough I got bitten. Sigh. I think it is right now. ] [Group exports so that all length functions are together; no semantic change simonpj@microsoft.com**20060808224808] [Check that lazy patterns are for lifted types simonpj@microsoft.com**20060808135910 A lazy pattern match must be for a lifted type. This is illegal: f x = case g x of ~(# x,y #) -> ... This commit fixes the problem. Trac #845, test is tcfail159 ] [Spelling in a comment simonpj@microsoft.com**20060808123514] [Remove srcSpanStartLine/srcSpanEndLine crash simonpj@microsoft.com**20060808123211 srcSpanStartLine/srcSpanEndLine panic on UnhelpfulLoc. They should not really be exported by SrcLoc at all, but unfortunately they are used in Lexer.x, which knows enough to avoid the panic. However the call in RnEnv didn't know, and the panic was triggered by Template Haskell spliced code. This patch fixes it by exporting the predicate RnEnv wanted, namely isOneLineSpan. ] [Replace deprecated AC_TRY_COMPILE macro with the reccomended replcament Duncan Coutts **20060706114902 See: http://www.gnu.org/software/autoconf/manual/html_node/Obsolete-Macros.html ] [Add ghc and version number in .ident directive in NCG Duncan Coutts **20060706114712 Just because we can and because every other compiler does, lets stick in an identifier directive: .ident "GHC x.y.z" into the assembly output of the NCG. ] [Support the GNU non-exec stack annotation system Duncan Coutts **20060706114331 On recent GNU ELF systems one can mark an object file as not requiring an executable stack. If all objects- linked into a program have this note then the program will not use an executable stack, which is good for security (and some distros have it as a QA policy). GHC generated code does not need an executable stack so add the note to the assembly output of the native code generator (conditional on a configure test). ] [Complain more loudly if any of the hsc2hs phases fail Duncan Coutts **20060703234356 previously hsc2hs just exits with a non-zero exit code, now if any of the compilation, linking or runing phases fail then we get a message saying so and the failing command is printed. ] [Remember to free() memory on exit Simon Marlow **20060808103110 Patch mostly from Lennart Augustsson in #803, with additions to Task.c by me. ] [Fix pre-subsumption and pre-matching simonpj@microsoft.com**20060808091108 The pre-subsuption and pre-matching functions should NEVER make bogus bindings of type variables, although they are free to bale out and make too few bindings. I hadn't been thiking carefully enough about this, and there were two separate bugs. - Firstly, in pre-subsumption we must ignore the 'theta' part of any overloaded type. - Second, in pre-matching, we must return the empty subustition on a mis-match, rather than returning the substitution so far. This bug showed up when compiling Data.Generics.Schemes.hs, and is imortalised in test tc206 ] [Improve error message simonpj@microsoft.com**20060808080255 Improve a little-used error message. Given f :: a -> a f x y = e the error says The equations for f have two arguments but its type `a -> a' has only one (Before, it said "its type `a' has only one" which is bogus. ] [Pull out common removal code, and detect does-not-exist correctly Ian Lynagh **20060710214308] [Create our own directory in the temporary directory to avoid various races Ian Lynagh **20060710204424] [Merge SysTools import declarations Ian Lynagh **20060709183850] [Don't freeze the dynamic flags used for filename generation before the pipeline starts Ian Lynagh **20060709145101] [#807: Removed double fclose of prof_file Ian Lynagh **20060708152424 prof_file was being fclose'd in both gen_XML_logfile and hs_exit, leading to glibc complaining of a double free. ] [Add -fextended-default-rules and -fmono-pat-binds simonpj@microsoft.com**20060807112107 Add -fextended-deafult-rules (in response to Don Stewart's message below), and document them. Also doucument -fmono-pat-binds/-fno-mono-pat-binds, which has been in GHC a few weeks now. (The two are in one patch because the diffs were so close together that Darcs combined them.) Simon From: Donald Bruce Stewart [mailto:dons@cse.unsw.edu.au] Sent: 07 August 2006 10:52 While we're thinking about defaulting, I have a question.. ghci uses an extended defaulting system, to allow things like: Prelude> reverse [] [] to work, and to have the right instance of Show found. The manual says: "..it is tiresome for the user to have to specify the type, so GHCi extends Haskell's type-defaulting rules (Section 4.3.4 of the Haskell 98 Report (Revised)) as follows. If the expression yields a set of type constraints that are all from standard classes (Num, Eq etc.), and at least one is either a numeric class or the Show, Eq, or Ord class, GHCi will try to use one of the default types, just as described in the Report. The standard defaulting rules require that one of the classes is numeric; the difference here is that defaulting is also triggered at least one is Show, Eq, or Ord." Currently, there is no way to get at this "extended" defaulting for compiled modules. However, I have a use case for in fact doing this. With runtime evaluated Haskell, embedding 'interpreters' (over hs-plugins) is easy. lambdabot, for example, implements a sandboxed haskell eval system. But it doesn't have access to the defaulting mechanism of ghci, so we have: dons:: > reverse [] lambdabot:: Add a type signature dons:: > reverse [] :: [()] lambdabot:: [] Which is annoying -- newbies wonder why they have to add these extra constraints to get a Show instance. I'm wondering, since the extended defaulting mechanisms are already implemented, could they be made available to compiled modules as well, perhaps using a flag, -fextended-defaulting? ] [add a comment Simon Marlow **20060807143102] [Do pre-subsumption in the main subsumption check simonpj@microsoft.com**20060804214942 This patch improves the subsumption check (in TcUnify.tc_sub) so that it does pre-subsumption first. The key code is in the case with guard (isSigmaTy actual_ty); note the new call to preSubType. Shorn of details, the question is this. Should this hold? forall a. a->a <= Int -> (forall b. Int) Really, it should; just instantiate 'a' to Int. This is just what the pre-subsumption phase (which used in function applications), will do. I did a bit of refactoring to achieve this. Fixes Trac #821. Test tc205 tests. ] [Make unification robust to a boxy type variable meeting itself simonpj@microsoft.com**20060801214302 Previously, the implicit assumption in unification is that a boxy type variable could never occur on both sides of the unification, so that we'd never find bx5 :=: bx5 But the pre-subsumption stuff really means that the same variable can occur on both sides. Consider forall a. a->Int <= bx5->Int Then pre-subumption will find a->bx5; and the full subsumption step will find bx5:=bx5. However, I think there is still no possiblity of a full occurs-check failure; that is, bx5 :=: Tree bx5 Although I can't quite see how to prove it! So I've added a DEBUG test in uMetaVar to check for this case. ] [Added cabal-setup sven.panne@aedion.de**20060804142149] [Don't include the package name in a cost centre's module name Simon Marlow **20060803093337 This is mainly to restore the old behaviour, but also we shouldn't normally need the package name in a cost centre because only the "main" package normally has cost centres. ] [Add a new section "Getting the Source" to both HACKING and README. But what about win32 users? shae@ScannedInAvian.com**20060720152929] [savingOldConfig: add Exception.block for extra paranoia Simon Marlow **20060801131027 ] [Refactor ghc-pkg Ian Lynagh **20060729192946 This patch fixes a couple of issues with the Be lazier in user config creation, and don't fail on missing configs. patch. It puts the createDirectoryIfMissing back in and removes assumptions that the package.conf file already exists. ] [No functionality changes Ian Lynagh **20060730105256 Consistently used spaces rather than tabs. Removed trailing whitespace. Wrapped comments to fit in a standard terminal. ] [Add notes about unsafeCoerce simonpj@microsoft.com**20060731080922] [.hi-boot-5 is obsolete; the earliest GHC we support uses .hi-boot-6 Simon Marlow **20060728140809 ] [update to match .lhs-boot Simon Marlow **20060728140607] [get ReadP from the right place. Simon Marlow **20060728140444 ] [Improve error message for deriving simonpj@microsoft.com**20060727160832] [Lazy patterns are like wild-cards for overlap warnings simonpj@microsoft.com**20060727155009 MERGE TO STABLE Fixes Trac #827 Test is should_compiler/ds058 ] [fix some problems with wired-in packages Simon Marlow **20060727153802] [oops, remove old packages when updating Simon Marlow **20060727150650] [fix symbols for GHC.PrimopWrappers Simon Marlow **20060727134755] [a couple more symbols need package names Simon Marlow **20060727102129] [Add missing import simonpj@microsoft.com**20060727085605] [Make -fcontext-stack into a dynamic flag simonpj@microsoft.com**20060727080422 This allows you to put -fcontext-stack into an options pragma, as requested by Trac #829 While I was at it, I added OptIntPrefix to the forms allowed in CmdLineParser. ] [Deal correctly with infix type constructors in GADT decls simonpj@microsoft.com**20060726225304] [Improve pretty printing of ConDecl simonpj@microsoft.com**20060726225223] [fix parse error (merge-o, I think) Simon Marlow **20060726103526] [fix DEBUG build Simon Marlow **20060726103433] [missed one symbol that needs a package name Simon Marlow **20060726085844] [change wired-in Haskell symbols to include the package name Simon Marlow **20060726084659] [Unbox the Unique stored in a Name Simon Marlow **20060725141747 I measured that this makes the comiler allocate a bit more, but it might also make it faster and reduce residency. The extra allocation is probably just because we're not inlining enough somewhere, so I think this change is a step in the right direction. ] [optimisations to newUnique Simon Marlow **20060725140816 It turned out that newUnique was wasting one node of the splittable uniq supply per invocation: it took the current supply, split it, used the unique from one half and stored the other half in the monad. In other words, the unique in the supply stored in the monad was never used. This optimisation fixes that and adds a bit of strictness, which together lead to small reduction in allocations by the compiler, and possibly an improvement in residency (hard to tell for sure when GCs move around). ] [tiny bit of extra strictness Simon Marlow **20060725131201] [Make a SplitUniqSupply contain an Int# rather than an Int Simon Marlow **20060725120252 The I# constructor is always removed when we make a unique later anyway, so this just saves a bit of time and allocation. ] [Use -package-name rather than -ignore-package Simon Marlow **20060725130913] [Remove most of the conflict checking and auto-hiding Simon Marlow **20060725130850 Now that the module restriction has been lifted, the auto-hiding is mostly not required. GHC itself automatically hides old versions of a package. ] [Generalise Package Support Simon Marlow **20060725130154 This patch pushes through one fundamental change: a module is now identified by the pair of its package and module name, whereas previously it was identified by its module name alone. This means that now a program can contain multiple modules with the same name, as long as they belong to different packages. This is a language change - the Haskell report says nothing about packages, but it is now necessary to understand packages in order to understand GHC's module system. For example, a type T from module M in package P is different from a type T from module M in package Q. Previously this wasn't an issue because there could only be a single module M in the program. The "module restriction" on combining packages has therefore been lifted, and a program can contain multiple versions of the same package. Note that none of the proposed syntax changes have yet been implemented, but the architecture is geared towards supporting import declarations qualified by package name, and that is probably the next step. It is now necessary to specify the package name when compiling a package, using the -package-name flag (which has been un-deprecated). Fortunately Cabal still uses -package-name. Certain packages are "wired in". Currently the wired-in packages are: base, haskell98, template-haskell and rts, and are always referred to by these versionless names. Other packages are referred to with full package IDs (eg. "network-1.0"). This is because the compiler needs to refer to entities in the wired-in packages, and we didn't want to bake the version of these packages into the comiler. It's conceivable that someone might want to upgrade the base package independently of GHC. Internal changes: - There are two module-related types: ModuleName just a FastString, the name of a module Module a pair of a PackageId and ModuleName A mapping from ModuleName can be a UniqFM, but a mapping from Module must be a FiniteMap (we provide it as ModuleEnv). - The "HomeModules" type that was passed around the compiler is now gone, replaced in most cases by the current package name which is contained in DynFlags. We can tell whether a Module comes from the current package by comparing its package name against the current package. - While I was here, I changed PrintUnqual to be a little more useful: it now returns the ModuleName that the identifier should be qualified with according to the current scope, rather than its original module. Also, PrintUnqual tells whether to qualify module names with package names (currently unused). Docs to follow. ] [comment formatting Simon Marlow **20060725110519 ] [unused import Simon Marlow **20060706141349] [unused import Simon Marlow **20060706141205] [remove more Addr bits Simon Marlow **20060704151217] [unused import Simon Marlow **20060704141319] [add default cases Simon Marlow **20060704135444] [redundant import Simon Marlow **20060704135435] [unused imports Simon Marlow **20060704135117] [unused import Simon Marlow **20060704134557] [remove unused bits, mostly to do with the Addr type Simon Marlow **20060704124912] [In interface files, store FastStrings rather than OccNames where possible Simon Marlow **20060724154826 In all cases the namespace is known from the context, so this saves 1 byte per variable binding/occurrence (a few percent per iface file). ] [Add -fmono-pat-binds, and make it the default simonpj@microsoft.com**20060722102245 In Haskell 98, pattern bindings are generalised. Thus in (f,g) = (\x->x, \y->y) both f and g will get polymorphic types. I have become convinced that generalisation for pattern-bound variables is just a bridge toof far. It is (I claim) almost never needed, and it adds significant complication. (All the more so if we add bang patterns.) So the flag -fmono-pat-binds switches off generalisation for pattern bindings. (A single variable is treated as a degnerate funtction binding.) Furthremore, as an experiment, I'm making it the default. I want to see how many progarms fail with monomorphic pattern bindings. You can recover the standard behaviour with -fno-mono-pa-binds. ] [Fix RULES lossage simonpj@microsoft.com**20060722101756 Don Stewart and Duncan Coutts encountered the following situation. f = {-# RULES f ... #-} where f is not exported, but appears in the inlinings of other functions that are exported. Then what happened was that the desugarer produced this: M.f = f f = where the rules get attached to the M.f. But since M.f's RHS is trivial (just f) it was unconditionally inlinined at all its call sites, thereby losing the RULES attached to it. This *is* a fragile aspect of rules. However this fix solves the problem by instead generating f = M.f M.f = A pretty small chanage to the desugarer does the job. It still feels a little fragile, bt it's certainly more robust than before. ] [Fix broken regex Simon Marlow **20060721111144 Don't know how I managed to use this before... maybe a different regex library. ] [fix bug in sample code Simon Marlow **20060721083200] [fix eran error message by reordering a couple of tests simonmar@microsoft.com**20060719111638] [Use a recursive error handler in case the exception causes more exceptions. Lemmih **20060717232553] [Check for overlap-flag differences in hi files simonpj@microsoft.com**20060714163843 MERGE TO STABLE I'd forgotten to compare the per-instance overlap flag when comparing interface files, and that meant that consequential recompilations weren't being triggered when the only change was to add -fallow-overlapping-instances Fixes Trac bug #824 ] [Add a clarification about overlapping instances in the manual simonpj@microsoft.com**20060714143220] [Comments and import trimming simonpj@microsoft.com**20060712153306] [Experimental flag -fdicts-cheap simonpj@microsoft.com**20060712153204 This experimental flag, -fdicts-cheap, makes a let-binding that bind a value of dictionary type look cheap. That in turn leads to more eta expansion. Instead of f = /\a. \(d1:Ord a). let d2:Ord [a] = dfOrd a d1 in \(x:a). which has arity 1, you get f = /\a. \(d1:Ord a). \(x:a). let d2:Ord [a] = dfOrd a d1 in Now f has arity 2. This can cretainly waste dictionary-construction work, if f is partially applied to its dictionary argument. However it has knock-on effects. Because f has arity 2, we won't float (f Int d) out of \x. h (f Int d) Floating f out of this lambda makes it impossible for an h/f fusion rule to fire; and this unexpected loss of RULE application was the immediate reason for implementing this flag. (Roman Leshchinskiy came across this when working on array fusion.) I've implemented the change only in CoreUtils.arityType, which only affects eta expansion. I thought of putting the change in exprIsCheap, which is a more systematic place (the former calls the latter) but a) I wanted this under flag control, and the flags are not readily available to all callers of exprIsCheap b) I'm not 100% convinced that this change is a good idea, so it's reasonable to do the narrowest change that solves the immediate problem. ] [document that -fglasgow-exts is needed for RULES to work Malcolm.Wallace@cs.york.ac.uk**20060712093907] [do a better job of ignoring unrecognised pragmas Simon Marlow **20060712083550] [Don't z-encode module names in external-core output Jan Rochel **20060706131109] [re-add -fvia-C Simon Marlow **20060710081522 There are still some fixes required to get the threaded RTS compilable with the NCG, and apparently there are problems on 32-bit archs too. ] [Be lazier in user config creation, and don't fail on missing configs. Ian Lynagh **20060624230800] [Z-Encode external-core output Jan Rochel **20060702214438 HEAD doesn't z-encode external-core output (unlike 6.4). I suppose, that this is unwanted behaviour. It probably results from this patch: ======================================================================== Fri Jan 6 17:30:19 CET 2006 simonmar * [project @ 2006-01-06 16:30:17 by simonmar] Add support for UTF-8 source files [...] Z-encoding has been moved right to the back end. Previously we used to Z-encode every identifier on the way in for simplicity, and only decode when we needed to show something to the user. Instead, we now keep every string in its UTF-8 encoding, and Z-encode right before printing it out. [...] ======================================================================== Greetings Jan ] [Add %local-tag to external core output Jan Rochel **20060702204559 Hello, this is my first patch contributed to GHC. If there are any inadequacies about it (maybe like this introductory disclaimer), please let me know about it. So, the need for this patch arose, while I was involved with processing hcr files (external core output) and I noticed, that the output didn't fully conform to the specification [1]. No %local-tags were used, which turned out to be a real nuisance as it was not possible to determine which VDEFs can be erased in a further optimization process and which ones are exported by the module. Since the specification does not define the meaning of the %local-tag, I assume, it makes sense, that it tags all functions, that are not exported by the module. The patch does not fully comply to the specification, as in my implementation a local tag may appear before a VDEF but not before a VDEFG. [1] An External Representation for the GHC Core Language (DRAFT for GHC5.02), page 3, line 1 Greetings Jan ] [Remove bashisms from darcs-all Alec Berryman **20060703012911 darcs-all may now be run with any POSIX-compatible /bin/sh. ] [Fix for warning message (bug #812) Duncan Coutts **20060704163413 say "{-# SOURCE #-}" rather than "{- SOURCE -}" in warning message. Fixes http://hackage.haskell.org/trac/ghc/ticket/812 ] [The dict-bindings in an IPBinds need not be in dependency order simonpj@microsoft.com**20060703151517 This appears to be a long-standing bug, discovered by BlueSpec (ravi@bluespec.com), Trac bug #795 The problem was that in an IP binding group, the dict bindings aren't necessarily in dependency order; and if they aren't we get a core-lint error. Test tc203 checks this case. (Though whether it shows up at all depends a bit on accidental factors of binding ordering.) ] [x86 needs -fno-unit-at-a-time too Simon Marlow **20060704083308 Fixes #809 ] [x86-64: fix a problem exposed by negative offsets in vector tables Simon Marlow **20060629140608 static relative offsets (eg .long l1-l2) are restricted to 32 bits on x86-64 due to lack of support in the linker. The codegen, NCG and runtime work around this, using 32-bit offsets instead of 64. However, we were missing a workaround for vector tables, and it happened to work by accident because the offsets were always positive and resolved by the assembler. The bug was exposed by using the NCG to compile the RTS, where the offsets became negative, again by accident. ] [No longer force -fvia-C for the RTS, it can now be compiled with the NCG Simon Marlow **20060629135836] [Replace inline C functions with C-- macros in .cmm code Simon Marlow **20060629134726 So that we can build the RTS with the NCG. ] [remove conditionals from definition of StgRegTable Simon Marlow **20060629134405 so that we can calculate deterministic offsets to some of the fields of Capability. ] [mpz_foo() functions are really called __gmpz_foo() in GMP Simon Marlow **20060629122217 gmp.h #defines mpz_foo to __gmpz_foo, so the real ABI is __gmpz_foo, so that is what we must invoke in order to be portable here. Similarly for mpn --> __gmpn. ] [use the new "prim %write_barrier()" in .cmm instead of calls to wb() Simon Marlow **20060629120526] [fix some problems with the fixup block code Simon Marlow **20060629120210 We weren't handling InBoth properly. InBoth needs to be expanded to appropriate InReg/InMem locations *before* building the interference graph, otherwise an InBoth will not be seen to conflict with other InReg/InMem locations. ] [small optimisation: eliminate more register-to-register moves Simon Marlow **20060629120029] [new syntax: "prim %OP (args)" for using CallishMachOps in .cmm Simon Marlow **20060629115949 ] [add MO_WriteBarrier to CallishMachOps Simon Marlow **20060629115837 This will let us express write barriers in C-- ] [Use -fno-strict-aliasing for *all* C files in the runtime Simon Marlow **20060629082902 as a precautionary measure. It is definitely required for GC.c, but it may well become necessary for other files in the future due to our (mis-)use of the C "type system". ] [the unlifted kind Simon Marlow **20060623152626] [fix a lint-o Simon Marlow **20060620151901] [fix sloppy conditionals Simon Marlow **20060620151758] [fix sloppy conditionals Simon Marlow **20060620151039] [fix a few sloppy conditionals caught by new test in CmmLint Simon Marlow **20060620150618] [flattenCgStmts: fix a case of empty code blocks being generated Simon Marlow **20060620150520] [improve a panic message Simon Marlow **20060620141219] [check that the argument to CmmCondBranch is really a conditional Simon Marlow **20060620141204] [Generate a new unique for each label Simon Marlow **20060620140106] [Remove long-redundant FieldLabel.lhs simonpj@microsoft.com**20060629105321] [Add comments to SpecConstr simonpj@microsoft.com**20060627161520] [fix up slop-overwriting for THUNK_SELECTORS in DEBUG mode Simon Marlow **20060627123951] [Make SpecConstr work better for nested functions simonpj@microsoft.com**20060627094742 In SpecConstr.scBind, we should pass the optimised body (body') to specialise, not the un-optimised one. In this way we'll benefit from specialising any nested functions inside body. Discovered by Roman. ] [More SpecConstr tuning simonpj@microsoft.com**20060626201709 For some reason, SpecConstr wasn't taking account of let-bound constructors: let v = Just 4 in ...(f v)... Now it does. An easy fix fortunately. ] [Improve consistency checking for derived instances simonpj@microsoft.com**20060626100034 This patch arranges that derived instances use the same instance-decl checking code as user-defined instances. That gives greater consistency in error messages. Furthermore, the error description if this consistency check fails is now much more explicit. For example, drvfail003 now says Variable occurs more often in a constraint than in the instance head in the constraint: Show (v (v a)) (Use -fallow-undecidable-instances to permit this) In the derived instance instance (Show (v (v a))) => Show (Square_ v w a) ] [Slight improvement in TH error reporting simonpj@microsoft.com**20060626095952] [Improve location info when typechecking interface fiels simonpj@microsoft.com**20060614114813] [Fix a bug in the pretty printing of class declarations davve@dtek.chalmers.se**20060625160826] [Improve RULE matching a bit more simonpj@microsoft.com**20060624160421 Consider this example (provided by Roman) foo :: Int -> Maybe Int -> Int foo 0 (Just n) = n foo m (Just n) = foo (m-n) (Just n) SpecConstr sees this fragment: case w_smT of wild_Xf [Just A] { Data.Maybe.Nothing -> lvl_smf; Data.Maybe.Just n_acT [Just S(L)] -> case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] -> $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf }}; and correctly generates the rule RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int# sc_snn :: GHC.Prim.Int#} $wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr)) = $s$wfoo_sno y_amr sc_snn ;] BUT we must ensure that this rule matches in the original function! Note that the call to $wfoo is $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf During matching we expand wild_Xf to (Just n_acT). But then we must also expand n_acT to (I# y_amr). And we can only do that if we look up n_acT in the in-scope set, because in wild_Xf's unfolding it won't have an unfolding at all. Happily, fixing the bug is easy: add a call to 'lookupRnInScope' in the (Var v2) case of 'match'. ] [--enable-src-tree-haddock and friends are no longer required Simon Marlow **20060623113303 Happy, Alex and Haddock are built separately using Cabal now. ] [fix a couple of bugs in markSparkQueue (#799) Simon Marlow **20060623092044] [pull in STABLE(!) tweaks sof@galois.com**20060622202734] [fix for when path to GHC contains spaces, from #695 Simon Marlow **20060622131700] [Comment only simonpj@microsoft.com**20060621223940] [Transfer INLINE to specialised functions simonpj@microsoft.com**20060621223637 When the Specialise pass generates a specialised copy of a function, it should transfer the INLINE information to the specialised function. Otherwise, whether or not the INLNE happens can depend on whether specialisation happens, which seems wrong. See Note [Inline specialisation] in Specialise.lhs Here's the example Roman reported primWriteMU :: UAE e => MUArr e s -> Int -> e -> ST s () {-# INLINE primWriteMU #-} primWriteMU = writeMBU . unMUAPrim ------ The problem is that primWriteMU doesn't get inlined *sometimes*, which results in code like case Data.Array.Parallel.Unlifted.Flat.UArr.$sprimWriteMU @ s11_X1nJ marr_s25s (GHC.Base.I# sc_s27F) GHC.Base.False new_s_a1Db of wild3_a1Dd { (# new_s1_X1F9, r_a1Dc #) -> ... Note the fact that we have a call to the *specialised* $sprimWriteMU. ] [Arity and eta-expansion tuning simonpj@microsoft.com**20060621205855 Roman found that loop :: STRef s a -> Int -> ST s Int loop ref n = case n of 0 -> return n n -> loop ref (n-1) wasn't eta-expanding nicely, despite the 'state hack' (see Id.isStateHackType). The reason was two-fold: a) a bug in CoreUtils.arityType (the Var case) b) the arity of a recursive function was not being exposed in its RHS (see commments with SimplEnv.addLetIdInfo The commit fixes both. ] [documentation for TH w/ profiling Simon Marlow **20060621112523] [Allow Template Haskell to be used with -prof Simon Marlow **20060621110436 In order for this to work, you need to build the program first in the normal way (without -prof), and then again with -prof and a suitable -osuf (eg. -osuf p_o). The compiler will pick up the object files from the normal way for running TH expressions, when it sees -prof together with -osuf. If you omit the -osuf, you get an error message: TH_genEx.hs:12:2: Dynamic linking required, but this is a non-standard build (eg. prof). You need to build the program twice: once the normal way, and then in the desired way using -osuf to set the object file suffix. If you use -osuf, but haven't built the program the normal way first, then you see: TH_genEx.hs:12:2: cannot find normal object file `TH_genExLib.o' while linking an interpreted expression Documentation to follow. Fixes: #651 ] [add decl for stg_block_throwto_ret Simon Marlow **20060620083410] [comment out a non-true assertion Simon Marlow **20060616140750] [make compilation a little less noisy Simon Marlow **20060616140652] [allow the max number of workers to scale with +RTS -N Simon Marlow **20060616140633] [fix one-character error in stack check Simon Marlow **20060616135621] [add STM support to the new throwTo mechanism Simon Marlow **20060616111937] [remove duplicate way names (-debug -debug didn't work) Simon Marlow **20060616110258] [Asynchronous exception support for SMP Simon Marlow **20060616103342 This patch makes throwTo work with -threaded, and also refactors large parts of the concurrency support in the RTS to clean things up. We have some new files: RaiseAsync.{c,h} asynchronous exception support Threads.{c,h} general threading-related utils Some of the contents of these new files used to be in Schedule.c, which is smaller and cleaner as a result of the split. Asynchronous exception support in the presence of multiple running Haskell threads is rather tricky. In fact, to my annoyance there are still one or two bugs to track down, but the majority of the tests run now. ] [make rmp_tmp_w an StgWord instead of StgInt Simon Marlow **20060616102311] [__compat_long_path_size(): have proto and defn agree on return type sof@galois.com**20060614164650] [call wakeUpRts() in the correct place Simon Marlow **20060614134728] [readerProc: split up text output using host's line termination convention sof@galois.com**20060613232605] [Improve pretty-printing for bags simonpj@microsoft.com**20060612114020] [Make scoped type variables work for default methods simonpj@microsoft.com**20060612113855 Consider class C a where op :: forall b. a -> b -> b op = Then 'b' should be in scope in . I had omitted this case. This patch fixes it. ] [And move 'Chasing ...' messages into verbosity 2 as well Don Stewart **20060612084656] [Emit 'linking not required' messages only with -v 2 or above. Don Stewart **20060611071041 Similar in philosophy to the 'Skipping' patch, this is another case of printing noisy messages when no work is being done. This patch makes the building-when-nothing-to-do case smoother. ] [Don't emit 'Skipping' messages unless -v2 or higher is on Don Stewart **20060610145713 Following GNU make, this patch makes GHC not emit messages about modules its skipping. This makes builds much quieter, and its a lot easier to work out what effects a change had on the code. The current behaviour can be recovered with -v2 ] [fix the stage3 build Simon Marlow **20060612084114] [oops, undo accidental commit of version number Simon Marlow **20060612083520] [Move readline configuration into the readline package Simon Marlow **20060609135840] [fix possible ^C problems Simon Marlow **20060608144457 Calling prodAllCapabilities() from interruptStgRts() was wrong, for the same reasons that we stopped doing it in handle_tick(). We now use the same mechanism (send a byte down the pipe to the IO manager thread), but abstract it in a wakeUpRts() function in the scheduler. ] [New tracing interface Simon Marlow **20060608144210 A simple interface for generating trace messages with timestamps and thread IDs attached to them. Most debugging output goes through this interface now, so it is straightforward to get timestamped debugging traces with +RTS -vt. Also, we plan to use this to generate parallelism profiles from the trace output. ] [fix warnings Simon Marlow **20060608143635] [fix warnings Simon Marlow **20060608143520] [Make it so that StgWord/StgInt are longs Simon Marlow **20060608143438 This means we can use a %ld format specifier for StgWord/StgInt with printf and not get shouted at by gcc. ] [more warning fixage Simon Marlow **20060608142844] [fix a warning Simon Marlow **20060608141903] [fix some warnings Simon Marlow **20060608140201] [Add new RTS flags for tracing: Simon Marlow **20060608130101 -vs Trace scheduler events (see also -Ds with -debug) -vt Time-stamp trace messages the intention is that we will pipe the -vs output into a profile-generating tool. This commit includes the flags only, functionality to follow. ] [codegen debug flag (+RTS -Dc) was unused; remove it Simon Marlow **20060607145848] [add 'const' modifiers to types where appropriate Simon Marlow **20060607145800] [rearrange casts to avoid gcc warnings Simon Marlow **20060607145626] [warning fix Simon Marlow **20060607141013] [remove //@ stuff Simon Marlow **20060607134553] [Gather timing stats for a Task when it completes. Simon Marlow **20060607124407 Previously we did this just for workers, now we do it for the main thread and for forkOS threads too. ] [Remove unnecessary SCHED_INTERRUPTED scheduler state Simon Marlow **20060607115105 ] [fix a warning Simon Marlow **20060427130048] [re-enable time package on Windows simonmar@microsoft.com**20060606124656] [fix a case of "naughty I386 byte reg" Simon Marlow **20060606112357 The fix is a little hacky, because we don't have support for register classes in general, but it's an improvement. ] [A better icon for GHCi Neil Mitchell **20060602145913] [markSignalHandlers(): implementation was unnecessary, and had a bug simonmar@microsoft.com**20060606085805 There's no need to mark the signal handler here, because it is stored in a StablePtr and hence is a root anyway. Furthermore, the call to evac() was passing the address of a local variable, which turned out to be harmless for copying GC, but fatal for compacting GC: compacting GC assumes that the addresses of the roots are the same each time. Fixes: possibly #783, possibly #776, definitely #787 ] [disable time package on mingw to unblock builds. sof@galois.com**20060605165125] [Remove one more IfaceInlineCall simonpj@microsoft.com**20060605154305] [Remove InlinePlease and add inline function and RULE simonpj@microsoft.com**20060605114900 For a long time GHC has had some internal mechanism designed to support a call-site inline directive, thus inline f xs makes f be inlined at the call site even if f is big. However, the surface syntax seems to have gone, and in any case it can be done more neatly using a RULE. This commit: * Removes the InlineCall constructor for Note and InlinePlease for SimplCont * Adds a new known-key Id called 'inline', whose definition in GHC.Base is just the identity function * Adds a built-in RULE in PrelRules that rewrites (inline f) to the body of f, if possible * Adds documentation NOTE: I have not tested this (aeroplane work). Give it a try! ] [Fix typo simonpj@microsoft.com**20060605114719] [fix type of allocateExec Simon Marlow **20060601125406] [stgMallocBytesRWX --> allocateExec Simon Marlow **20060601123314] [fix non-Windows build Simon Marlow **20060601121435] [Win32: set up the console code pages simonmar@microsoft.com**20060601115423 This may help with entering non-ASCII characters at the GHCi prompt, but as usual with Unicode there's no simple solution that just works. See commentary in InteractiveUI.hs for more details. ] [add a type signature simonmar@microsoft.com**20060601115335] [improvements to lexical error reporting simonmar@microsoft.com**20060601115306] [commented-out debugging code simonmar@microsoft.com**20060601115247] [understand Latin-1 symbols simonmar@microsoft.com**20060601115149] [stgMallocBytesRWX --> allocateExec Simon Marlow **20060531091202 Not sure how I left this out of the previous patch, oh well. ] ['time' depends on 'Win32' when Windows=YES; mirror that sof@galois.com**20060530223009 when setting up SUBDIRS. ] [Win32: add _imp__tzname simonmar@microsoft.com**20060530101452] [fix Win32 build simonmar@microsoft.com**20060530101418] [replace stgMallocBytesRWX() with our own allocator Simon Marlow **20060530100211 See bug #738 Allocating executable memory is getting more difficult these days. In particular, the default SELinux policy on Fedora Core 5 disallows making the heap (i.e. malloc()'d memory) executable, although it does apparently allow mmap()'ing anonymous executable memory by default. Previously, stgMallocBytesRWX() used malloc() underneath, and then tried to make the page holding the memory executable. This was rather hacky and fails with Fedora Core 5. This patch adds a mini-allocator for executable memory, based on the block allocator. We grab page-sized blocks and make them executable, then allocate small objects from the page. There's a simple free function, that will free whole pages back to the system when they are empty. ] [add time subdir Simon Marlow **20060530070721] [Make rule-matching robust to lets simonpj@microsoft.com**20060525154447 Consider a RULE like forall arr. splitD (joinD arr) = arr Until now, this rule would not match code of form splitD (let { d = ... } in joinD (...d...)) because the 'let' got in the way. This patch makes the rule-matcher robust to lets. See comments with the Let case of Rules.match. This improvement is highly desirable in the fusion rules for NDP stuff that Roman is working on, where we are doing fusion of *overloaded* functions (which may look lazy). The let expression that Roman tripped up on was a dictioary binding. ] [Improve error reporting in interface typechecking simonpj@microsoft.com**20060525094545] [Fix egregious and long-standing tidying bug simonpj@microsoft.com**20060525094300 A typo in tidyAlt meant that we could get shadowing of occurrence names in the output of tidying. (Specifically, of existentially bound type variables.) That in turn meant that an IfaceExpr could have shadowing, so when the IfaceExpr was read in, it meant something different. That in turn led to an obscure crash like: Panic: tcIfaceTyVar Anyway, this fixes it. MERGE into 6.4.3. ] [Prune imports simonpj@microsoft.com**20060525094251] [performGC_(): don't use the existing Task, always grab a new one Simon Marlow **20060525090035] [Better control of the IO manager thread; improvements to deadlock checking Simon Marlow **20060524122839 In the threaded RTS on *nix platforms: - we now start the IO manager thread eagerly at startup time (previously was started on demand). - we now ask the IO manager thread to stop at shutdown - In Timer.c:handle_tick, if it looks like we might be in a deadlock, instead of calling prodOneCapability() which was known to be wrong, we now send a byte down the IO manager's pipe to wake it up. This also avoids a case of double-acquisition of a mutex, which happened if prodOneCapability() was called while the current thread was holding a mutex. ] [TARGET_OS ==> HOST_OS Simon Marlow **20060524122103] [fix a _TARGET_ARCH that should be _HOST_ARCH Simon Marlow **20060524122022] [we don't need OutOfHeapHook(), and the version in the RTS has a better message Simon Marlow **20060524112007] [Bug-fix to patch "Run simplifier before SpecConstr" simonpj@microsoft.com**20060523130022] [Run simplifier before SpecConstr simonpj@microsoft.com**20060523085546 Arrange to run the simplifier before SpecConstr, to (almost entirely) eliminate shadowing. Reason: otherwise SpecConstr can generate a RULE that never files; and LiberateCase specifically *does* generate lots of shadowing. See Note [Shadowing] in SpecConstr.lhs ] [Prune imports simonpj@microsoft.com**20060522192532] [Add deShadowBinds simonpj@microsoft.com**20060522192404 Add CoreSubst.deShadowBinds, which removes shadowing from a Core term. I thought we wanted it for SpecConstr, but in fact decided not to use it. Nevertheless, it's a useful sort of function to have around, and it has a particularly simple definition! ] [Inline in a call argument if the caller has RULES simonpj@microsoft.com**20060522163255 This is an experimental change suggested by Roman. Consider {-# INLINE f #-} f x y = ... ....(g (f a b))... where g has RULES. Then we'd like to inline f, even though the context of the call is otherwise 100% boring -- g is lazy and we know nothing about x and y. This patch just records in the continuation that f has rules. And does so somewhat recursively...e.g. ...(g (h (f a b)))... where g has rules. ] [Add idHasRules simonpj@microsoft.com**20060522163109 Add Id.idHasRules :: Id -> Bool, with the obvious semantics. This patch makes sense by itself, but it's just a tidy-up. ] [Transmit inline pragmas faithfully simonpj@microsoft.com**20060522110256 *** WARNING: you will need to recompile your libraries *** when you pull this patch (make clean; make) The inline pragma on wrapper-functions was being lost; this patch makes it be transmitted faithfully. The reason is that we don't write the full inlining for a wrapper into an interface file, because it's generated algorithmically from its strictness info. But previously the inline pragma as being written out only when we wrote out an unfolding, and hence it was lost for a wrapper. This makes a particular difference when a function has a NOINLINE[k] pragma. Then it may be w/w'd, and we must retain the pragma. It's the only consistent thing to do really. The change does change the binary format of interface files, slightly. So you need to recompile all your libraries. ] [Improved RULE lhs typechecking; less dictionary sharing simonpj@microsoft.com**20060519103433 See long comment with Simplify.tcSimplifyRuleLhs. Here's the key example: RULE "g" forall x y z. g (x == y) (y == z) = ... Here, the two dictionaries are *identical*, but we do NOT WANT to generate the rule RULE forall x::a, y::a, z::a, d1::Eq a f ((==) d1 x y) ((>) d1 y z) = ... Instead we want RULE forall x::a, y::a, z::a, d1::Eq a, d2:Eq a f ((==) d1 x y) ((>) d2 y z) = ... ] [Bug-fix for infix function definitions (parse/rename) simonpj@microsoft.com**20060519095022 Fix a crash provoked by x `op` y = x op = True The trouble was that there is currently a single 'infix' flag for the whole group; and RnTypes.checkPrecMatch was therefore expecting the second eqn to have two args. This fixes the crash, and also or-s the infix flags for the various eqns together; previously it was just taken from the first eqn, which was wrong. ] [Remove misleading comments simonpj@microsoft.com**20060519094936] [Fix a nasty continuation-duplication bug simonpj@microsoft.com**20060518163617 For a long-time mkDupableCont has had a bug that allows it to duplicate an arbitrary continuation, which it should not do, of course. The bug was that in the Select case of mkDupableCont we were calling prepareCaseCont, which did not duplicate the continuation if there is but a single alternative. This is quite right in the case of the call in rebuildCase, but quite wrong in mkDupableCont. The bug manifest as follows. In the expression f (case ... of { ..several alts.. }) (when f is strict), we should transform to f (...transformed arg...) The application of f should not be pushed down (see notes with the ArgOf case of mkDupableCont. But that was not happening in an example like this (see how the call to f is pushed inwards). f (a `div` abs (b::Int)) ---> case b_afT of wild_aHa { GHC.Base.I# x_aHc -> let { $j_sIe :: GHC.Prim.Int# -> GHC.Base.Int [] $j_sIe = \ (ds1_aHr [Nothing OneShot] :: GHC.Prim.Int#) -> Foo7.f (case ds1_aHr of ds2_aHq { __DEFAULT -> case a_afS of wild1_aHM { GHC.Base.I# x_aHO -> GHC.Base.I# (GHC.Base.divInt# x_aHO ds2_aHq) }; 0 -> GHC.Err.divZeroError @ GHC.Base.Int }) } in case GHC.Prim.>=# x_aHc 0 of wild1_aHe [Dead Nothing] { GHC.Base.False -> let { ds1_aHr :: GHC.Prim.Int# [] ds1_aHr = GHC.Prim.negateInt# x_aHc } in $j_sIe ds1_aHr; GHC.Base.True -> $j_sIe x_aHc } } ] [Make simplifier report which phase it is doing in -ddump output simonpj@microsoft.com**20060518163448] [Comments only simonpj@microsoft.com**20060518163425] [take parsec out of $(GhcBootLibs) Simon Marlow **20060518131506] [Improve documentation of INLINE pragmas simonpj@microsoft.com**20060518113212] [a couple of additions Simon Marlow **20060518104025] [#define _REENTRANT 1 (needed to get the right errno on some OSs) Simon Marlow **20060518103715 Partial fix for hanging problems on Solaris and possibly *BSD. A similar fix is also required to libraries/base/includes/HsBase.h. ] [Declare this file to be POSIX Simon Marlow **20060518102858 This is simpler than using _POSIX_THREAD_SEMANTICS on Solaris to get the right version of ctime_r(). ] [somewhere to keep track of release notes for 6.6 Simon Marlow **20060518074415] [Newtype data constructors get a compulsory unfolding simonpj@microsoft.com**20060517155009 With this change, newtype data constructors get a "compulsory" unfolding, which means that they *must* be inlined, and no top-level definition of the constructor is provided at all. Since these constructors are no-ops, I'm not sure why this wasn't the case all along. ] [White space only simonpj@microsoft.com**20060517154936] [Retain InlinePragInfo on wrappers simonpj@microsoft.com**20060517154725 For some reason, when doing the worker/wrapper split, we transferred the InlinePragInfo from the original function, but expunging it from the wrapper. This meant, for example, that a NOINLINE function would have its wrapper inlined, which isn't sensible. For a change, fixing a bug involves only deleting code! ] [Spelling correction simonpj@microsoft.com**20060517154710] [Retain INLINE pragma information during indirection-shorting simonpj@microsoft.com**20060517154449 During indirection-shorting, we were dropping the InlinePragInfo, although were were carefully retaining strictness info etc. I think this is a long-standing bug. ] [Improve pretty-printing simonpj@microsoft.com**20060517154349] [Comments only simonpj@microsoft.com**20060517154304] [Improve pretty-printing slightly simonpj@microsoft.com**20060517154204] [Let GHCi work with with Sparc32+/V8+ .o files Duncan Coutts **20060516090430 Currently the GHCi linker looks exclusively for V7 ABI .o files. You can generate V8+ ABI .o files using flags to gcc such as: -optc-mcpu=ultrasparc -opta-mcpu=ultrasparc Note that this allows gcc to generate hardware integer division and hardware floating point instructions rather than using software emulation. All recent sparc hardware is V8+ or later. Perhaps we should check for the cpu generation in configure and use the later ABI if possible. Tested briefly on a SunBlade 100 (TI UltraSparc IIe) sparc-unknown-linux ] [match up more closely with compiler/main/DynFlags.hs:machdepCCOpts Simon Marlow **20060515090031 In particular, add -fno-builtin to x86 and x86_64, which was missing. ] [set $(GhcVersion) and $(GhcPatchLevel) correctly when $(UseStage1)==YES Simon Marlow **20060510124621] [.raw_s and .s live in $(odir), not the source dir Simon Marlow **20060510121524] [additions from Reilly Hayes Simon Marlow **20060510120000] [some tweaks to the HC bootstrapping instructions Simon Marlow **20060510115236] [Ignore unboxed values in breakpoints. Lemmih **20060510072722] [Don't read ~/.ghci on breakpoints. Lemmih **20060509223455] [make it possible to define an alias for :quit Simon Marlow **20060509083124] [Do not put wired-in things in interface files simonpj@microsoft.com**20060508142946 There is no need for wired-in things to go into interface files; the compiler knows about them anyway. Worse, it turns ou that if they are in an interface file, they may get read in with not-quite-right type info (e.g. GHC.Err.error), and the not-quite-right thing gets into the type envt. Than it gets used instead of the wired in thing. Best all round never to put them into interface files. This is the way it used to be, but it looks as if it rotted away some time ago. (I noticed this when fixing unsafePerformIO stuff, becuase 'lazy' was getting an unfolding when it shouldn't.) ] [Remove NOINLINE strictness hack simonpj@microsoft.com**20060508142834 The stricteness analyser used to have a HACK which ensured that NOINLNE things were not strictness-analysed. The reason was unsafePerformIO. Left to itself, the strictness analyser would discover this strictness for unsafePerformIO: unsafePerformIO: C(U(AV)) But then consider this sub-expression unsafePerformIO (\s -> let r = f x in case writeIORef v r s of (# s1, _ #) -> (# s1, r #) The strictness analyser will now find that r is sure to be eval'd, and may then hoist it out. This makes tests/lib/should_run/memo002 deadlock. Solving this by making all NOINLINE things have no strictness info is overkill. In particular, it's overkill for runST, which is perfectly respectable. Consider f x = runST (return x) This should be strict in x. So the new plan is to define unsafePerformIO using the 'lazy' combinator: unsafePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r) Remember, 'lazy' is a wired-in identity-function Id, of type a->a, which is magically NON-STRICT, and is inlined after strictness analysis. So unsafePerformIO will look non-strict, and that's what we want. Now we don't need the hack in the strictness analyser. ] [Trim imports simonpj@microsoft.com**20060508141804] [Trim imports simonpj@microsoft.com**20060508141713] [GHC_MANGLER-->MANGLER Simon Marlow **20060508111206] [Fix bug #763: Breakpoint mechanism crashes when there's a type error. Lemmih **20060505232158] [breakpointCond Lemmih **20060502174340] [Preserve type variable names during type inference simonpj@microsoft.com**20060505153753 During unification we attempt to preserve the print-names of type variables, so that type error messages tend to mention type variables using the programmer's vocabulary. This had bit-rotted a bit when I added impredicative polymorphism; especially when unBoxing a boxy type variable we should not gratuitously lose its name. ] [Trim imports simonpj@microsoft.com**20060505150506] [fixup for new source tree layout Simon Marlow **20060505114100] [FPTOOLS_TOP-->GHC_TOP, and remove some references to "fptools" Simon Marlow **20060505110520] [$(FPTOOLS_TOP) is now known as $(GHC_TOP) Simon Marlow **20060505110127 I kept $(FPTOOLS_TOP) as an alias for $(GHC_TOP) while we switch ] [update the build system documentation Simon Marlow **20060505105843] [update for new source tree layout Simon Marlow **20060505102903] [partial update for new source tree layout Simon Marlow **20060505030218] [update for new source tree layout (untested) Simon Marlow **20060505081549] [Print a more helpful error for find_thing simonpj@microsoft.com**20060504153337] [Fix a bug in rule matching simonpj@microsoft.com**20060504112430 The rule matcher uses a "rough-match" pre-filter, which was being too aggressive. The case looked like this: rule: f True expr: case e of x { True -> f x } Jues because x doesn't immediately look like True, we shouldn't say "can't match", but that is exactly what ruleCantMatch was doing. ] [Fix constructor-specialisation bug simonpj@microsoft.com**20060504112131 The constructor-specialisation optimisation was not dealing with the case of (letrec ... in f) a1 a2 We need to apply constructor specialisation in the letrec; previously we were leaving it untouched on the grounds that the function part of an application is almost always a variable. But in fact, float-in immediately precedes SpecConstr, so we can get these odd-looking applications. ] [Fix precedence for records in derived Read simonpj@microsoft.com**20060504111804 The derived instance for Read of records wasn't quite right. Consider data T = T1 T | T2 { x::Int } The string "T1 T2 { x=2 }" should parse correctly as T1 (T2 {x=2}) because of Haskell's odd precedence rules (record construction binds even more tightly than application), but the derived Read didn't take account of that. drvrun020 is the regression test ] [Make rules available in RHS simonpj@microsoft.com**20060504111500 After some earlier re-factoring, the code that was carefully trying to make RULES available in a function's own RHS was plain wrong. This commit fixes it. Some programs should go faster! ] [Pretty printing instance for Unfolding simonpj@microsoft.com**20060504111429] [small clarification Simon Marlow **20060504103414] [small fix to booting instructions from #762 Simon Marlow **20060504083104] [$(ProjectNameShort) => ghc Simon Marlow **20060503102419] [only pass -fno-unit-at-a-time to gcc if it is supported Simon Marlow **20060503093614] [Arrange that -fth is no longer implied by -fglasgow-exts simonpj@microsoft.com**20060426182114 Messages involving Template Haskell are deeply puzzling if you don't know about TH, so it seems better to make -fth an explicit flag. It is no longer switched on by -fglasgow-exts. ] [remove code not required in the new source tree layout Simon Marlow **20060502114235] [move "compat" earlier in the build for .hc bootstrapping Simon Marlow **20060502112001] [fix ctime_r problem on Solaris (I hope) Simon Marlow **20060502111231] [fix whitespace problem that shows up on Solaris (x86) Simon Marlow **20060502110001] [libraries/time is boring Simon Marlow **20060502105524] [add time package to libraries Makefile Ashley Yakeley **20060501092241] [add time package to default-packages Ashley Yakeley **20060426070445] [Fix stage2 segfault on openbsd. dons@cse.unsw.edu.au**20060428074811 Somewhere along the 6.5 branch, gcc started compiling the rts such that it triggers the stack smash handler, causing stage2 to by kill'd immediately. This turns off the stack protector, which will do for now. ] [fix quoting around ${FPTOOLS_TOP_ABS} (fixes #749) Simon Marlow **20060428085252] [Fix bug shown in the mod77 test. Lemmih **20060427113313] [Don't init root pointers if they aren't gonna be used. Lemmih **20060426111143] [Fix recompilation checking. Simon Marlow **20060425140932 One-shot compilation was throwing away the old iface read by checkOldIface, with the result that version numbers were never being incremented. Fixes the recomp001 test too. ] [Solaris needs -lrt for the threaded RTS Simon Marlow **20060425082823] [fix problem with binary-dist docs Simon Marlow **20060424090159] [Enable breakpoint support. Lemmih **20060421113112] [Fixing some lexer errors with extcore Josef Svenningsson **20060420222625] [Extcore can now handle data types without constructors Josef Svenningsson **20060420213622] [Comments only Josef Svenningsson **20060420213555] [Resurrect ProjectName sven.panne@aedion.de**20060421085125] [Remove the section on platform support, link to the wiki page Simon Marlow **20060420125555 The section in the building guide was becoming out of date, a wiki page is much more likely to be kept fresh. ] [Fix workaround for a GHC 6.4 bug rl@cse.unsw.edu.au**20060420044223] [hslibs is dead, Jim... sven.panne@aedion.de**20060419144609] [Synched .spec file with reality sven.panne@aedion.de**20060419143138] [Add .spec file to source distribution sven.panne@aedion.de**20060419103725] [remove paragraph about mutable objects that doesn't apply now Simon Marlow **20060419082038] [HsBool should be HsInt, not StgBool Simon Marlow **20060418144214 StgBool is mapped to C's int type. GHC doesn't currently know the size of a C int on the target arch, it's easier to use StgInt instead. I guess nobody ever uses Bool arguments to foreign imports/exports. ] [handle Bool arg to foreign import "wrapper" Simon Marlow **20060418143936 Fixes #746 ] [update commentry for foreign import "wrapper" handling Simon Marlow **20060418143714] [remove vestiges of ByteArray and MutableByteArray, which are no more Simon Marlow **20060418143641] [Comment only simonpj@microsoft.com**20060418125624] [Fix rank-validity testing simonpj@microsoft.com**20060418125350 GHC does not now do "hoisting" as it used to. Instead, it allows foralls to the right of fuction arrows, as well as to the left. But the type-validity tester hadn't caught up. This commit fixes it. The test is tc203. Incidentally, GHC still doesn't let you write forall a. Eq a => forall b. b -> b because we get a zillion reduce/reduce errors if we allow that. I'm sure it's fixable. But meanwhile you have to use an auxiliary type synonym, which is a bit stupid. ] [Make the initial rdr and type scope available in the ghc-api. Lemmih **20060418023606] [Fix minor bug in Linker.withExtendedLinkEnv Lemmih **20060418023518] [Export 'insertSymbol' and 'insertStableSymbol'. Lemmih **20060418021806 'insertStableSymbol' is used for exporting closures that are affected by the GC. ] [Allow $x, as well as $(x), at top level in TH simonpj@microsoft.com**20060414121907 Bulat pointed out that in Template Haskell $x is allowed instead of $(x) in expressions, but not at the top level of modules. This commit fixes the omission. Now you can say f x = x $h data T = T and the $h will run Template Haskell just as you'd expect. ] [Fix TH erorr recovery (test is TH_recover) simonpj@microsoft.com**20060414120411] [Comments only simonpj@microsoft.com**20060414120359] [Recover gracefully from a Template Haskell programmers error simonpj@microsoft.com**20060414115831 If a TH programmer uses a type constructor as a data constructor, GHC simply crashed. This commit makes it report the error in a graceful way. ] [Document newtype-unwrapping for IO in FFI simonpj@microsoft.com**20060414105212] [Cosmetics in SpecConstr simonpj@microsoft.com**20060412152721 SpecConstr currently uses substExpr for tiresome reasons to do with GADTs. Unfortunately the substExpr generates some WARNINGS (when DEBUG) is on, because we aren't adding all the in-scope Ids to the in-scope set of the substitution. When we move to FC these substExprs will go away, so I'm not going to worry about this now. ] [Improve pruning of case alternatives to account for GADTs simonpj@microsoft.com**20060412152327 Consider data T a where T1 :: T Int T2 :: T Bool T3 :: T Char f :: T Bool -> Int f x = case x of DEFAULT -> ... T2 -> 3 Here the DEFAULT case covers multiple constructors (T1,T3), but none of them can match a scrutinee of type (T Bool). So we can prune away the default case altogether. In implementing this, I re-factored this bit of the simplifier, elminiating prepareAlts from SimplUtils, and putting all the work into simplAlts in Simplify The proximate cause was a program written by Manuel using PArrays ] [Fix a bug in optimising division to shift right Simon Marlow **20060412144247 Division by an integral log2 can't be directly optimised to a shift right, because shift right behaves like a division that rounds to negative infinity, whereas we want one that rounds to zero. Fix this by adding (divisor-1) to the dividend when it is negative before shifting. We do this without jumps, generating very slightly worse code than gcc, which uses conditional moves on CPUs that support it. ] [Omit lndir on Windows, as it used to be simonpj@microsoft.com**20060411135334] [remove a trace Simon Marlow **20060411131531] [Allow IO to be wrapped in a newtype in foreign import/export simonpj@microsoft.com**20060411120441 Up to now, the silent unwrapping of newtypes in foreign import/export has been limited to data values. But it's useful for the IO monad itself: newtype MyIO a = MIO (IO a) foreign import foo :: Int -> MyIO Int This patch allows the IO monad to be wrapped too. This applies to foreign import "dynamic" and "wrapper", thus foreign import "wrapper" foo :: MyIO () -> HisIO (FunPtr (MyIO ())) Warning: I did on the plane, and I'm no longer sure if its 100% complete, so needs more testing. In particular the wrapper/dynamic bit. ] [Improve newtype deriving simonpj@microsoft.com**20060402215911 Ross Paterson pointed out a useful generalisation of GHC's newtype-deriving mechanism. This implements it. The idea is to allow newtype Wrap m a = Wrap (m a) deriving (Monad, Eq) where the representation type doesn't start with a type constructor. Actually GHC already *did* implement this, but the eta-ok check in TcDeriv missed a case, so there was a lurking bug. This patches fixes the documentation too. drvrun019 tests. ] [add take to the list of functions deforestable Simon Marlow **20060411090131] [avoid versionitis in Numeric.showHex (should fix tcrun007) Simon Marlow **20060411085009] [add a note about full-laziness Simon Marlow **20060410093824] [robustify the test for the top of the tree a little Simon Marlow **20060410082224] [Make darcs-all work without a ghc toplevel directory Josef Svenningsson **20060407161738] [Fix typo in darcsall warning Josef Svenningsson **20060407161335] [fix source dists Simon Marlow **20060407150045] [add a README for binary dists Simon Marlow **20060407143832] [fix binary dists Simon Marlow **20060407143822] [remove the last bits of the ghc/ subdir Simon Marlow **20060407085219] [TAG 07.04.06 Lemmih **20060407130411] Patch bundle hash: f7d1e07fbf87742d11469b9f331baa3cde93f87b