[project @ 2000-12-20 13:40:08 by simonmar]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcModule.lhs

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 3bd6902..0a0280d 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -43,15 +43,14 @@ import TcTyClsDecls ( tcTyAndClassDecls )
 import CoreUnfold      ( unfoldingTemplate, hasUnfolding )
 import Type            ( funResultTy, splitForAllTys, openTypeKind )
 import Bag             ( isEmptyBag )
-import ErrUtils                ( printErrorsAndWarnings, dumpIfSet_dyn, showPass )
-import Id              ( idType, idUnfolding )
+import ErrUtils                ( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
+import Id              ( idType, idName, isLocalId, idUnfolding )
 import Module           ( Module )
-import Name            ( Name, toRdrName )
+import Name            ( Name, toRdrName, isGlobalName )
 import Name            ( nameEnvElts, lookupNameEnv )
 import TyCon           ( tyConGenInfo )
 import Util
 import BasicTypes       ( EP(..), Fixity )
-import Bag             ( isEmptyBag )
 import Outputable
 import HscTypes                ( PersistentCompilerState(..), HomeSymbolTable, 
                          PackageTypeEnv, ModIface(..),
@@ -141,14 +140,14 @@ typecheck dflags pcs hst unqual thing_inside
  = do  { showPass dflags "Typechecker";
        ; env <- initTcEnv hst (pcs_PTE pcs)
 
-       ; (maybe_tc_result, (warns,errs)) <- initTc dflags env thing_inside
+       ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
 
-       ; printErrorsAndWarnings unqual (errs,warns)
+       ; printErrorsAndWarnings unqual errs
 
-       ; if isEmptyBag errs then 
-             return maybe_tc_result
-           else 
+       ; if errorsFound errs then 
              return Nothing 
+           else 
+             return maybe_tc_result
        }
 \end{code}
 
@@ -359,7 +358,11 @@ dump_sigs results  -- Print type signatures
     ppr_sig (n,t)        = ppr n <+> dcolon <+> ppr t
 
     want_sig id | opt_PprStyle_Debug = True
-               | otherwise          = True     -- For now
+               | otherwise          = isLocalId id && isGlobalName (idName id)
+       -- isLocalId ignores data constructors, records selectors etc
+       -- The isGlobalName ignores local dictionary and method bindings
+       -- that the type checker has invented.  User-defined things have
+       -- Global names.
 
 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
                           vcat (map ppr_gen_tycon tcs),