Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/817d1b047b538e408a8758a18270c51d429de670

>---------------------------------------------------------------

commit 817d1b047b538e408a8758a18270c51d429de670
Author: Simon Peyton Jones <[email protected]>
Date:   Thu Sep 29 16:05:16 2011 +0100

    Fix scoping for RHS of associated type decls (fixes Trac #5515)
    
    We should not allow things like
    
    class C a b where
      type F a :: *
    
    instance C (p,q) r where
      type F (p,q) = r   -- No! fvs(rhs) should be a subset
                         --     of fvs(lhs)

>---------------------------------------------------------------

 compiler/hsSyn/HsDecls.lhs   |   11 ++++++++---
 compiler/rename/RnSource.lhs |   42 ++++++++++++++++++++++++++----------------
 2 files changed, 34 insertions(+), 19 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 940e6a7..deb72ed 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -532,9 +532,14 @@ tcdTyPats = Just tys
    This is a data/type family instance declaration
    tcdTyVars are fv(tys)
 
-   Eg   instance C (a,b) where
-          type F a x y = x->y
-   After the renamer, the tcdTyVars of the F decl are {x,y}
+   Eg   class C a b where
+          type F a x :: *
+        instance D p s => C (p,q) [r] where
+          type F (p,q) x = p -> x
+   The tcdTyVars of the F instance decl are {p,q,x},
+   i.e. not including s, nor r 
+        (and indeed neither s nor should be mentioned
+         on the RHS of the F instance decl; Trac #5515)
 
 ------------------------------
 Simple classifiers
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 1d7e956..f405a0e 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -436,8 +436,7 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
                                                  mbinds    
 
        -- Rename the associated types
-       -- Here the instance variables always scope, regardless of 
-XScopedTypeVariables                                        
-       -- NB: we allow duplicate associated-type decls; 
+       -- NB: We allow duplicate associated-type decls; 
        --     See Note [Associated type instances] in TcInstDcls
        ; (ats', at_fvs) <- extendTyVarEnvFVRn (map hsLTyVarName inst_tyvars) $
                            rnATInsts cls ats
@@ -866,23 +865,34 @@ bindQTvs mb_cls tyvars thing_inside
        ; mapM_ dupBoundTyVar (findDupRdrNames tv_rdr_names)
 
        ; rdr_env <- getLocalRdrEnv
-       ; tv_nbs <- mapM (mk_tv_name rdr_env) tv_rdr_names
-       ; let tv_ns, fresh_ns :: [Name]
-             tv_ns = map fst tv_nbs
-            fresh_ns = [n | (n,True)  <- tv_nbs]
-
-       ; (thing, fvs) <- bindLocalNames tv_ns $
+       ; tv_ns <- mapM (mk_tv_name rdr_env) tv_rdr_names
+       ; (thing, fvs) <- bindLocalNamesFV tv_ns $
                          thing_inside (zipWith replaceLTyVarName tyvars tv_ns)
-       ; return (thing, delFVs fresh_ns fvs) }
+
+       -- Check that the RHS of the decl mentions only type variables
+       -- bound on the LHS.  For example, this is not ok
+       --       class C a b where
+       --         type F a x :: *
+       --       instance C (p,q) r where
+        --        type F (p,q) x = (x, r)      -- BAD: mentions 'r'
+       -- c.f. Trac #5515
+       ; let bad_tvs = filterNameSet (isTvOcc . nameOccName) fvs
+       ; unless (isEmptyNameSet bad_tvs) (badAssocRhs (nameSetToList bad_tvs))
+
+       ; return (thing, fvs) }
   where
-    mk_tv_name :: LocalRdrEnv -> Located RdrName -> RnM (Name, Bool)
-              -- False <=> already in scope
-              -- True  <=> fresh
+    mk_tv_name :: LocalRdrEnv -> Located RdrName -> RnM Name
     mk_tv_name rdr_env (L l tv_rdr)
-      = do { case lookupLocalRdrEnv rdr_env tv_rdr of 
-               Just n  -> return (n, False)
-               Nothing -> do { n <- newLocalBndrRn (L l tv_rdr)
-                             ; return (n, True) } }
+      = case lookupLocalRdrEnv rdr_env tv_rdr of 
+          Just n  -> return n
+          Nothing -> newLocalBndrRn (L l tv_rdr)
+
+badAssocRhs :: [Name] -> RnM ()
+badAssocRhs ns
+  = addErr (hang (ptext (sLit "The RHS of an associated type declaration 
mentions type variable") 
+                  <> plural ns 
+                  <+> pprWithCommas (quotes . ppr) ns)
+               2 (ptext (sLit "All such variables must be bound on the LHS")))
 
 dupBoundTyVar :: [Located RdrName] -> RnM ()
 dupBoundTyVar (L loc tv : _) 



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to