diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmMonad.hs | 11 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 29 |
3 files changed, 27 insertions, 19 deletions
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index f2287e0fbd..a8ec300157 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -86,8 +86,10 @@ cgTopRhsCon dflags id con args = mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len)) mk_payload (FieldOff arg _) = do - CmmLit lit <- getArgAmode arg - return lit + amode <- getArgAmode arg + case amode of + CmmLit lit -> return lit + _ -> panic "StgCmmCon.cgTopRhsCon" nonptr_wds = tot_wds - ptr_wds diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index cc941a2e57..1a708670b3 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -29,7 +29,7 @@ module StgCmmMonad ( mkCall, mkCmmCall, - forkClosureBody, forkLneBody, forkAlts, codeOnly, + forkClosureBody, forkLneBody, forkAlts, forkAltPair, codeOnly, ConTagZ, @@ -636,6 +636,15 @@ forkAlts branch_fcodes -- NB foldl. state is the *left* argument to stateIncUsage ; return branch_results } +forkAltPair :: FCode a -> FCode a -> FCode (a,a) +-- Most common use of 'forkAlts'; having this helper function avoids +-- accidental use of failible pattern-matches in @do@-notation +forkAltPair x y = do + xy' <- forkAlts [x,y] + case xy' of + [x',y'] -> return (x',y') + _ -> panic "forkAltPair" + -- collect the code emitted by an FCode computation getCodeR :: FCode a -> FCode (a, CmmAGraph) getCodeR fcode diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index da18949846..6ed3ca7402 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1929,10 +1929,9 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy -- TODO: Optimize branch for common case of no aliasing. copy src dst dst_p src_p bytes = do dflags <- getDynFlags - [moveCall, cpyCall] <- forkAlts [ - getCode $ emitMemmoveCall dst_p src_p bytes 1, - getCode $ emitMemcpyCall dst_p src_p bytes 1 - ] + (moveCall, cpyCall) <- forkAltPair + (getCode $ emitMemmoveCall dst_p src_p bytes 1) + (getCode $ emitMemcpyCall dst_p src_p bytes 1) emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr @@ -2073,12 +2072,11 @@ doCopyMutableArrayOp = emitCopyArray copy -- TODO: Optimize branch for common case of no aliasing. copy src dst dst_p src_p bytes = do dflags <- getDynFlags - [moveCall, cpyCall] <- forkAlts [ - getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes) - (wORD_SIZE dflags), - getCode $ emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes) - (wORD_SIZE dflags) - ] + (moveCall, cpyCall) <- forkAltPair + (getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes) + (wORD_SIZE dflags)) + (getCode $ emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes) + (wORD_SIZE dflags)) emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff @@ -2136,12 +2134,11 @@ doCopySmallMutableArrayOp = emitCopySmallArray copy -- TODO: Optimize branch for common case of no aliasing. copy src dst dst_p src_p bytes = do dflags <- getDynFlags - [moveCall, cpyCall] <- forkAlts - [ getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes) - (wORD_SIZE dflags) - , getCode $ emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes) - (wORD_SIZE dflags) - ] + (moveCall, cpyCall) <- forkAltPair + (getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes) + (wORD_SIZE dflags)) + (getCode $ emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes) + (wORD_SIZE dflags)) emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff |