[project @ 1996-04-30 13:08:34 by partain]

Sansom 1.3 changes through 960429

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index f73b36a..303fd04 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -36,13 +36,15 @@ module Name (
        nameOrigName,
        nameExportFlag,
        nameSrcLoc,
+       nameImpLocs,
        nameImportFlag,
        isLocallyDefinedName,
        isPreludeDefinedName,
 
        origName, moduleOf, nameOf, moduleNamePair,
        getOccName, getExportFlag,
-       getSrcLoc, isLocallyDefined, isPreludeDefined,
+       getSrcLoc, getImpLocs,
+       isLocallyDefined, isPreludeDefined,
        getLocalName, ltLexical,
 
        isSymLexeme, pprSym, pprNonSym,
@@ -157,7 +159,7 @@ data Provenance
 
   | Imported ExportFlag          -- how it was imported
             SrcLoc       -- *original* source location
-         --  [SrcLoc]     -- any import source location(s)
+             [SrcLoc]     -- any import source location(s)
 
   | Implicit
   | Builtin
@@ -167,7 +169,7 @@ data Provenance
 mkLocalName = Local
 
 mkTopLevName   u orig locn exp occs = Global u orig (LocalDef locn) exp occs
-mkImportedName u orig imp locn exp occs = Global u orig (Imported imp locn) exp occs
+mkImportedName u orig imp locn imp_locs exp occs = Global u orig (Imported imp locn imp_locs) exp occs
 
 mkImplicitName :: Unique -> RdrName -> Name
 mkImplicitName u o = Global u o Implicit NotExported []
@@ -274,23 +276,26 @@ nameOccName (Global   _ orig _ _ occs) = head occs
 nameExportFlag (Local    _ _ _)              = NotExported
 nameExportFlag (Global   _ _ _ exp _) = exp
 
-nameSrcLoc (Local  _ _ loc)                 = loc
-nameSrcLoc (Global _ _ (LocalDef loc)   _ _) = loc
-nameSrcLoc (Global _ _ (Imported _ loc) _ _) = loc
-nameSrcLoc (Global _ _ Implicit         _ _) = mkUnknownSrcLoc
-nameSrcLoc (Global _ _ Builtin          _ _) = mkBuiltinSrcLoc
-
-nameImportFlag (Local _ _ _)                     = NotExported
-nameImportFlag (Global _ _ (LocalDef _)     _ _) = ExportAll
-nameImportFlag (Global _ _ (Imported exp _) _ _) = exp
-nameImportFlag (Global _ _ Implicit         _ _) = ExportAll
-nameImportFlag (Global _ _ Builtin          _ _) = ExportAll
-
-isLocallyDefinedName (Local  _ _ _)                 = True
-isLocallyDefinedName (Global _ _ (LocalDef _)   _ _) = True
-isLocallyDefinedName (Global _ _ (Imported _ _) _ _) = False
-isLocallyDefinedName (Global _ _ Implicit       _ _) = False
-isLocallyDefinedName (Global _ _ Builtin        _ _) = False
+nameSrcLoc (Local  _ _ loc)                   = loc
+nameSrcLoc (Global _ _ (LocalDef loc)     _ _) = loc
+nameSrcLoc (Global _ _ (Imported _ loc _) _ _) = loc
+nameSrcLoc (Global _ _ Implicit           _ _) = mkUnknownSrcLoc
+nameSrcLoc (Global _ _ Builtin            _ _) = mkBuiltinSrcLoc
+  
+nameImpLocs (Global _ _ (Imported _ _ locs) _ _) = locs
+nameImpLocs _                                   = []
+
+nameImportFlag (Local _ _ _)                       = NotExported
+nameImportFlag (Global _ _ (LocalDef _)       _ _) = ExportAll
+nameImportFlag (Global _ _ (Imported exp _ _) _ _) = exp
+nameImportFlag (Global _ _ Implicit           _ _) = ExportAll
+nameImportFlag (Global _ _ Builtin            _ _) = ExportAll
+
+isLocallyDefinedName (Local  _ _ _)                   = True
+isLocallyDefinedName (Global _ _ (LocalDef _)     _ _) = True
+isLocallyDefinedName (Global _ _ (Imported _ _ _) _ _) = False
+isLocallyDefinedName (Global _ _ Implicit         _ _) = False
+isLocallyDefinedName (Global _ _ Builtin          _ _) = False
 
 isPreludeDefinedName (Local    _ n _)        = False
 isPreludeDefinedName (Global   _ orig _ _ _) = isUnqual orig
@@ -375,6 +380,7 @@ getOccName      :: NamedThing a => a -> RdrName
 getLocalName       :: NamedThing a => a -> FAST_STRING
 getExportFlag      :: NamedThing a => a -> ExportFlag
 getSrcLoc          :: NamedThing a => a -> SrcLoc
+getImpLocs         :: NamedThing a => a -> [SrcLoc]
 isLocallyDefined    :: NamedThing a => a -> Bool
 isPreludeDefined    :: NamedThing a => a -> Bool
 
@@ -393,6 +399,7 @@ getLocalName            = nameOf . origName
 getOccName         = nameOccName          . getName
 getExportFlag      = nameExportFlag       . getName
 getSrcLoc          = nameSrcLoc           . getName
+getImpLocs         = nameImpLocs          . getName
 isLocallyDefined    = isLocallyDefinedName . getName
 isPreludeDefined    = isPreludeDefinedName . getName
 \end{code}

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 4522b96..a9c4ffc 100644 (file)
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -46,7 +46,7 @@ import PrelInfo               ( mkTupleTy, unitTy, nilDataCon, consDataCon,
                        )
 import Pretty          ( ppShow, ppBesides, ppPStr, ppStr )
 import Type            ( splitSigmaTy, splitFunTy, typePrimRep, getAppDataTyCon )
-import TyVar           ( nullTyVarEnv, addOneToTyVarEnv )
+import TyVar           ( GenTyVar, nullTyVarEnv, addOneToTyVarEnv )
 import Usage           ( UVar(..) )
 import Util            ( zipEqual, pprError, panic, assertPanic )
 
@@ -358,26 +358,23 @@ before printing it as
 dsExpr (RecordCon con_expr rbinds)
   = dsExpr con_expr    `thenDs` \ con_expr' ->
     let
-       con_id   = get_con_id con_expr'
+       con_id       = get_con con_expr'
+       (arg_tys, _) = splitFunTy (coreExprType con_expr')
 
-       mk_arg lbl
+       mk_arg (arg_ty, lbl)
          = case [rhs | (sel_id,rhs,_) <- rbinds,
                        lbl == recordSelectorFieldLabel sel_id] of
              (rhs:rhss) -> ASSERT( null rhss )
                            dsExpr rhs
-             []         -> mkErrorAppDs rEC_CON_ERROR_ID (fieldLabelType lbl) (showForErr lbl)
-
-       -- ToDo Bug: fieldLabelType lbl needs to be instantiated with appropriate type args
-       --           problem also arises if ty is extraced by splitting the type of the con_id
+             []         -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (showForErr lbl)
     in
-    mapDs mk_arg (dataConFieldLabels con_id) `thenDs` \ con_args ->
+    mapDs mk_arg (arg_tys `zipEqual` dataConFieldLabels con_id) `thenDs` \ con_args ->
     mkAppDs con_expr' [] con_args
   where
-       -- The "con_expr'" is simply an application of the constructor Id
-       -- to types and (perhaps) dictionaries.  This boring little 
-       -- function gets the constructor out.
-    get_con_id (App fun _) = get_con_id fun
-    get_con_id (Var con)   = con
+       -- "con_expr'" is simply an application of the constructor Id
+       -- to types and (perhaps) dictionaries. This gets the constructor...
+    get_con (Var con)   = con
+    get_con (App fun _) = get_con fun
 \end{code}
 
 Record update is a little harder. Suppose we have the decl:

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 4e1f517..5491079 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -91,6 +91,12 @@ isRnImplicit _                        = False
 isRnUnbound (RnUnbound _) = True
 isRnUnbound _            = False
 
+isRnDecl (RnName _)    = True
+isRnDecl (RnSyn _)     = True
+isRnDecl (RnData _ _ _)        = True
+isRnDecl (RnClass _ _) = True
+isRnDecl _             = False
+
 -- Very general NamedThing comparison, used when comparing
 -- Uniquable things with different types
 

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 388b8c2..b3a142b 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -27,21 +27,21 @@ import ParseUtils   ( ParsedIface(..), RdrIfaceDecl(..), RdrIfaceInst )
 
 
 import Bag             ( emptyBag, unitBag, consBag, snocBag, unionBags,
-                         unionManyBags, mapBag, listToBag, bagToList )
+                         unionManyBags, mapBag, filterBag, listToBag, bagToList )
 import CmdLineOpts     ( opt_NoImplicitPrelude )
 import ErrUtils                ( Error(..), Warning(..), addErrLoc, addShortErrLocLine )
 import FiniteMap       ( emptyFM, addListToFM, lookupFM, fmToList, eltsFM, delListFromFM )
 import Id              ( GenId )
 import Maybes          ( maybeToBool, catMaybes, MaybeErr(..) )
-import Name            ( RdrName(..), Name, isQual, mkTopLevName,
+import Name            ( RdrName(..), Name, isQual, mkTopLevName, origName,
                          mkImportedName, nameExportFlag, nameImportFlag,
-                         getLocalName, getSrcLoc, pprNonSym, moduleNamePair,
-                         isLexCon, isRdrLexCon, ExportFlag(..)
+                         getLocalName, getSrcLoc, getImpLocs, moduleNamePair,
+                         pprNonSym, isLexCon, isRdrLexCon, ExportFlag(..)
                        )
 import PrelInfo                ( BuiltinNames(..), BuiltinKeys(..) )
 import PrelMods                ( fromPrelude, pRELUDE )
 import Pretty
-import SrcLoc          ( SrcLoc, mkIfaceSrcLoc )
+import SrcLoc          ( SrcLoc, mkBuiltinSrcLoc )
 import TyCon           ( tyConDataCons )
 import UniqFM          ( emptyUFM, addListToUFM_C, lookupUFM )
 import UniqSupply      ( splitUniqSupply )
@@ -81,17 +81,20 @@ getGlobalNames iface_cache info us
        \ (imp_vals, imp_tcs, imp_mods, unqual_imps, imp_fixes, imp_errs, imp_warns) ->
 
     let
-        unqual_vals = mapBag (\rn -> (Unqual (getLocalName rn), rn)) src_vals
-        unqual_tcs  = mapBag (\rn -> (Unqual (getLocalName rn), rn)) src_tcs
+        unqual_vals = map (\rn -> (Unqual (getLocalName rn), rn)) (bagToList src_vals)
+        unqual_tcs  = map (\rn -> (Unqual (getLocalName rn), rn)) (bagToList src_tcs)
 
-       all_vals = bagToList (unqual_vals `unionBags` imp_vals)
-       all_tcs  = bagToList (unqual_tcs  `unionBags` imp_tcs)
+        (src_env, src_dups) = extendGlobalRnEnv emptyRnEnv unqual_vals unqual_tcs
+       (all_env, imp_dups) = extendGlobalRnEnv src_env (bagToList imp_vals) (bagToList imp_tcs)
 
-        (all_env, dups) = extendGlobalRnEnv emptyRnEnv all_vals all_tcs
+       -- remove dups of the same imported thing
+       diff_imp_dups = filterBag diff_orig imp_dups
+       diff_orig (_,rn1,rn2) = origName rn1 /= origName rn2
 
-       dup_errs = map dup_err (equivClasses cmp_rdr (bagToList dups))
+       all_dups = bagToList (src_dups `unionBags` diff_imp_dups)
+       dup_errs = map dup_err (equivClasses cmp_rdr all_dups)
        cmp_rdr (rdr1,_,_) (rdr2,_,_) = cmp rdr1 rdr2
-       dup_err ((_,rn,rn'):rest) = globalDupNamesErr (rn:rn': [rn|(_,_,rn)<-rest])
+       dup_err ((rdr,rn1,rn2):rest) = globalDupNamesErr rdr (rn1:rn2: [rn|(_,_,rn)<-rest])
 
        all_errs  = src_errs  `unionBags` imp_errs `unionBags` listToBag dup_errs
        all_warns = src_warns `unionBags` imp_warns
@@ -303,7 +306,7 @@ newGlobalName locn maybe_exp rdr
 type ImportNameInfo = (GlobalNameInfo,
                       FiniteMap (Module,FAST_STRING) RnName,   -- values imported so far
                       FiniteMap (Module,FAST_STRING) RnName,   -- tycons/classes imported so far
-                      Name -> ExportFlag)                      -- import flag
+                      Name -> (ExportFlag, [SrcLoc]))          -- import flag and src locns
                
 type RnM_IInfo s r = RnMonad ImportNameInfo s r
 
@@ -321,14 +324,15 @@ doImportDecls ::
               Bag Warning)
 
 doImportDecls iface_cache g_info us src_imps
-  = fixIO ( \ ~(_, _, _, _, _, _, rec_imp_flags) ->
+  = fixIO ( \ ~(_, _, _, _, _, _, rec_imp_stuff) ->
        let
-           rec_imp_fm = addListToUFM_C lubExportFlag emptyUFM (bagToList rec_imp_flags)
+           rec_imp_fm = addListToUFM_C add_stuff emptyUFM (bagToList rec_imp_stuff)
+           add_stuff (imp1,locns1) (imp2,locns2) = (lubExportFlag imp1 imp2, locns1 `unionBags` locns2)
 
-           rec_imp_fn :: Name -> ExportFlag
+           rec_imp_fn :: Name -> (ExportFlag, [SrcLoc])
            rec_imp_fn n = case lookupUFM rec_imp_fm n of
-                            Nothing   -> panic "RnNames:rec_imp_fn"
-                            Just flag -> flag
+                            Nothing            -> panic "RnNames:rec_imp_fn"
+                            Just (flag, locns) -> (flag, bagToList locns)
 
            i_info = (g_info, emptyFM, emptyFM, rec_imp_fn)
        in
@@ -336,35 +340,37 @@ doImportDecls iface_cache g_info us src_imps
     ) >>= \ (vals, tcs, unquals, fixes, errs, warns, _) ->
 
     return (vals, tcs, imp_mods, unquals, fixes,
-           imp_errs  `unionBags` errs,
-           imp_warns `unionBags` warns)
+           errs, imp_warns `unionBags` warns)
   where
-    (ok_imps, src_qprels) = partition not_qual_prel src_imps
-    the_imps = prel_imp ++ ok_imps
-    all_imps = qprel_imp ++ the_imps
+    (src_qprels, ok_imps) = partition qual_prel src_imps
+    the_imps = ok_imps ++ prel_imp
+    all_imps = the_imps ++ qprel_imp
 
-    not_qual_prel (ImportDecl mod qual _ _ _) = not (fromPrelude mod && qual)
+    qual_prel (ImportDecl mod qual imp_as _ _)
+      = fromPrelude mod && qual && not (maybeToBool imp_as)
 
     explicit_prelude_import
-      = null [() | (ImportDecl mod qual _ _ _) <- ok_imps,
-                  fromPrelude mod && not qual]
+      = null [() | (ImportDecl mod qual _ _ _) <- ok_imps, fromPrelude mod]
 
     qprel_imp = if opt_NoImplicitPrelude
                then [{-the flag really means it: *NO* implicit "import Prelude" -}]
-               else [ImportDecl pRELUDE True Nothing Nothing mkIfaceSrcLoc]
+               else [ImportDecl pRELUDE True Nothing Nothing prel_loc]
 
     prel_imp  = if not explicit_prelude_import || opt_NoImplicitPrelude
                then
                   [{- no "import Prelude" -}]
                else
-                  [ImportDecl pRELUDE False Nothing Nothing mkIfaceSrcLoc]
+                  [ImportDecl pRELUDE False Nothing Nothing prel_loc]
+
+    prel_loc = mkBuiltinSrcLoc
 
     (uniq_imps, imp_dups) = removeDups cmp_mod the_imps
     cmp_mod (ImportDecl m1 _ _ _ _) (ImportDecl m2 _ _ _ _) = cmpPString m1 m2
 
     imp_mods  = [ mod | ImportDecl mod _ _ _ _ <- uniq_imps ]
     imp_warns = listToBag (map dupImportWarn imp_dups)
-    imp_errs  = listToBag (map qualPreludeImportErr src_qprels)
+               `unionBags`
+               listToBag (map qualPreludeImportWarn src_qprels)
 
 
 doImports iface_cache i_info us []
@@ -399,13 +405,13 @@ doImport :: IfaceCache
         -> ImportNameInfo
         -> UniqSupply
         -> RdrNameImportDecl
-        -> IO (Bag (RdrName,RnName),           -- values
-               Bag (RdrName,RnName),           -- tycons/classes
-               Bag (Module,RnName),            -- unqual imports
+        -> IO (Bag (RdrName,RnName),                   -- values
+               Bag (RdrName,RnName),                   -- tycons/classes
+               Bag (Module,RnName),                    -- unqual imports
                Bag RenamedFixityDecl,
                 Bag Error,
                Bag Warning,
-               Bag (RnName,ExportFlag))        -- import flags
+               Bag (RnName,(ExportFlag,Bag SrcLoc)))   -- import flags and src locs
 
 doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
   = cachedIface iface_cache mod        >>= \ maybe_iface ->
@@ -440,9 +446,10 @@ doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
                          `unionBags` errs `unionBags` unionManyBags fix_errs
            final_warns = mapBag (\ warn -> warn mod src_loc) (unionManyBags chk_warns)
                          `unionBags` warns
+           imp_stuff   = mapBag (\ (n,imp) -> (n,(imp,unitBag src_loc))) imp_flags
         in
        return (final_vals, final_tcs, unquals, final_fixes,
-               final_errs, final_warns, imp_flags)
+               final_errs, final_warns, imp_stuff)
   where
     as_mod = case maybe_as of {Nothing -> mod; Just as_this -> as_this}
     mk_occ str = if qual then Qual as_mod str else Unqual str
@@ -452,6 +459,10 @@ doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
     pair_as  rn       = (as_mod, rn)
 
 
+getBuiltins _ mod maybe_spec
+  | not (fromPrelude mod)
+  = (emptyBag, emptyBag, maybe_spec)
+
 getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
   = case maybe_spec of 
       Nothing           -> (all_vals, all_tcs, Nothing)
@@ -547,14 +558,14 @@ doOrigIEs iface_cache info mod src_loc us []
 
 doOrigIEs iface_cache info mod src_loc us (ie:ies)
   = doOrigIE iface_cache info mod src_loc us1 ie 
-       >>= \ (vals1, tcs1, errs1, warns1, imps1) ->
+       >>= \ (vals1, tcs1, imps1, errs1, warns1) ->
     doOrigIEs iface_cache info mod src_loc us2 ies
-       >>= \ (vals2, tcs2, errs2, warns2, imps2) ->
+       >>= \ (vals2, tcs2, imps2, errs2, warns2) ->
     return (vals1    `unionBags` vals2,
            tcs1     `unionBags` tcs2,
+           imps1    `unionBags` imps2,
            errs1    `unionBags` errs2,
-           warns1   `unionBags` warns2,
-           imps1    `unionBags` imps2)
+           warns1   `unionBags` warns2)
   where
     (us1, us2) = splitUniqSupply us
 
@@ -743,33 +754,35 @@ newImportedName tycon_or_class locn maybe_exp maybe_imp rdr
 
            imp  = case maybe_imp of
                     Just imp -> imp
-                    Nothing  -> imp_fn n
+                    Nothing  -> imp_flag
+
+           (imp_flag, imp_locs) = imp_fn n
 
-           n = mkImportedName uniq rdr imp locn exp (occ_fn n)
+           n = mkImportedName uniq rdr imp locn imp_locs exp (occ_fn n)
        in
        returnRn n
 \end{code}
 
 \begin{code}
-globalDupNamesErr (rn1:dup_rns) sty
-  = ppAboves (item1 : map dup_item dup_rns)
+globalDupNamesErr rdr rns sty
+  = ppAboves (message : map pp_dup rns)
   where
-    item1 = addShortErrLocLine (getSrcLoc rn1) (\ sty ->
-           ppBesides [ppStr "multiple declarations of `", 
-                      pprNonSym sty rn1, ppStr "' ", pp_descrip rn1]) sty
-
-    dup_item rn
-          = addShortErrLocLine (getSrcLoc rn) (\ sty ->
-            ppBesides [ppStr "here was another declaration of `",
-                      pprNonSym sty rn, ppStr "' ", pp_descrip rn]) sty
-
-    pp_descrip (RnName _)      = ppStr "(as a value)"
-    pp_descrip (RnSyn  _)      = ppStr "(as a type synonym)"
-    pp_descrip (RnData _ _ _)  = ppStr "(as a data type)"
-    pp_descrip (RnConstr _ _)  = ppStr "(as a data constructor)"
-    pp_descrip (RnField _ _)   = ppStr "(as a record field)"
-    pp_descrip (RnClass _ _)   = ppStr "(as a class)"
-    pp_descrip (RnClassOp _ _) = ppStr "(as a class method)"
+    message   = ppBesides [ppStr "multiple declarations of `", pprNonSym sty rdr, ppStr "'"]
+
+    pp_dup rn = addShortErrLocLine (get_loc rn) (\ sty ->
+               ppBesides [pp_descrip rn, pprNonSym sty rn]) sty
+
+    get_loc rn = case getImpLocs rn of
+                    []   -> getSrcLoc rn
+                    locs -> head locs
+
+    pp_descrip (RnName _)      = ppStr "a value"
+    pp_descrip (RnSyn  _)      = ppStr "a type synonym"
+    pp_descrip (RnData _ _ _)  = ppStr "a data type"
+    pp_descrip (RnConstr _ _)  = ppStr "a data constructor"
+    pp_descrip (RnField _ _)   = ppStr "a record field"
+    pp_descrip (RnClass _ _)   = ppStr "a class"
+    pp_descrip (RnClassOp _ _) = ppStr "a class method"
     pp_descrip _               = ppNil 
 
 dupImportWarn (ImportDecl m1 _ _ _ locn1 : dup_imps) sty
@@ -782,9 +795,9 @@ dupImportWarn (ImportDecl m1 _ _ _ locn1 : dup_imps) sty
           = addShortErrLocLine locn (\ sty ->
             ppCat [ppStr "here was another import from module", ppPStr m]) sty
 
-qualPreludeImportErr (ImportDecl m _ _ _ locn)
+qualPreludeImportWarn (ImportDecl m _ _ _ locn)
   = addShortErrLocLine locn (\ sty ->
-    ppCat [ppStr "qualified import form prelude module", ppPStr m])
+    ppCat [ppStr "qualified import of prelude module", ppPStr m])
 
 unknownImpSpecErr ie imp_mod locn
   = addShortErrLocLine locn (\ sty ->

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 2d60801..dadfc61 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -135,7 +135,7 @@ rnExports mods unqual_imps (Just exps)
 
        mod_fm = addListToFM_C unionBags emptyFM
                 [(mod, unitBag (getName rn, nameImportFlag (getName rn)))
-                 | (mod,rn) <- bagToList unqual_imps]
+                 | (mod,rn) <- bagToList unqual_imps, isRnDecl rn]
 
         add_mod_names (exp_map, empty) mod
          = case lookupFM mod_fm mod of
@@ -586,8 +586,10 @@ rnPolyType tv_env (HsPreForAllTy ctxt ty)
   = rn_poly_help tv_env forall_tyvars ctxt ty
   where
     mentioned_tyvars = extractCtxtTyNames ctxt `unionLists` extractMonoTyNames is_tyvar_name ty
-    forall_tyvars    = --pprTrace "mentioned:" (ppCat (map (ppr PprShowAll) mentioned_tyvars)) $
-                      --pprTrace "from_ty:" (ppCat (map (ppr PprShowAll) (extractMonoTyNames is_tyvar_name ty))) $
+    forall_tyvars    = {-
+                      pprTrace "mentioned:" (ppCat (map (ppr PprShowAll) mentioned_tyvars)) $
+                      pprTrace "from_ty:" (ppCat (map (ppr PprShowAll) (extractMonoTyNames is_tyvar_name ty))) $
+                      -}
                       mentioned_tyvars `minusList` domTyVarNamesEnv tv_env
 
 ------------
@@ -598,11 +600,13 @@ rn_poly_help :: TyVarNamesEnv
             -> RnM_Fixes s RenamedPolyType
 
 rn_poly_help tv_env tyvars ctxt ty
-  = --pprTrace "rnPolyType:" (ppCat [ppCat (map (ppr PprShowAll . snd) tv_env),
-    --                            ppStr ";tvs=", ppCat (map (ppr PprShowAll) tyvars),
-    --                            ppStr ";ctxt=", ppCat (map (ppr PprShowAll) ctxt),
-    --                            ppStr ";ty=", ppr PprShowAll ty]
-    --                    ) $
+  = {-
+    pprTrace "rnPolyType:"
+       (ppCat [ppCat (map (ppr PprShowAll . snd) tv_env),
+               ppStr ";tvs=", ppCat (map (ppr PprShowAll) tyvars),
+               ppStr ";ctxt=", ppCat (map (ppr PprShowAll) ctxt),
+               ppStr ";ty=", ppr PprShowAll ty]) $
+    -}
     getSrcLocRn                                `thenRn` \ src_loc ->
     mkTyVarNamesEnv src_loc tyvars             `thenRn` \ (tv_env1, new_tyvars) ->
     let