projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
460784c
)
Remove CoreSyn SOURCE imports
author
Max Bolingbroke
<batterseapower@hotmail.com>
Thu, 7 Aug 2008 22:37:18 +0000
(22:37 +0000)
committer
Max Bolingbroke
<batterseapower@hotmail.com>
Thu, 7 Aug 2008 22:37:18 +0000
(22:37 +0000)
compiler/basicTypes/Id.lhs
patch
|
blob
|
history
compiler/basicTypes/IdInfo.lhs
patch
|
blob
|
history
compiler/coreSyn/CoreSyn.lhs
patch
|
blob
|
history
compiler/coreSyn/CoreSyn.lhs-boot
[deleted file]
patch
|
blob
|
history
compiler/simplCore/CSE.lhs
patch
|
blob
|
history
compiler/simplCore/FloatIn.lhs
patch
|
blob
|
history
compiler/simplCore/SetLevels.lhs
patch
|
blob
|
history
compiler/stranal/DmdAnal.lhs
patch
|
blob
|
history
compiler/stranal/WorkWrap.lhs
patch
|
blob
|
history
compiler/vectorise/VectUtils.hs
patch
|
blob
|
history
diff --git
a/compiler/basicTypes/Id.lhs
b/compiler/basicTypes/Id.lhs
index
c3cb952
..
154275b
100644
(file)
--- a/
compiler/basicTypes/Id.lhs
+++ b/
compiler/basicTypes/Id.lhs
@@
-97,7
+97,7
@@
module Id (
#include "HsVersions.h"
#include "HsVersions.h"
-import {-# SOURCE #-} CoreSyn ( CoreRule, Unfolding )
+import CoreSyn ( CoreRule, Unfolding )
import IdInfo
import BasicTypes
import IdInfo
import BasicTypes
diff --git
a/compiler/basicTypes/IdInfo.lhs
b/compiler/basicTypes/IdInfo.lhs
index
969f186
..
1ebfcf9
100644
(file)
--- a/
compiler/basicTypes/IdInfo.lhs
+++ b/
compiler/basicTypes/IdInfo.lhs
@@
-89,7
+89,7
@@
module IdInfo (
TickBoxOp(..), TickBoxId,
) where
TickBoxOp(..), TickBoxId,
) where
-import {-# SOURCE #-} CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
+import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
import Class
import PrimOp
import Class
import PrimOp
diff --git
a/compiler/coreSyn/CoreSyn.lhs
b/compiler/coreSyn/CoreSyn.lhs
index
d9827af
..
79e25a2
100644
(file)
--- a/
compiler/coreSyn/CoreSyn.lhs
+++ b/
compiler/coreSyn/CoreSyn.lhs
@@
-25,7
+25,7
@@
module CoreSyn (
mkConApp, mkTyBind,
varToCoreExpr, varsToCoreExprs,
mkConApp, mkTyBind,
varToCoreExpr, varsToCoreExprs,
- isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
+ isTyVar, isIdVar, cmpAltCon, cmpAlt, ltAlt,
-- ** Simple 'Expr' access functions and predicates
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
-- ** Simple 'Expr' access functions and predicates
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
@@
-68,7
+68,6
@@
module CoreSyn (
import CostCentre
import Var
import CostCentre
import Var
-import Id
import Type
import Coercion
import Name
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
-- | 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]
| otherwise = Type (mkTyVarTy v)
varsToCoreExprs :: [CoreBndr] -> [Expr b]
@@
-778,8
+777,8
@@
collectTyBinders expr
collectValBinders expr
= go [] expr
where
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}
\end{code}
\begin{code}
@@
-817,7
+816,7
@@
at runtime. Similarly isRuntimeArg.
\begin{code}
-- | Will this variable exist at runtime?
isRuntimeVar :: Var -> Bool
\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
-- | 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
-- | 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
-- | 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
(file)
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
(file)
--- 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)
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
| 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
(file)
--- 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
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}
\end{code}
diff --git
a/compiler/simplCore/SetLevels.lhs
b/compiler/simplCore/SetLevels.lhs
index
4b4a349
..
f5a5a26
100644
(file)
--- 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)
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
= 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)
[] 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
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
-- 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
| 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
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
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
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)
-- 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
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
-- 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]
, 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
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
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
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
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
(file)
--- 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
-- 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'
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
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
(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
(file)
--- 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)
-- 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
| 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
(file)
--- 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
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
isAnnTypeArg :: AnnExpr b ann -> Bool
isAnnTypeArg (_, AnnType _) = True