X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgExpr.lhs;h=f22071e2c5569fb376a3152e73c79ee8e1596583;hb=9367b24fde0c3f5efa5934e69571f5834ed43548;hp=a71493a28b52d4815cd1d23c8deb0d081b3b037b;hpb=affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index a71493a..f22071e 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.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 CgExpr ( cgExpr ) where
 
 #include "HsVersions.h"
@@ -126,13 +133,13 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
                  then assignPtrTemp arg
                  else assignNonPtrTemp arg
                      | (arg, stg_arg) <- arg_exprs]
-    let	arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
+    let	arg_hints = zipWith CmmKinded arg_tmps (map (typeHint.stgArgType) stg_args)
     {-
 	Now, allocate some result regs.
     -}
     (res_reps,res_regs,res_hints)  <- newUnboxedTupleRegs res_ty
     ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
-	emitForeignCall (zip res_regs res_hints) fcall 
+	emitForeignCall (zipWith CmmKinded res_regs res_hints) fcall 
 	   arg_hints emptyVarSet{-no live vars-}
       
 -- tagToEnum# is special: we need to pull the constructor out of the table,
@@ -146,8 +153,7 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
 	            else assignNonPtrTemp amode
 					-- We're going to use it twice,
 					-- so save in a temp if non-trivial
-	; this_pkg <- getThisPackage
-	; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
+	; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
 	; performReturn emitReturnInstr }
    where
 	  -- If you're reading this code in the attempt to figure
@@ -183,10 +189,9 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
 	= do tag_reg <- if isFollowableArg (typeCgRep res_ty)
                         then newPtrTemp wordRep
                         else newNonPtrTemp wordRep
-	     this_pkg <- getThisPackage
 	     cgPrimOp [tag_reg] primop args emptyVarSet
 	     stmtC (CmmAssign nodeReg
-                    (tagToClosure this_pkg tycon
+                    (tagToClosure tycon
                      (CmmReg (CmmLocal tag_reg))))
 	     performReturn emitReturnInstr
   where
@@ -292,8 +297,7 @@ cgRhs name (StgRhsCon maybe_cc con args)
 	; returnFC (name, idinfo) }
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = do this_pkg <- getThisPackage
-       setSRT srt $ mkRhsClosure this_pkg name cc bi fvs upd_flag args body
+  = setSRT srt $ mkRhsClosure name cc bi fvs upd_flag args body
 \end{code}
 
 mkRhsClosure looks for two special forms of the right-hand side:
@@ -316,7 +320,7 @@ form:
 
 
 \begin{code}
-mkRhsClosure	this_pkg bndr cc bi
+mkRhsClosure	bndr cc bi
 		[the_fv]   		-- Just one free var
 		upd_flag		-- Updatable thunk
 		[]			-- A thunk
@@ -338,7 +342,7 @@ mkRhsClosure	this_pkg bndr cc bi
   where
     lf_info 		  = mkSelectorLFInfo bndr offset_into_int
 				 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
+    (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
 			-- Just want the layout
     maybe_offset	  = assocMaybe params_w_offsets selectee
     Just the_offset 	  = maybe_offset
@@ -362,7 +366,7 @@ We only generate an Ap thunk if all the free variables are pointers,
 for semi-obvious reasons.
 
 \begin{code}
-mkRhsClosure 	this_pkg bndr cc bi
+mkRhsClosure    bndr cc bi
 		fvs
 		upd_flag
 		[]			-- No args; a thunk
@@ -387,7 +391,7 @@ mkRhsClosure 	this_pkg bndr cc bi
 The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
-mkRhsClosure this_pkg bndr cc bi fvs upd_flag args body
+mkRhsClosure bndr cc bi fvs upd_flag args body
   = cgRhsClosure bndr cc bi fvs upd_flag args body
 \end{code}