Commit f33b7c70 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Wibbles to MkZipCfgCmm stuff

Watch out: I've added MkZipCfg.sequence, which clashes with the
Prelude (like some other names in MkZipCfg.  Maybe you can think
of a better name for it.
parent d8f6f78c
{-# LANGUAGE ScopedTypeVariables #-}
module MkZipCfg
( AGraph, (<*>), emptyAGraph, withFreshLabel, withUnique
( AGraph, (<*>), sequence
, emptyAGraph, withFreshLabel, withUnique
, mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
, outOfLine
, emptyGraph, graphOfMiddles, graphOfZTail
......@@ -15,7 +16,7 @@ import Unique
import UniqFM
import UniqSupply
import Prelude hiding (zip, unzip, last)
import Prelude hiding (zip, unzip, last, sequence)
#include "HsVersions.h"
......@@ -153,6 +154,8 @@ representation is agnostic on this point.)
infixr 3 <*>
(<*>) :: AGraph m l -> AGraph m l -> AGraph m l
sequence :: [AGraph m l] -> AGraph m l
-- | A graph is built up by splicing together graphs each containing a
-- single node (where a label is considered a 'first' node. The empty
-- graph is a left and right unit for splicing. All of the AGraph
......@@ -247,6 +250,8 @@ newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
AGraph f1 <*> AGraph f2 = AGraph f
where f g = f2 g >>= f1 -- note right associativity
sequence = foldr (<*>) emptyAGraph
emptyAGraph = AGraph return
graphOfAGraph (AGraph f) = f emptyGraph
......
......@@ -6,10 +6,10 @@
-- complain to Norman Ramsey.
module MkZipCfgCmm
( mkNop, mkAssign, mkStore, mkCall, mkUnsafeCall, mkFinalCall
( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
, mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
, mkCmmWhileDo
, (<*>), mkLabel, mkBranch
, (<*>), sequence, mkLabel, mkBranch
, emptyAGraph, withFreshLabel, withUnique, outOfLine
, lgraphOfAGraph, graphOfAGraph, labelAGraph
, CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
......@@ -31,6 +31,7 @@ import FastString
import ForeignCall
import ZipCfg
import MkZipCfg
import Prelude hiding( sequence )
type CmmGraph = LGraph Middle Last
type CmmAGraph = AGraph Middle Last
......@@ -38,25 +39,37 @@ type CmmBlock = Block Middle Last
type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
---------- No-ops
mkNop :: CmmAGraph
mkComment :: FastString -> CmmAGraph
---------- Assignment and store
mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
---------- Calls
mkCall :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
-- Native C-- calling convention
mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
-- Never returns; like exit() or barf()
mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
mkReturn :: CmmActuals -> CmmAGraph
mkComment :: FastString -> CmmAGraph
-- Not to be forgotten, but exported by MkZipCfg:
--mkBranch :: BlockId -> CmmAGraph
--mkLabel :: BlockId -> CmmAGraph
---------- Control transfer
mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
mkReturn :: CmmActuals -> CmmAGraph
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
-- Not to be forgotten, but exported by MkZipCfg:
-- mkBranch :: BlockId -> CmmAGraph
-- mkLabel :: BlockId -> CmmAGraph
-- outOfLine :: CmmAGraph -> CmmAGraph
-- withUnique :: (Unique -> CmmAGraph) -> CmmAGraph
-- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
--------------------------------------------------------------------------
mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
......@@ -86,6 +99,8 @@ mkFinalCall f conv actuals =
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkLast (LastCall f Nothing)
mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
mkCall f conv results actuals srt =
withFreshLabel "call successor" $ \k ->
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment