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