[commit: ghc] overlapping-tyfams: Revert "Checkpoint, working on RnSource" (780d4b9)

[Richard Eisenberg]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : overlapping-tyfams

https://github.com/ghc/ghc/commit/780d4b90031dc73ea6d9a9c58f36f745500dee3f

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

commit 780d4b90031dc73ea6d9a9c58f36f745500dee3f
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Tue Jun 11 18:56:46 2013 +0100

    Revert "Checkpoint, working on RnSource"
    
    This reverts commit 33582704caaf2ba4cd6f06360ff2834667d2ce6d.

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

 compiler/rename/RnSource.lhs | 66 +++++++++++++++++++++++++++-----------------
 1 file changed, 41 insertions(+), 25 deletions(-)

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index da79fb1..de42e75 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -499,11 +499,11 @@ rnFamInstLHS :: HsDocContext
              -> Maybe (Name, [Name])
              -> Located RdrName
              -> [LHsType RdrName]
-             -> RnM (Located Name, HsWithBndrs [LHsType Name], FreeVars)
+             -> RnM (???)
 rnFamInstLHS doc mb_cls tycon pats
-  = do { tycon' <- lookupFamInstName (fmap fst mb_cls) tycon
+  = do { tycon'   <- lookupFamInstName (fmap fst mb_cls) tycon
        ; let loc = case pats of
-                     []             -> pprPanic "rnFamInstLHS" (ppr tycon)
+                     []             -> pprPanic "rnFamInstDecl" (ppr tycon)
                      (L loc _ : []) -> loc
                      (L loc _ : ps) -> combineSrcSpans loc (getLoc (last ps))
              (kv_rdr_names, tv_rdr_names) = extractHsTysRdrTyVars pats
@@ -518,10 +518,6 @@ rnFamInstLHS doc mb_cls tycon pats
                          bindLocalNamesFV tv_names $ 
                          rnLHsTypes doc pats
 
-       ; return ( tycon'
-                , HsWB { hswb_cts = pats', hswb_kvs = kv_names, hswb_tvs = tv_names }
-                , fvs `addOneFV` unLoc tycon' )
-
 rnFamInstDecl :: HsDocContext
               -> Maybe (Name, [Name])
               -> Located RdrName
@@ -530,20 +526,41 @@ rnFamInstDecl :: HsDocContext
               -> (HsDocContext -> rhs -> RnM (rhs', FreeVars))
               -> RnM (Located Name, HsWithBndrs [LHsType Name], rhs', FreeVars)
 rnFamInstDecl doc mb_cls tycon pats payload rnPayload
-  = do { (tycon', pats', pats_fvs) <- rnFamInstLHS doc mb_cls tycon pats
-       ; let HsWB { hswb_kvs = kv_names, hswb_tvs = tv_names } = pats'
-       ; (payload', rhs_fvs)
-           <- bindLocalNamesFV kv_names $
-              bindLocalNamesFV tv_names $
-              do { (payload', rhs_fvs) <- rnPayload doc payload
-                 ; let bad_tvs = case mb_cls of
-                         Nothing          -> []
-                         Just (_,cls_tvs) -> filter is_bad cls_tvs
-                       is_bad tv = not (tv `elem` tv_names) && tv `elemNameSet` rhs_fvs
-
-                 ; unless (null bad_tvs) (badAssocRhs bad_tvs)
-                 ; return (payload', rhs_fvs) }
-       ; return (tycon', pats', payload', pats_fvs `plusFV` rhs_fvs) }
+  = do { tycon'   <- lookupFamInstName (fmap fst mb_cls) tycon
+       ; let loc = case pats of
+                     []             -> pprPanic "rnFamInstDecl" (ppr tycon)
+                     (L loc _ : []) -> loc
+                     (L loc _ : ps) -> combineSrcSpans loc (getLoc (last ps))
+             (kv_rdr_names, tv_rdr_names) = extractHsTysRdrTyVars pats
+
+
+       ; rdr_env  <- getLocalRdrEnv
+       ; kv_names <- mapM (newTyVarNameRn mb_cls rdr_env loc) kv_rdr_names
+       ; tv_names <- mapM (newTyVarNameRn mb_cls rdr_env loc) tv_rdr_names
+             -- All the free vars of the family patterns
+             -- with a sensible binding location
+       ; ((pats', payload'), fvs) 
+              <- bindLocalNamesFV kv_names $ 
+                 bindLocalNamesFV tv_names $ 
+                 do { (pats', pat_fvs) <- rnLHsTypes doc pats
+                    ; (payload', rhs_fvs) <- rnPayload doc payload
+
+                         -- See Note [Renaming associated types]
+                    ; let bad_tvs = case mb_cls of
+                                      Nothing          -> []
+                                      Just (_,cls_tvs) -> filter is_bad cls_tvs
+                          is_bad tv = not (tv `elem` tv_names) && tv `elemNameSet` rhs_fvs
+
+                    ; unless (null bad_tvs) (badAssocRhs bad_tvs)
+                    ; return ((pats', payload'), rhs_fvs `plusFV` pat_fvs) }
+                              
+
+       ; let all_fvs = fvs `addOneFV` unLoc tycon'
+       ; return (tycon',
+                 HsWB { hswb_cts = pats', hswb_kvs = kv_names, hswb_tvs = tv_names },
+                 payload',
+                 all_fvs) }
+             -- type instance => use, hence addOneFV
 
 rnTyFamInstDecl :: Maybe (Name, [Name])
                 -> TyFamInstDecl RdrName
@@ -559,12 +576,11 @@ rnTyFamInstDecl Nothing (TyFamInstBranched { tfid_eqns = eqns, tfid_space = mspa
        ; return (TyFamInstBranched { tfid_eqns  = eqns'
                                    , tfid_space = space'
                                    , tfid_fvs   = fvs }, fvs) }
-  where rn_space Nothing = (Nothing, emptyFVs)
+  where rn_space Nothing  = (Nothing, emptyFVs)
         rn_space (Just (TyFamInstSpace { tfis_tycon = tycon
                                        , tfis_pats  = pats }))
-          = do { (tycon', pats', fvs) <- rnFamInstLHS ??? Nothing tycon pats
-               ; return (TyFamInstSpace { tfis_tycon = tycon'
-                                        , tfis_pats  = pats' }, fvs) }
+          = do { tycon' <- lookupFamInstName Nothing tycon
+               ; let loc
 
 rnTyFamInstEqn :: Maybe (Name, [Name])
                -> TyFamInstEqn RdrName