[project @ 2001-02-20 15:44:26 by simonpj]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreUtils.lhs

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index 78230bc..f0649d1 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -14,7 +14,7 @@ module CoreUtils (
        exprType, coreAltsType, 
        exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap, 
        exprIsValue,exprOkForSpeculation, exprIsBig, 
-       exprIsConApp_maybe,
+       exprIsConApp_maybe, exprIsAtom,
        idAppIsBottom, idAppIsCheap,
        exprArity,
 
@@ -44,13 +44,13 @@ import Var          ( Var, isId, isTyVar )
 import VarSet
 import VarEnv
 import Name            ( hashName )
-import Literal         ( hashLiteral, literalType, litSize, litIsDupable )
+import Literal         ( hashLiteral, literalType, litIsDupable )
 import DataCon         ( DataCon, dataConRepArity )
 import PrimOp          ( primOpOkForSpeculation, primOpIsCheap, 
                          primOpIsDupable )
 import Id              ( Id, idType, idFlavour, idStrictness, idLBVarInfo, 
                          mkWildId, idArity, idName, idUnfolding, idInfo, 
-                         isDataConId_maybe, isPrimOpId_maybe, mkSysLocal
+                         isDataConId_maybe, isPrimOpId_maybe, mkSysLocal, hasNoBinding
                        )
 import IdInfo          ( LBVarInfo(..),  
                          IdFlavour(..),
@@ -258,7 +258,17 @@ mkIfThenElse guard then_expr else_expr
 
 \begin{code}
 exprIsTrivial (Var v)
-  | Just op <- isPrimOpId_maybe v      = primOpIsDupable op
+  | hasNoBinding v                    = idArity v == 0
+       -- WAS: | Just op <- isPrimOpId_maybe v      = primOpIsDupable op
+       -- The idea here is that a constructor worker, like $wJust, is
+       -- really short for (\x -> $wJust x), becuase $wJust has no binding.
+       -- So it should be treated like a lambda.
+       -- Ditto unsaturated primops.
+       -- This came up when dealing with eta expansion/reduction for
+       --      x = $wJust
+       -- Here we want to eta-expand.  This looks like an optimisation,
+       -- but it's important (albeit tiresome) that CoreSat doesn't increase 
+       -- anything's arity
   | otherwise                          = True
 exprIsTrivial (Type _)                = True
 exprIsTrivial (Lit lit)               = True
@@ -266,6 +276,15 @@ exprIsTrivial (App e arg)                 = isTypeArg arg && exprIsTrivial e
 exprIsTrivial (Note _ e)              = exprIsTrivial e
 exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
 exprIsTrivial other                   = False
+
+exprIsAtom :: CoreExpr -> Bool
+-- Used to decide whether to let-binding an STG argument
+-- when compiling to ILX => type applications are not allowed
+exprIsAtom (Var v)    = True   -- primOpIsDupable?
+exprIsAtom (Lit lit)  = True
+exprIsAtom (Type ty)  = True
+exprIsAtom (Note _ e) = exprIsAtom e
+exprIsAtom other      = False
 \end{code}