[project @ 2001-03-27 16:32:46 by rrt]

[ghc-hetmet.git] / ghc / compiler / prelude / PrimOp.lhs

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 82e1f0d..f96617d 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -17,8 +17,6 @@ module PrimOp (
 
        getPrimOpResultInfo,  PrimOpResultInfo(..),
 
-       pprPrimOp,
-
        CCall(..), CCallTarget(..), ccallMayGC, ccallIsCasm, pprCCallOp,
        isDynamicTarget, dynamicTarget, setCCallUnique
     ) where
@@ -33,13 +31,13 @@ import Demand               ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
 import Var             ( TyVar )
 import CallConv                ( CallConv, pprCallConv )
 import Name            ( Name, mkWiredInName )
-import RdrName         ( RdrName, mkRdrQual )
+import RdrName         ( RdrName, mkRdrOrig )
 import OccName         ( OccName, pprOccName, mkVarOcc )
 import TyCon           ( TyCon, tyConArity )
 import Type            ( Type, mkForAllTys, mkFunTy, mkFunTys, mkTyVarTys,
                          mkTyConApp, typePrimRep,
-                         splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
-                          UsageAnn(..), mkUsgTy
+                         splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp,
+                          mkUTy, usOnce, usMany
                        )
 import Unique          ( Unique, mkPrimOpIdUnique )
 import BasicTypes      ( Arity, Boxity(..) )
@@ -365,7 +363,7 @@ See also @primOpIsCheap@ (below).
 primOpOkForSpeculation :: PrimOp -> Bool
        -- See comments with CoreUtils.exprOkForSpeculation
 primOpOkForSpeculation op 
-  = primOpIsCheap op && not (primOpCanFail op)
+  = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op)
 \end{code}
 
 
@@ -378,8 +376,9 @@ than once.  Evaluation order is unaffected.
 
 \begin{code}
 primOpIsCheap :: PrimOp -> Bool
-       -- See comments with CoreUtils.exprOkForSpeculation
-primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
+primOpIsCheap op = False
+       -- March 2001: be less eager to inline PrimOps
+       -- Was: not (primOpHasSideEffects op || primOpOutOfLine op)
 \end{code}
 
 primOpIsDupable
@@ -445,7 +444,7 @@ mkPrimOpIdName op
   = mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
 
 primOpRdrName :: PrimOp -> RdrName 
-primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
+primOpRdrName op = mkRdrOrig pREL_GHC_Name (primOpOcc op)
 
 primOpOcc :: PrimOp -> OccName
 primOpOcc op = case (primOpInfo op) of
@@ -489,11 +488,11 @@ primOpUsg p@(CCallOp _) = mangle p [] mkM
 
 -- Helper bits & pieces for usage info.
                                     
-mkZ          = mkUsgTy UsOnce  -- pointed argument used zero
-mkO          = mkUsgTy UsOnce  -- pointed argument used once
-mkM          = mkUsgTy UsMany  -- pointed argument used multiply
-mkP          = mkUsgTy UsOnce  -- unpointed argument
-mkR          = mkUsgTy UsMany  -- unpointed result
+mkZ          = mkUTy usOnce  -- pointed argument used zero
+mkO          = mkUTy usOnce  -- pointed argument used once
+mkM          = mkUTy usMany  -- pointed argument used multiply
+mkP          = mkUTy usOnce  -- unpointed argument
+mkR          = mkUTy usMany  -- unpointed result
 
 nomangle op
    = case primOpSig op of
@@ -511,11 +510,9 @@ inFun op f g ty
         Nothing    -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
 
 inUB op fs ty
-   = case splitTyConApp_maybe ty of
-        Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
-                         mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg"
-                                                                     ($) fs tys)
-        Nothing       -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
+   = case splitTyConApp ty of
+        (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
+                    mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg" ($) fs tys)
 \end{code}
 
 \begin{code}