\section[CgBindery]{Utility functions related to doing @CgBindings@}
\begin{code}
-#include "HsVersions.h"
-
module CgBindery (
- CgBindings(..), CgIdInfo(..){-dubiously concrete-},
+ CgBindings, CgIdInfo(..){-dubiously concrete-},
StableLoc, VolatileLoc,
maybeAStkLoc, maybeBStkLoc,
rebindToAStack, rebindToBStack
) where
-import Ubiq{-uitous-}
-import CgLoop1 -- here for paranoia-checking
+#include "HsVersions.h"
import AbsCSyn
import CgMonad
import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
-import CLabel ( mkClosureLabel )
-import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument )
-import HeapOffs ( VirtualHeapOffset(..),
- VirtualSpAOffset(..), VirtualSpBOffset(..)
+import CLabel ( mkStaticClosureLabel, mkClosureLabel )
+import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
+import HeapOffs ( VirtualHeapOffset,
+ VirtualSpAOffset, VirtualSpBOffset
)
-import Id ( idPrimRep, toplevelishId, isDataCon,
- mkIdEnv, rngIdEnv, IdEnv(..),
+import Id ( idPrimRep, toplevelishId,
+ mkIdEnv, rngIdEnv, IdEnv,
idSetToList,
- GenId{-instance NamedThing-}
+ Id
)
+import Literal ( Literal )
import Maybes ( catMaybes )
-import Name ( isLocallyDefined )
-#ifdef DEBUG
+import Name ( isLocallyDefined, isWiredInName,
+ Name{-instance NamedThing-}, NamedThing(..) )
import PprAbsC ( pprAmode )
-#endif
-import PprStyle ( PprStyle(..) )
-import StgSyn ( StgArg(..), StgLiveVars(..), GenStgArg(..) )
-import Unpretty ( uppShow )
+import PrimRep ( PrimRep )
+import StgSyn ( StgArg, StgLiveVars, GenStgArg(..) )
+import Unique ( Unique, Uniquable(..) )
import Util ( zipWithEqual, panic )
+import Outputable
\end{code}
| VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
-- ie *(Node+offset)
+\end{code}
+
+@StableLoc@ encodes where an Id can be found, used by
+the @CgBindings@ environment in @CgBindery@.
+\begin{code}
data StableLoc
= NoStableLoc
| VirAStkLoc VirtualSpAOffset
\begin{code}
getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
-getCAddrModeAndInfo name
- | not (isLocallyDefined name)
- = returnFC (global_amode, mkLFImported name)
-
- | isDataCon name
- = returnFC (global_amode, mkConLFInfo name)
+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)
| otherwise = -- *might* be a nested defn: in any case, it's something whose
-- definition we will know about...
- lookupBindC name `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
+ lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
returnFC (amode, lf_info)
where
- global_amode = CLbl (mkClosureLabel name) kind
- kind = idPrimRep name
+ name = getName id
+ global_amode = CLbl (mkClosureLabel id) kind
+ kind = idPrimRep id
getCAddrMode :: Id -> FCode CAddrMode
getCAddrMode name
getArgAmode :: StgArg -> FCode CAddrMode
-getArgAmode (StgVarArg var) = getCAddrMode var
+getArgAmode (StgConArg var)
+ {- 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 var) (idPrimRep var))
+
+getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
+
getArgAmode (StgLitArg lit) = returnFC (CLit lit)
\end{code}
bindArgsToRegs :: [Id] -> [MagicId] -> Code
bindArgsToRegs args regs
- = listCs (zipWithEqual bind args regs)
+ = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
where
arg `bind` reg = bindNewToReg arg reg mkLFArgument
\end{code}
#ifdef DEBUG
bindNewPrimToAmode name amode
- = panic ("bindNew...:"++(uppShow 80 (pprAmode PprDebug amode)))
+ = pprPanic "bindNew...:" (pprAmode amode)
#endif
\end{code}
projects / ghc-hetmet.git / blobdiff