diff options
Diffstat (limited to 'compiler/codeGen/StgCmmMonad.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmMonad.hs | 21 |
1 files changed, 4 insertions, 17 deletions
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index eb6b9a988f..3d34cb9bdd 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -30,7 +30,7 @@ module StgCmmMonad ( getCodeR, getCode, getHeapUsage, mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto, - mkCall, mkCmmCall, mkSafeCall, + mkCall, mkCmmCall, forkClosureBody, forkStatics, forkAlts, forkProc, codeOnly, @@ -95,6 +95,9 @@ infixr 9 `thenFC` newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState)) +instance Functor FCode where + fmap f (FCode g) = FCode $ \i s -> let (a,s') = g i s in (f a, s') + instance Monad FCode where (>>=) = thenFC return = returnFC @@ -792,22 +795,6 @@ mkCmmCall f results actuals updfr_off = mkCall f (NativeDirectCall, NativeReturn) results actuals updfr_off (0,[]) -mkSafeCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] - -> UpdFrameOffset -> Bool - -> FCode CmmAGraph -mkSafeCall t fs as upd i = do - k <- newLabelC - let (_off, copyout) = copyInOflow NativeReturn (Young k) fs - -- see Note [safe foreign call convention] - return - ( mkStore (CmmStackSlot (Young k) (widthInBytes wordWidth)) - (CmmLit (CmmBlock k)) - <*> mkLast (CmmForeignCall { tgt=t, res=fs, args=as, succ=k - , updfr=upd, intrbl=i }) - <*> mkLabel k - <*> copyout - ) - -- ---------------------------------------------------------------------------- -- CgStmts |