[project @ 2004-04-05 10:11:34 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 295c15e..2b1ba61 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -21,7 +21,8 @@ import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
 
 import CmdLineOpts     ( DynFlag(..), opt_PprStyle_Debug, dopt )
 import DriverState     ( v_MainModIs, v_MainFunIs )
-import HsSyn
+import HsSyn           ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl, SpliceDecl(..), HsBind(..),
+                         nlHsApp, nlHsVar )
 import RdrHsSyn                ( findSplice )
 
 import PrelNames       ( runIOName, rootMainName, mAIN_Name,
@@ -35,7 +36,7 @@ import TcType         ( tidyTopType )
 import Inst            ( showLIE )
 import TcBinds         ( tcTopBinds )
 import TcDefaults      ( tcDefaults )
-import TcEnv           ( tcExtendGlobalValEnv, tcLookupGlobal )
+import TcEnv           ( tcExtendGlobalValEnv )
 import TcRules         ( tcRules )
 import TcForeign       ( tcForeignImports, tcForeignExports )
 import TcInstDcls      ( tcInstDecls1, tcInstDecls2 )
@@ -49,7 +50,7 @@ import RnEnv          ( lookupSrcOcc_maybe )
 import RnSource                ( rnSrcDecls, rnTyClDecls, checkModDeprec )
 import PprCore         ( pprIdRules, pprCoreBindings )
 import CoreSyn         ( IdCoreRule, bindersOfBinds )
-import ErrUtils                ( mkDumpDoc, showPass )
+import ErrUtils                ( Messages, mkDumpDoc, showPass )
 import Id              ( mkExportedLocalId, isLocalId, idName, idType )
 import Var             ( Var )
 import Module           ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
@@ -62,15 +63,14 @@ import Outputable
 import HscTypes                ( ModGuts(..), HscEnv(..),
                          GhciMode(..), noDependencies,
                          Deprecs( NoDeprecs ), plusDeprecs,
-                         GenAvailInfo(Avail), availsToNameSet, availName,
                          ForeignStubs(NoStubs), TypeEnv, typeEnvTyCons, 
                          extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
                          emptyFixityEnv
                        )
 #ifdef GHCI
-import HsSyn           ( HsStmtContext(..), 
-                         Stmt(..), 
-                         collectStmtsBinders, mkSimpleMatch, placeHolderType )
+import HsSyn           ( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..), LStmt, LHsExpr,
+                         collectStmtsBinders, mkSimpleMatch, placeHolderType,
+                         nlLetStmt, nlExprStmt, nlBindStmt, nlResultStmt, nlVarPat )
 import RdrName         ( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
                          Provenance(..), ImportSpec(..),
                          lookupLocalRdrEnv, extendLocalRdrEnv )
@@ -81,13 +81,13 @@ import TcMType              ( zonkTcType )
 import TcMatches       ( tcStmtsAndThen, TcStmtCtxt(..) )
 import TcSimplify      ( tcSimplifyInteractive, tcSimplifyInfer )
 import TcType          ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType )
-import TcEnv           ( tcLookupTyCon, tcLookupId )
-import TyCon           ( DataConDetails(..) )
+import TcEnv           ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
 import Inst            ( tcStdSyntaxName )
 import RnExpr          ( rnStmts, rnLExpr )
 import RnNames         ( exportsToAvails )
 import LoadIface       ( loadSrcInterface )
-import IfaceSyn                ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceExtName(..),
+import IfaceSyn                ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), 
+                         IfaceExtName(..), IfaceConDecls(..),
                          tyThingToIfaceDecl )
 import RnEnv           ( lookupOccRn, dataTcOccs, lookupFixityRn )
 import Id              ( Id, isImplicitId )
@@ -102,7 +102,7 @@ import PrelNames    ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, retu
 import Module          ( ModuleName, lookupModuleEnvByName )
 import HscTypes                ( InteractiveContext(..),
                          HomeModInfo(..), typeEnvElts, 
-                         TyThing(..), availNames, icPrintUnqual,
+                         TyThing(..), availName, availNames, icPrintUnqual,
                          ModIface(..), ModDetails(..) )
 import BasicTypes      ( RecFlag(..), Fixity )
 import Bag             ( unitBag )
@@ -128,7 +128,7 @@ import Maybe                ( isJust )
 \begin{code}
 tcRnModule :: HscEnv 
           -> Located (HsModule RdrName)
-          -> IO (Maybe TcGblEnv)
+          -> IO (Messages, Maybe TcGblEnv)
 
 tcRnModule hsc_env (L loc (HsModule maybe_mod exports 
                                import_decls local_decls mod_deprec))
@@ -228,7 +228,7 @@ tcRnStmt :: HscEnv
                -- a list of the bound values, coerced to ().
 
 tcRnStmt hsc_env ictxt rdr_stmt
-  = initTc hsc_env iNTERACTIVE $ 
+  = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext ictxt $ do {
 
     -- Rename; use CmdLineMode because tcRnStmt is only used interactively
@@ -400,7 +400,7 @@ tcRnExpr :: HscEnv
         -> LHsExpr RdrName
         -> IO (Maybe Type)
 tcRnExpr hsc_env ictxt rdr_expr
-  = initTc hsc_env iNTERACTIVE $ 
+  = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext ictxt $ do {
 
     (rn_expr, fvs) <- rnLExpr rdr_expr ;
@@ -433,7 +433,7 @@ tcRnThing :: HscEnv
 -- *and* as a type or class constructor; 
 -- hence the call to dataTcOccs, and we return up to two results
 tcRnThing hsc_env ictxt rdr_name
-  = initTc hsc_env iNTERACTIVE $ 
+  = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext ictxt $ do {
 
        -- If the identifier is a constructor (begins with an
@@ -470,7 +470,7 @@ tcRnThing hsc_env ictxt rdr_name
 
 toIfaceDecl :: InteractiveContext -> TyThing -> IfaceDecl
 toIfaceDecl ictxt thing
-  = tyThingToIfaceDecl True {- Discard IdInfo -} (const False) {- Show data cons -} 
+  = tyThingToIfaceDecl True {- Discard IdInfo -} emptyNameSet {- Show data cons -} 
                       ext_nm thing
   where
     unqual = icPrintUnqual ictxt
@@ -499,7 +499,7 @@ setInteractiveContext icxt thing_inside
 \begin{code}
 tcRnExtCore :: HscEnv 
            -> HsExtCore RdrName
-           -> IO (Maybe ModGuts)
+           -> IO (Messages, Maybe ModGuts)
        -- Nothing => some error occurred 
 
 tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
@@ -804,7 +804,7 @@ mkExportEnv :: HscEnv -> [ModuleName]       -- Expose these modules' exports only
            -> IO GlobalRdrEnv
 
 mkExportEnv hsc_env exports
-  = do { mb_envs <- initTc hsc_env iNTERACTIVE $
+  = do { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
                     mappM getModuleExports exports 
        ; case mb_envs of
             Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
@@ -836,7 +836,7 @@ getModuleContents
   -> IO (Maybe [IfaceDecl])
 
 getModuleContents hsc_env ictxt mod exports_only
- = initTc hsc_env iNTERACTIVE (get_mod_contents exports_only)
+ = initTcPrintErrors hsc_env iNTERACTIVE (get_mod_contents exports_only)
  where
    get_mod_contents exports_only
       | not exports_only       -- We want the whole top-level type env
@@ -864,8 +864,11 @@ getModuleContents hsc_env ictxt mod exports_only
 ---------------------
 filter_decl occs decl@(IfaceClass {ifSigs = sigs})
   = decl { ifSigs = filter (keep_sig occs) sigs }
-filter_decl occs decl@(IfaceData {ifCons = DataCons cons})
-  = decl { ifCons = DataCons (filter (keep_con occs) cons) }
+filter_decl occs decl@(IfaceData {ifCons = IfDataTyCon cons})
+  = decl { ifCons = IfDataTyCon (filter (keep_con occs) cons) }
+filter_decl occs decl@(IfaceData {ifCons = IfNewTyCon con})
+  | keep_con occs con = decl
+  | otherwise        = decl {ifCons = IfAbstractTyCon} -- Hmm?
 filter_decl occs decl
   = decl