[project @ 2003-07-09 11:06:31 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 4f22d54..463ff1d 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -22,7 +22,6 @@ import                      DsMeta   ( templateHaskellNames )
 
 import CmdLineOpts     ( DynFlag(..), opt_PprStyle_Debug, dopt )
 import DriverState     ( v_MainModIs, v_MainFunIs )
-import DriverUtil      ( split_longest_prefix )
 import HsSyn           ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..),
                          Stmt(..), Pat(VarPat), HsStmtContext(..), RuleDecl(..),
                          HsGroup(..), SpliceDecl(..),
@@ -34,9 +33,8 @@ import RdrHsSyn               ( RdrNameHsModule, RdrNameHsDecl, RdrNameStmt, RdrNameHsExpr,
 
 import PrelNames       ( iNTERACTIVE, ioTyConName, printName, monadNames,
                          returnIOName, runIOName, 
-                         dollarMainName, itName, mAIN_Name, unsafeCoerceName
+                         rootMainName, itName, mAIN_Name, unsafeCoerceName
                        )
-import MkId            ( unsafeCoerceId )
 import RdrName         ( RdrName, getRdrName, mkRdrUnqual, 
                          lookupRdrEnv, elemRdrEnv )
 
@@ -49,12 +47,10 @@ import TcHsSyn              ( TypecheckedHsExpr, TypecheckedRuleDecl,
 
 import TcExpr          ( tcInferRho, tcCheckRho )
 import TcRnMonad
-import TcMType         ( newTyVarTy, zonkTcType )
-import TcType          ( Type, liftedTypeKind, 
+import TcType          ( Type, 
                          tyVarsOfType, tcFunResultTy, tidyTopType,
                          mkForAllTys, mkFunTys, mkTyConApp, tcSplitForAllTys
                        )
-import TcMatches       ( tcStmtsAndThen, TcStmtCtxt(..) )
 import Inst            ( showLIE, tcStdSyntaxName )
 import TcBinds         ( tcTopBinds )
 import TcClassDcl      ( tcClassDecls2 )
@@ -68,7 +64,7 @@ import TcRules                ( tcRules )
 import TcForeign       ( tcForeignImports, tcForeignExports )
 import TcIfaceSig      ( tcInterfaceSigs, tcCoreBinds )
 import TcInstDcls      ( tcInstDecls1, tcIfaceInstDecls, tcInstDecls2 )
-import TcSimplify      ( tcSimplifyTop, tcSimplifyInfer )
+import TcSimplify      ( tcSimplifyTop, tcSimplifyInteractive, tcSimplifyInfer )
 import TcTyClsDecls    ( tcTyAndClassDecls )
 
 import RnNames         ( importsFromLocalDecls, rnImports, exportsFromAvail, 
@@ -77,25 +73,20 @@ import RnIfaces             ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
 import RnHiFiles       ( readIface, loadOldIface )
 import RnEnv           ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
                          ubiquitousNames, implicitModuleFVs, implicitStmtFVs, dataTcOccs )
-import RnExpr          ( rnStmts, rnExpr )
 import RnSource                ( rnSrcDecls, checkModDeprec, rnStats )
 
 import CoreUnfold      ( unfoldingTemplate )
 import CoreSyn         ( IdCoreRule, Bind(..) )
 import PprCore         ( pprIdRules, pprCoreBindings )
-import TysWiredIn      ( mkListTy, unitTy )
 import ErrUtils                ( mkDumpDoc, showPass, pprBagOfErrors )
 import Id              ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
-import IdInfo          ( GlobalIdDetails(..) )
 import Var             ( Var, setGlobalIdDetails )
-import Module           ( Module, ModuleName, mkHomeModule, mkModuleName, moduleName, moduleUserString, moduleEnvElts )
+import Module           ( Module, mkHomeModule, mkModuleName, moduleName, moduleUserString, moduleEnvElts )
 import OccName         ( mkVarOcc )
 import Name            ( Name, isExternalName, getSrcLoc, nameOccName )
-import NameEnv         ( delListFromNameEnv )
 import NameSet
 import TyCon           ( tyConGenInfo )
 import BasicTypes       ( EP(..), RecFlag(..) )
-import SrcLoc          ( noSrcLoc )
 import Outputable
 import HscTypes                ( PersistentCompilerState(..), InteractiveContext(..),
                          ModIface, ModDetails(..), ModGuts(..),
@@ -111,14 +102,20 @@ import HscTypes           ( PersistentCompilerState(..), InteractiveContext(..),
                          extendLocalRdrEnv, emptyFixityEnv
                        )
 #ifdef GHCI
+import TcMType         ( zonkTcType )
+import TcMatches       ( tcStmtsAndThen, TcStmtCtxt(..) )
 import RdrName         ( rdrEnvElts )
+import RnExpr          ( rnStmts, rnExpr )
 import RnHiFiles       ( loadInterface )
 import RnEnv           ( mkGlobalRdrEnv )
+import TysWiredIn      ( mkListTy, unitTy )
+import IdInfo          ( GlobalIdDetails(..) )
+import SrcLoc          ( noSrcLoc )
+import NameEnv         ( delListFromNameEnv )
 import HscTypes                ( GlobalRdrElt(..), GlobalRdrEnv, ImportReason(..), Provenance(..), 
                          isLocalGRE )
 #endif
 
-import DATA_IOREF      ( readIORef )
 import FastString      ( mkFastString )
 import Panic           ( showException )
 import List            ( partition )
@@ -428,7 +425,7 @@ tc_stmts stmts
        -- and then                     let it = e
        -- It's the simplify step that rejects the first.
        traceTc (text "tcs 3") ;
-       const_binds <- tcSimplifyTop lie ;
+       const_binds <- tcSimplifyInteractive lie ;
 
        -- Build result expression and zonk it
        let { expr = mkHsLet const_binds tc_expr } ;
@@ -464,7 +461,7 @@ tcRnExpr hsc_env pcs ictxt rdr_expr
        -- it might have a rank-2 type (e.g. :t runST)
     ((tc_expr, res_ty), lie)      <- getLIE (tcInferRho rn_expr) ;
     ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie)  ;
-    tcSimplifyTop lie_top ;
+    tcSimplifyInteractive lie_top ;
 
     let { all_expr_ty = mkForAllTys qtvs               $
                        mkFunTys (map idType dict_ids)  $
@@ -532,7 +529,7 @@ initRnInteractive ictxt rn_thing
   = initRn CmdLineMode $
     setLocalRdrEnv (ic_rn_local_env ictxt) $
     rn_thing
-#endif
+#endif /* GHCI */
 \end{code}
 
 %************************************************************************
@@ -559,13 +556,13 @@ tcRnExtCore hsc_env pcs (HsModule (Just this_mod) _ _ decls _ loc)
        -- rnSrcDecls handles fixity decls etc too, which won't occur
        -- but that doesn't matter
    let { local_group = mkGroup decls } ;
-   (_, rn_decls, dus) <- initRn (InterfaceMode this_mod) 
-                                     (rnSrcDecls local_group) ;
+   (_, rn_src_decls, dus) <- initRn (InterfaceMode this_mod) 
+                                   (rnSrcDecls local_group) ;
    failIfErrsM ;
 
        -- Get the supporting decls
    rn_imp_decls <- slurpImpDecls (duUses dus) ;
-   let { rn_decls = rn_decls `addImpDecls` rn_imp_decls } ;
+   let { rn_decls = rn_src_decls `addImpDecls` rn_imp_decls } ;
 
        -- Dump trace of renaming part
    rnDump (ppr rn_decls) ;
@@ -1162,12 +1159,12 @@ check_main ghci_mode tcg_env main_mod main_fn
        addErrCtxt mainCtxt             $
        setGblEnv tcg_env               $ do {
        
-       -- $main :: IO () = runIO main
+       -- :Main.main :: IO () = runIO main
        let { rhs = HsApp (HsVar runIOName) (HsVar main_name) } ;
        (main_expr, ty) <- tcInferRho rhs ;
 
-       let { dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty) ;
-             main_bind      = VarMonoBind dollar_main_id main_expr ;
+       let { root_main_id = setIdLocalExported (mkLocalId rootMainName ty) ;
+             main_bind      = VarMonoBind root_main_id main_expr ;
              tcg_env'       = tcg_env { tcg_binds = tcg_binds tcg_env 
                                                     `andMonoBinds` main_bind } } ;