Commit 04612d54 authored by simonpj's avatar simonpj
Browse files

[project @ 2005-01-31 13:22:57 by simonpj]

Rename mkTvSubst to mkOpenTvSubst; add new mkTvSubst
parent 94df1013
......@@ -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, mkOpenTvSubst, 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 = mkOpenTvSubst tenv
in
return (sig { sig_tvs = tvs',
sig_theta = substTheta subst theta,
......
......@@ -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 ( zipOpenTvSubst, 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 (zipOpenTvSubst clas_tyvars inst_tys)
(classSCTheta clas)
-- If there are no tyvars, there's no need
......
......@@ -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 ( zipOpenTvSubst, 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 (zipOpenTvSubst 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 = zipOpenTvSubst inst_tyvars' (mkTyVarTys inst_tyvars')
\end{code}
Note: [Superclass loops]
......
......@@ -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, mkOpenTvSubst, 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 (mkOpenTvSubst (mkVarEnv (catMaybes mb_prs))) }
where
mk_pr tv = do { details <- readMetaTyVar tv
; case details of
......
......@@ -94,7 +94,7 @@ module TcType (
-- Type substitutions
TvSubst(..), -- Representation visible to a few friends
TvSubstEnv, emptyTvSubst,
mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
mkOpenTvSubst, zipOpenTvSubst, 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,
mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
extendTvSubst, extendTvSubstList, isInScope,
substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
......
......@@ -65,7 +65,7 @@ module Type (
-- Type substitutions
TvSubstEnv, emptyTvSubstEnv, -- Representation widely visible
TvSubst(..), emptyTvSubst, -- Representation visible to a few friends
mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, 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, becuause 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
-- mkOpenTvSubst and zipOpenTvSubst 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
zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
zipOpenTvSubst 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 (zipOpenTvSubst tvs tys)
substTy :: TvSubst -> Type -> Type
substTy subst ty | isEmptyTvSubst subst = ty
......
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