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"
48 -------------------------------------
50 -------------------------------------
51 -- We frequently need the invariant that an Id or a an argument
52 -- is of a non-void type. This type is a witness to the invariant.
54 newtype NonVoid a = NonVoid a
57 instance (Outputable a) => Outputable (NonVoid a) where
58 ppr (NonVoid a) = ppr a
60 isVoidId :: Id -> Bool
61 isVoidId = isVoidRep . idPrimRep
63 nonVoidIds :: [Id] -> [NonVoid Id]
64 nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))]
66 -------------------------------------
67 -- Manipulating CgIdInfo
68 -------------------------------------
70 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
72 = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
73 cg_lf = lf, cg_rep = idPrimRep id,
74 cg_tag = lfDynTag lf }
76 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
78 = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
79 cg_lf = lf, cg_rep = idPrimRep id,
80 cg_tag = lfDynTag lf }
83 blk_id = mkBlockId (idUnique id)
85 litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
86 litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit)
87 mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info))
89 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo
90 regIdInfo id lf_info reg =
91 mkCgIdInfo id lf_info (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info))
93 idInfoToAmode :: CgIdInfo -> CmmExpr
94 -- Returns a CmmExpr for the *tagged* pointer
95 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
97 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
99 addDynTag :: CmmExpr -> DynTag -> CmmExpr
100 -- A tag adds a byte offset to the pointer
101 addDynTag expr tag = cmmOffsetB expr tag
103 cgIdInfoId :: CgIdInfo -> Id
106 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
109 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
110 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
111 maybeLetNoEscape _other = Nothing
115 ---------------------------------------------------------
116 -- The binding environment
118 -- There are three basic routines, for adding (addBindC),
119 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
120 ---------------------------------------------------------
122 addBindC :: Id -> CgIdInfo -> FCode ()
123 addBindC name stuff_to_bind = do
125 setBinds $ extendVarEnv binds name stuff_to_bind
127 addBindsC :: [CgIdInfo] -> FCode ()
128 addBindsC new_bindings = do
130 let new_binds = foldl (\ binds info -> extendVarEnv binds (cg_id info) info)
135 getCgIdInfo :: Id -> FCode CgIdInfo
137 = do { -- Try local bindings first
138 ; local_binds <- getBinds
139 ; case lookupVarEnv local_binds id of {
140 Just info -> return info ;
143 { -- Try top-level bindings
144 static_binds <- getStaticBinds
145 ; case lookupVarEnv static_binds id of {
146 Just info -> return info ;
149 -- Should be imported; make up a CgIdInfo for it
153 if isExternalName name then do
154 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
155 return (litIdInfo id (mkLFImported id) ext_lbl)
161 cgLookupPanic :: Id -> FCode a
163 = do static_binds <- getStaticBinds
164 local_binds <- getBinds
166 pprPanic "StgCmmEnv: variable not found"
168 ptext (sLit "static binds for:"),
169 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
170 ptext (sLit "local binds for:"),
171 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
172 ptext (sLit "SRT label") <+> pprCLabel srt
177 getArgAmode :: NonVoid StgArg -> FCode CmmExpr
178 getArgAmode (NonVoid (StgVarArg var)) =
179 do { info <- getCgIdInfo var; return (idInfoToAmode info) }
180 getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit
181 getArgAmode (NonVoid (StgTypeArg _)) = panic "getArgAmode: type arg"
183 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
184 -- NB: Filters out void args,
185 -- so the result list may be shorter than the argument list
186 getNonVoidArgAmodes [] = return []
187 getNonVoidArgAmodes (arg:args)
188 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
189 | otherwise = do { amode <- getArgAmode (NonVoid arg)
190 ; amodes <- getNonVoidArgAmodes args
191 ; return ( amode : amodes ) }
194 ------------------------------------------------------------------------
195 -- Interface functions for binding and re-binding names
196 ------------------------------------------------------------------------
198 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
199 -- Bind an Id to a fresh LocalReg
200 bindToReg nvid@(NonVoid id) lf_info
201 = do { let reg = idToReg nvid
202 ; addBindC id (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
205 rebindToReg :: NonVoid Id -> FCode LocalReg
206 -- Like bindToReg, but the Id is already in scope, so
207 -- get its LF info from the envt
208 rebindToReg nvid@(NonVoid id)
209 = do { info <- getCgIdInfo id
210 ; bindToReg nvid (cgIdInfoLF info) }
212 bindArgToReg :: NonVoid Id -> FCode LocalReg
213 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
215 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
216 bindArgsToRegs args = mapM bindArgToReg args
218 idToReg :: NonVoid Id -> LocalReg
219 -- Make a register from an Id, typically a function argument,
220 -- free variable, or case binder
222 -- We re-use the Unique from the Id to make it easier to see what is going on
224 -- By now the Ids should be uniquely named; else one would worry
225 -- about accidental collision
226 idToReg (NonVoid id) = LocalReg (idUnique id)
227 (case idPrimRep id of VoidRep -> pprPanic "idToReg" (ppr id)
228 _ -> primRepCmmType (idPrimRep id))