From 2e06595241350a6548b6ab6430c65d6458f7c197 Mon Sep 17 00:00:00 2001 From: Max Bolingbroke Date: Thu, 7 Aug 2008 22:37:18 +0000 Subject: [PATCH] Remove CoreSyn SOURCE imports --- compiler/basicTypes/Id.lhs | 2 +- compiler/basicTypes/IdInfo.lhs | 2 +- compiler/coreSyn/CoreSyn.lhs | 13 ++++++------- compiler/coreSyn/CoreSyn.lhs-boot | 18 ------------------ compiler/simplCore/CSE.lhs | 2 +- compiler/simplCore/FloatIn.lhs | 2 +- compiler/simplCore/SetLevels.lhs | 18 +++++++++--------- compiler/stranal/DmdAnal.lhs | 4 ++-- compiler/stranal/WorkWrap.lhs | 2 +- compiler/vectorise/VectUtils.hs | 4 ++-- 10 files changed, 24 insertions(+), 43 deletions(-) delete mode 100644 compiler/coreSyn/CoreSyn.lhs-boot diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index c3cb952..154275b 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -97,7 +97,7 @@ module Id ( #include "HsVersions.h" -import {-# SOURCE #-} CoreSyn ( CoreRule, Unfolding ) +import CoreSyn ( CoreRule, Unfolding ) import IdInfo import BasicTypes diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 969f186..1ebfcf9 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -89,7 +89,7 @@ module IdInfo ( TickBoxOp(..), TickBoxId, ) where -import {-# SOURCE #-} CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding ) +import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding ) import Class import PrimOp diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index d9827af..79e25a2 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -25,7 +25,7 @@ module CoreSyn ( mkConApp, mkTyBind, varToCoreExpr, varsToCoreExprs, - isTyVar, isId, cmpAltCon, cmpAlt, ltAlt, + isTyVar, isIdVar, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, @@ -68,7 +68,6 @@ module CoreSyn ( import CostCentre import Var -import Id import Type import Coercion import Name @@ -705,7 +704,7 @@ mkTyBind tv ty = NonRec tv (Type ty) -- | 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] @@ -778,8 +777,8 @@ collectTyBinders expr 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} @@ -817,7 +816,7 @@ at runtime. Similarly isRuntimeArg. \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 @@ -835,7 +834,7 @@ isTypeArg _ = False -- | 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 diff --git a/compiler/coreSyn/CoreSyn.lhs-boot b/compiler/coreSyn/CoreSyn.lhs-boot deleted file mode 100644 index 5bdfeae..0000000 --- a/compiler/coreSyn/CoreSyn.lhs-boot +++ /dev/null @@ -1,18 +0,0 @@ -\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} diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index bf35f28..495ea42 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -344,7 +344,7 @@ extendSubst (CS cs in_scope sub) x y = CS cs in_scope (extendVarEnv sub x y) 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 diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index d46cb38..8938731 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -370,7 +370,7 @@ noFloatIntoRhs (AnnLam b _) = not (is_one_shot b) 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} diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index 4b4a349..f5a5a26 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -515,7 +515,7 @@ lvlBind top_lvl ctxt_lvl env (AnnRec pairs) 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 @@ -595,7 +595,7 @@ lvlLamBndrs lvl bndrs [] 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 @@ -637,7 +637,7 @@ isFunction :: CoreExprWithFVs -> Bool -- 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 @@ -755,10 +755,10 @@ maxIdLevel (_, lvl_env,_,id_env) var_set 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 @@ -798,7 +798,7 @@ abstractVars dest_lvl (_, lvl_env, _, id_env) fvs -- 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 @@ -813,7 +813,7 @@ absVarsOf :: IdEnv ([Var], LevelledExpr) -> Var -> [Var] -- 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] @@ -861,7 +861,7 @@ cloneVar :: TopLevelFlag -> LevelEnv -> Id -> Level -> Level -> LvlM (LevelEnv, 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 @@ -873,7 +873,7 @@ cloneRecVars :: TopLevelFlag -> LevelEnv -> [Id] -> Level -> Level -> LvlM (Leve 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 diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 66bf926..2290b1c 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -271,7 +271,7 @@ dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)]) -- 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' @@ -751,7 +751,7 @@ annotateLamIdBndr :: DmdType -- Demand type of body 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 diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs index 8bd89c0..faa26fe 100644 --- a/compiler/stranal/WorkWrap.lhs +++ b/compiler/stranal/WorkWrap.lhs @@ -311,7 +311,7 @@ splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs -- 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 diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index fd399e0..2c37f73 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -57,8 +57,8 @@ collectAnnTypeBinders expr = go [] expr 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 -- 1.7.10.4