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
)
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}
-- 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(..) )
---------------------------------------------
-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)) }
---------------------------------------------