Detabify StgCmmEnv
[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 module StgCmmEnv (
9 CgIdInfo,
10
11 cgIdInfoId, cgIdInfoLF,
12
13 litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit,
14 idInfoToAmode,
15
16 NonVoid(..), isVoidId, nonVoidIds,
17
18 addBindC, addBindsC,
19
20 bindArgsToRegs, bindToReg, rebindToReg,
21 bindArgToReg, idToReg,
22 getArgAmode, getNonVoidArgAmodes,
23 getCgIdInfo,
24 maybeLetNoEscape,
25 ) where
26
27 #include "HsVersions.h"
28
29 import TyCon
30 import StgCmmMonad
31 import StgCmmUtils
32 import StgCmmClosure
33
34 import CLabel
35
36 import DynFlags
37 import MkGraph
38 import BlockId
39 import CmmExpr
40 import CmmUtils
41 import FastString
42 import Id
43 import VarEnv
44 import Control.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 :: DynFlags -> Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
72 mkCgIdInfo dflags id lf expr
73 = CgIdInfo { cg_id = id, cg_lf = lf
74 , cg_loc = CmmLoc expr,
75 cg_tag = lfDynTag dflags lf }
76
77 litIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
78 litIdInfo dflags id lf lit
79 = CgIdInfo { cg_id = id, cg_lf = lf
80 , cg_loc = CmmLoc (addDynTag dflags (CmmLit lit) tag)
81 , cg_tag = tag }
82 where
83 tag = lfDynTag dflags lf
84
85 lneIdInfo :: DynFlags -> Id -> [NonVoid Id] -> CgIdInfo
86 lneIdInfo dflags id regs
87 = CgIdInfo { cg_id = id, cg_lf = lf
88 , cg_loc = LneLoc blk_id (map (idToReg dflags) regs)
89 , cg_tag = lfDynTag dflags lf }
90 where
91 lf = mkLFLetNoEscape
92 blk_id = mkBlockId (idUnique id)
93
94
95 rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
96 rhsIdInfo id lf_info
97 = do dflags <- getDynFlags
98 reg <- newTemp (gcWord dflags)
99 return (mkCgIdInfo dflags id lf_info (CmmReg (CmmLocal reg)), reg)
100
101 mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
102 mkRhsInit dflags reg lf_info expr
103 = mkAssign (CmmLocal reg) (addDynTag dflags expr (lfDynTag dflags lf_info))
104
105 idInfoToAmode :: CgIdInfo -> CmmExpr
106 -- Returns a CmmExpr for the *tagged* pointer
107 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
108 idInfoToAmode cg_info
109 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
110
111 addDynTag :: DynFlags -> CmmExpr -> DynTag -> CmmExpr
112 -- A tag adds a byte offset to the pointer
113 addDynTag dflags expr tag = cmmOffsetB dflags expr tag
114
115 cgIdInfoId :: CgIdInfo -> Id
116 cgIdInfoId = cg_id
117
118 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
119 cgIdInfoLF = cg_lf
120
121 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
122 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
123 maybeLetNoEscape _other = Nothing
124
125
126
127 ---------------------------------------------------------
128 -- The binding environment
129 --
130 -- There are three basic routines, for adding (addBindC),
131 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
132 ---------------------------------------------------------
133
134 addBindC :: Id -> CgIdInfo -> FCode ()
135 addBindC name stuff_to_bind = do
136 binds <- getBinds
137 setBinds $ extendVarEnv binds name stuff_to_bind
138
139 addBindsC :: [CgIdInfo] -> FCode ()
140 addBindsC new_bindings = do
141 binds <- getBinds
142 let new_binds = foldl (\ binds info -> extendVarEnv binds (cg_id info) info)
143 binds
144 new_bindings
145 setBinds new_binds
146
147 getCgIdInfo :: Id -> FCode CgIdInfo
148 getCgIdInfo id
149 = do { -- Try local bindings first
150 ; local_binds <- getBinds
151 ; case lookupVarEnv local_binds id of {
152 Just info -> return info ;
153 Nothing -> do
154
155 { -- Try top-level bindings
156 static_binds <- getStaticBinds
157 ; case lookupVarEnv static_binds id of {
158 Just info -> return info ;
159 Nothing ->
160
161 -- Should be imported; make up a CgIdInfo for it
162 let
163 name = idName id
164 in
165 if isExternalName name then do
166 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
167 dflags <- getDynFlags
168 return (litIdInfo dflags id (mkLFImported id) ext_lbl)
169 else
170 -- Bug
171 cgLookupPanic id
172 }}}}
173
174 cgLookupPanic :: Id -> FCode a
175 cgLookupPanic id
176 = do static_binds <- getStaticBinds
177 local_binds <- getBinds
178 pprPanic "StgCmmEnv: variable not found"
179 (vcat [ppr id,
180 ptext (sLit "static binds for:"),
181 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
182 ptext (sLit "local binds for:"),
183 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
184 ])
185
186
187 --------------------
188 getArgAmode :: NonVoid StgArg -> FCode CmmExpr
189 getArgAmode (NonVoid (StgVarArg var)) =
190 do { info <- getCgIdInfo var; return (idInfoToAmode info) }
191 getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit
192
193 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
194 -- NB: Filters out void args,
195 -- so the result list may be shorter than the argument list
196 getNonVoidArgAmodes [] = return []
197 getNonVoidArgAmodes (arg:args)
198 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
199 | otherwise = do { amode <- getArgAmode (NonVoid arg)
200 ; amodes <- getNonVoidArgAmodes args
201 ; return ( amode : amodes ) }
202
203 ------------------------------------------------------------------------
204 -- Interface functions for binding and re-binding names
205 ------------------------------------------------------------------------
206
207 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
208 -- Bind an Id to a fresh LocalReg
209 bindToReg nvid@(NonVoid id) lf_info
210 = do dflags <- getDynFlags
211 let reg = idToReg dflags nvid
212 addBindC id (mkCgIdInfo dflags id lf_info (CmmReg (CmmLocal reg)))
213 return reg
214
215 rebindToReg :: NonVoid Id -> FCode LocalReg
216 -- Like bindToReg, but the Id is already in scope, so
217 -- get its LF info from the envt
218 rebindToReg nvid@(NonVoid id)
219 = do { info <- getCgIdInfo id
220 ; bindToReg nvid (cgIdInfoLF info) }
221
222 bindArgToReg :: NonVoid Id -> FCode LocalReg
223 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
224
225 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
226 bindArgsToRegs args = mapM bindArgToReg args
227
228 idToReg :: DynFlags -> NonVoid Id -> LocalReg
229 -- Make a register from an Id, typically a function argument,
230 -- free variable, or case binder
231 --
232 -- We re-use the Unique from the Id to make it easier to see what is going on
233 --
234 -- By now the Ids should be uniquely named; else one would worry
235 -- about accidental collision
236 idToReg dflags (NonVoid id)
237 = LocalReg (idUnique id)
238 (case idPrimRep id of VoidRep -> pprPanic "idToReg" (ppr id)
239 _ -> primRepCmmType dflags (idPrimRep id))
240
241