[rearrange and clean up several of the predicates on core expressions
John Meacham <john@repetae.net>**20060314024314] hunk ./C/Prims.hs 44
+
+
+-- | whether a primitive represents a constant expression (assuming all its arguments are constant)
+-- TODO needs grin support
+primIsConstant :: Prim -> Bool
+-- primIsConstant CConst {} = True
+-- primIsConstant AddrOf {} = True
+-- primIsConstant CCast {} = True -- grin doesn't support this yet
+-- primIsConstant Operator {} = True -- inhibits rules matching, divide by zero.
+primIsConstant _ = False
+
+
hunk ./E/E.hs 296
-fullyConst :: Monad m => E -> m ()
-fullyConst (ELit (LitCons _ [] _)) = return ()
-fullyConst (ELit (LitCons _ xs _)) = mapM_ fullyConst xs
-fullyConst ELit {} = return ()
-fullyConst (EPi (TVr { tvrType = t }) x) = do
-    fullyConst t
-    fullyConst x
-fullyConst _ = fail "not fully constant"
-
-isFullyConst :: E -> Bool
-isFullyConst = maybe False (const True) . fullyConst
hunk ./E/Values.hs 18
+import qualified Info.Info as Info
hunk ./E/Values.hs 133
-isAtomic :: E -> Bool
---isAtomic e | sortTypeLike e = True
-isAtomic EVar {}  = True
-isAtomic e | sortTypeLike e = True
-isAtomic e = isFullyConst e
hunk ./E/Values.hs 151
--- | determine if term can contain _|_
-isLifted :: E -> Bool
-isLifted x = sortTermLike x && not (isUnboxed (getType x))
-
--- Note: This does not treat lambdas as whnf
-whnfOrBot :: E -> Bool
-whnfOrBot (EError {}) = True
-whnfOrBot (ELit (LitCons _ xs _)) = all isAtomic xs
-whnfOrBot (EPi (TVr { tvrIdent =  j, tvrType =  x }) y) | not (j `Set.member` freeVars y) = isAtomic x && isAtomic y
-whnfOrBot e = isAtomic e
-
--- Determine if a type represents an unboxed value
-isUnboxed :: E -> Bool
-isUnboxed e@EPi {} = False
-isUnboxed e = getType e == eHash
-
-safeToDup ec@ECase {}
-    | EVar _ <- eCaseScrutinee ec = all safeToDup (caseBodies ec)
-    | EPrim p _ _ <- eCaseScrutinee ec, aprimIsCheap p = all safeToDup (caseBodies ec)
-safeToDup (EPrim p _ _) = aprimIsCheap p
-safeToDup e = whnfOrBot e || isELam e || isEPi e
-
hunk ./E/Values.hs 202
+-- various routines used to classify expressions
+-- many assume atomicity constraints are in place
+
+-- | whether a value is a compile time constant
+isFullyConst :: E -> Bool
+isFullyConst (ELit (LitCons _ [] _)) = True
+isFullyConst (ELit (LitCons _ xs _)) = all isFullyConst xs
+isFullyConst ELit {} = True
+isFullyConst (EPi (TVr { tvrType = t }) x) =  isFullyConst t && isFullyConst x
+isFullyConst (EPrim (APrim p _) as _) = primIsConstant p && all isFullyConst as
+isFullyConst _ = False
+
+
+-- | whether a value may be used as an argument to an application, literal, or primitive
+-- these may be duplicated with no code size or runtime penalty
+isAtomic :: E -> Bool
+isAtomic EVar {}  = True
+isAtomic e | sortTypeLike e = True
+isAtomic e = isFullyConst e
+
+
+-- | whether an expression is small enough that it can be duplicated without code size growing too much. (work may be repeated)
+isSmall e | isAtomic e = True
+isSmall ELit {} = True
+isSmall EPrim {} = True
+isSmall EError {} = True
+isSmall e | (EVar _,xs) <- fromAp e = length xs <= 4
+isSmall _ = False
+
+-- | whether an expression may be duplicated or pushed inside a lambda without duplicating too much work
+
+isCheap :: E -> Bool
+isCheap x | isAtomic x = True
+isCheap EError {} = True
+isCheap ELit {} = True
+isCheap EPi {} = True
+isCheap ELam {} = True -- should exclude values dropped at compile time
+isCheap (EPrim p _ _) = aprimIsCheap p
+isCheap ec@ECase {} = isCheap (eCaseScrutinee ec) && all isCheap (caseBodies ec)
+isCheap e | (EVar v,xs) <- fromAp e, Just (Arity n) <- Info.lookup (tvrInfo v), length xs < n = True  -- Partial applications are cheap
+isCheap _ = False
+
+
+-- | determine if term can contain _|_
+isLifted :: E -> Bool
+isLifted x = sortTermLike x && not (isUnboxed (getType x))
+
+-- Note: This does not treat lambdas as whnf
+whnfOrBot :: E -> Bool
+whnfOrBot (EError {}) = True
+whnfOrBot (ELit (LitCons _ xs _)) = all isAtomic xs
+whnfOrBot (EPi (TVr { tvrIdent =  j, tvrType =  x }) y) | not (j `Set.member` freeVars y) = isAtomic x && isAtomic y
+whnfOrBot e = isAtomic e
+
+-- Determine if a type represents an unboxed value
+isUnboxed :: E -> Bool
+isUnboxed e@EPi {} = False
+isUnboxed e = getType e == eHash
+
+safeToDup ec@ECase {}
+    | EVar _ <- eCaseScrutinee ec = all safeToDup (caseBodies ec)
+    | EPrim p _ _ <- eCaseScrutinee ec, aprimIsCheap p = all safeToDup (caseBodies ec)
+safeToDup (EPrim p _ _) = aprimIsCheap p
+safeToDup e = whnfOrBot e || isELam e || isEPi e
+