Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
04612d54
Commit
04612d54
authored
Jan 31, 2005
by
simonpj
Browse files
[project @ 2005-01-31 13:22:57 by simonpj]
Rename mkTvSubst to mkOpenTvSubst; add new mkTvSubst
parent
94df1013
Changes
6
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/typecheck/TcBinds.lhs
View file @
04612d54
...
...
@@ -34,7 +34,7 @@ import TcSimplify ( bindInstsOfLocalFuns )
import TcMType ( newTyFlexiVarTy, tcSkolType, zonkQuantifiedTyVar, zonkTcTypes )
import TcType ( TcTyVar, SkolemInfo(SigSkol),
TcTauType, TcSigmaType,
TvSubstEnv, mkTvSubst, substTheta, substTy,
TvSubstEnv, mk
Open
TvSubst, substTheta, substTy,
mkTyVarTy, mkForAllTys, mkFunTys, tyVarsOfType,
mkForAllTy, isUnLiftedType, tcGetTyVar_maybe,
mkTyVarTys )
...
...
@@ -605,7 +605,7 @@ checkSigCtxt sig1 sig@(TcSigInfo { sig_tvs = tvs, sig_theta = theta, sig_tau = t
Just tvs' ->
let
subst = mkTvSubst tenv
subst = mk
Open
TvSubst tenv
in
return (sig { sig_tvs = tvs',
sig_theta = substTheta subst theta,
...
...
ghc/compiler/typecheck/TcDeriv.lhs
View file @
04612d54
...
...
@@ -29,7 +29,7 @@ import RnEnv ( bindLocalNames )
import HscTypes ( DFunId, FixityEnv )
import Class ( className, classArity, classKey, classTyVars, classSCTheta, Class )
import Type ( zipTvSubst, substTheta )
import Type ( zip
Open
TvSubst, substTheta )
import ErrUtils ( dumpIfSet_dyn )
import MkId ( mkDictFunId )
import DataCon ( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys )
...
...
@@ -441,7 +441,7 @@ makeDerivEqns tycl_decls
-- There's no 'corece' needed because after the type checker newtypes
-- are transparent.
sc_theta = substTheta (zipTvSubst clas_tyvars inst_tys)
sc_theta = substTheta (zip
Open
TvSubst clas_tyvars inst_tys)
(classSCTheta clas)
-- If there are no tyvars, there's no need
...
...
ghc/compiler/typecheck/TcInstDcls.lhs
View file @
04612d54
...
...
@@ -27,7 +27,7 @@ import TcEnv ( tcExtendGlobalValEnv, tcExtendTyVarEnv,
import TcHsType ( kcHsSigType, tcHsKindedType )
import TcUnify ( checkSigTyVars )
import TcSimplify ( tcSimplifyCheck, tcSimplifyTop )
import Type ( zipTvSubst, substTheta, substTys )
import Type ( zip
Open
TvSubst, substTheta, substTys )
import DataCon ( classDataCon )
import Class ( classBigSig )
import Var ( Id, idName, idType )
...
...
@@ -328,7 +328,7 @@ tcInstDecl2 (InstInfo { iDFunId = dfun_id, iBinds = binds })
(class_tyvars, sc_theta, _, op_items) = classBigSig clas
-- Instantiate the super-class context with inst_tys
sc_theta' = substTheta (zipTvSubst class_tyvars inst_tys') sc_theta
sc_theta' = substTheta (zip
Open
TvSubst class_tyvars inst_tys') sc_theta
origin = SigOrigin rigid_info
in
-- Create dictionary Ids from the specified instance contexts.
...
...
@@ -512,7 +512,7 @@ tcMethods origin clas inst_tyvars' dfun_theta' inst_tys'
-- of the type variables in the instance declaration; but rep_tys doesn't
-- have the skolemised version, so we substitute them in here
rep_tys' = substTys subst rep_tys
subst = zipTvSubst inst_tyvars' (mkTyVarTys inst_tyvars')
subst = zip
Open
TvSubst inst_tyvars' (mkTyVarTys inst_tyvars')
\end{code}
Note: [Superclass loops]
...
...
ghc/compiler/typecheck/TcPat.lhs
View file @
04612d54
...
...
@@ -26,7 +26,7 @@ import TcEnv ( newLocalName, tcExtendIdEnv1, tcExtendTyVarEnv2,
import TcMType ( newTyFlexiVarTy, arityErr, tcSkolTyVars, readMetaTyVar )
import TcType ( TcType, TcTyVar, TcSigmaType, TcTauType, zipTopTvSubst,
SkolemInfo(PatSkol), isSkolemTyVar, isMetaTyVar, pprSkolemTyVar,
TvSubst, mkTvSubst, substTyVar, substTy, MetaDetails(..),
TvSubst, mk
Open
TvSubst, substTyVar, substTy, MetaDetails(..),
mkTyVarTys, mkClassPred, mkTyConApp, isOverloadedTy )
import VarEnv ( mkVarEnv ) -- ugly
import Kind ( argTypeKind, liftedTypeKind )
...
...
@@ -535,7 +535,7 @@ refineTyVars :: [TcTyVar] -- Newly instantiated meta-tyvars of the function
-- Just one level of de-wobblification though. What a hack!
refineTyVars tvs
= do { mb_prs <- mapM mk_pr tvs
; return (mkTvSubst (mkVarEnv (catMaybes mb_prs))) }
; return (mk
Open
TvSubst (mkVarEnv (catMaybes mb_prs))) }
where
mk_pr tv = do { details <- readMetaTyVar tv
; case details of
...
...
ghc/compiler/typecheck/TcType.lhs
View file @
04612d54
...
...
@@ -94,7 +94,7 @@ module TcType (
-- Type substitutions
TvSubst(..), -- Representation visible to a few friends
TvSubstEnv, emptyTvSubst,
mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
mk
Open
TvSubst, zip
Open
TvSubst, zipTopTvSubst, mkTopTvSubst,
getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
extendTvSubst, extendTvSubstList, isInScope,
substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
...
...
@@ -146,7 +146,7 @@ import Type ( -- Re-exports
TvSubst(..),
TvSubstEnv, emptyTvSubst,
mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
mk
Open
TvSubst, zip
Open
TvSubst, zipTopTvSubst, mkTopTvSubst,
getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
extendTvSubst, extendTvSubstList, isInScope,
substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
...
...
ghc/compiler/types/Type.lhs
View file @
04612d54
...
...
@@ -65,7 +65,7 @@ module Type (
-- Type substitutions
TvSubstEnv, emptyTvSubstEnv, -- Representation widely visible
TvSubst(..), emptyTvSubst, -- Representation visible to a few friends
mkTvSubst,
zip
TvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
mkTvSubst,
mkOpenTvSubst, zipOpen
TvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
extendTvSubst, extendTvSubstList, isInScope, composeTvSubst,
...
...
@@ -1031,12 +1031,13 @@ emptyTvSubstEnv = emptyVarEnv
composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
-- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
-- It assumes that both are idempotent
-- Typically, env1 is the refinement to a base substitution env2
composeTvSubst in_scope env1 env2
= env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
-- First apply env1 to the range of env2
-- Then combine the two, making sure that env1 loses if
-- both bind the same variable; that's why env1 is the
-- *left* argument to plusVarEnv, bec
u
ause the right arg wins
-- *left* argument to plusVarEnv, because the right arg wins
where
subst1 = TvSubst in_scope env1
...
...
@@ -1044,6 +1045,9 @@ emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
isEmptyTvSubst :: TvSubst -> Bool
isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
mkTvSubst = TvSubst
getTvSubstEnv :: TvSubst -> TvSubstEnv
getTvSubstEnv (TvSubst _ env) = env
...
...
@@ -1069,16 +1073,15 @@ extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
extendTvSubstList (TvSubst in_scope env) tvs tys
= TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
-- mkTvSubst and zipTvSubst generate the in-scope set from
-- mk
Open
TvSubst and zip
Open
TvSubst generate the in-scope set from
-- the types given; but it's just a thunk so with a bit of luck
-- it'll never be evaluated
mkTvSubst :: TvSubstEnv -> TvSubst
mkTvSubst env
= TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
mkOpenTvSubst :: TvSubstEnv -> TvSubst
mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
zipTvSubst :: [TyVar] -> [Type] -> TvSubst
zipTvSubst tyvars tys
zip
Open
TvSubst :: [TyVar] -> [Type] -> TvSubst
zip
Open
TvSubst tyvars tys
= TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
-- mkTopTvSubst is called when doing top-level substitutions.
...
...
@@ -1131,7 +1134,7 @@ instance Outputable TvSubst where
\begin{code}
substTyWith :: [TyVar] -> [Type] -> Type -> Type
substTyWith tvs tys = substTy (zipTvSubst tvs tys)
substTyWith tvs tys = substTy (zip
Open
TvSubst tvs tys)
substTy :: TvSubst -> Type -> Type
substTy subst ty | isEmptyTvSubst subst = ty
...
...
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