Merging in the new codegen branch

[ghc-hetmet.git] / compiler / codeGen / CgExpr.lhs

diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index a71493a..3b75267 100644 (file)
--- 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"
@@ -30,7 +37,7 @@ import CgHpc
 import CgUtils
 import ClosureInfo
 import Cmm
-import MachOp
+import CmmUtils
 import VarSet
 import Literal
 import PrimOp
@@ -41,6 +48,7 @@ import Maybes
 import ListSetOps
 import BasicTypes
 import Util
+import FastString
 import Outputable
 \end{code}
 
@@ -121,18 +129,15 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
                    | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, 
                      nonVoidArg rep]
 
-    arg_tmps <- sequence [
-                 if isFollowableArg (typeCgRep (stgArgType stg_arg))
-                 then assignPtrTemp arg
-                 else assignNonPtrTemp arg
-                     | (arg, stg_arg) <- arg_exprs]
-    let        arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
+    arg_tmps <- sequence [ assignTemp arg
+                         | (arg, stg_arg) <- arg_exprs]
+    let        arg_hints = zipWith CmmHinted arg_tmps (map (typeForeignHint.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 CmmHinted res_regs res_hints) fcall 
           arg_hints emptyVarSet{-no live vars-}
       
 -- tagToEnum# is special: we need to pull the constructor out of the table,
@@ -141,13 +146,9 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty) 
   = ASSERT(isEnumerationTyCon tycon)
     do { (rep,amode) <- getArgAmode arg
-       ; amode' <- if isFollowableArg rep
-                    then assignPtrTemp amode
-                   else assignNonPtrTemp amode
-                                       -- We're going to use it twice,
+       ; amode' <- assignTemp 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
@@ -167,9 +168,7 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
             performReturn emitReturnInstr
 
   | ReturnsPrim rep <- result_info
-       = do res <- if isFollowableArg (typeCgRep res_ty)
-                        then newPtrTemp (argMachRep (typeCgRep res_ty))
-                        else newNonPtrTemp (argMachRep (typeCgRep res_ty))
+       = do res <- newTemp (typeCmmType res_ty)
              cgPrimOp [res] primop args emptyVarSet
             performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
 
@@ -180,13 +179,10 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
 
   | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
        -- c.f. cgExpr (...TagToEnumOp...)
-       = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
-                        then newPtrTemp wordRep
-                        else newNonPtrTemp wordRep
-            this_pkg <- getThisPackage
+       = do tag_reg <- newTemp bWord   -- The tag is a word
             cgPrimOp [tag_reg] primop args emptyVarSet
             stmtC (CmmAssign nodeReg
-                    (tagToClosure this_pkg tycon
+                    (tagToClosure tycon
                      (CmmReg (CmmLocal tag_reg))))
             performReturn emitReturnInstr
   where
@@ -292,8 +288,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 +311,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 +333,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 +357,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 +382,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}
 
@@ -451,16 +446,14 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
 Little helper for primitives that return unboxed tuples.
 
 \begin{code}
-newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [MachHint])
+newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [ForeignHint])
 newUnboxedTupleRegs res_ty =
    let
        ty_args = tyConAppArgs (repType res_ty)
-       (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
+       (reps,hints) = unzip [ (rep, typeForeignHint ty) | ty <- ty_args,
                                                    let rep = typeCgRep ty,
                                                    nonVoidArg rep ]
-       make_new_temp rep = if isFollowableArg rep
-                            then newPtrTemp (argMachRep rep)
-                            else newNonPtrTemp (argMachRep rep)
+       make_new_temp rep = newTemp (argMachRep rep)
    in do
    regs <- mapM make_new_temp reps
    return (reps,regs,hints)