[project @ 2001-03-19 16:20:44 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 1b552af..00d5723 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -51,12 +51,12 @@ import Literal              ( hashLiteral, literalType, litIsDupable )
 import DataCon         ( DataCon, dataConRepArity )
 import PrimOp          ( primOpOkForSpeculation, primOpIsCheap, 
                          primOpIsDupable )
-import Id              ( Id, idType, idFlavour, idStrictness, idLBVarInfo, 
+import Id              ( Id, idType, globalIdDetails, idStrictness, idLBVarInfo, 
                          mkWildId, idArity, idName, idUnfolding, idInfo, isOneShotLambda,
                          isDataConId_maybe, isPrimOpId_maybe, mkSysLocal, hasNoBinding
                        )
 import IdInfo          ( LBVarInfo(..),  
-                         IdFlavour(..),
+                         GlobalIdDetails(..),
                          megaSeqIdInfo )
 import Demand          ( appIsBottom )
 import Type            ( Type, mkFunTy, mkForAllTy, splitFunTy_maybe, 
@@ -315,6 +315,7 @@ exprIsAtom :: CoreExpr -> Bool
 exprIsAtom (Var v)    = True   -- primOpIsDupable?
 exprIsAtom (Lit lit)  = True
 exprIsAtom (Type ty)  = True
+exprIsAtom (Note (SCC _) e) = False
 exprIsAtom (Note _ e) = exprIsAtom e
 exprIsAtom other      = False
 \end{code}
@@ -332,10 +333,11 @@ exprIsAtom other      = False
 
 
 \begin{code}
-exprIsDupable (Type _)      = True
-exprIsDupable (Var v)       = True
-exprIsDupable (Lit lit)      = litIsDupable lit
-exprIsDupable (Note _ e)     = exprIsDupable e
+exprIsDupable (Type _)         = True
+exprIsDupable (Var v)          = True
+exprIsDupable (Lit lit)        = litIsDupable lit
+exprIsDupable (Note InlineMe e) = True
+exprIsDupable (Note _ e)        = exprIsDupable e
 exprIsDupable expr          
   = go expr 0
   where
@@ -382,6 +384,7 @@ exprIsCheap :: CoreExpr -> Bool
 exprIsCheap (Lit lit)            = True
 exprIsCheap (Type _)             = True
 exprIsCheap (Var _)              = True
+exprIsCheap (Note InlineMe e)            = True
 exprIsCheap (Note _ e)           = exprIsCheap e
 exprIsCheap (Lam x e)            = if isId x then True else exprIsCheap e
 exprIsCheap (Case e _ alts)       = exprIsCheap e && 
@@ -419,7 +422,7 @@ idAppIsCheap id n_val_args
   | n_val_args == 0 = True     -- Just a type application of
                                -- a variable (f t1 t2 t3)
                                -- counts as WHNF
-  | otherwise = case idFlavour id of
+  | otherwise = case globalIdDetails id of
                  DataConId _   -> True                 
                  RecordSelId _ -> True                 -- I'm experimenting with making record selection
                                                        -- look cheap, so we will substitute it inside a
@@ -467,7 +470,7 @@ exprOkForSpeculation other_expr
   = go other_expr 0 True
   where
     go (Var f) n_args args_ok 
-      = case idFlavour f of
+      = case globalIdDetails f of
          DataConId _ -> True   -- The strictness of the constructor has already
                                -- been expressed by its "wrapper", so we don't need
                                -- to take the arguments into account
@@ -517,9 +520,11 @@ as values, even if their arguments are non-trivial;
              map (...redex...)         is a value
 Because `seq` on such things completes immediately
 
-A worry: constructors with unboxed args:
+A possible worry: constructors with unboxed args:
                C (f x :: Int#)
-Suppose (f x) diverges; then C (f x) is not a value.
+Suppose (f x) diverges; then C (f x) is not a value.  True, but
+this form is illegal (see the invariants in CoreSyn).  Args of unboxed
+type must be ok-for-speculation (or trivial).
 
 \begin{code}
 exprIsValue :: CoreExpr -> Bool                -- True => Value-lambda, constructor, PAP
@@ -543,7 +548,7 @@ exprIsValue other_expr
 
 idAppIsValue :: Id -> Int -> Bool
 idAppIsValue id n_val_args 
-  = case idFlavour id of
+  = case globalIdDetails id of
        DataConId _ -> True
        PrimOpId _  -> n_val_args < idArity id
        other | n_val_args == 0 -> isEvaldUnfolding (idUnfolding id)