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
-- 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
-- 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)
-- 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.
+More notes (June 11)\r
+~~~~~~~~~~~~~~~~~~~~\r
+* Kill dead code assignArguments, argumentsSize in CmmCallConv.\r
+ Bake in ByteOff to ParamLocation and ArgumentFormat\r
+ CmmActuals -> [CmmActual] similary CmmFormals\r
+\r
+* Possible refactoring: Nuke AGraph in favour of \r
+ mkIfThenElse :: Expr -> Graph -> Graph -> FCode Graph\r
+ or even\r
+ mkIfThenElse :: HasUniques m => Expr -> Graph -> Graph -> m Graph\r
+ (Remmber that the .cmm file parser must use this function)\r
+\r
+ or parameterise FCode over its envt; the CgState part seem useful for both\r
+\r
+* Move top and tail calls to runCmmContFlowOpts from HscMain to CmmCps.cpsTop\r
+ (and rename the latter!)\r
+\r
+* "Remove redundant reloads" in CmmSpillReload should be redundant; since\r
+ insertLateReloads is now gone, every reload is reloading a live variable.\r
+ Test and nuke.\r
+\r
+* Sink and inline S(RegSlot(x)) = e in precisely the same way that we\r
+ sink and inline x = e\r
+\r
+* Stack layout is very like register assignment: find non-conflicting assigments.\r
+ In particular we can use colouring or linear scan (etc).\r
+\r
+ We'd fine-grain interference (on a word by word basis) to get maximum overlap.\r
+ But that may make very big interference graphs. So linear scan might be\r
+ more attactive.\r
+\r
+ NB: linear scan does on-the-fly live range splitting.\r
+\r
+* When stubbing dead slots be careful not to write into an area that\r
+ overlaps with an area that's in use. So stubbing needs to *follow* \r
+ stack layout.\r
+\r
+\r
More notes (May 11)\r
~~~~~~~~~~~~~~~~~~~\r
In CmmNode, consider spliting CmmCall into two: call and jump\r
; 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)
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
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 ;
-- 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
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)
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
| 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
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}
%*********************************************************
= 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
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),
projects / ghc-hetmet.git / commitdiff