From: Simon Peyton Jones Date: Fri, 10 Jun 2011 18:54:49 +0000 (+0100) Subject: Merge branch 'master' of http://darcs.haskell.org/ghc X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=7b5b3b0cab463e108a0132435a28ef19d17cb32b;hp=0b4324456e472d15a3a124f56387486f71cb765d Merge branch 'master' of darcs.haskell.org/ghc --- diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs index e7d0acc..830c879 100644 --- a/compiler/cmm/CmmCallConv.hs +++ b/compiler/cmm/CmmCallConv.hs @@ -31,8 +31,8 @@ instance (Outputable a) => Outputable (ParamLocation a) where type ArgumentFormat a b = [(a, ParamLocation b)] --- Stack parameters are returned as word offsets. assignArguments :: (a -> CmmType) -> [a] -> ArgumentFormat a WordOff +-- Stack parameters are returned as word offsets. assignArguments _ _ = panic "assignArguments only used in dead codegen" -- assignments -- | JD: For the new stack story, I want arguments passed on the stack to manifest as @@ -40,6 +40,8 @@ assignArguments _ _ = panic "assignArguments only used in dead codegen" -- assig -- Also, I want byte offsets, not word offsets. assignArgumentsPos :: (Outputable a) => Convention -> (a -> CmmType) -> [a] -> ArgumentFormat a ByteOff +-- Given a list of arguments, and a function that tells their types, +-- return a list showing where each argument is passed assignArgumentsPos conv arg_ty reps = assignments where -- The calling conventions (CgCallConv.hs) are complicated, to say the least regs = case (reps, conv) of diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs index c9e422f..1e3f17b 100644 --- a/compiler/cmm/MkGraph.hs +++ b/compiler/cmm/MkGraph.hs @@ -290,8 +290,6 @@ stackStubExpr w = CmmLit (CmmInt 0 w) -- functions to pass the arguments in an overflow area and to pass them in spill slots. copyInOflow :: Convention -> Area -> CmmFormals -> (Int, CmmAGraph) copyInSlot :: Convention -> CmmFormals -> [CmmNode O O] -copyOutOflow :: Convention -> Transfer -> Area -> CmmActuals -> UpdFrameOffset -> - (Int, CmmAGraph) copyOutSlot :: Convention -> [LocalReg] -> [CmmNode O O] copyInOflow conv area formals = (offset, catAGraphs $ map mkMiddle nodes) @@ -333,26 +331,37 @@ oneCopySlotI _ (reg, _) (n, ms) = -- Factoring out the common parts of the copyout functions yielded something -- more complicated: +copyOutOflow :: Convention -> Transfer -> Area -> CmmActuals -> UpdFrameOffset -> + (Int, CmmAGraph) +-- Generate code to move the actual parameters into the locations +-- required by the calling convention. This includes a store for the return address. +-- -- The argument layout function ignores the pointer to the info table, so we slot that -- in here. When copying-out to a young area, we set the info table for return -- and adjust the offsets of the other parameters. -- If this is a call instruction, we adjust the offsets of the other parameters. -copyOutOflow conv transfer area@(CallArea a) actuals updfr_off = - foldr co (init_offset, emptyAGraph) args' - where co (v, RegisterParam r) (n, ms) = (n, mkAssign (CmmGlobal r) v <*> ms) - co (v, StackParam off) (n, ms) = - (max n off, mkStore (CmmStackSlot area off) v <*> ms) - (setRA, init_offset) = - case a of Young id -> id `seq` -- set RA if making a call - if transfer == Call then - ([(CmmLit (CmmBlock id), StackParam init_offset)], - widthInBytes wordWidth) - else ([], 0) - Old -> ([], updfr_off) - args = assignArgumentsPos conv cmmExprType actuals - args' = foldl adjust setRA args - where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst - adjust rst x@(_, RegisterParam _) = x : rst +copyOutOflow conv transfer area@(CallArea a) actuals updfr_off + = foldr co (init_offset, emptyAGraph) args' + where + co (v, RegisterParam r) (n, ms) = (n, mkAssign (CmmGlobal r) v <*> ms) + co (v, StackParam off) (n, ms) = (max n off, mkStore (CmmStackSlot area off) v <*> ms) + + (setRA, init_offset) = + case a of Young id -> id `seq` -- Generate a store instruction for + -- the return address if making a call + if transfer == Call then + ([(CmmLit (CmmBlock id), StackParam init_offset)], + widthInBytes wordWidth) + else ([], 0) + Old -> ([], updfr_off) + + args :: [(CmmExpr, ParamLocation ByteOff)] -- The argument and where to put it + args = assignArgumentsPos conv cmmExprType actuals + + args' = foldl adjust setRA args + where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst + adjust rst x@(_, RegisterParam _) = x : rst + copyOutOflow _ _ (RegSlot _) _ _ = panic "cannot copy arguments into a register slot" -- Args passed only in registers and stack slots; no overflow space. diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes index c0ccadf..98c2e83 100644 --- a/compiler/cmm/cmm-notes +++ b/compiler/cmm/cmm-notes @@ -1,3 +1,41 @@ +More notes (June 11) +~~~~~~~~~~~~~~~~~~~~ +* Kill dead code assignArguments, argumentsSize in CmmCallConv. + Bake in ByteOff to ParamLocation and ArgumentFormat + CmmActuals -> [CmmActual] similary CmmFormals + +* Possible refactoring: Nuke AGraph in favour of + mkIfThenElse :: Expr -> Graph -> Graph -> FCode Graph + or even + mkIfThenElse :: HasUniques m => Expr -> Graph -> Graph -> m Graph + (Remmber that the .cmm file parser must use this function) + + or parameterise FCode over its envt; the CgState part seem useful for both + +* Move top and tail calls to runCmmContFlowOpts from HscMain to CmmCps.cpsTop + (and rename the latter!) + +* "Remove redundant reloads" in CmmSpillReload should be redundant; since + insertLateReloads is now gone, every reload is reloading a live variable. + Test and nuke. + +* Sink and inline S(RegSlot(x)) = e in precisely the same way that we + sink and inline x = e + +* Stack layout is very like register assignment: find non-conflicting assigments. + In particular we can use colouring or linear scan (etc). + + We'd fine-grain interference (on a word by word basis) to get maximum overlap. + But that may make very big interference graphs. So linear scan might be + more attactive. + + NB: linear scan does on-the-fly live range splitting. + +* When stubbing dead slots be careful not to write into an area that + overlaps with an area that's in use. So stubbing needs to *follow* + stack layout. + + More notes (May 11) ~~~~~~~~~~~~~~~~~~~ In CmmNode, consider spliting CmmCall into two: call and jump diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index a4b47ee..a5cbdd3 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -880,6 +880,10 @@ repSts (ExprStmt e _ _ _ : ss) = ; z <- repNoBindSt e2 ; (ss2,zs) <- repSts ss ; return (ss2, z : zs) } +repSts [LastStmt e _] + = do { e2 <- repLE e + ; z <- repNoBindSt e2 + ; return ([], [z]) } repSts [] = return ([],[]) repSts other = notHandled "Exotic statement" (ppr other) diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 3867e17..ee6001b 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -828,14 +828,14 @@ it re-exports @GHC@, which includes @takeMVar#@, whose type includes type ExportAccum -- The type of the accumulating parameter of -- the main worker function in rnExports = ([LIE Name], -- Export items with Names - ExportOccMap, -- Tracks exported occurrence names + ExportOccMap, -- Tracks exported occurrence names [AvailInfo]) -- The accumulated exported stuff -- Not nub'd! emptyExportAccum :: ExportAccum emptyExportAccum = ([], emptyOccEnv, []) -type ExportOccMap = OccEnv (Name, IE RdrName) +type ExportOccMap = OccEnv (Name, IE Name) -- Tracks what a particular exported OccName -- in an export list refers to, and which item -- it came from. It's illegal to export two distinct things @@ -912,7 +912,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item acc@(ie_names, occs, exports) - (L loc ie@(IEModuleContents mod)) + (L loc (IEModuleContents mod)) | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ] , mod `elem` earlier_mods -- Duplicate export of M = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ; @@ -937,7 +937,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod -- The qualified and unqualified version of all of -- these names are, in effect, used by this export - ; occs' <- check_occs ie occs names + ; occs' <- check_occs (IEModuleContents mod) occs names -- This check_occs not only finds conflicts -- between this item and others, but also -- internally within this item. That is, if @@ -958,7 +958,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod then return acc -- Avoid error cascade else do - occs' <- check_occs ie occs (availNames avail) + occs' <- check_occs new_ie occs (availNames avail) return (L loc new_ie : lie_names, occs', avail : exports) @@ -1054,8 +1054,8 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is ------------------------------- -check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap -check_occs ie occs names +check_occs :: IE Name -> ExportOccMap -> [Name] -> RnM ExportOccMap +check_occs ie occs names -- 'names' are the entities specifed by 'ie' = foldlM check occs names where check occs name @@ -1066,7 +1066,7 @@ check_occs ie occs names | name == name' -- Duplicate export -- But we don't want to warn if the same thing is exported -- by two different module exports. See ticket #4478. - -> do unless (diffModules ie ie') $ do + -> do unless (dupExport_ok name ie ie') $ do warn_dup_exports <- doptM Opt_WarnDuplicateExports warnIf warn_dup_exports (dupExportWarn name_occ ie ie') return occs @@ -1077,9 +1077,38 @@ check_occs ie occs names return occs } where name_occ = nameOccName name - -- True if the two IE RdrName are different module exports. - diffModules (IEModuleContents n1) (IEModuleContents n2) = n1 /= n2 - diffModules _ _ = False + + +dupExport_ok :: Name -> IE Name -> IE Name -> Bool +-- The Name is exported by both IEs. Is that ok? +-- "No" iff the name is mentioned explicitly in both IEs +-- "Yes" otherwise +-- +-- Example of "no": module M( f, f ) +-- +-- Example of "yes" +-- module M( module A, module B ) where +-- import A( f ) +-- import B( f ) +-- +-- Example of "yes" (Trac #2436) +-- module M( C(..), T(..) ) where +-- class C a where { data T a } +-- instace C Int where { data T Int = TInt } +-- +-- Example of "yes" (Trac #2436) +-- module Foo ( T ) where +-- data family T a +-- module Bar ( T(..), module Foo ) where +-- import Foo +-- data instance T Int = TInt + +dupExport_ok n ie1 ie2 + = not (explicit_in ie1 && explicit_in ie2) + where + explicit_in (IEModuleContents _) = False + explicit_in (IEThingAll n') = n == n' + explicit_in _ = True \end{code} %********************************************************* @@ -1530,7 +1559,7 @@ typeItemErr name wherestr = sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr, ptext (sLit "Use -XTypeFamilies to enable this extension") ] -exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName +exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE Name -> IE Name -> Message exportClashErr global_env name1 name2 ie1 ie2 = vcat [ ptext (sLit "Conflicting exports for") <+> quotes (ppr occ) <> colon @@ -1574,7 +1603,7 @@ addDupDeclErr names@(name : _) where sorted_names = sortWith nameSrcLoc names -dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc +dupExportWarn :: OccName -> IE Name -> IE Name -> SDoc dupExportWarn occ_name ie1 ie2 = hsep [quotes (ppr occ_name), ptext (sLit "is exported by"), quotes (ppr ie1),