[project @ 2001-08-08 08:44:47 by simonmar]

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

diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 8e8b5e2..f4ad2a1 100644 (file)
--- 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.40 2000/11/24 09:51:38 simonpj Exp $
+% $Id: CgExpr.lhs,v 1.43 2001/05/22 13:43:15 simonpj Exp $
 %
 %********************************************************
 %*                                                     *
@@ -114,13 +114,13 @@ 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 (StgPrimApp op@(CCallOp ccall) args res_ty)
+cgExpr (StgOpApp op@(StgFCallOp _ _) 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 (StgPrimApp TagToEnumOp [arg] res_ty) 
+cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty) 
   = ASSERT(isEnumerationTyCon tycon)
     getArgAmode arg `thenFC` \amode ->
        -- save the tag in a temporary in case amode overlaps
@@ -145,14 +145,16 @@ cgExpr (StgPrimApp TagToEnumOp [arg] res_ty)
        tycon = tyConAppTyCon res_ty
 
 
-cgExpr x@(StgPrimApp op args res_ty)
-  | primOpOutOfLine op = tailCallPrimOp op args
+cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
+  | primOpOutOfLine primop 
+  = tailCallPrimOp primop args
+
   | otherwise
-  = ASSERT(op /= SeqOp) -- can't handle SeqOp
+  = ASSERT(primop /= SeqOp) -- can't handle SeqOp
 
     getArgAmodes args  `thenFC` \ arg_amodes ->
 
-    case (getPrimOpResultInfo op) of
+    case (getPrimOpResultInfo primop) of
 
        ReturnsPrim kind ->
            let result_amode = CReg (dataReturnConvPrim kind) in
@@ -208,14 +210,14 @@ cgExpr (StgCase expr live_vars save_vars bndr srt alts)
 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
 
 \begin{code}
-cgExpr (StgLet (StgNonRec name rhs) expr)
-  = cgRhs name rhs     `thenFC` \ (name, info) ->
+cgExpr (StgLet (StgNonRec srt name rhs) expr)
+  = cgRhs srt name rhs `thenFC` \ (name, info) ->
     addBindC name info         `thenC`
     cgExpr expr
 
-cgExpr (StgLet (StgRec pairs) expr)
+cgExpr (StgLet (StgRec srt pairs) expr)
   = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
-                           listFCs [ cgRhs b e | (b,e) <- pairs ]
+                           listFCs [ cgRhs srt b e | (b,e) <- pairs ]
     ) `thenFC` \ new_bindings ->
 
     addBindsC new_bindings `thenC`
@@ -274,17 +276,15 @@ We rely on the support code in @CgCon@ (to do constructors) and
 in @CgClosure@ (to do closures).
 
 \begin{code}
-cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
+cgRhs :: SRT -> Id -> StgRhs -> FCode (Id, CgIdInfo)
        -- the Id is passed along so a binding can be set up
 
-cgRhs name (StgRhsCon maybe_cc con args)
+cgRhs srt name (StgRhsCon maybe_cc con args)
   = getArgAmodes args                          `thenFC` \ amodes ->
     buildDynCon name maybe_cc con amodes       `thenFC` \ idinfo ->
     returnFC (name, idinfo)
 
-cgRhs name (StgRhsClosure cc bi srt@(NoSRT) fvs upd_flag args body)
-  = mkRhsClosure name cc bi srt fvs upd_flag args body
-cgRhs name (StgRhsClosure cc bi srt@(SRT _ _) fvs upd_flag args body)
+cgRhs srt name (StgRhsClosure cc bi fvs upd_flag args body)
   = mkRhsClosure name cc bi srt fvs upd_flag args body
 \end{code}
 
@@ -391,17 +391,19 @@ mkRhsClosure bndr cc bi srt fvs upd_flag args body
 %*                                                     *
 %********************************************************
 \begin{code}
-cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
+cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot 
+       (StgNonRec srt binder rhs)
   = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot   
-                       NonRecursive binder rhs 
+                       NonRecursive srt binder rhs 
                                `thenFC` \ (binder, info) ->
     addBindC binder info
 
-cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
+cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot 
+       (StgRec srt pairs)
   = fixC (\ new_bindings ->
                addBindsC new_bindings  `thenC`
                listFCs [ cgLetNoEscapeRhs full_live_in_rhss 
-                               rhs_eob_info maybe_cc_slot Recursive b e 
+                               rhs_eob_info maybe_cc_slot Recursive srt b e 
                        | (b,e) <- pairs ]
     ) `thenFC` \ new_bindings ->
 
@@ -416,25 +418,28 @@ cgLetNoEscapeRhs
     -> EndOfBlockInfo
     -> Maybe VirtualSpOffset
     -> RecFlag
+    -> SRT
     -> Id
     -> StgRhs
     -> FCode (Id, CgIdInfo)
 
-cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
-                (StgRhsClosure cc bi srt _ upd_flag args body)
+cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec srt binder
+                (StgRhsClosure cc bi _ upd_flag args body)
   = -- We could check the update flag, but currently we don't switch it off
     -- for let-no-escaped things, so we omit the check too!
     -- case upd_flag of
     --     Updatable -> panic "cgLetNoEscapeRhs"       -- Nothing to update!
     --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
-    cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info maybe_cc_slot rec args body
+    cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
+       maybe_cc_slot rec args body
 
 -- For a constructor RHS we want to generate a single chunk of code which
 -- can be jumped to from many places, which will return the constructor.
 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
-cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
+cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec srt binder
                 (StgRhsCon cc con args)
-  = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} NoSRT full_live_in_rhss rhs_eob_info maybe_cc_slot rec
+  = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} srt
+                        full_live_in_rhss rhs_eob_info maybe_cc_slot rec
        []      --No args; the binder is data structure, not a function
        (StgConApp con args)
 \end{code}
@@ -443,7 +448,7 @@ Little helper for primitives that return unboxed tuples.
 
 
 \begin{code}
-primRetUnboxedTuple :: PrimOp -> [StgArg] -> Type -> Code
+primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
 primRetUnboxedTuple op args res_ty
   = getArgAmodes args      `thenFC` \ arg_amodes ->
     {-