X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgMonad.lhs;h=9b195bfab2a868b3d3db2b2c15a70ffe69f5d1ad;hp=af6b1ed311c222775b148ed4062f8dc850c20c49;hb=a0346fa834f8005f9f33b736ee4b098ea4205de1;hpb=9d0c8f842e35dde3d570580cf62a32779f66a6de diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index af6b1ed..9b195bf 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -47,7 +47,7 @@ module CgMonad ( Sequel(..), -- ToDo: unabstract? -- ideally we wouldn't export these, but some other modules access internal state - getState, setState, getInfoDown, getDynFlags, getThisPackage, + getState, setState, getInfoDown, getDynFlags, getThisPackage, -- more localised access to monad state getStkUsage, setStkUsage, @@ -63,8 +63,8 @@ import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds ) import DynFlags import BlockId -import Cmm -import CmmUtils +import OldCmm +import OldCmmUtils import CLabel import StgSyn (SRT) import SMRep @@ -73,9 +73,7 @@ import Id import VarEnv import OrdList import Unique -import Util() import UniqSupply -import FastString() import Outputable import Control.Monad @@ -169,7 +167,6 @@ block. \begin{code} data Sequel = OnStack -- Continuation is on the stack - | UpdateCode -- Continuation is update | CaseAlts CLabel -- Jump to this; if the continuation is for a vectored @@ -704,6 +701,8 @@ whenC :: Bool -> Code -> Code whenC True code = code whenC False _ = nopC +-- Corresponds to 'emit' in new code generator with a smart constructor +-- from cmm/MkGraph.hs stmtC :: CmmStmt -> Code stmtC stmt = emitCgStmt (CgStmt stmt) @@ -712,7 +711,7 @@ labelC id = emitCgStmt (CgLabel id) newLabelC :: FCode BlockId newLabelC = do { u <- newUnique - ; return $ BlockId u } + ; return $ mkBlockId u } checkedAbsC :: CmmStmt -> Code -- Emit code, eliminating no-ops @@ -744,11 +743,12 @@ emitData sect lits where data_block = CmmData sect lits -emitProc :: CmmInfo -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code -emitProc info lbl args blocks - = do { let proc_block = CmmProc info lbl args (ListGraph blocks) +emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code +emitProc info lbl [] blocks + = do { let proc_block = CmmProc info lbl (ListGraph blocks) ; state <- getState ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } } +emitProc _ _ (_:_) _ = panic "emitProc called with nonempty args" emitSimpleProc :: CLabel -> Code -> Code -- Emit a procedure whose body is the specified code; no info table