import CgMonad
import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
-import CgStackery ( freeStackSlots, addFreeSlots )
-import CLabel ( mkStaticClosureLabel, mkClosureLabel,
+import CgStackery ( freeStackSlots )
+import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
import BitSet ( mkBS, emptyBS )
import PrimRep ( isFollowableRep, getPrimRepSize )
-import DataCon ( DataCon, dataConName )
import Id ( Id, idPrimRep, idType )
import Type ( typePrimRep )
import VarEnv
import VarSet ( varSetElems )
-import Const ( Con(..), Literal )
+import Literal ( Literal )
import Maybes ( catMaybes, maybeToBool )
-import Name ( isLocallyDefined, isWiredInName, NamedThing(..) )
+import Name ( isLocalName, NamedThing(..) )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
import PrimRep ( PrimRep(..) )
-import StgSyn ( StgArg, StgLiveVars, GenStgArg(..) )
+import StgSyn ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
import Unique ( Unique, Uniquable(..) )
import UniqSet ( elementOfUniqSet )
import Util ( zipWithEqual, sortLt )
= MkCgState absC (modifyVarEnv mangle_fn binds name) usage
lookupBindC :: Id -> FCode CgIdInfo
-lookupBindC name info_down@(MkCgInfoDown _ static_binds srt _)
+lookupBindC name info_down@(MkCgInfoDown _ static_binds srt ticky _)
state@(MkCgState absC local_binds usage)
= (val, state)
where
-> cgPanic (text "lookupBindC: no info for" <+> ppr name) info_down state
cgPanic :: SDoc -> CgInfoDownwards -> CgState -> a
-cgPanic doc info_down@(MkCgInfoDown _ static_binds srt _)
+cgPanic doc info_down@(MkCgInfoDown _ static_binds srt ticky _)
state@(MkCgState absC local_binds usage)
= pprPanic "cgPanic"
(vcat [doc,
I {\em think} all looking-up is done through @getCAddrMode(s)@.
\begin{code}
-getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
+getCAddrModeAndInfo :: Id -> FCode (Id, CAddrMode, LambdaFormInfo)
getCAddrModeAndInfo id
- | not (isLocallyDefined name) || isWiredInName name
- {- Why the "isWiredInName"?
- Imagine you are compiling PrelBase.hs (a module that
- supplies some of the wired-in values). What can
- happen is that the compiler will inject calls to
- (e.g.) GHCbase.unpackPS, where-ever it likes -- it
- assumes those values are ubiquitously available.
- The main point is: it may inject calls to them earlier
- in GHCbase.hs than the actual definition...
- -}
- = returnFC (global_amode, mkLFImported id)
+ | not (isLocalName name)
+ = returnFC (id, global_amode, mkLFImported id)
+ -- deals with imported or locally defined but externally visible ids
+ -- (CoreTidy makes all these into global names).
| otherwise = -- *might* be a nested defn: in any case, it's something whose
-- definition we will know about...
- lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
+ lookupBindC id `thenFC` \ (MkCgIdInfo id' volatile_loc stable_loc lf_info) ->
idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
- returnFC (amode, lf_info)
+ returnFC (id', amode, lf_info)
where
name = getName id
global_amode = CLbl (mkClosureLabel name) kind
getCAddrMode :: Id -> FCode CAddrMode
getCAddrMode name
- = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
+ = getCAddrModeAndInfo name `thenFC` \ (_, amode, _) ->
returnFC amode
\end{code}
getArgAmodes :: [StgArg] -> FCode [CAddrMode]
getArgAmodes [] = returnFC []
getArgAmodes (atom:atoms)
+ | isStgTypeArg atom
+ = getArgAmodes atoms
+ | otherwise
= getArgAmode atom `thenFC` \ amode ->
getArgAmodes atoms `thenFC` \ amodes ->
returnFC ( amode : amodes )
getArgAmode :: StgArg -> FCode CAddrMode
getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
-
-getArgAmode (StgConArg (DataCon con))
- {- Why does this case differ from StgVarArg?
- Because the program might look like this:
- data Foo a = Empty | Baz a
- f a x = let c = Empty! a
- in h c
- Now, when we go Core->Stg, we drop the type applications,
- so we can inline c, giving
- f x = h Empty
- Now we are referring to Empty as an argument (rather than in an STGCon),
- so we'll look it up with getCAddrMode. We want to return an amode for
- the static closure that we make for nullary constructors. But if we blindly
- go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
-
- This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
- Consider:
- f a x = Baz a x
- If the constructor Baz isn't inlined we simply want to treat it like any other
- identifier, with a top level definition. We don't want to spot that it's a constructor.
-
- In short
- StgApp con args
- and
- StgCon con args
- are treated differently; the former is a call to a bog standard function while the
- latter uses the specially-labelled, pre-defined info tables etc for the constructor.
-
- The way to think of this case in getArgAmode is that
- SApp f Empty
- is really
- App f (StgCon Empty [])
- -}
- = returnFC (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
-
-
-getArgAmode (StgConArg (Literal lit)) = returnFC (CLit lit)
+getArgAmode (StgLitArg lit) = returnFC (CLit lit)
\end{code}
%************************************************************************
where
info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
-bindNewToLit name lit
- = addBindC name info
- where
- info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
-
bindArgsToRegs :: [Id] -> [MagicId] -> Code
bindArgsToRegs args regs
= listCs (zipWithEqual "bindArgsToRegs" bind args regs)
projects / ghc-hetmet.git / blobdiff