View patterns, record wildcards, and record puns

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

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index bb67d9b..694a77a 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -5,6 +5,13 @@
 \section[TcModule]{Typechecking a whole module}
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module TcRnDriver (
 #ifdef GHCI
        tcRnStmt, tcRnExpr, tcRnType,
@@ -163,8 +170,9 @@ tcRnModule hsc_env hsc_src save_rn_syntax
        tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ;
 
                -- Process the export list
+       traceRn (text "rn4a: before exports");
        tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
-       traceRn (text "rn4") ;
+       traceRn (text "rn4b: after exportss") ;
 
        -- Compare the hi-boot iface (if any) with the real thing
        -- Must be done after processing the exports
@@ -275,9 +283,15 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 
    let { ldecls  = map noLoc decls } ;
 
-       -- Deal with the type declarations; first bring their stuff
-       -- into scope, then rname them, then type check them
-   tcg_env  <- importsFromLocalDecls (mkFakeGroup ldecls) ;
+       -- bring the type and class decls into scope
+       -- ToDo: check that this doesn't need to extract the val binds.
+       --       It seems that only the type and class decls need to be in scope below because
+       --          (a) tcTyAndClassDecls doesn't need the val binds, and 
+       --          (b) tcExtCoreBindings doesn't need anything
+       --              (in fact, it might not even need to be in the scope of
+       --               this tcg_env at all)
+   tcg_env  <- importsFromLocalDecls False (mkFakeGroup ldecls) 
+               emptyUFM {- no fixity decls -} ;
 
    setGblEnv tcg_env $ do {
 
@@ -625,17 +639,11 @@ monad; it augments it and returns the new TcGblEnv.
 ------------------------------------------------
 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
 rnTopSrcDecls group
- = do {        -- Bring top level binders into scope
-       tcg_env <- importsFromLocalDecls group ;
-       setGblEnv tcg_env $ do {
-
-       failIfErrsM ;   -- No point in continuing if (say) we have duplicate declarations
-
-               -- Rename the source decls
-       (tcg_env, rn_decls) <- rnSrcDecls group ;
+ = do { -- Rename the source decls (with no shadowing; error on duplicates)
+       (tcg_env, rn_decls) <- rnSrcDecls False group ;
        failIfErrsM ;
 
-               -- save the renamed syntax, if we want it
+        -- save the renamed syntax, if we want it
        let { tcg_env'
                | Just grp <- tcg_rn_decls tcg_env
                  = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
@@ -646,7 +654,7 @@ rnTopSrcDecls group
        rnDump (ppr rn_decls) ;
 
        return (tcg_env', rn_decls)
-   }}
+   }
 
 ------------------------------------------------
 tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
@@ -830,16 +838,16 @@ get two defns for 'main' in the interface file!
 #ifdef GHCI
 setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
 setInteractiveContext hsc_env icxt thing_inside 
-  = let 
-       -- Initialise the tcg_inst_env with instances 
-       -- from all home modules.  This mimics the more selective
-       -- call to hptInstances in tcRnModule
-       dfuns = fst (hptInstances hsc_env (\mod -> True))
+  = let -- Initialise the tcg_inst_env with instances from all home modules.  
+        -- This mimics the more selective call to hptInstances in tcRnModule.
+       (home_insts, home_fam_insts) = hptInstances hsc_env (\mod -> True)
     in
     updGblEnv (\env -> env { 
-       tcg_rdr_env  = ic_rn_gbl_env icxt,
-       tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
-
+       tcg_rdr_env      = ic_rn_gbl_env icxt,
+       tcg_inst_env     = extendInstEnvList    (tcg_inst_env env) home_insts,
+       tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env env) 
+                                                home_fam_insts 
+      }) $
 
     tcExtendGhciEnv (ic_tmp_ids icxt) $
         -- tcExtendGhciEnv does lots: 
@@ -1060,16 +1068,18 @@ tcGhciStmts stmts
         } ;
 
        -- OK, we're ready to typecheck the stmts
-       traceTc (text "tcs 2") ;
+       traceTc (text "TcRnDriver.tcGhciStmts: tc stmts") ;
        ((tc_stmts, ids), lie) <- getLIE $ tc_io_stmts stmts $ \ _ ->
                                           mappM tcLookupId names ;
                                        -- Look up the names right in the middle,
                                        -- where they will all be in scope
 
        -- Simplify the context
+       traceTc (text "TcRnDriver.tcGhciStmts: simplify ctxt") ;
        const_binds <- checkNoErrs (tcSimplifyInteractive lie) ;
                -- checkNoErrs ensures that the plan fails if context redn fails
 
+       traceTc (text "TcRnDriver.tcGhciStmts: done") ;
        return (ids, mkHsDictLet const_binds $
                     noLoc (HsDo DoExpr tc_stmts (mk_return ids) io_ret_ty))
     }