import SimplUtils
import FamInstEnv ( FamInstEnv )
import Id
-import MkId ( mkImpossibleExpr, seqId )
+import MkId ( seqId, realWorldPrimId )
+import MkCore ( mkImpossibleExpr )
import Var
import IdInfo
import Name ( mkSystemVarName, isExternalName )
import BasicTypes ( isMarkedStrict, Arity )
import CostCentre ( currentCCS, pushCCisNop )
import TysPrim ( realWorldStatePrimTy )
-import PrelInfo ( realWorldPrimId )
import BasicTypes ( TopLevelFlag(..), isTopLevel, RecFlag(..) )
import MonadUtils ( foldlM, mapAccumLM )
import Maybes ( orElse )
expr_ty = exprType expr
bindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool
--- True iff we can have a binding of this expression at this leve
+-- True iff we can have a binding of this expression at this level
-- Precondition: the type is the type of the expression
bindingOk top_lvl _ expr_ty
| isTopLevel top_lvl = not (isUnLiftedType expr_ty)
-> OccInfo -> OutExpr
-> Unfolding -> SimplM Unfolding
-- Note [Setting the new unfolding]
-simplUnfolding env _ _ _ _ (DFunUnfolding con ops)
- = return (DFunUnfolding con ops')
+simplUnfolding env _ _ _ _ (DFunUnfolding ar con ops)
+ = return (DFunUnfolding ar con ops')
where
ops' = map (substExpr (text "simplUnfolding") env) ops
n_params = length bndrs
(bndrs, body) = collectBinders expr
zap | n_args >= n_params = \b -> b
- | otherwise = \b -> if isTyVar b then b
+ | otherwise = \b -> if isTyCoVar b then b
else zapLamIdInfo b
-- NB: we count all the args incl type args
-- so we must count all the binders (incl type lambdas)
-- First deal with type applications and type lets
-- (/\a. e) (Type ty) and (let a = Type ty in e)
simplNonRecE env bndr (Type ty_arg, rhs_se) (bndrs, body) cont
- = ASSERT( isTyVar bndr )
+ = ASSERT( isTyCoVar bndr )
do { ty_arg' <- simplType (rhs_se `setInScope` env) ty_arg
; simplLam (extendTvSubst env bndr ty_arg') bndrs body cont }
(StrictBind bndr bndrs body env cont) }
| otherwise
- = ASSERT( not (isTyVar bndr) )
+ = ASSERT( not (isTyCoVar bndr) )
do { (env1, bndr1) <- simplNonRecBndr env bndr
; let (env2, bndr2) = addBndrRules env1 bndr bndr1
; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
simplVar :: SimplEnv -> InVar -> SimplM OutExpr
-- Look up an InVar in the environment
simplVar env var
- | isTyVar var
+ | isTyCoVar var
= return (Type (substTyVar env var))
| otherwise
= case substId env var of
= go vs the_strs
where
go [] [] = []
- go (v:vs') strs | isTyVar v = v : go vs' strs
+ go (v:vs') strs | isTyCoVar v = v : go vs' strs
go (v:vs') (str:strs)
| isMarkedStrict str = evald_v : go vs' strs
| otherwise = zapped_v : go vs' strs
bind_args env' [] _ = return env'
bind_args env' (b:bs') (Type ty : args)
- = ASSERT( isTyVar b )
+ = ASSERT( isTyCoVar b )
bind_args (extendTvSubst env' b ty) bs' args
bind_args env' (b:bs') (arg : args)
| otherwise = bndrs' ++ [case_bndr_w_unf]
abstract_over bndr
- | isTyVar bndr = True -- Abstract over all type variables just in case
+ | isTyCoVar bndr = True -- Abstract over all type variables just in case
| otherwise = not (isDeadBinder bndr)
-- The deadness info on the new Ids is preserved by simplBinders