X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTailCall.lhs;h=4f890998ae186b0e77f0661ee340b21eed249b81;hb=5892af0e08fdb890b5a0b9a64346d9f7773a6ed8;hp=16369ab573ef89f1e33308f47be37227c35913c5;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index 16369ab..4f89099 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -34,7 +34,6 @@ import CgUtils
 import CgTicky
 import ClosureInfo
 import SMRep
-import MachOp
 import Cmm	
 import CmmUtils
 import CLabel
@@ -42,6 +41,7 @@ import Type
 import Id
 import StgSyn
 import PrimOp
+import FastString
 import Outputable
 
 import Control.Monad
@@ -117,7 +117,7 @@ performTailCall fun_info arg_amodes pending_assts
 	; EndOfBlockInfo sp _ <- getEndOfBlockInfo
 	; this_pkg <- getThisPackage
 
-	; case (getCallMethod fun_name lf_info (length arg_amodes)) of
+	; case (getCallMethod fun_name fun_has_cafs lf_info (length arg_amodes)) of
 
 	    -- Node must always point to things we enter
 	    EnterIt -> do
@@ -184,8 +184,10 @@ performTailCall fun_info arg_amodes pending_assts
 	        }
 	}
   where
-    fun_name  = idName (cgIdInfoId fun_info)
+    fun_id    = cgIdInfoId fun_info
+    fun_name  = idName fun_id
     lf_info   = cgIdInfoLF fun_info
+    fun_has_cafs = idCafInfo fun_id
     untag_node = CmmAssign nodeReg (cmmUntag (CmmReg nodeReg))
     -- Test if closure is a constructor
     maybeSwitchOnCons enterClosure eob
@@ -227,6 +229,7 @@ performTailCall fun_info arg_amodes pending_assts
         where
           --cond1 tag  = cmmULtWord tag lowCons
           -- More efficient than the above?
+{-
           tag_expr   = cmmGetClosureType (CmmReg nodeReg)
           cond1 tag  = cmmEqWord tag (CmmLit (mkIntCLit 0))
           cond2 tag  = cmmUGtWord tag highCons
@@ -234,11 +237,9 @@ performTailCall fun_info arg_amodes pending_assts
             -- CONSTR
           highCons   = CmmLit (mkIntCLit 8)
             -- CONSTR_NOCAF_STATIC (from ClosureType.h)
+-}
 
 
-untagCmmAssign (CmmAssign r cmmExpr) = CmmAssign r (cmmUntag cmmExpr)
-untagCmmAssign stmt                  = stmt
-
 directCall sp lbl args extra_args assts = do
   let
 	-- First chunk of args go in registers
@@ -475,3 +476,4 @@ adjustSpAndHp newRealSp
 	; setRealHp vHp
 	}
 \end{code}
+