diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2012-02-13 21:19:21 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-02-13 21:19:21 +0000 |
| commit | ec2184eded032ec3305cc40c61149c4f8408ce49 (patch) | |
| tree | 9cbe1184a655a4afa5bebe20c0187b4eca3df7dc /compiler/codeGen/CgCon.lhs | |
| parent | 3a47819657f6b8542107d14cbd883d93f6fbf442 (diff) | |
| parent | 4a0973bb25f8d328f1a41d43d9f45c374178113c (diff) | |
| download | haskell-ec2184eded032ec3305cc40c61149c4f8408ce49.tar.gz | |
Merge remote-tracking branch 'origin/master' into newcg
Conflicts:
compiler/cmm/CmmLint.hs
compiler/cmm/OldCmm.hs
compiler/codeGen/CgMonad.lhs
compiler/main/CodeOutput.lhs
Diffstat (limited to 'compiler/codeGen/CgCon.lhs')
| -rw-r--r-- | compiler/codeGen/CgCon.lhs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 17bb9d0ad8..9049504dca 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -116,7 +116,7 @@ buildDynCon :: Id -- Name of the thing to which this constr will -> CostCentreStack -- Where to grab cost centre from; -- current CCS if currentOrSubsumedCCS -> DataCon -- The data constructor - -> [(CgRep,CmmExpr)] -- Its args + -> [(CgRep,CmmExpr)] -- Its args -> FCode CgIdInfo -- Return details about how to find it buildDynCon binder ccs con args = do dflags <- getDynFlags @@ -348,12 +348,15 @@ cgReturnDataCon con amodes | otherwise -> build_it_then (jump_to deflt_lbl) } _otherwise -- The usual case - -> build_it_then emitReturnInstr + -> build_it_then $ emitReturnInstr node_live } where + node_live = Just [node] enter_it = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)), - CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ] - jump_to lbl = stmtC (CmmJump (CmmLit lbl) []) + CmmJump (entryCode $ closureInfoPtr $ CmmReg nodeReg) + node_live + ] + jump_to lbl = stmtC $ CmmJump (CmmLit lbl) node_live build_it_then return_code = do { -- BUILD THE OBJECT IN THE HEAP -- The first "con" says that the name bound to this @@ -472,7 +475,7 @@ cgDataCon data_con -- The case continuation code is expecting a tagged pointer ; stmtC (CmmAssign nodeReg (tagCons data_con (CmmReg nodeReg))) - ; performReturn emitReturnInstr } + ; performReturn $ emitReturnInstr (Just []) } -- noStmts: Ptr to thing already in Node ; whenC (not (isNullaryRepDataCon data_con)) |