[project @ 2006-01-06 16:30:17 by simonmar]

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

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 81c91cc..a650352 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -17,15 +17,15 @@ module PrimOp (
 
 #include "HsVersions.h"
 
-import PrimRep         -- most of it
 import TysPrim
 import TysWiredIn
 
 import NewDemand
 import Var             ( TyVar )
-import OccName         ( OccName, pprOccName, mkVarOcc )
-import TyCon           ( TyCon, isPrimTyCon, tyConPrimRep )
-import Type            ( Type, mkForAllTys, mkFunTy, mkFunTys, typePrimRep, tyConAppTyCon )
+import OccName         ( OccName, pprOccName, mkVarOccFS )
+import TyCon           ( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
+import Type            ( Type, mkForAllTys, mkFunTy, mkFunTys, tyConAppTyCon,
+                         typePrimRep )
 import BasicTypes      ( Arity, Boxity(..) )
 import Outputable
 import FastTypes
@@ -55,7 +55,6 @@ primOpTag op = iBox (tagOf_PrimOp op)
 -- supplies   
 -- tagOf_PrimOp :: PrimOp -> FastInt
 #include "primop-tag.hs-incl"
-tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
 
 
 instance Eq PrimOp where
@@ -114,10 +113,10 @@ data PrimOpInfo
                [Type] 
                Type 
 
-mkDyadic str  ty = Dyadic  (mkVarOcc str) ty
-mkMonadic str ty = Monadic (mkVarOcc str) ty
-mkCompare str ty = Compare (mkVarOcc str) ty
-mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOcc str) tvs tys ty
+mkDyadic str  ty = Dyadic  (mkVarOccFS str) ty
+mkMonadic str ty = Monadic (mkVarOccFS str) ty
+mkCompare str ty = Compare (mkVarOccFS str) ty
+mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
 \end{code}
 
 %************************************************************************
@@ -321,13 +320,28 @@ primOpIsCheap
 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}.  For now (HACK
 WARNING), we just borrow some other predicates for a
 what-should-be-good-enough test.  "Cheap" means willing to call it more
-than once.  Evaluation order is unaffected.
+than once, and/or push it inside a lambda.  The latter could change the
+behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
 
 \begin{code}
 primOpIsCheap :: PrimOp -> Bool
-primOpIsCheap op = False
-       -- March 2001: be less eager to inline PrimOps
-       -- Was: not (primOpHasSideEffects op || primOpOutOfLine op)
+primOpIsCheap op = primOpOkForSpeculation op
+-- In March 2001, we changed this to 
+--     primOpIsCheap op = False
+-- thereby making *no* primops seem cheap.  But this killed eta
+-- expansion on case (x ==# y) of True -> \s -> ... 
+-- which is bad.  In particular a loop like
+--     doLoop n = loop 0
+--     where
+--         loop i | i == n    = return ()
+--                | otherwise = bar i >> loop (i+1)
+-- allocated a closure every time round because it doesn't eta expand.
+-- 
+-- The problem that originally gave rise to the change was
+--     let x = a +# b *# c in x +# x
+-- were we don't want to inline x. But primopIsCheap doesn't control
+-- that (it's exprIsDupable that does) so the problem doesn't occur
+-- even if primOpIsCheap sometimes says 'True'.
 \end{code}
 
 primOpIsDupable