Commit 6084fb55 authored by batterseapower's avatar batterseapower

Split the Id related functions out from Var into Id, document Var and some of Id

parent bbc58376
......@@ -30,6 +30,8 @@ module BasicTypes(
RecFlag(..), isRec, isNonRec, boolToRecFlag,
RuleName,
TopLevelFlag(..), isTopLevel, isNotTopLevel,
OverlapFlag(..),
......@@ -129,6 +131,15 @@ instance Outputable name => Outputable (IPName name) where
ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
\end{code}
%************************************************************************
%* *
Rules
%* *
%************************************************************************
\begin{code}
type RuleName = FastString
\end{code}
%************************************************************************
%* *
......
This diff is collapsed.
......@@ -77,7 +77,6 @@ module IdInfo (
TickBoxOp(..), TickBoxId,
) where
import CoreSyn
import Class
import PrimOp
import Name
......@@ -503,9 +502,7 @@ specInfoRules (SpecInfo rules _) = rules
setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
setSpecInfoHead fn (SpecInfo rules fvs)
= SpecInfo (map set_head rules) fvs
where
set_head rule = rule { ru_fn = fn }
= SpecInfo (map (setRuleIdName fn) rules) fvs
seqSpecInfo :: SpecInfo -> ()
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
......@@ -747,7 +744,7 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo
zapFragileInfo info
= Just (info `setSpecInfo` emptySpecInfo
`setWorkerInfo` NoWorker
`setUnfoldingInfo` NoUnfolding
`setUnfoldingInfo` noUnfolding
`setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
where
occ = occInfo info
......
......@@ -1314,7 +1314,7 @@ errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy
\begin{code}
pcMiscPrelId :: Name -> Type -> IdInfo -> Id
pcMiscPrelId name ty info
= mkVanillaGlobal name ty info
= mkVanillaGlobalWithInfo name ty info
-- We lie and say the thing is imported; otherwise, we get into
-- a mess with dependency analysis; e.g., core2stg may heave in
-- random calls to GHCbase.unpackPS__. If GHCbase is the module
......
This diff is collapsed.
......@@ -22,7 +22,7 @@ module VarSet (
#include "HsVersions.h"
import Var
import Var ( Var, TyVar, Id )
import Unique
import UniqSet
\end{code}
......
......@@ -36,6 +36,7 @@ import CmmUtils
import CLabel
import ClosureInfo
import CostCentre
import Id
import Var
import SMRep
import BasicTypes
......
......@@ -566,7 +566,7 @@ lintAndScopeIds ids linterF
lintAndScopeId :: Var -> (Var -> LintM a) -> LintM a
lintAndScopeId id linterF
= do { ty <- lintTy (idType id)
; let id' = Var.setIdType id ty
; let id' = setIdType id ty
; addInScopeVars [id'] $ (linterF id')
}
......
......@@ -42,13 +42,14 @@ module CoreSyn (
-- Core rules
CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
RuleName, seqRules, ruleArity,
isBuiltinRule, ruleName, isLocalRule, ruleIdName
isBuiltinRule, ruleName, isLocalRule, ruleIdName, setRuleIdName
) where
#include "HsVersions.h"
import CostCentre
import Var
import Id
import Type
import Coercion
import Name
......@@ -205,8 +206,6 @@ A Rule is
as the rule itself
\begin{code}
type RuleName = FastString
data CoreRule
= Rule {
ru_name :: RuleName,
......@@ -262,6 +261,9 @@ ruleIdName = ru_fn
isLocalRule :: CoreRule -> Bool
isLocalRule = ru_local
setRuleIdName :: Name -> CoreRule -> CoreRule
setRuleIdName nm ru = ru { ru_fn = nm }
\end{code}
......
\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}
......@@ -114,7 +114,7 @@ make_tbind :: TyVar -> C.Tbind
make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv))
make_vbind :: Var -> C.Vbind
make_vbind v = (make_var_id (Var.varName v), make_ty (idType v))
make_vbind v = (make_var_id (Var.varName v), make_ty (varType v))
make_vdef :: Bool -> CoreBind -> CoreM C.Vdefg
make_vdef topLevel b =
......@@ -128,7 +128,7 @@ make_vdef topLevel b =
let local = not topLevel || localN
rhs <- make_exp e
-- use local flag to determine where to add the module name
return (local, make_qid local True vName, make_ty (idType v),rhs)
return (local, make_qid local True vName, make_ty (varType v),rhs)
where vName = Var.varName v
make_exp :: CoreExpr -> CoreM C.Exp
......@@ -136,11 +136,11 @@ make_exp (Var v) = do
let vName = Var.varName v
isLocal <- isALocal vName
return $
case globalIdDetails v of
case globalIdVarDetails v of
FCallId (CCall (CCallSpec (StaticTarget nm) callconv _))
-> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v))
-> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (varType v))
FCallId (CCall (CCallSpec DynamicTarget callconv _))
-> C.DynExternal (showSDoc (ppr callconv)) (make_ty (idType v))
-> C.DynExternal (showSDoc (ppr callconv)) (make_ty (varType v))
FCallId _
-> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call"
(ppr v)
......
......@@ -16,7 +16,7 @@ import SrcLoc
import ErrUtils
import Name
import Bag
import Var
import Id
import VarSet
import Data.List
import FastString
......
......@@ -33,6 +33,7 @@ import CoreUtils
import Name
import Var
import Id
import PrelInfo
import DataCon
import TysWiredIn
......
......@@ -28,7 +28,7 @@ import DsUtils
import DynFlags
import CoreUtils
import Var
import Id
import Type
import TysWiredIn
import Match
......
......@@ -17,7 +17,7 @@ import RtClosureInspect
import HscTypes
import IdInfo
--import Id
import Id
import Name
import Var hiding ( varName )
import VarSet
......
......@@ -46,7 +46,6 @@ import HsPat
import HsTypes
import HsDoc
import NameSet
import CoreSyn
import {- Kind parts of -} Type
import BasicTypes
import ForeignCall
......
......@@ -24,7 +24,6 @@ module IfaceSyn (
#include "HsVersions.h"
import CoreSyn
import IfaceType
import NewDemand
......
......@@ -25,6 +25,7 @@ module IfaceType (
import TypeRep
import TyCon
import Id
import Var
import TysWiredIn
import Name
......
......@@ -354,7 +354,7 @@ tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdI
= do { name <- lookupIfaceTop occ_name
; ty <- tcIfaceType iface_type
; info <- tcIdInfo ignore_prags name ty info
; return (AnId (mkVanillaGlobal name ty info)) }
; return (AnId (mkVanillaGlobalWithInfo name ty info)) }
tcIfaceDecl _
(IfaceData {ifName = occ_name,
......
......@@ -223,7 +223,7 @@ import HsSyn hiding ((<.>))
import Type hiding (typeKind)
import TcType hiding (typeKind)
import Id
import Var hiding (setIdType)
import Var
import TysPrim ( alphaTyVars )
import TyCon
import Class
......
......@@ -51,7 +51,7 @@ import VarSet
import VarEnv ( emptyTidyEnv )
#endif
import Var ( Id )
import Id ( Id )
import Module ( emptyModuleEnv, ModLocation(..), Module )
import RdrName
import HsSyn
......
......@@ -90,7 +90,7 @@ import Rules ( RuleBase )
import CoreSyn ( CoreBind )
import VarEnv
import VarSet
import Var hiding ( setIdType )
import Var
import Id
import Type
......
......@@ -45,7 +45,7 @@ import TcRnDriver
import Type hiding (typeKind)
import TcType hiding (typeKind)
import InstEnv
import Var hiding (setIdType)
import Var
import Id
import IdInfo
import Name hiding ( varName )
......
......@@ -20,7 +20,7 @@ import CoreLint
import CoreUtils
import VarEnv
import VarSet
import Var hiding( mkGlobalId )
import Var
import Id
import IdInfo
import InstEnv
......@@ -176,7 +176,7 @@ tidyExternalId :: Id -> Id
-- (NB: vanillaIdInfo makes a conservative assumption about Caf-hood.)
tidyExternalId id
= ASSERT2( isLocalId id && isExternalName (idName id), ppr id )
mkVanillaGlobal (idName id) (tidyTopType (idType id)) vanillaIdInfo
mkVanillaGlobal (idName id) (tidyTopType (idType id))
\end{code}
......
......@@ -21,7 +21,7 @@ import CoreSyn
import CoreUtils ( exprIsHNF, exprIsDupable )
import CoreLint ( showPass, endPass )
import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleVars )
import Id ( isOneShotBndr )
import Id ( isOneShotBndr, idType )
import Var
import Type ( isUnLiftedType )
import VarSet
......
......@@ -53,7 +53,7 @@ essential to make this work well!
module SAT ( doStaticArgs ) where
import DynFlags
import Var hiding (mkLocalId)
import Var
import CoreSyn
import CoreLint
import CoreUtils
......
......@@ -18,7 +18,7 @@ import StgSyn
import Type
import TyCon
import Id
import Var ( Var, globalIdDetails, idType )
import Var ( Var )
import IdInfo
import DataCon
import CostCentre ( noCCS )
......
......@@ -48,8 +48,7 @@ module StgSyn (
import CostCentre ( CostCentreStack, CostCentre )
import VarSet ( IdSet, isEmptyVarSet )
import Var ( isId )
import Id ( Id, idName, idType, idCafInfo )
import Id ( Id, idName, idType, idCafInfo, isId )
import IdInfo ( mayHaveCafRefs )
import Packages ( isDllName )
import Literal ( Literal, literalType )
......
......@@ -23,7 +23,7 @@ import TysWiredIn ( tupleCon )
import Type
import Coercion ( mkSymCoercion, splitNewTypeRepCo_maybe )
import BasicTypes ( Boxity(..) )
import Var ( Var, isId )
import Var ( Var, isIdVar )
import UniqSupply
import Unique
import Util ( zipWithEqual, notNull )
......@@ -127,12 +127,12 @@ mkWwBodies fun_ty demands res_info one_shots = do
-- Don't do CPR if the worker doesn't have any value arguments
-- Then the worker is just a constant, so we don't want to unbox it.
(wrap_fn_cpr, work_fn_cpr, _cpr_res_ty)
<- if any isId work_args then
<- if any isIdVar work_args then
mkWWcpr res_ty res_info
else
return (id, id, res_ty)
return ([idNewDemandInfo v | v <- work_call_args, isId v],
return ([idNewDemandInfo v | v <- work_call_args, isIdVar v],
Note InlineMe . wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var,
mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args)
-- We use an INLINE unconditionally, even if the wrapper turns out to be
......@@ -170,7 +170,7 @@ mkWorkerArgs :: [Var]
-> ([Var], -- Lambda bound args
[Var]) -- Args at call site
mkWorkerArgs args res_ty
| any isId args || not (isUnLiftedType res_ty)
| any isIdVar args || not (isUnLiftedType res_ty)
= (args, args)
| otherwise
= (args ++ [voidArgId], args ++ [realWorldPrimId])
......
......@@ -31,8 +31,7 @@ import Coercion
import VarEnv
import TysPrim
import Id
import IdInfo
import Var hiding (mkLocalId)
import Var
import Name
import NameSet
import NameEnv
......@@ -103,7 +102,7 @@ tcHsBootSigs (ValBindsOut binds sigs)
where
tc_boot_sig (TypeSig (L _ name) ty)
= do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) }
; return (mkVanillaGlobal name sigma_ty) }
-- Notice that we make GlobalIds, not LocalIds
tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s)
tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
......
......@@ -31,6 +31,7 @@ import TypeRep
import DataCon
import Class
import Var
import Id
import MkId
import Name
import NameSet
......
......@@ -36,6 +36,7 @@ import TcIface
import TcTyFuns
import DsUtils -- Big-tuple functions
import Var
import Id
import Name
import NameSet
import Class
......
......@@ -31,6 +31,7 @@ import Generics
import Class
import TyCon
import DataCon
import Id
import Var
import VarSet
import Name
......
......@@ -147,7 +147,6 @@ import TyCon
-- others:
import DynFlags
import CoreSyn
import Name
import NameSet
import VarEnv
......
......@@ -420,7 +420,7 @@ buildEnv vvs
return (vbody', lbody'))
where
(vs,ls) = unzip vvs
tys = map idType vs
tys = map varType vs
mkVectEnv :: [Type] -> [Var] -> (Type, CoreExpr, CoreExpr -> CoreExpr -> CoreExpr)
mkVectEnv [] [] = (unitTy, Var unitDataConId, \_ body -> body)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment