X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTailCall.lhs;h=e4f79a7aa6bde56706eb66fe7ea5d47d12abfd7e;hb=0aa5f6851c493805be58da3798f6ad55b6538cf2;hp=73030d1d27072911ee2e3c47ff79f556d83e7421;hpb=b4ca3b65d621bf8c792a41587bc5e10ab25b3350;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index 73030d1..e4f79a7 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -5,13 +5,6 @@
 % Code generation for tail calls.
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module CgTailCall (
 	cgTailCall, performTailCall,
 	performReturn, performPrimReturn,
@@ -41,7 +34,6 @@ import Type
 import Id
 import StgSyn
 import PrimOp
-import FastString
 import Outputable
 
 import Control.Monad
@@ -116,7 +108,8 @@ performTailCall fun_info arg_amodes pending_assts
 			    | otherwise		        = noStmts
 	; EndOfBlockInfo sp _ <- getEndOfBlockInfo
 
-	; case (getCallMethod fun_name fun_has_cafs lf_info (length arg_amodes)) of
+	; dflags <- getDynFlags
+	; case (getCallMethod dflags fun_name fun_has_cafs lf_info (length arg_amodes)) of
 
 	    -- Node must always point to things we enter
 	    EnterIt -> do
@@ -141,7 +134,7 @@ performTailCall fun_info arg_amodes pending_assts
 	    -- A real constructor.  Don't bother entering it, 
 	    -- just do the right sort of return instead.
 	    -- As with any return, Node must point to it.
-	    ReturnCon con -> do
+	    ReturnCon _ -> do
 		{ emitSimultaneously (node_asst `plusStmts` pending_assts)
 		; doFinalJump sp False emitReturnInstr }
 
@@ -238,7 +231,9 @@ performTailCall fun_info arg_amodes pending_assts
             -- CONSTR_NOCAF_STATIC (from ClosureType.h)
 -}
 
-
+directCall :: VirtualSpOffset -> CLabel -> [(CgRep, CmmExpr)]
+           -> [(CgRep, CmmExpr)] -> CmmStmts
+           -> Code
 directCall sp lbl args extra_args assts = do
   let
 	-- First chunk of args go in registers
@@ -289,7 +284,7 @@ performReturn :: Code	-- The code to execute to actually do the return
 	      -> Code
 
 performReturn finish_code
-  = do  { EndOfBlockInfo args_sp sequel <- getEndOfBlockInfo
+  = do  { EndOfBlockInfo args_sp _sequel <- getEndOfBlockInfo
 	; doFinalJump args_sp False{-not a LNE-} finish_code }
 
 -- ----------------------------------------------------------------------------
@@ -321,7 +316,7 @@ performPrimReturn rep amode
 
 returnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code
 returnUnboxedTuple amodes
-  = do 	{ eob@(EndOfBlockInfo args_sp sequel) <- getEndOfBlockInfo
+  = do 	{ (EndOfBlockInfo args_sp _sequel) <- getEndOfBlockInfo
 	; tickyUnboxedTupleReturn (length amodes)
 	; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
 	; emitSimultaneously assts
@@ -415,7 +410,7 @@ tailCallPrimOp op args
 
 pushReturnAddress :: EndOfBlockInfo -> Code
 
-pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _))
+pushReturnAddress (EndOfBlockInfo args_sp (CaseAlts lbl _ _))
   = do	{ sp_rel <- getSpRelOffset args_sp
 	; stmtC (CmmStore sp_rel (mkLblExpr lbl)) }