Commit bcacf0b7 authored by simonpj's avatar simonpj
Browse files

[project @ 2005-03-07 15:16:58 by simonpj]

-----------------------------------------
       Fix scoping bug for quantified type variables
	-----------------------------------------

	Merge to STABLE

When instantiating a declaration type signature, make sure to instantiate
fresh names for non-scoped type variables, else they may be spuriously shared.
Turns out that the test lib/Generics/reify tests this, which is good.

Comments are with TcMType.tcInstSigType
parent 57f94a24
......@@ -14,7 +14,7 @@ import {-# SOURCE #-} TcExpr ( tcCheckSigma, tcCheckRho )
import CmdLineOpts ( DynFlag(Opt_MonomorphismRestriction) )
import HsSyn ( HsExpr(..), HsBind(..), LHsBinds, Sig(..),
LSig, Match(..), HsBindGroup(..), IPBind(..),
HsType(..), hsLTyVarNames, isVanillaLSig,
HsType(..), HsExplicitForAll(..), hsLTyVarNames, isVanillaLSig,
LPat, GRHSs, MatchGroup(..), emptyLHsBinds, isEmptyLHsBinds,
collectHsBindBinders, collectPatBinders, pprPatBind
)
......@@ -593,21 +593,18 @@ tcTySig :: LSig Name -> TcM TcSigInfo
tcTySig (L span (Sig (L _ name) ty))
= setSrcSpan span $
do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; (tvs, theta, tau) <- tcInstSigType name sigma_ty
; (tvs, theta, tau) <- tcInstSigType name scoped_names sigma_ty
; loc <- getInstLoc (SigOrigin (SigSkol name))
; let poly_id = mkLocalId name sigma_ty
; return (TcSigInfo { sig_id = mkLocalId name sigma_ty,
sig_tvs = tvs, sig_theta = theta, sig_tau = tau,
sig_scoped = scoped_names, sig_loc = loc }) }
where
-- The scoped names are the ones explicitly mentioned
-- in the HsForAll. (There may be more in sigma_ty, because
-- of nested type synonyms. See Note [Scoped] with TcSigInfo.)
scoped_names = case ty of
L _ (HsForAllTy _ tvs _ _) -> hsLTyVarNames tvs
other -> []
; return (TcSigInfo { sig_id = poly_id, sig_scoped = scoped_names,
sig_tvs = tvs, sig_theta = theta, sig_tau = tau,
sig_loc = loc }) }
scoped_names = case ty of
L _ (HsForAllTy Explicit tvs _ _) -> hsLTyVarNames tvs
other -> []
\end{code}
\begin{code}
......
......@@ -77,7 +77,7 @@ import Var ( TyVar, tyVarKind, tyVarName,
-- others:
import TcRnMonad -- TcType, amongst others
import FunDeps ( grow )
import Name ( Name, setNameUnique, mkSysTvName, mkSystemName, getOccName )
import Name ( Name, setNameUnique, mkSysTvName )
import VarSet
import VarEnv
import CmdLineOpts ( dopt, DynFlag(..) )
......@@ -174,24 +174,38 @@ tcInstType ty = tc_inst_type (mappM tcInstTyVar) ty
---------------------------------------------
tcInstSigType :: Name -> TcType -> TcM ([TcTyVar], TcThetaType, TcType)
tcInstSigType :: Name -> [Name] -> TcType -> TcM ([TcTyVar], TcThetaType, TcType)
-- Instantiate a type with fresh SigSkol variables
-- See Note [Signature skolems] in TcType.
--
-- Tne new type variables have the sane Name as the original.
-- We don't need a fresh unique, because the renamer has made them
-- Tne new type variables have the sane Name as the original *iff* they are scoped.
-- For scoped tyvars, we don't need a fresh unique, because the renamer has made them
-- unique, and it's better not to do so because we extend the envt
-- with them as scoped type variables, and we'd like to avoid spurious
-- 's = s' bindings in error messages
tcInstSigType id_name ty = tc_inst_type (tcInstSigTyVars id_name) ty
--
-- For non-scoped ones, we *must* instantiate fresh ones:
--
-- type T = forall a. [a] -> [a]
-- f :: T;
-- f = g where { g :: T; g = <rhs> }
--
-- We must not use the same 'a' from the defn of T at both places!!
tcInstSigType id_name scoped_names ty = tc_inst_type (tcInstSigTyVars id_name scoped_names) ty
tcInstSigTyVars :: Name -> [TyVar] -> TcM [TcTyVar]
tcInstSigTyVars id_name tyvars
tcInstSigTyVars :: Name -> [Name] -> [TyVar] -> TcM [TcTyVar]
tcInstSigTyVars id_name scoped_names tyvars
= mapM new_tv tyvars
where
new_tv tv = do { ref <- newMutVar Flexi ;
; return (mkTcTyVar (tyVarName tv) (tyVarKind tv)
(SigSkolTv id_name ref)) }
new_tv tv
= do { let name = tyVarName tv
; ref <- newMutVar Flexi
; name' <- if name `elem` scoped_names
then return name
else do { uniq <- newUnique; return (setNameUnique name uniq) }
; return (mkTcTyVar name' (tyVarKind tv)
(SigSkolTv id_name ref)) }
---------------------------------------------
......
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