X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgExpr.lhs;h=37ef6e8817a3530eedbf7f7b1e4fbf4221124c4d;hb=52abeea72f9b5ac0dae896db49e7391f12de1fb3;hp=e12979d9c2f6ec25960a7e9b08ce81b79262c812;hpb=a5f7799965947977599a777dae10f103f9b9fd1a;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index e12979d..37ef6e8 100644 --- a/ghc/compiler/codeGen/CgExpr.lhs +++ b/ghc/compiler/codeGen/CgExpr.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgExpr.lhs,v 1.28 1999/06/24 13:04:18 simonmar Exp $ +% $Id: CgExpr.lhs,v 1.36 2000/10/03 08:43:00 simonpj Exp $ % %******************************************************** %* * @@ -40,16 +40,15 @@ import CostCentre ( sccAbleCostCentre, isSccCountCostCentre ) import Id ( idPrimRep, idType, Id ) import VarSet import DataCon ( DataCon, dataConTyCon ) -import Const ( Con(..) ) -import IdInfo ( ArityInfo(..) ) -import PrimOp ( primOpOutOfLine, +import PrimOp ( primOpOutOfLine, ccallMayGC, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) ) import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep ) import TyCon ( maybeTyConSingleCon, isUnboxedTupleTyCon, isEnumerationTyCon ) -import Type ( Type, typePrimRep, splitTyConApp_maybe, splitRepTyConApp_maybe ) -import Maybes ( assocMaybe, maybeToBool ) +import Type ( Type, typePrimRep, splitTyConApp_maybe, repType ) +import Maybes ( maybeToBool ) +import ListSetOps ( assocMaybe ) import Unique ( mkBuiltinUnique ) import BasicTypes ( TopLevelFlag(..), RecFlag(..) ) import Outputable @@ -85,11 +84,9 @@ cgExpr (StgApp fun args) = cgTailCall fun args %******************************************************** \begin{code} -cgExpr (StgCon (DataCon con) args res_ty) +cgExpr (StgConApp con args) = getArgAmodes args `thenFC` \ amodes -> - cgReturnDataCon con amodes (all zero_size args) - where - zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0 + cgReturnDataCon con amodes \end{code} Literals are similar to constructors; they return by putting @@ -97,9 +94,8 @@ themselves in an appropriate register and returning to the address on top of the stack. \begin{code} -cgExpr (StgCon (Literal lit) args res_ty) - = ASSERT( null args ) - performPrimReturn (text "literal" <+> ppr lit) (CLit lit) +cgExpr (StgLit lit) + = performPrimReturn (text "literal" <+> ppr lit) (CLit lit) \end{code} @@ -113,19 +109,21 @@ Here is where we insert real live machine instructions. NOTE about _ccall_GC_: -A _ccall_GC_ is treated as an out-of-line primop for the case -expression code, because we want a proper stack frame on the stack -when we perform it. When we get here, however, we need to actually -perform the call, so we treat it as an inline primop. +A _ccall_GC_ is treated as an out-of-line primop (returns True +for primOpOutOfLine) so that when we see the call in case context + case (ccall ...) of { ... } +we get a proper stack frame on the stack when we perform it. When we +get in a tail-call position, however, we need to actually perform the +call, so we treat it as an inline primop. \begin{code} -cgExpr (StgCon (PrimOp op@(CCallOp _ _ may_gc@True _)) args res_ty) +cgExpr (StgPrimApp op@(CCallOp ccall) args res_ty) = primRetUnboxedTuple op args res_ty -- tagToEnum# is special: we need to pull the constructor out of the table, -- and perform an appropriate return. -cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty) +cgExpr (StgPrimApp TagToEnumOp [arg] res_ty) = ASSERT(isEnumerationTyCon tycon) getArgAmode arg `thenFC` \amode -> -- save the tag in a temporary in case amode overlaps @@ -139,10 +137,18 @@ cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty) (\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel) where dyn_tag = CTemp (mkBuiltinUnique 0) IntRep + -- + -- if you're reading this code in the attempt to figure + -- out why the compiler panic'ed here, it is probably because + -- you used tagToEnum# in a non-monomorphic setting, e.g., + -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x# + -- + -- That won't work. + -- (Just (tycon,_)) = splitTyConApp_maybe res_ty -cgExpr x@(StgCon (PrimOp op) args res_ty) +cgExpr x@(StgPrimApp op args res_ty) | primOpOutOfLine op = tailCallPrimOp op args | otherwise = ASSERT(op /= SeqOp) -- can't handle SeqOp @@ -275,12 +281,9 @@ cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo) -- the Id is passed along so a binding can be set up cgRhs name (StgRhsCon maybe_cc con args) - = getArgAmodes args `thenFC` \ amodes -> - buildDynCon name maybe_cc con amodes (all zero_size args) - `thenFC` \ idinfo -> + = getArgAmodes args `thenFC` \ amodes -> + buildDynCon name maybe_cc con amodes `thenFC` \ idinfo -> returnFC (name, idinfo) - where - zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0 cgRhs name (StgRhsClosure cc bi srt@(NoSRT) fvs upd_flag args body) = mkRhsClosure name cc bi srt fvs upd_flag args body @@ -437,7 +440,7 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder (StgRhsCon cc con args) = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} NoSRT full_live_in_rhss rhs_eob_info maybe_cc_slot rec [] --No args; the binder is data structure, not a function - (StgCon (DataCon con) args (idType binder)) + (StgConApp con args) \end{code} Little helper for primitives that return unboxed tuples. @@ -462,7 +465,7 @@ primRetUnboxedTuple op args res_ty allocate some temporaries for the return values. -} let - (tc,ty_args) = case splitRepTyConApp_maybe res_ty of + (tc,ty_args) = case splitTyConApp_maybe (repType res_ty) of Nothing -> pprPanic "primRetUnboxedTuple" (ppr res_ty) Just pr -> pr prim_reps = map typePrimRep ty_args @@ -470,5 +473,4 @@ primRetUnboxedTuple op args res_ty temp_amodes = zipWith CTemp temp_uniqs prim_reps in returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps [])) - \end{code}