Remove unused imports
[ghc.git] / compiler / codeGen / StgCmmEnv.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Stg to C-- code generation: the binding environment
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 module StgCmmEnv (
10 CgIdInfo,
11
12 cgIdInfoId, cgIdInfoLF,
13
14 litIdInfo, lneIdInfo, regIdInfo,
15 idInfoToAmode,
16
17 NonVoid(..), isVoidId, nonVoidIds,
18
19 addBindC, addBindsC,
20
21 bindArgsToRegs, bindToReg, rebindToReg,
22 bindArgToReg, idToReg,
23 getArgAmode, getNonVoidArgAmodes,
24 getCgIdInfo,
25 maybeLetNoEscape,
26 ) where
27
28 #include "HsVersions.h"
29
30 import TyCon
31 import StgCmmMonad
32 import StgCmmUtils
33 import StgCmmClosure
34
35 import CLabel
36
37 import BlockId
38 import Cmm
39 import CmmUtils
40 import FastString
41 import PprCmm ( {- instance Outputable -} )
42 import Id
43 import VarEnv
44 import Monad
45 import Name
46 import StgSyn
47 import Outputable
48
49 -------------------------------------
50 -- Non-void types
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.
54
55 newtype NonVoid a = NonVoid a
56 deriving (Eq, Show)
57
58 instance (Outputable a) => Outputable (NonVoid a) where
59 ppr (NonVoid a) = ppr a
60
61 isVoidId :: Id -> Bool
62 isVoidId = isVoidRep . idPrimRep
63
64 nonVoidIds :: [Id] -> [NonVoid Id]
65 nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))]
66
67 -------------------------------------
68 -- Manipulating CgIdInfo
69 -------------------------------------
70
71 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
72 mkCgIdInfo id lf expr
73 = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
74 cg_lf = lf, cg_rep = idPrimRep id,
75 cg_tag = lfDynTag lf }
76
77 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
78 lneIdInfo id regs
79 = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
80 cg_lf = lf, cg_rep = idPrimRep id,
81 cg_tag = lfDynTag lf }
82 where
83 lf = mkLFLetNoEscape
84 blk_id = mkBlockId (idUnique id)
85
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))
89
90 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo
91 regIdInfo id lf_info reg =
92 mkCgIdInfo id lf_info (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info))
93
94 idInfoToAmode :: CgIdInfo -> CmmExpr
95 -- Returns a CmmExpr for the *tagged* pointer
96 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
97 idInfoToAmode cg_info
98 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
99
100 addDynTag :: CmmExpr -> DynTag -> CmmExpr
101 -- A tag adds a byte offset to the pointer
102 addDynTag expr tag = cmmOffsetB expr tag
103
104 cgIdInfoId :: CgIdInfo -> Id
105 cgIdInfoId = cg_id
106
107 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
108 cgIdInfoLF = cg_lf
109
110 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
111 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
112 maybeLetNoEscape _other = Nothing
113
114
115
116 ---------------------------------------------------------
117 -- The binding environment
118 --
119 -- There are three basic routines, for adding (addBindC),
120 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
121 ---------------------------------------------------------
122
123 addBindC :: Id -> CgIdInfo -> FCode ()
124 addBindC name stuff_to_bind = do
125 binds <- getBinds
126 setBinds $ extendVarEnv binds name stuff_to_bind
127
128 addBindsC :: [CgIdInfo] -> FCode ()
129 addBindsC new_bindings = do
130 binds <- getBinds
131 let new_binds = foldl (\ binds info -> extendVarEnv binds (cg_id info) info)
132 binds
133 new_bindings
134 setBinds new_binds
135
136 getCgIdInfo :: Id -> FCode CgIdInfo
137 getCgIdInfo id
138 = do { -- Try local bindings first
139 ; local_binds <- getBinds
140 ; case lookupVarEnv local_binds id of {
141 Just info -> return info ;
142 Nothing -> do
143
144 { -- Try top-level bindings
145 static_binds <- getStaticBinds
146 ; case lookupVarEnv static_binds id of {
147 Just info -> return info ;
148 Nothing ->
149
150 -- Should be imported; make up a CgIdInfo for it
151 let
152 name = idName id
153 in
154 if isExternalName name then do
155 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
156 return (litIdInfo id (mkLFImported id) ext_lbl)
157 else
158 -- Bug
159 cgLookupPanic id
160 }}}}
161
162 cgLookupPanic :: Id -> FCode a
163 cgLookupPanic id
164 = do static_binds <- getStaticBinds
165 local_binds <- getBinds
166 srt <- getSRTLabel
167 pprPanic "StgCmmEnv: variable not found"
168 (vcat [ppr id,
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
174 ])
175
176
177 --------------------
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"
183
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 ) }
193
194
195 ------------------------------------------------------------------------
196 -- Interface functions for binding and re-binding names
197 ------------------------------------------------------------------------
198
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)))
204 ; return reg }
205
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) }
212
213 bindArgToReg :: NonVoid Id -> FCode LocalReg
214 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
215
216 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
217 bindArgsToRegs args = mapM bindArgToReg args
218
219 idToReg :: NonVoid Id -> LocalReg
220 -- Make a register from an Id, typically a function argument,
221 -- free variable, or case binder
222 --
223 -- We re-use the Unique from the Id to make it easier to see what is going on
224 --
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))
230
231