X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgCase.lhs;h=859b2208fefd52bcd8cb4b7f5ca2a65cc89af1fc;hp=a473e9158e02f45605745b48c3c58896a049c52f;hb=176fa33f17dd78355cc572e006d2ab26898e2c69;hpb=207802589da0d23c3f16195f453b24a1e46e322d

diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index a473e91..859b220 100644
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -4,6 +4,13 @@
 %
 
 \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 CgCase (	cgCase, saveVolatileVarsAndRegs, 
 		restoreCurrentCostCentre
 	) where
@@ -29,7 +36,6 @@ import ClosureInfo
 import SMRep
 import CmmUtils
 import Cmm
-import MachOp
 
 import StgSyn
 import StaticFlags
@@ -95,7 +101,6 @@ cgCase	:: StgExpr
 	-> StgLiveVars
 	-> StgLiveVars
 	-> Id
-	-> SRT
 	-> AltType
 	-> [StgAlt]
 	-> Code
@@ -104,7 +109,7 @@ cgCase	:: StgExpr
 Special case #1: case of literal.
 
 \begin{code}
-cgCase (StgLit lit) live_in_whole_case live_in_alts bndr srt 
+cgCase (StgLit lit) live_in_whole_case live_in_alts bndr
        alt_type@(PrimAlt tycon) alts
   = do	{ tmp_reg <- bindNewToTemp bndr
 	; cm_lit <- cgLit lit
@@ -120,7 +125,7 @@ allocating more heap than strictly necessary, but it will sometimes
 eliminate a heap check altogether.
 
 \begin{code}
-cgCase (StgApp v []) live_in_whole_case live_in_alts bndr srt
+cgCase (StgApp v []) live_in_whole_case live_in_alts bndr
        alt_type@(PrimAlt tycon) alts
   = do	{ -- Careful! we can't just bind the default binder to the same thing
 	  -- as the scrutinee, since it might be a stack location, and having
@@ -137,7 +142,7 @@ Special case #3: inline PrimOps and foreign calls.
 
 \begin{code}
 cgCase (StgOpApp op@(StgPrimOp primop) args _) 
-       live_in_whole_case live_in_alts bndr srt alt_type alts
+       live_in_whole_case live_in_alts bndr alt_type alts
   | not (primOpOutOfLine primop)
   = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
 \end{code}
@@ -152,14 +157,14 @@ right here, just like an inline primop.
 
 \begin{code}
 cgCase (StgOpApp op@(StgFCallOp fcall _) args _) 
-       live_in_whole_case live_in_alts bndr srt alt_type alts
+       live_in_whole_case live_in_alts bndr alt_type alts
   | unsafe_foreign_call
   = ASSERT( isSingleton alts )
     do	--  *must* be an unboxed tuple alt.
 	-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
 	{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; let res_hints = map (typeHint.idType) non_void_res_ids
-	; cgForeignCall (zip res_tmps res_hints) fcall args live_in_alts
+	; let res_hints = map (typeForeignHint.idType) non_void_res_ids
+	; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
 	; cgExpr rhs }
   where
    (_, res_ids, _, rhs) = head alts
@@ -177,7 +182,7 @@ we can reuse/trim the stack slot holding the variable (if it is in one).
 
 \begin{code}
 cgCase (StgApp fun args)
-	live_in_whole_case live_in_alts bndr srt alt_type alts
+	live_in_whole_case live_in_alts bndr alt_type alts
   = do	{ fun_info <- getCgIdInfo fun
 	; arg_amodes <- getArgAmodes args
 
@@ -195,7 +200,7 @@ cgCase (StgApp fun args)
 	    <- forkEval alts_eob_info 
 			(allocStackTop retAddrSizeW >> nopC)
 			(do { deAllocStackTop retAddrSizeW
-			    ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
+			    ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
 
 	; setEndOfBlockInfo scrut_eob_info
 			    (performTailCall fun_info arg_amodes save_assts) }
@@ -215,7 +220,7 @@ deAllocStackTop call is doing above.
 Finally, here is the general case.
 
 \begin{code}
-cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts
+cgCase expr live_in_whole_case live_in_alts bndr alt_type alts
   = do	{	-- Figure out what volatile variables to save
 	  nukeDeadBindings live_in_whole_case
     
@@ -232,7 +237,7 @@ cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts
 				; allocStackTop retAddrSizeW   -- space for retn address 
 				; nopC })
 			   (do	{ deAllocStackTop retAddrSizeW
-				; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
+				; cgEvalAlts maybe_cc_slot bndr alt_type alts })
 
 	; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
     }
@@ -317,7 +322,7 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
 		(do { tmp_reg <- bindNewToTemp bndr
 		    ; stmtC (CmmAssign
                              (CmmLocal tmp_reg)
-                             (tagToClosure this_pkg tycon tag_amode)) })
+                             (tagToClosure tycon tag_amode)) })
 
 		-- Compile the alts
 	; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
@@ -334,7 +339,7 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
          (_,e) <- getArgAmode arg
 	 return e
     do_enum_primop primop
-      = do tmp <- newNonPtrTemp wordRep
+      = do tmp <- newTemp bWord
 	   cgPrimOp [tmp] primop args live_in_alts
     	   returnFC (CmmReg (CmmLocal tmp))
 
@@ -355,14 +360,13 @@ is some evaluation to be done.
 \begin{code}
 cgEvalAlts :: Maybe VirtualSpOffset	-- Offset of cost-centre to be restored, if any
 	   -> Id
-	   -> SRT			-- SRT for the continuation
 	   -> AltType
 	   -> [StgAlt]
 	   -> FCode Sequel	-- Any addr modes inside are guaranteed
 				-- to be a label so that we can duplicate it 
 				-- without risk of duplicating code
 
-cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
+cgEvalAlts cc_slot bndr alt_type@(PrimAlt tycon) alts
   = do	{ let   rep = tyConCgRep tycon
 		reg = dataReturnConvPrim rep	-- Bottom for voidRep
 
@@ -374,10 +378,10 @@ cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
 		; restoreCurrentCostCentre cc_slot True
 		; cgPrimAlts GCMayHappen alt_type reg alts }
 
-	; lbl <- emitReturnTarget (idName bndr) abs_c srt
+	; lbl <- emitReturnTarget (idName bndr) abs_c
 	; returnFC (CaseAlts lbl Nothing bndr) }
 
-cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
+cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)]
   =	-- Unboxed tuple case
 	-- By now, the simplifier should have have turned it
 	-- into 	case e of (# a,b #) -> e
@@ -396,10 +400,10 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
 			-- and finally the code for the alternative
 		; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
 				     (cgExpr rhs) }
-	; lbl <- emitReturnTarget (idName bndr) abs_c srt
+	; lbl <- emitReturnTarget (idName bndr) abs_c
 	; returnFC (CaseAlts lbl Nothing bndr) }
 
-cgEvalAlts cc_slot bndr srt alt_type alts
+cgEvalAlts cc_slot bndr alt_type alts
   = 	-- Algebraic and polymorphic case
     do	{	-- Bind the default binder
 	  bindNewToReg bndr nodeReg (mkLFArgument bndr)
@@ -416,7 +420,7 @@ cgEvalAlts cc_slot bndr srt alt_type alts
 	; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
 
 	; (lbl, branches) <- emitAlgReturnTarget (idName bndr) 
-				alts mb_deflt srt fam_sz
+				alts mb_deflt fam_sz
 
 	; returnFC (CaseAlts lbl branches bndr) }
   where
@@ -607,6 +611,6 @@ restoreCurrentCostCentre Nothing     _freeit = nopC
 restoreCurrentCostCentre (Just slot) freeit
  = do 	{ sp_rel <- getSpRelOffset slot
 	; whenC freeit (freeStackSlots [slot])
-	; stmtC (CmmStore curCCSAddr (CmmLoad sp_rel wordRep)) }
+	; stmtC (CmmStore curCCSAddr (CmmLoad sp_rel bWord)) }
 \end{code}