1 -----------------------------------------------------------------------------
3 -- Stg to C-- code generation: the binding environment
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
12 cgIdInfoId, cgIdInfoLF,
14 litIdInfo, lneIdInfo, regIdInfo,
17 NonVoid(..), isVoidId, nonVoidIds,
21 bindArgsToRegs, bindToReg, rebindToReg,
22 bindArgToReg, idToReg,
23 getArgAmode, getNonVoidArgAmodes,
28 #include "HsVersions.h"
41 import PprCmm ( {- instance Outputable -} )
50 -------------------------------------
52 -------------------------------------
53 -- We frequently need the invariant that an Id or a an argument
54 -- is of a non-void type. This type is a witness to the invariant.
56 newtype NonVoid a = NonVoid a
59 instance (Outputable a) => Outputable (NonVoid a) where
60 ppr (NonVoid a) = ppr a
62 isVoidId :: Id -> Bool
63 isVoidId = isVoidRep . idPrimRep
65 nonVoidIds :: [Id] -> [NonVoid Id]
66 nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))]
68 -------------------------------------
69 -- Manipulating CgIdInfo
70 -------------------------------------
72 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
74 = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
75 cg_lf = lf, cg_rep = idPrimRep id,
76 cg_tag = lfDynTag lf }
78 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
80 = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
81 cg_lf = lf, cg_rep = idPrimRep id,
82 cg_tag = lfDynTag lf }
85 blk_id = mkBlockId (idUnique id)
87 litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
88 litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit)
89 mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info))
91 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo
92 regIdInfo id lf_info reg =
93 mkCgIdInfo id lf_info (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info))
95 idInfoToAmode :: CgIdInfo -> CmmExpr
96 -- Returns a CmmExpr for the *tagged* pointer
97 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
99 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
101 addDynTag :: CmmExpr -> DynTag -> CmmExpr
102 -- A tag adds a byte offset to the pointer
103 addDynTag expr tag = cmmOffsetB expr tag
105 cgIdInfoId :: CgIdInfo -> Id
108 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
111 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
112 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
113 maybeLetNoEscape _other = Nothing
117 ---------------------------------------------------------
118 -- The binding environment
120 -- There are three basic routines, for adding (addBindC),
121 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
122 ---------------------------------------------------------
124 addBindC :: Id -> CgIdInfo -> FCode ()
125 addBindC name stuff_to_bind = do
127 setBinds $ extendVarEnv binds name stuff_to_bind
129 addBindsC :: [CgIdInfo] -> FCode ()
130 addBindsC new_bindings = do
132 let new_binds = foldl (\ binds info -> extendVarEnv binds (cg_id info) info)
137 getCgIdInfo :: Id -> FCode CgIdInfo
139 = do { -- Try local bindings first
140 ; local_binds <- getBinds
141 ; case lookupVarEnv local_binds id of {
142 Just info -> return info ;
145 { -- Try top-level bindings
146 static_binds <- getStaticBinds
147 ; case lookupVarEnv static_binds id of {
148 Just info -> return info ;
151 -- Should be imported; make up a CgIdInfo for it
155 if isExternalName name then do
156 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
157 return (litIdInfo id (mkLFImported id) ext_lbl)
163 cgLookupPanic :: Id -> FCode a
165 = do static_binds <- getStaticBinds
166 local_binds <- getBinds
168 pprPanic "StgCmmEnv: variable not found"
170 ptext (sLit "static binds for:"),
171 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
172 ptext (sLit "local binds for:"),
173 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
174 ptext (sLit "SRT label") <+> pprCLabel srt
179 getArgAmode :: NonVoid StgArg -> FCode CmmExpr
180 getArgAmode (NonVoid (StgVarArg var)) =
181 do { info <- getCgIdInfo var; return (idInfoToAmode info) }
182 getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit
183 getArgAmode (NonVoid (StgTypeArg _)) = panic "getArgAmode: type arg"
185 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
186 -- NB: Filters out void args,
187 -- so the result list may be shorter than the argument list
188 getNonVoidArgAmodes [] = return []
189 getNonVoidArgAmodes (arg:args)
190 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
191 | otherwise = do { amode <- getArgAmode (NonVoid arg)
192 ; amodes <- getNonVoidArgAmodes args
193 ; return ( amode : amodes ) }
196 ------------------------------------------------------------------------
197 -- Interface functions for binding and re-binding names
198 ------------------------------------------------------------------------
200 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
201 -- Bind an Id to a fresh LocalReg
202 bindToReg nvid@(NonVoid id) lf_info
203 = do { let reg = idToReg nvid
204 ; addBindC id (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
207 rebindToReg :: NonVoid Id -> FCode LocalReg
208 -- Like bindToReg, but the Id is already in scope, so
209 -- get its LF info from the envt
210 rebindToReg nvid@(NonVoid id)
211 = do { info <- getCgIdInfo id
212 ; bindToReg nvid (cgIdInfoLF info) }
214 bindArgToReg :: NonVoid Id -> FCode LocalReg
215 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
217 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
218 bindArgsToRegs args = mapM bindArgToReg args
220 idToReg :: NonVoid Id -> LocalReg
221 -- Make a register from an Id, typically a function argument,
222 -- free variable, or case binder
224 -- We re-use the Unique from the Id to make it easier to see what is going on
226 -- By now the Ids should be uniquely named; else one would worry
227 -- about accidental collision
228 idToReg (NonVoid id) = LocalReg (idUnique id)
229 (case idPrimRep id of VoidRep -> pprPanic "idToReg" (ppr id)
230 _ -> primRepCmmType (idPrimRep id))