Snapshot of codegen refactoring to share with simonpj
[ghc.git] / compiler / codeGen / StgCmmMonad.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Monad for Stg to C-- code generation
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 module StgCmmMonad (
10 FCode, -- type
11
12 initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
13 returnFC, fixC, fixC_, nopC, whenC,
14 newUnique, newUniqSupply,
15
16 emit, emitDecl, emitProc, emitProcWithConvention, emitSimpleProc,
17
18 getCmm, cgStmtsToBlocks,
19 getCodeR, getCode, getHeapUsage,
20
21 forkClosureBody, forkStatics, forkAlts, forkProc, codeOnly,
22
23 ConTagZ,
24
25 Sequel(..),
26 withSequel, getSequel,
27
28 setSRTLabel, getSRTLabel,
29 setTickyCtrLabel, getTickyCtrLabel,
30
31 withUpdFrameOff, getUpdFrameOff, initUpdFrameOff,
32
33 HeapUsage(..), VirtualHpOffset, initHpUsage,
34 getHpUsage, setHpUsage, heapHWM,
35 setVirtHp, getVirtHp, setRealHp,
36
37 getModuleName,
38
39 -- ideally we wouldn't export these, but some other modules access internal state
40 getState, setState, getInfoDown, getDynFlags, getThisPackage,
41
42 -- more localised access to monad state
43 CgIdInfo(..), CgLoc(..),
44 getBinds, setBinds, getStaticBinds,
45
46 -- out of general friendliness, we also export ...
47 CgInfoDownwards(..), CgState(..) -- non-abstract
48 ) where
49
50 #include "HsVersions.h"
51
52 import Cmm
53 import StgCmmClosure
54 import DynFlags
55 import MkGraph
56 import BlockId
57 import CLabel
58 import TyCon ( PrimRep )
59 import SMRep
60 import Module
61 import Id
62 import VarEnv
63 import OrdList
64 import Unique
65 import UniqSupply
66 import FastString(sLit)
67 import Outputable
68
69 import Control.Monad
70 import Data.List
71 import Prelude hiding( sequence )
72 import qualified Prelude( sequence )
73
74 infixr 9 `thenC` -- Right-associative!
75 infixr 9 `thenFC`
76
77
78 --------------------------------------------------------
79 -- The FCode monad and its types
80 --------------------------------------------------------
81
82 newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
83
84 instance Monad FCode where
85 (>>=) = thenFC
86 return = returnFC
87
88 {-# INLINE thenC #-}
89 {-# INLINE thenFC #-}
90 {-# INLINE returnFC #-}
91
92 initC :: DynFlags -> Module -> FCode a -> IO a
93 initC dflags mod (FCode code)
94 = do { uniqs <- mkSplitUniqSupply 'c'
95 ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
96 (res, _) -> return res
97 }
98
99 returnFC :: a -> FCode a
100 returnFC val = FCode (\_info_down state -> (val, state))
101
102 thenC :: FCode () -> FCode a -> FCode a
103 thenC (FCode m) (FCode k) =
104 FCode (\info_down state -> let (_,new_state) = m info_down state in
105 k info_down new_state)
106
107 nopC :: FCode ()
108 nopC = return ()
109
110 whenC :: Bool -> FCode () -> FCode ()
111 whenC True code = code
112 whenC False _code = nopC
113
114 listCs :: [FCode ()] -> FCode ()
115 listCs [] = return ()
116 listCs (fc:fcs) = do
117 fc
118 listCs fcs
119
120 mapCs :: (a -> FCode ()) -> [a] -> FCode ()
121 mapCs = mapM_
122
123 thenFC :: FCode a -> (a -> FCode c) -> FCode c
124 thenFC (FCode m) k = FCode (
125 \info_down state ->
126 let
127 (m_result, new_state) = m info_down state
128 (FCode kcode) = k m_result
129 in
130 kcode info_down new_state
131 )
132
133 listFCs :: [FCode a] -> FCode [a]
134 listFCs = Prelude.sequence
135
136 mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
137 mapFCs = mapM
138
139 fixC :: (a -> FCode a) -> FCode a
140 fixC fcode = FCode (
141 \info_down state ->
142 let
143 FCode fc = fcode v
144 result@(v,_) = fc info_down state
145 -- ^--------^
146 in
147 result
148 )
149
150 fixC_ :: (a -> FCode a) -> FCode ()
151 fixC_ fcode = fixC fcode >> return ()
152
153 --------------------------------------------------------
154 -- The code generator environment
155 --------------------------------------------------------
156
157 -- This monadery has some information that it only passes
158 -- *downwards*, as well as some ``state'' which is modified
159 -- as we go along.
160
161 data CgInfoDownwards -- information only passed *downwards* by the monad
162 = MkCgInfoDown {
163 cgd_dflags :: DynFlags,
164 cgd_mod :: Module, -- Module being compiled
165 cgd_statics :: CgBindings, -- [Id -> info] : static environment
166 cgd_srt_lbl :: CLabel, -- Label of the current top-level SRT
167 cgd_updfr_off :: UpdFrameOffset, -- Size of current update frame
168 cgd_ticky :: CLabel, -- Current destination for ticky counts
169 cgd_sequel :: Sequel -- What to do at end of basic block
170 }
171
172 type CgBindings = IdEnv CgIdInfo
173
174 data CgIdInfo
175 = CgIdInfo
176 { cg_id :: Id -- Id that this is the info for
177 -- Can differ from the Id at occurrence sites by
178 -- virtue of being externalised, for splittable C
179 , cg_lf :: LambdaFormInfo
180 , cg_loc :: CgLoc -- CmmExpr for the *tagged* value
181 , cg_rep :: PrimRep -- Cache for (idPrimRep id)
182 , cg_tag :: {-# UNPACK #-} !DynTag -- Cache for (lfDynTag cg_lf)
183 }
184
185 data CgLoc
186 = CmmLoc CmmExpr -- A stable CmmExpr; that is, one not mentioning
187 -- Hp, so that it remains valid across calls
188
189 | LneLoc BlockId [LocalReg] -- A join point
190 -- A join point (= let-no-escape) should only
191 -- be tail-called, and in a saturated way.
192 -- To tail-call it, assign to these locals,
193 -- and branch to the block id
194
195 instance Outputable CgIdInfo where
196 ppr (CgIdInfo { cg_id = id, cg_loc = loc })
197 = ppr id <+> ptext (sLit "-->") <+> ppr loc
198
199 instance Outputable CgLoc where
200 ppr (CmmLoc e) = ptext (sLit "cmm") <+> ppr e
201 ppr (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
202
203
204 -- Sequel tells what to do with the result of this expression
205 data Sequel
206 = Return Bool -- Return result(s) to continuation found on the stack
207 -- True <=> the continuation is update code (???)
208
209 | AssignTo
210 [LocalReg] -- Put result(s) in these regs and fall through
211 -- NB: no void arguments here
212 Bool -- Should we adjust the heap pointer back to recover
213 -- space that's unused on this path?
214 -- We need to do this only if the expression may
215 -- allocate (e.g. it's a foreign call or allocating primOp)
216 instance Show Sequel where
217 show (Return _) = "Sequel: Return"
218 show (AssignTo _ _) = "Sequel: Assign"
219
220 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
221 initCgInfoDown dflags mod
222 = MkCgInfoDown { cgd_dflags = dflags,
223 cgd_mod = mod,
224 cgd_statics = emptyVarEnv,
225 cgd_srt_lbl = error "initC: srt_lbl",
226 cgd_updfr_off = initUpdFrameOff,
227 cgd_ticky = mkTopTickyCtrLabel,
228 cgd_sequel = initSequel }
229
230 initSequel :: Sequel
231 initSequel = Return False
232
233 initUpdFrameOff :: UpdFrameOffset
234 initUpdFrameOff = widthInBytes wordWidth -- space for the RA
235
236
237 --------------------------------------------------------
238 -- The code generator state
239 --------------------------------------------------------
240
241 data CgState
242 = MkCgState {
243 cgs_stmts :: CmmAGraph, -- Current procedure
244
245 cgs_tops :: OrdList CmmTop,
246 -- Other procedures and data blocks in this compilation unit
247 -- Both are ordered only so that we can
248 -- reduce forward references, when it's easy to do so
249
250 cgs_binds :: CgBindings, -- [Id -> info] : *local* bindings environment
251 -- Bindings for top-level things are given in
252 -- the info-down part
253
254 cgs_hp_usg :: HeapUsage,
255
256 cgs_uniqs :: UniqSupply }
257
258 data HeapUsage =
259 HeapUsage {
260 virtHp :: VirtualHpOffset, -- Virtual offset of highest-allocated word
261 -- Incremented whenever we allocate
262 realHp :: VirtualHpOffset -- realHp: Virtual offset of real heap ptr
263 -- Used in instruction addressing modes
264 }
265
266 type VirtualHpOffset = WordOff
267
268 initCgState :: UniqSupply -> CgState
269 initCgState uniqs
270 = MkCgState { cgs_stmts = mkNop, cgs_tops = nilOL,
271 cgs_binds = emptyVarEnv,
272 cgs_hp_usg = initHpUsage,
273 cgs_uniqs = uniqs }
274
275 stateIncUsage :: CgState -> CgState -> CgState
276 -- stateIncUsage@ e1 e2 incorporates in e1
277 -- the heap high water mark found in e2.
278 stateIncUsage s1 s2@(MkCgState { cgs_hp_usg = hp_usg })
279 = s1 { cgs_hp_usg = cgs_hp_usg s1 `maxHpHw` virtHp hp_usg }
280 `addCodeBlocksFrom` s2
281
282 addCodeBlocksFrom :: CgState -> CgState -> CgState
283 -- Add code blocks from the latter to the former
284 -- (The cgs_stmts will often be empty, but not always; see codeOnly)
285 s1 `addCodeBlocksFrom` s2
286 = s1 { cgs_stmts = cgs_stmts s1 <*> cgs_stmts s2,
287 cgs_tops = cgs_tops s1 `appOL` cgs_tops s2 }
288
289
290 -- The heap high water mark is the larger of virtHp and hwHp. The latter is
291 -- only records the high water marks of forked-off branches, so to find the
292 -- heap high water mark you have to take the max of virtHp and hwHp. Remember,
293 -- virtHp never retreats!
294 --
295 -- Note Jan 04: ok, so why do we only look at the virtual Hp??
296
297 heapHWM :: HeapUsage -> VirtualHpOffset
298 heapHWM = virtHp
299
300 initHpUsage :: HeapUsage
301 initHpUsage = HeapUsage { virtHp = 0, realHp = 0 }
302
303 maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
304 hp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }
305
306
307 --------------------------------------------------------
308 -- Operators for getting and setting the state and "info_down".
309 --------------------------------------------------------
310
311 getState :: FCode CgState
312 getState = FCode $ \_info_down state -> (state,state)
313
314 setState :: CgState -> FCode ()
315 setState state = FCode $ \_info_down _ -> ((),state)
316
317 getHpUsage :: FCode HeapUsage
318 getHpUsage = do
319 state <- getState
320 return $ cgs_hp_usg state
321
322 setHpUsage :: HeapUsage -> FCode ()
323 setHpUsage new_hp_usg = do
324 state <- getState
325 setState $ state {cgs_hp_usg = new_hp_usg}
326
327 setVirtHp :: VirtualHpOffset -> FCode ()
328 setVirtHp new_virtHp
329 = do { hp_usage <- getHpUsage
330 ; setHpUsage (hp_usage {virtHp = new_virtHp}) }
331
332 getVirtHp :: FCode VirtualHpOffset
333 getVirtHp
334 = do { hp_usage <- getHpUsage
335 ; return (virtHp hp_usage) }
336
337 setRealHp :: VirtualHpOffset -> FCode ()
338 setRealHp new_realHp
339 = do { hp_usage <- getHpUsage
340 ; setHpUsage (hp_usage {realHp = new_realHp}) }
341
342 getBinds :: FCode CgBindings
343 getBinds = do
344 state <- getState
345 return $ cgs_binds state
346
347 setBinds :: CgBindings -> FCode ()
348 setBinds new_binds = do
349 state <- getState
350 setState $ state {cgs_binds = new_binds}
351
352 getStaticBinds :: FCode CgBindings
353 getStaticBinds = do
354 info <- getInfoDown
355 return (cgd_statics info)
356
357 withState :: FCode a -> CgState -> FCode (a,CgState)
358 withState (FCode fcode) newstate = FCode $ \info_down state ->
359 let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
360
361 newUniqSupply :: FCode UniqSupply
362 newUniqSupply = do
363 state <- getState
364 let (us1, us2) = splitUniqSupply (cgs_uniqs state)
365 setState $ state { cgs_uniqs = us1 }
366 return us2
367
368 newUnique :: FCode Unique
369 newUnique = do
370 us <- newUniqSupply
371 return (uniqFromSupply us)
372
373 ------------------
374 getInfoDown :: FCode CgInfoDownwards
375 getInfoDown = FCode $ \info_down state -> (info_down,state)
376
377 getDynFlags :: FCode DynFlags
378 getDynFlags = liftM cgd_dflags getInfoDown
379
380 getThisPackage :: FCode PackageId
381 getThisPackage = liftM thisPackage getDynFlags
382
383 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
384 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
385
386 doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
387 doFCode (FCode fcode) info_down state = fcode info_down state
388
389
390 -- ----------------------------------------------------------------------------
391 -- Get the current module name
392
393 getModuleName :: FCode Module
394 getModuleName = do { info <- getInfoDown; return (cgd_mod info) }
395
396 -- ----------------------------------------------------------------------------
397 -- Get/set the end-of-block info
398
399 withSequel :: Sequel -> FCode () -> FCode ()
400 withSequel sequel code
401 = do { info <- getInfoDown
402 ; withInfoDown code (info {cgd_sequel = sequel }) }
403
404 getSequel :: FCode Sequel
405 getSequel = do { info <- getInfoDown
406 ; return (cgd_sequel info) }
407
408 -- ----------------------------------------------------------------------------
409 -- Get/set the current SRT label
410
411 -- There is just one SRT for each top level binding; all the nested
412 -- bindings use sub-sections of this SRT. The label is passed down to
413 -- the nested bindings via the monad.
414
415 getSRTLabel :: FCode CLabel -- Used only by cgPanic
416 getSRTLabel = do info <- getInfoDown
417 return (cgd_srt_lbl info)
418
419 setSRTLabel :: CLabel -> FCode a -> FCode a
420 setSRTLabel srt_lbl code
421 = do info <- getInfoDown
422 withInfoDown code (info { cgd_srt_lbl = srt_lbl})
423
424 -- ----------------------------------------------------------------------------
425 -- Get/set the size of the update frame
426
427 -- We keep track of the size of the update frame so that we
428 -- can set the stack pointer to the proper address on return
429 -- (or tail call) from the closure.
430 -- There should be at most one update frame for each closure.
431 -- Note: I'm including the size of the original return address
432 -- in the size of the update frame -- hence the default case on `get'.
433
434 withUpdFrameOff :: UpdFrameOffset -> FCode () -> FCode ()
435 withUpdFrameOff size code
436 = do { info <- getInfoDown
437 ; withInfoDown code (info {cgd_updfr_off = size }) }
438
439 getUpdFrameOff :: FCode UpdFrameOffset
440 getUpdFrameOff
441 = do { info <- getInfoDown
442 ; return $ cgd_updfr_off info }
443
444 -- ----------------------------------------------------------------------------
445 -- Get/set the current ticky counter label
446
447 getTickyCtrLabel :: FCode CLabel
448 getTickyCtrLabel = do
449 info <- getInfoDown
450 return (cgd_ticky info)
451
452 setTickyCtrLabel :: CLabel -> FCode () -> FCode ()
453 setTickyCtrLabel ticky code = do
454 info <- getInfoDown
455 withInfoDown code (info {cgd_ticky = ticky})
456
457
458 --------------------------------------------------------
459 -- Forking
460 --------------------------------------------------------
461
462 forkClosureBody :: FCode () -> FCode ()
463 -- forkClosureBody takes a code, $c$, and compiles it in a
464 -- fresh environment, except that:
465 -- - compilation info and statics are passed in unchanged.
466 -- - local bindings are passed in unchanged
467 -- (it's up to the enclosed code to re-bind the
468 -- free variables to a field of the closure)
469 --
470 -- The current state is passed on completely unaltered, except that
471 -- C-- from the fork is incorporated.
472
473 forkClosureBody body_code
474 = do { info <- getInfoDown
475 ; us <- newUniqSupply
476 ; state <- getState
477 ; let body_info_down = info { cgd_sequel = initSequel
478 , cgd_updfr_off = initUpdFrameOff }
479 fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }
480 ((),fork_state_out)
481 = doFCode body_code body_info_down fork_state_in
482 ; setState $ state `addCodeBlocksFrom` fork_state_out }
483
484 forkStatics :: FCode a -> FCode a
485 -- @forkStatics@ $fc$ compiles $fc$ in an environment whose *statics* come
486 -- from the current *local bindings*, but which is otherwise freshly initialised.
487 -- The Abstract~C returned is attached to the current state, but the
488 -- bindings and usage information is otherwise unchanged.
489 forkStatics body_code
490 = do { info <- getInfoDown
491 ; us <- newUniqSupply
492 ; state <- getState
493 ; let rhs_info_down = info { cgd_statics = cgs_binds state
494 , cgd_sequel = initSequel
495 , cgd_updfr_off = initUpdFrameOff }
496 (result, fork_state_out) = doFCode body_code rhs_info_down
497 (initCgState us)
498 ; setState (state `addCodeBlocksFrom` fork_state_out)
499 ; return result }
500
501 forkProc :: FCode a -> FCode a
502 -- 'forkProc' takes a code and compiles it in the *current* environment,
503 -- returning the graph thus constructed.
504 --
505 -- The current environment is passed on completely unchanged to
506 -- the successor. In particular, any heap usage from the enclosed
507 -- code is discarded; it should deal with its own heap consumption
508 forkProc body_code
509 = do { info_down <- getInfoDown
510 ; us <- newUniqSupply
511 ; state <- getState
512 ; let info_down' = info_down -- { cgd_sequel = initSequel }
513 fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }
514 (result, fork_state_out) = doFCode body_code info_down' fork_state_in
515 ; setState $ state `addCodeBlocksFrom` fork_state_out
516 ; return result }
517
518 codeOnly :: FCode () -> FCode ()
519 -- Emit any code from the inner thing into the outer thing
520 -- Do not affect anything else in the outer state
521 -- Used in almost-circular code to prevent false loop dependencies
522 codeOnly body_code
523 = do { info_down <- getInfoDown
524 ; us <- newUniqSupply
525 ; state <- getState
526 ; let fork_state_in = (initCgState us) { cgs_binds = cgs_binds state,
527 cgs_hp_usg = cgs_hp_usg state }
528 ((), fork_state_out) = doFCode body_code info_down fork_state_in
529 ; setState $ state `addCodeBlocksFrom` fork_state_out }
530
531 forkAlts :: [FCode a] -> FCode [a]
532 -- (forkAlts' bs d) takes fcodes 'bs' for the branches of a 'case', and
533 -- an fcode for the default case 'd', and compiles each in the current
534 -- environment. The current environment is passed on unmodified, except
535 -- that the virtual Hp is moved on to the worst virtual Hp for the branches
536
537 forkAlts branch_fcodes
538 = do { info_down <- getInfoDown
539 ; us <- newUniqSupply
540 ; state <- getState
541 ; let compile us branch
542 = (us2, doFCode branch info_down branch_state)
543 where
544 (us1,us2) = splitUniqSupply us
545 branch_state = (initCgState us1) {
546 cgs_binds = cgs_binds state,
547 cgs_hp_usg = cgs_hp_usg state }
548
549 (_us, results) = mapAccumL compile us branch_fcodes
550 (branch_results, branch_out_states) = unzip results
551 ; setState $ foldl stateIncUsage state branch_out_states
552 -- NB foldl. state is the *left* argument to stateIncUsage
553 ; return branch_results }
554
555 -- collect the code emitted by an FCode computation
556 getCodeR :: FCode a -> FCode (a, CmmAGraph)
557 getCodeR fcode
558 = do { state1 <- getState
559 ; (a, state2) <- withState fcode (state1 { cgs_stmts = mkNop })
560 ; setState $ state2 { cgs_stmts = cgs_stmts state1 }
561 ; return (a, cgs_stmts state2) }
562
563 getCode :: FCode a -> FCode CmmAGraph
564 getCode fcode = do { (_,stmts) <- getCodeR fcode; return stmts }
565
566 -- 'getHeapUsage' applies a function to the amount of heap that it uses.
567 -- It initialises the heap usage to zeros, and passes on an unchanged
568 -- heap usage.
569 --
570 -- It is usually a prelude to performing a GC check, so everything must
571 -- be in a tidy and consistent state.
572 --
573 -- Note the slightly subtle fixed point behaviour needed here
574
575 getHeapUsage :: (VirtualHpOffset -> FCode a) -> FCode a
576 getHeapUsage fcode
577 = do { info_down <- getInfoDown
578 ; state <- getState
579 ; let fstate_in = state { cgs_hp_usg = initHpUsage }
580 (r, fstate_out) = doFCode (fcode hp_hw) info_down fstate_in
581 hp_hw = heapHWM (cgs_hp_usg fstate_out) -- Loop here!
582
583 ; setState $ fstate_out { cgs_hp_usg = cgs_hp_usg state }
584 ; return r }
585
586 -- ----------------------------------------------------------------------------
587 -- Combinators for emitting code
588
589 emit :: CmmAGraph -> FCode ()
590 emit ag
591 = do { state <- getState
592 ; setState $ state { cgs_stmts = cgs_stmts state <*> ag } }
593
594 emitDecl :: CmmTop -> FCode ()
595 emitDecl decl
596 = do { state <- getState
597 ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
598
599 emitProcWithConvention :: Convention -> CmmInfoTable -> CLabel -> [CmmFormal] ->
600 CmmAGraph -> FCode ()
601 emitProcWithConvention conv info lbl args blocks
602 = do { us <- newUniqSupply
603 ; let (offset, entry) = mkCallEntry conv args
604 blks = initUs_ us $ lgraphOfAGraph $ entry <*> blocks
605 ; let sinfo = StackInfo {arg_space = offset, updfr_space = Just initUpdFrameOff}
606 proc_block = CmmProc (TopInfo {info_tbl=info, stack_info=sinfo}) lbl blks
607 ; state <- getState
608 ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
609
610 emitProc :: CmmInfoTable -> CLabel -> [CmmFormal] -> CmmAGraph -> FCode ()
611 emitProc = emitProcWithConvention NativeNodeCall
612
613 emitSimpleProc :: CLabel -> CmmAGraph -> FCode ()
614 emitSimpleProc lbl code =
615 emitProc CmmNonInfoTable lbl [] code
616
617 getCmm :: FCode () -> FCode CmmPgm
618 -- Get all the CmmTops (there should be no stmts)
619 -- Return a single Cmm which may be split from other Cmms by
620 -- object splitting (at a later stage)
621 getCmm code
622 = do { state1 <- getState
623 ; ((), state2) <- withState code (state1 { cgs_tops = nilOL })
624 ; setState $ state2 { cgs_tops = cgs_tops state1 }
625 ; return (fromOL (cgs_tops state2)) }
626
627 -- ----------------------------------------------------------------------------
628 -- CgStmts
629
630 -- These functions deal in terms of CgStmts, which is an abstract type
631 -- representing the code in the current proc.
632
633 -- turn CgStmts into [CmmBasicBlock], for making a new proc.
634 cgStmtsToBlocks :: CmmAGraph -> FCode CmmGraph
635 cgStmtsToBlocks stmts
636 = do { us <- newUniqSupply
637 ; return (initUs_ us (lgraphOfAGraph stmts)) }
638