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 -} )
49 -------------------------------------
51 -------------------------------------
52 -- We frequently need the invariant that an Id or a an argument
53 -- is of a non-void type. This type is a witness to the invariant.
55 newtype NonVoid a = NonVoid a
58 instance (Outputable a) => Outputable (NonVoid a) where
59 ppr (NonVoid a) = ppr a
61 isVoidId :: Id -> Bool
62 isVoidId = isVoidRep . idPrimRep
64 nonVoidIds :: [Id] -> [NonVoid Id]
65 nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))]
67 -------------------------------------
68 -- Manipulating CgIdInfo
69 -------------------------------------
71 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
73 = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
74 cg_lf = lf, cg_rep = idPrimRep id,
75 cg_tag = lfDynTag lf }
77 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
79 = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
80 cg_lf = lf, cg_rep = idPrimRep id,
81 cg_tag = lfDynTag lf }
84 blk_id = mkBlockId (idUnique id)
86 litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
87 litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit)
88 mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info))
90 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo
91 regIdInfo id lf_info reg =
92 mkCgIdInfo id lf_info (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info))
94 idInfoToAmode :: CgIdInfo -> CmmExpr
95 -- Returns a CmmExpr for the *tagged* pointer
96 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
98 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
100 addDynTag :: CmmExpr -> DynTag -> CmmExpr
101 -- A tag adds a byte offset to the pointer
102 addDynTag expr tag = cmmOffsetB expr tag
104 cgIdInfoId :: CgIdInfo -> Id
107 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
110 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
111 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
112 maybeLetNoEscape _other = Nothing
116 ---------------------------------------------------------
117 -- The binding environment
119 -- There are three basic routines, for adding (addBindC),
120 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
121 ---------------------------------------------------------
123 addBindC :: Id -> CgIdInfo -> FCode ()
124 addBindC name stuff_to_bind = do
126 setBinds $ extendVarEnv binds name stuff_to_bind
128 addBindsC :: [CgIdInfo] -> FCode ()
129 addBindsC new_bindings = do
131 let new_binds = foldl (\ binds info -> extendVarEnv binds (cg_id info) info)
136 getCgIdInfo :: Id -> FCode CgIdInfo
138 = do { -- Try local bindings first
139 ; local_binds <- getBinds
140 ; case lookupVarEnv local_binds id of {
141 Just info -> return info ;
144 { -- Try top-level bindings
145 static_binds <- getStaticBinds
146 ; case lookupVarEnv static_binds id of {
147 Just info -> return info ;
150 -- Should be imported; make up a CgIdInfo for it
154 if isExternalName name then do
155 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
156 return (litIdInfo id (mkLFImported id) ext_lbl)
162 cgLookupPanic :: Id -> FCode a
164 = do static_binds <- getStaticBinds
165 local_binds <- getBinds
167 pprPanic "StgCmmEnv: variable not found"
169 ptext (sLit "static binds for:"),
170 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
171 ptext (sLit "local binds for:"),
172 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
173 ptext (sLit "SRT label") <+> pprCLabel srt
178 getArgAmode :: NonVoid StgArg -> FCode CmmExpr
179 getArgAmode (NonVoid (StgVarArg var)) =
180 do { info <- getCgIdInfo var; return (idInfoToAmode info) }
181 getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit
182 getArgAmode (NonVoid (StgTypeArg _)) = panic "getArgAmode: type arg"
184 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
185 -- NB: Filters out void args,
186 -- so the result list may be shorter than the argument list
187 getNonVoidArgAmodes [] = return []
188 getNonVoidArgAmodes (arg:args)
189 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
190 | otherwise = do { amode <- getArgAmode (NonVoid arg)
191 ; amodes <- getNonVoidArgAmodes args
192 ; return ( amode : amodes ) }
195 ------------------------------------------------------------------------
196 -- Interface functions for binding and re-binding names
197 ------------------------------------------------------------------------
199 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
200 -- Bind an Id to a fresh LocalReg
201 bindToReg nvid@(NonVoid id) lf_info
202 = do { let reg = idToReg nvid
203 ; addBindC id (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
206 rebindToReg :: NonVoid Id -> FCode LocalReg
207 -- Like bindToReg, but the Id is already in scope, so
208 -- get its LF info from the envt
209 rebindToReg nvid@(NonVoid id)
210 = do { info <- getCgIdInfo id
211 ; bindToReg nvid (cgIdInfoLF info) }
213 bindArgToReg :: NonVoid Id -> FCode LocalReg
214 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
216 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
217 bindArgsToRegs args = mapM bindArgToReg args
219 idToReg :: NonVoid Id -> LocalReg
220 -- Make a register from an Id, typically a function argument,
221 -- free variable, or case binder
223 -- We re-use the Unique from the Id to make it easier to see what is going on
225 -- By now the Ids should be uniquely named; else one would worry
226 -- about accidental collision
227 idToReg (NonVoid id) = LocalReg (idUnique id)
228 (case idPrimRep id of VoidRep -> pprPanic "idToReg" (ppr id)
229 _ -> primRepCmmType (idPrimRep id))