root/compiler/cmm/CmmUtils.hs

Revision 1df198643cc5502ee103f043193d2990c9837e25, 19.3 KB (checked in by Ian Lynagh <igloo@…>, 7 months ago)

Use -fwarn-tabs when validating

We only use it for "compiler" sources, i.e. not for libraries.
Many modules have a -fno-warn-tabs kludge for now.

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