#include "HsVersions.h"
-import {-# SOURCE #-} CoreSyn ( CoreRule, Unfolding )
+import CoreSyn ( CoreRule, Unfolding )
import IdInfo
import BasicTypes
TickBoxOp(..), TickBoxId,
) where
-import {-# SOURCE #-} CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
+import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
import Class
import PrimOp
mkConApp, mkTyBind,
varToCoreExpr, varsToCoreExprs,
- isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
+ isTyVar, isIdVar, cmpAltCon, cmpAlt, ltAlt,
-- ** Simple 'Expr' access functions and predicates
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
import CostCentre
import Var
-import Id
import Type
import Coercion
import Name
-- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
varToCoreExpr :: CoreBndr -> Expr b
-varToCoreExpr v | isId v = Var v
+varToCoreExpr v | isIdVar v = Var v
| otherwise = Type (mkTyVarTy v)
varsToCoreExprs :: [CoreBndr] -> [Expr b]
collectValBinders expr
= go [] expr
where
- go ids (Lam b e) | isId b = go (b:ids) e
- go ids body = (reverse ids, body)
+ go ids (Lam b e) | isIdVar b = go (b:ids) e
+ go ids body = (reverse ids, body)
\end{code}
\begin{code}
\begin{code}
-- | Will this variable exist at runtime?
isRuntimeVar :: Var -> Bool
-isRuntimeVar = isId
+isRuntimeVar = isIdVar
-- | Will this argument expression exist at runtime?
isRuntimeArg :: CoreExpr -> Bool
-- | The number of binders that bind values rather than types
valBndrCount :: [CoreBndr] -> Int
-valBndrCount = count isId
+valBndrCount = count isIdVar
-- | The number of argument expressions that are values rather than types at their top level
valArgCount :: [Arg b] -> Int
+++ /dev/null
-\begin{code}
-module CoreSyn where
-
--- Needed by Var.lhs
---data Expr b
---type CoreExpr = Expr Var.Var
-
-
-import Name ( Name )
-
--- Needed by Id
-data CoreRule
-setRuleIdName :: Name -> CoreRule -> CoreRule
-seqRules :: [CoreRule] -> ()
-
-data Unfolding
-noUnfolding :: Unfolding
-\end{code}
addBinder :: CSEnv -> Id -> (CSEnv, Id)
addBinder (CS cs in_scope sub) v
| not (v `elemInScopeSet` in_scope) = (CS cs (extendInScopeSet in_scope v) sub, v)
- | isId v = (CS cs (extendInScopeSet in_scope v') (extendVarEnv sub v v'), v')
+ | isIdVar v = (CS cs (extendInScopeSet in_scope v') (extendVarEnv sub v v'), v')
| otherwise = WARN( True, ppr v )
(CS emptyUFM in_scope sub, v)
-- This last case is the unusual situation where we have shadowing of
noFloatIntoRhs rhs = exprIsHNF (deAnnotate' rhs) -- We'd just float right back out again...
is_one_shot :: Var -> Bool
-is_one_shot b = isId b && isOneShotBndr b
+is_one_shot b = isIdVar b && isOneShotBndr b
\end{code}
new_rhss <- mapM (lvlExpr ctxt_lvl new_env) rhss
return (Rec ([TB b dest_lvl | b <- new_bndrs] `zip` new_rhss), new_env)
- | isSingleton pairs && count isId abs_vars > 1
+ | isSingleton pairs && count isIdVar abs_vars > 1
= do -- Special case for self recursion where there are
-- several variables carried around: build a local loop:
-- poly_f = \abs_vars. \lam_vars . letrec f = \lam_vars. rhs in f lam_vars
[] bndrs
where
go old_lvl bumped_major rev_lvld_bndrs (bndr:bndrs)
- | isId bndr && -- Go to the next major level if this is a value binder,
+ | isIdVar bndr && -- Go to the next major level if this is a value binder,
not bumped_major && -- and we havn't already gone to the next level (one jump per group)
not (isOneShotLambda bndr) -- and it isn't a one-shot lambda
= go new_lvl True (TB bndr new_lvl : rev_lvld_bndrs) bndrs
-- We may only want to do this if there are sufficiently few free
-- variables. We certainly only want to do it for values, and not for
-- constructors. So the simple thing is just to look for lambdas
-isFunction (_, AnnLam b e) | isId b = True
+isFunction (_, AnnLam b e) | isIdVar b = True
| otherwise = isFunction e
isFunction (_, AnnNote _ e) = isFunction e
isFunction _ = False
Nothing -> [in_var])
max_out out_var lvl
- | isId out_var = case lookupVarEnv lvl_env out_var of
+ | isIdVar out_var = case lookupVarEnv lvl_env out_var of
Just lvl' -> maxLvl lvl' lvl
Nothing -> lvl
- | otherwise = lvl -- Ignore tyvars in *maxIdLevel*
+ | otherwise = lvl -- Ignore tyvars in *maxIdLevel*
lookupVar :: LevelEnv -> Id -> LevelledExpr
lookupVar (_, _, _, id_env) v = case lookupVarEnv id_env v of
-- We are going to lambda-abstract, so nuke any IdInfo,
-- and add the tyvars of the Id (if necessary)
- zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
+ zap v | isIdVar v = WARN( workerExists (idWorkerInfo v) ||
not (isEmptySpecInfo (idSpecialisation v)),
text "absVarsOf: discarding info on" <+> ppr v )
setIdInfo v vanillaIdInfo
-- we must look in x's type
-- And similarly if x is a coercion variable.
absVarsOf id_env v
- | isId v = [av2 | av1 <- lookup_avs v
+ | isIdVar v = [av2 | av1 <- lookup_avs v
, av2 <- add_tyvars av1]
| isCoVar v = add_tyvars v
| otherwise = [v]
cloneVar TopLevel env v _ _
= return (env, v) -- Don't clone top level things
cloneVar NotTopLevel env@(_,_,subst,_) v ctxt_lvl dest_lvl
- = ASSERT( isId v ) do
+ = ASSERT( isIdVar v ) do
us <- getUniqueSupplyM
let
(subst', v1) = cloneIdBndr subst us v
cloneRecVars TopLevel env vs _ _
= return (env, vs) -- Don't clone top level things
cloneRecVars NotTopLevel env@(_,_,subst,_) vs ctxt_lvl dest_lvl
- = ASSERT( all isId vs ) do
+ = ASSERT( all isIdVar vs ) do
us <- getUniqueSupplyM
let
(subst', vs1) = cloneRecIdBndrs subst us vs
-- The insight is, of course, that a demand on y is a demand on the
-- scrutinee, so we need to `both` it with the scrut demand
- alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b])
+ alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isIdVar b])
scrut_dmd = alt_dmd `both`
idNewDemandInfo case_bndr'
annotateLamIdBndr dmd_ty@(DmdType fv ds res) id
-- For lambdas we add the demand to the argument demands
-- Only called for Ids
- = ASSERT( isId id )
+ = ASSERT( isIdVar id )
(DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd)
where
(fv', dmd) = removeFV fv id res
-- Otherwise we spuriously float stuff out of case-expression join points,
-- which is very annoying.
get_one_shots (Lam b e)
- | isId b = isOneShotLambda b : get_one_shots e
+ | isIdVar b = isOneShotLambda b : get_one_shots e
| otherwise = get_one_shots e
get_one_shots (Note _ e) = get_one_shots e
get_one_shots other = noOneShotInfo
collectAnnValBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
collectAnnValBinders expr = go [] expr
where
- go bs (_, AnnLam b e) | isId b = go (b:bs) e
- go bs e = (reverse bs, e)
+ go bs (_, AnnLam b e) | isIdVar b = go (b:bs) e
+ go bs e = (reverse bs, e)
isAnnTypeArg :: AnnExpr b ann -> Bool
isAnnTypeArg (_, AnnType _) = True
projects / ghc-hetmet.git / commitdiff