Remove vectored returns.

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

diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index 551a40b..e58fda7 100644 (file)
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -1,56 +1,46 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.62 2005/06/21 10:44:41 simonmar Exp $
-%
-%********************************************************
-%*                                                     *
-\section[CgExpr]{Converting @StgExpr@s}
-%*                                                     *
-%********************************************************
 
 \begin{code}
 module CgExpr ( cgExpr ) where
 
 #include "HsVersions.h"
 
-import Constants       ( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
+import Constants
 import StgSyn
 import CgMonad
 
-import SMRep           ( fixedHdrSize, isFollowableArg, CgRep(..), argMachRep,
-                         nonVoidArg, idCgRep, typeCgRep, typeHint,
-                         primRepToCgRep )
-import CoreSyn         ( AltCon(..) )
-import CgProf          ( emitSetCCC )
-import CgHeapery       ( layOutDynConstr )
-import CgBindery       ( getArgAmodes, getArgAmode, CgIdInfo, 
-                         nukeDeadBindings, addBindC, addBindsC )
-import CgCase          ( cgCase, saveVolatileVarsAndRegs )
-import CgClosure       ( cgRhsClosure, cgStdRhsClosure )
-import CgCon           ( buildDynCon, cgReturnDataCon )
-import CgLetNoEscape   ( cgLetNoEscapeClosure )
-import CgCallConv      ( dataReturnConvPrim )
+import SMRep
+import CoreSyn
+import CgProf
+import CgHeapery
+import CgBindery
+import CgCase
+import CgClosure
+import CgCon
+import CgLetNoEscape
+import CgCallConv
 import CgTailCall
-import CgInfoTbls      ( emitDirectReturnInstr )
-import CgForeignCall   ( emitForeignCall, shimForeignCallArg )
-import CgPrimOp                ( cgPrimOp )
-import CgUtils         ( addIdReps, newTemp, assignTemp, cgLit, tagToClosure )
-import ClosureInfo     ( mkSelectorLFInfo, mkApLFInfo )
-import Cmm             ( CmmExpr(..), CmmStmt(..), CmmReg, nodeReg )
-import MachOp          ( wordRep, MachHint )
+import CgInfoTbls
+import CgForeignCall
+import CgPrimOp
+import CgHpc
+import CgUtils
+import ClosureInfo
+import Cmm
+import MachOp
 import VarSet
-import Literal         ( literalType )
-import PrimOp          ( primOpOutOfLine, getPrimOpResultInfo, 
-                         PrimOp(..), PrimOpResultInfo(..) )
-import Id              ( Id )
-import TyCon           ( isUnboxedTupleTyCon, isEnumerationTyCon )
-import Type            ( Type, tyConAppArgs, tyConAppTyCon, repType,
-                         PrimRep(VoidRep) )
-import Maybes          ( maybeToBool )
-import ListSetOps      ( assocMaybe )
-import BasicTypes      ( RecFlag(..) )
-import Util             ( lengthIs )
+import Literal
+import PrimOp
+import Id
+import TyCon
+import Type
+import Maybes
+import ListSetOps
+import BasicTypes
+import Util
 import Outputable
 \end{code}
 
@@ -131,11 +121,8 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
                    | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, 
                      nonVoidArg rep]
 
-    -- in
     arg_tmps <- mapM assignTemp arg_exprs
-    let
-       arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
-    -- in
+    let        arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
     {-
        Now, allocate some result regs.
     -}
@@ -154,7 +141,7 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
                                        -- so save in a temp if non-trivial
        ; this_pkg <- getThisPackage
        ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
-       ; performReturn (emitAlgReturnCode tycon amode') }
+       ; performReturn emitReturnInstr }
    where
          -- If you're reading this code in the attempt to figure
          -- out why the compiler panic'ed here, it is probably because
@@ -170,12 +157,12 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
 
   | ReturnsPrim VoidRep <- result_info
        = do cgPrimOp [] primop args emptyVarSet
-            performReturn emitDirectReturnInstr
+            performReturn emitReturnInstr
 
   | ReturnsPrim rep <- result_info
        = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)] 
                        primop args emptyVarSet
-            performReturn emitDirectReturnInstr
+            performReturn emitReturnInstr
 
   | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
        = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
@@ -188,7 +175,7 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
             this_pkg <- getThisPackage
             cgPrimOp [tag_reg] primop args emptyVarSet
             stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg)))
-            performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
+            performReturn emitReturnInstr
   where
        result_info = getPrimOpResultInfo primop
 \end{code}
@@ -263,6 +250,16 @@ cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
 \end{code}
 
 %********************************************************
+%*                                                     *
+%*             Hpc Tick Boxes                          *
+%*                                                     *
+%********************************************************
+
+\begin{code}
+cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr
+\end{code}
+
+%********************************************************
 %*                                                     *
 %*             Non-top-level bindings                  *
 %*                                                     *