Produce new-style Cmm from the Cmm parser
[ghc.git] / compiler / cmm / CmmUtils.hs
1 {-# LANGUAGE GADTs #-}
2
3 {-# OPTIONS_GHC -fno-warn-deprecations #-}
4 -- Warnings from deprecated blockToNodeList
5
6
7 -----------------------------------------------------------------------------
8 --
9 -- Cmm utilities.
10 --
11 -- (c) The University of Glasgow 2004-2006
12 --
13 -----------------------------------------------------------------------------
14
15 module CmmUtils(
16 -- CmmType
17 primRepCmmType, primRepForeignHint,
18 typeCmmType, typeForeignHint,
19
20 -- CmmLit
21 zeroCLit, mkIntCLit,
22 mkWordCLit, packHalfWordsCLit,
23 mkByteStringCLit,
24 mkDataLits, mkRODataLits,
25 mkStgWordCLit,
26
27 -- CmmExpr
28 mkIntExpr, zeroExpr,
29 mkLblExpr,
30 cmmRegOff, cmmOffset, cmmLabelOff, cmmOffsetLit, cmmOffsetExpr,
31 cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB,
32 cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW,
33 cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW,
34 cmmNegate,
35 cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
36 cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
37 cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord,
38
39 isTrivialCmmExpr, hasNoGlobalRegs,
40
41 -- Statics
42 blankWord,
43
44 -- Tagging
45 cmmTagMask, cmmPointerMask, cmmUntag, cmmGetTag, cmmIsTagged,
46 cmmConstrTag, cmmConstrTag1,
47
48 -- Liveness and bitmaps
49 mkLiveness,
50
51 -- * Operations that probably don't belong here
52 modifyGraph,
53
54 lastNode, replaceLastNode,
55 ofBlockMap, toBlockMap, insertBlock,
56 ofBlockList, toBlockList, bodyToBlockList,
57 foldGraphBlocks, mapGraphNodes, postorderDfs, mapGraphNodes1,
58
59 analFwd, analBwd, analRewFwd, analRewBwd,
60 dataflowPassFwd, dataflowPassBwd, dataflowAnalFwd, dataflowAnalBwd,
61 dataflowAnalFwdBlocks
62 ) where
63
64 #include "HsVersions.h"
65
66 import TyCon ( PrimRep(..) )
67 import Type ( UnaryType, typePrimRep )
68
69 import SMRep
70 import Cmm
71 import BlockId
72 import CLabel
73 import Outputable
74 import Unique
75 import UniqSupply
76 import DynFlags
77 import Util
78
79 import Data.Word
80 import Data.Maybe
81 import Data.Bits
82 import Hoopl
83
84 ---------------------------------------------------
85 --
86 -- CmmTypes
87 --
88 ---------------------------------------------------
89
90 primRepCmmType :: DynFlags -> PrimRep -> CmmType
91 primRepCmmType _ VoidRep = panic "primRepCmmType:VoidRep"
92 primRepCmmType dflags PtrRep = gcWord dflags
93 primRepCmmType dflags IntRep = bWord dflags
94 primRepCmmType dflags WordRep = bWord dflags
95 primRepCmmType _ Int64Rep = b64
96 primRepCmmType _ Word64Rep = b64
97 primRepCmmType dflags AddrRep = bWord dflags
98 primRepCmmType _ FloatRep = f32
99 primRepCmmType _ DoubleRep = f64
100
101 typeCmmType :: DynFlags -> UnaryType -> CmmType
102 typeCmmType dflags ty = primRepCmmType dflags (typePrimRep ty)
103
104 primRepForeignHint :: PrimRep -> ForeignHint
105 primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep"
106 primRepForeignHint PtrRep = AddrHint
107 primRepForeignHint IntRep = SignedHint
108 primRepForeignHint WordRep = NoHint
109 primRepForeignHint Int64Rep = SignedHint
110 primRepForeignHint Word64Rep = NoHint
111 primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg
112 primRepForeignHint FloatRep = NoHint
113 primRepForeignHint DoubleRep = NoHint
114
115 typeForeignHint :: UnaryType -> ForeignHint
116 typeForeignHint = primRepForeignHint . typePrimRep
117
118 ---------------------------------------------------
119 --
120 -- CmmLit
121 --
122 ---------------------------------------------------
123
124 -- XXX: should really be Integer, since Int doesn't necessarily cover
125 -- the full range of target Ints.
126 mkIntCLit :: DynFlags -> Int -> CmmLit
127 mkIntCLit dflags i = CmmInt (toInteger i) (wordWidth dflags)
128
129 mkIntExpr :: DynFlags -> Int -> CmmExpr
130 mkIntExpr dflags i = CmmLit $! mkIntCLit dflags i
131
132 zeroCLit :: DynFlags -> CmmLit
133 zeroCLit dflags = CmmInt 0 (wordWidth dflags)
134
135 zeroExpr :: DynFlags -> CmmExpr
136 zeroExpr dflags = CmmLit (zeroCLit dflags)
137
138 mkWordCLit :: DynFlags -> Integer -> CmmLit
139 mkWordCLit dflags wd = CmmInt wd (wordWidth dflags)
140
141 mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stmt)
142 -- We have to make a top-level decl for the string,
143 -- and return a literal pointing to it
144 mkByteStringCLit uniq bytes
145 = (CmmLabel lbl, CmmData ReadOnlyData $ Statics lbl [CmmString bytes])
146 where
147 lbl = mkStringLitLabel uniq
148 mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
149 -- Build a data-segment data block
150 mkDataLits section lbl lits
151 = CmmData section (Statics lbl $ map CmmStaticLit lits)
152
153 mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
154 -- Build a read-only data block
155 mkRODataLits lbl lits
156 = mkDataLits section lbl lits
157 where
158 section | any needsRelocation lits = RelocatableReadOnlyData
159 | otherwise = ReadOnlyData
160 needsRelocation (CmmLabel _) = True
161 needsRelocation (CmmLabelOff _ _) = True
162 needsRelocation _ = False
163
164 mkStgWordCLit :: DynFlags -> StgWord -> CmmLit
165 mkStgWordCLit dflags wd = CmmInt (fromStgWord wd) (wordWidth dflags)
166
167 packHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit
168 -- Make a single word literal in which the lower_half_word is
169 -- at the lower address, and the upper_half_word is at the
170 -- higher address
171 -- ToDo: consider using half-word lits instead
172 -- but be careful: that's vulnerable when reversed
173 packHalfWordsCLit dflags lower_half_word upper_half_word
174 = if wORDS_BIGENDIAN dflags
175 then mkWordCLit dflags ((l `shiftL` hALF_WORD_SIZE_IN_BITS dflags) .|. u)
176 else mkWordCLit dflags (l .|. (u `shiftL` hALF_WORD_SIZE_IN_BITS dflags))
177 where l = fromStgHalfWord lower_half_word
178 u = fromStgHalfWord upper_half_word
179
180 ---------------------------------------------------
181 --
182 -- CmmExpr
183 --
184 ---------------------------------------------------
185
186 mkLblExpr :: CLabel -> CmmExpr
187 mkLblExpr lbl = CmmLit (CmmLabel lbl)
188
189 cmmOffsetExpr :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
190 -- assumes base and offset have the same CmmType
191 cmmOffsetExpr dflags e (CmmLit (CmmInt n _)) = cmmOffset dflags e (fromInteger n)
192 cmmOffsetExpr dflags e byte_off = CmmMachOp (MO_Add (cmmExprWidth dflags e)) [e, byte_off]
193
194 -- NB. Do *not* inspect the value of the offset in these smart constructors!!!
195 -- because the offset is sometimes involved in a loop in the code generator
196 -- (we don't know the real Hp offset until we've generated code for the entire
197 -- basic block, for example). So we cannot eliminate zero offsets at this
198 -- stage; they're eliminated later instead (either during printing or
199 -- a later optimisation step on Cmm).
200 --
201 cmmOffset :: DynFlags -> CmmExpr -> Int -> CmmExpr
202 cmmOffset _ e 0 = e
203 cmmOffset _ (CmmReg reg) byte_off = cmmRegOff reg byte_off
204 cmmOffset _ (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
205 cmmOffset _ (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
206 cmmOffset _ (CmmStackSlot area off) byte_off
207 = CmmStackSlot area (off - byte_off)
208 -- note stack area offsets increase towards lower addresses
209 cmmOffset _ (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
210 = CmmMachOp (MO_Add rep)
211 [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
212 cmmOffset dflags expr byte_off
213 = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]
214 where
215 width = cmmExprWidth dflags expr
216
217 -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
218 cmmRegOff :: CmmReg -> Int -> CmmExpr
219 cmmRegOff reg 0 = CmmReg reg
220 cmmRegOff reg byte_off = CmmRegOff reg byte_off
221
222 cmmOffsetLit :: CmmLit -> Int -> CmmLit
223 cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off
224 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
225 cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep
226 cmmOffsetLit _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
227
228 cmmLabelOff :: CLabel -> Int -> CmmLit
229 -- Smart constructor for CmmLabelOff
230 cmmLabelOff lbl 0 = CmmLabel lbl
231 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
232
233 -- | Useful for creating an index into an array, with a staticaly known offset.
234 -- The type is the element type; used for making the multiplier
235 cmmIndex :: DynFlags
236 -> Width -- Width w
237 -> CmmExpr -- Address of vector of items of width w
238 -> Int -- Which element of the vector (0 based)
239 -> CmmExpr -- Address of i'th element
240 cmmIndex dflags width base idx = cmmOffset dflags base (idx * widthInBytes width)
241
242 -- | Useful for creating an index into an array, with an unknown offset.
243 cmmIndexExpr :: DynFlags
244 -> Width -- Width w
245 -> CmmExpr -- Address of vector of items of width w
246 -> CmmExpr -- Which element of the vector (0 based)
247 -> CmmExpr -- Address of i'th element
248 cmmIndexExpr dflags width base (CmmLit (CmmInt n _)) = cmmIndex dflags width base (fromInteger n)
249 cmmIndexExpr dflags width base idx =
250 cmmOffsetExpr dflags base byte_off
251 where
252 idx_w = cmmExprWidth dflags idx
253 byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr dflags (widthInLog width)]
254
255 cmmLoadIndex :: DynFlags -> CmmType -> CmmExpr -> Int -> CmmExpr
256 cmmLoadIndex dflags ty expr ix = CmmLoad (cmmIndex dflags (typeWidth ty) expr ix) ty
257
258 -- The "B" variants take byte offsets
259 cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
260 cmmRegOffB = cmmRegOff
261
262 cmmOffsetB :: DynFlags -> CmmExpr -> ByteOff -> CmmExpr
263 cmmOffsetB = cmmOffset
264
265 cmmOffsetExprB :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
266 cmmOffsetExprB = cmmOffsetExpr
267
268 cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
269 cmmLabelOffB = cmmLabelOff
270
271 cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
272 cmmOffsetLitB = cmmOffsetLit
273
274 -----------------------
275 -- The "W" variants take word offsets
276 cmmOffsetExprW :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
277 -- The second arg is a *word* offset; need to change it to bytes
278 cmmOffsetExprW dflags e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromInteger n)
279 cmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags (wordWidth dflags) e wd_off
280
281 cmmOffsetW :: DynFlags -> CmmExpr -> WordOff -> CmmExpr
282 cmmOffsetW dflags e n = cmmOffsetB dflags e (wORD_SIZE dflags * n)
283
284 cmmRegOffW :: DynFlags -> CmmReg -> WordOff -> CmmExpr
285 cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE dflags)
286
287 cmmOffsetLitW :: DynFlags -> CmmLit -> WordOff -> CmmLit
288 cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wORD_SIZE dflags * wd_off)
289
290 cmmLabelOffW :: DynFlags -> CLabel -> WordOff -> CmmLit
291 cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wORD_SIZE dflags * wd_off)
292
293 cmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
294 cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty
295
296 -----------------------
297 cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
298 cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
299 cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord
300 :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
301 cmmOrWord dflags e1 e2 = CmmMachOp (mo_wordOr dflags) [e1, e2]
302 cmmAndWord dflags e1 e2 = CmmMachOp (mo_wordAnd dflags) [e1, e2]
303 cmmNeWord dflags e1 e2 = CmmMachOp (mo_wordNe dflags) [e1, e2]
304 cmmEqWord dflags e1 e2 = CmmMachOp (mo_wordEq dflags) [e1, e2]
305 cmmULtWord dflags e1 e2 = CmmMachOp (mo_wordULt dflags) [e1, e2]
306 cmmUGeWord dflags e1 e2 = CmmMachOp (mo_wordUGe dflags) [e1, e2]
307 cmmUGtWord dflags e1 e2 = CmmMachOp (mo_wordUGt dflags) [e1, e2]
308 --cmmShlWord dflags e1 e2 = CmmMachOp (mo_wordShl dflags) [e1, e2]
309 cmmUShrWord dflags e1 e2 = CmmMachOp (mo_wordUShr dflags) [e1, e2]
310 cmmAddWord dflags e1 e2 = CmmMachOp (mo_wordAdd dflags) [e1, e2]
311 cmmSubWord dflags e1 e2 = CmmMachOp (mo_wordSub dflags) [e1, e2]
312 cmmMulWord dflags e1 e2 = CmmMachOp (mo_wordMul dflags) [e1, e2]
313 cmmQuotWord dflags e1 e2 = CmmMachOp (mo_wordUQuot dflags) [e1, e2]
314
315 cmmNegate :: DynFlags -> CmmExpr -> CmmExpr
316 cmmNegate _ (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
317 cmmNegate dflags e = CmmMachOp (MO_S_Neg (cmmExprWidth dflags e)) [e]
318
319 blankWord :: DynFlags -> CmmStatic
320 blankWord dflags = CmmUninitialised (wORD_SIZE dflags)
321
322 ---------------------------------------------------
323 --
324 -- CmmExpr predicates
325 --
326 ---------------------------------------------------
327
328 isTrivialCmmExpr :: CmmExpr -> Bool
329 isTrivialCmmExpr (CmmLoad _ _) = False
330 isTrivialCmmExpr (CmmMachOp _ _) = False
331 isTrivialCmmExpr (CmmLit _) = True
332 isTrivialCmmExpr (CmmReg _) = True
333 isTrivialCmmExpr (CmmRegOff _ _) = True
334 isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
335
336 hasNoGlobalRegs :: CmmExpr -> Bool
337 hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
338 hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es
339 hasNoGlobalRegs (CmmLit _) = True
340 hasNoGlobalRegs (CmmReg (CmmLocal _)) = True
341 hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
342 hasNoGlobalRegs _ = False
343
344 ---------------------------------------------------
345 --
346 -- Tagging
347 --
348 ---------------------------------------------------
349
350 -- Tag bits mask
351 --cmmTagBits = CmmLit (mkIntCLit tAG_BITS)
352 cmmTagMask, cmmPointerMask :: DynFlags -> CmmExpr
353 cmmTagMask dflags = mkIntExpr dflags (tAG_MASK dflags)
354 cmmPointerMask dflags = mkIntExpr dflags (complement (tAG_MASK dflags))
355
356 -- Used to untag a possibly tagged pointer
357 -- A static label need not be untagged
358 cmmUntag, cmmGetTag :: DynFlags -> CmmExpr -> CmmExpr
359 cmmUntag _ e@(CmmLit (CmmLabel _)) = e
360 -- Default case
361 cmmUntag dflags e = cmmAndWord dflags e (cmmPointerMask dflags)
362
363 cmmGetTag dflags e = cmmAndWord dflags e (cmmTagMask dflags)
364
365 -- Test if a closure pointer is untagged
366 cmmIsTagged :: DynFlags -> CmmExpr -> CmmExpr
367 cmmIsTagged dflags e = cmmNeWord dflags (cmmAndWord dflags e (cmmTagMask dflags)) (zeroExpr dflags)
368
369 cmmConstrTag, cmmConstrTag1 :: DynFlags -> CmmExpr -> CmmExpr
370 cmmConstrTag dflags e = cmmSubWord dflags (cmmAndWord dflags e (cmmTagMask dflags)) (mkIntExpr dflags 1)
371 -- Get constructor tag, but one based.
372 cmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags)
373
374
375 --------------------------------------------
376 --
377 -- mkLiveness
378 --
379 ---------------------------------------------
380
381 mkLiveness :: DynFlags -> [Maybe LocalReg] -> Liveness
382 mkLiveness _ [] = []
383 mkLiveness dflags (reg:regs)
384 = take sizeW bits ++ mkLiveness dflags regs
385 where
386 sizeW = case reg of
387 Nothing -> 1
388 Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE dflags - 1)
389 `quot` wORD_SIZE dflags
390 -- number of words, rounded up
391 bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
392
393 is_non_ptr Nothing = True
394 is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
395
396
397 -- ============================================== -
398 -- ============================================== -
399 -- ============================================== -
400
401 ---------------------------------------------------
402 --
403 -- Manipulating CmmGraphs
404 --
405 ---------------------------------------------------
406
407 modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
408 modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
409
410 toBlockMap :: CmmGraph -> BlockEnv CmmBlock
411 toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
412
413 ofBlockMap :: BlockId -> BlockEnv CmmBlock -> CmmGraph
414 ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}
415
416 insertBlock :: CmmBlock -> BlockEnv CmmBlock -> BlockEnv CmmBlock
417 insertBlock block map =
418 ASSERT (isNothing $ mapLookup id map)
419 mapInsert id block map
420 where id = entryLabel block
421
422 toBlockList :: CmmGraph -> [CmmBlock]
423 toBlockList g = mapElems $ toBlockMap g
424
425 ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
426 ofBlockList entry blocks = CmmGraph { g_entry = entry
427 , g_graph = GMany NothingO body NothingO }
428 where body = foldr addBlock emptyBody blocks
429
430 bodyToBlockList :: Body CmmNode -> [CmmBlock]
431 bodyToBlockList body = mapElems body
432
433 mapGraphNodes :: ( CmmNode C O -> CmmNode C O
434 , CmmNode O O -> CmmNode O O
435 , CmmNode O C -> CmmNode O C)
436 -> CmmGraph -> CmmGraph
437 mapGraphNodes funs@(mf,_,_) g =
438 ofBlockMap (entryLabel $ mf $ CmmEntry $ g_entry g) $ mapMap (mapBlock3' funs) $ toBlockMap g
439
440 mapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph
441 mapGraphNodes1 f = modifyGraph (mapGraph f)
442
443
444 foldGraphBlocks :: (CmmBlock -> a -> a) -> a -> CmmGraph -> a
445 foldGraphBlocks k z g = mapFold k z $ toBlockMap g
446
447 postorderDfs :: CmmGraph -> [CmmBlock]
448 postorderDfs g = {-# SCC "postorderDfs" #-} postorder_dfs_from (toBlockMap g) (g_entry g)
449
450 -------------------------------------------------
451 -- Running dataflow analysis and/or rewrites
452
453 -- Constructing forward and backward analysis-only pass
454 analFwd :: DataflowLattice f -> FwdTransfer n f -> FwdPass UniqSM n f
455 analBwd :: DataflowLattice f -> BwdTransfer n f -> BwdPass UniqSM n f
456
457 analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
458 analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
459
460 -- Constructing forward and backward analysis + rewrite pass
461 analRewFwd :: DataflowLattice f -> FwdTransfer n f
462 -> FwdRewrite UniqSM n f
463 -> FwdPass UniqSM n f
464
465 analRewBwd :: DataflowLattice f
466 -> BwdTransfer n f
467 -> BwdRewrite UniqSM n f
468 -> BwdPass UniqSM n f
469
470 analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
471 analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
472
473 -- Running forward and backward dataflow analysis + optional rewrite
474 dataflowPassFwd :: NonLocal n =>
475 GenCmmGraph n -> [(BlockId, f)]
476 -> FwdPass UniqSM n f
477 -> UniqSM (GenCmmGraph n, BlockEnv f)
478 dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
479 (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
480 return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
481
482 dataflowAnalFwd :: NonLocal n =>
483 GenCmmGraph n -> [(BlockId, f)]
484 -> FwdPass UniqSM n f
485 -> BlockEnv f
486 dataflowAnalFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd =
487 analyzeFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
488
489 dataflowAnalFwdBlocks :: NonLocal n =>
490 GenCmmGraph n -> [(BlockId, f)]
491 -> FwdPass UniqSM n f
492 -> UniqSM (BlockEnv f)
493 dataflowAnalFwdBlocks (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
494 -- (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
495 -- return facts
496 return (analyzeFwdBlocks fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts))
497
498 dataflowAnalBwd :: NonLocal n =>
499 GenCmmGraph n -> [(BlockId, f)]
500 -> BwdPass UniqSM n f
501 -> BlockEnv f
502 dataflowAnalBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd =
503 analyzeBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
504
505 dataflowPassBwd :: NonLocal n =>
506 GenCmmGraph n -> [(BlockId, f)]
507 -> BwdPass UniqSM n f
508 -> UniqSM (GenCmmGraph n, BlockEnv f)
509 dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
510 (graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
511 return (CmmGraph {g_entry=entry, g_graph=graph}, facts)