Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
2e065952
Commit
2e065952
authored
Aug 07, 2008
by
batterseapower
Browse files
Remove CoreSyn SOURCE imports
parent
460784c3
Changes
10
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/Id.lhs
View file @
2e065952
...
...
@@ -97,7 +97,7 @@ module Id (
#include "HsVersions.h"
import
{-# SOURCE #-}
CoreSyn ( CoreRule, Unfolding )
import CoreSyn ( CoreRule, Unfolding )
import IdInfo
import BasicTypes
...
...
compiler/basicTypes/IdInfo.lhs
View file @
2e065952
...
...
@@ -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
...
...
compiler/coreSyn/CoreSyn.lhs
View file @
2e065952
...
...
@@ -25,7 +25,7 @@ module CoreSyn (
mkConApp, mkTyBind,
varToCoreExpr, varsToCoreExprs,
isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
isTyVar, isId
Var
, 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 | isId
Var 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) | isId
Var
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 = isId
Var
-- | 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 isId
Var
-- | The number of argument expressions that are values rather than types at their top level
valArgCount :: [Arg b] -> Int
...
...
compiler/coreSyn/CoreSyn.lhs-boot
deleted
100644 → 0
View file @
460784c3
\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}
compiler/simplCore/CSE.lhs
View file @
2e065952
...
...
@@ -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')
| isId
Var
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
...
...
compiler/simplCore/FloatIn.lhs
View file @
2e065952
...
...
@@ -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 = isId
Var
b && isOneShotBndr b
\end{code}
...
...
compiler/simplCore/SetLevels.lhs
View file @
2e065952
...
...
@@ -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 isId
Var
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,
| isId
Var
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) | isId
Var 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
| isId
Var
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 | isId
Var
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
| isId
Var 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( isId
Var
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 isId
Var
vs ) do
us <- getUniqueSupplyM
let
(subst', vs1) = cloneRecIdBndrs subst us vs
...
...
compiler/stranal/DmdAnal.lhs
View file @
2e065952
...
...
@@ -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', isId
Var
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( isId
Var
id )
(DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd)
where
(fv', dmd) = removeFV fv id res
...
...
compiler/stranal/WorkWrap.lhs
View file @
2e065952
...
...
@@ -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
| isId
Var 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
...
...
compiler/vectorise/VectUtils.hs
View file @
2e065952
...
...
@@ -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
)
|
isId
Var
b
=
go
(
b
:
bs
)
e
go
bs
e
=
(
reverse
bs
,
e
)
isAnnTypeArg
::
AnnExpr
b
ann
->
Bool
isAnnTypeArg
(
_
,
AnnType
_
)
=
True
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment