[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

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index c4e1b92..b1bfc65 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -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}

diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index 46968f5..4a9df50 100644 (file)
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -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)) }
                            
 
 ---------------------------------------------