Simon's big boxy-type commit

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

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 9cd7164..dcf1636 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -62,12 +62,12 @@ import DataCon              ( dataConWrapId )
 import ErrUtils                ( Messages, mkDumpDoc, showPass )
 import Id              ( Id, mkExportedLocalId, isLocalId, idName, idType )
 import Var             ( Var )
-import Module           ( Module, ModuleEnv, mkModule, moduleEnvElts, elemModuleEnv )
-import OccName         ( mkVarOcc, mkOccFS, varName )
+import Module           ( Module, ModuleEnv, moduleEnvElts, elemModuleEnv )
+import OccName         ( mkVarOccFS )
 import Name            ( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName,
                          mkExternalName )
 import NameSet
-import TyCon           ( tyConHasGenerics, isSynTyCon, getSynTyConDefn, tyConKind )
+import TyCon           ( tyConHasGenerics, isSynTyCon, synTyConDefn, tyConKind )
 import SrcLoc          ( srcLocSpan, Located(..), noLoc )
 import DriverPhases    ( HscSource(..), isHsBoot )
 import HscTypes                ( ModGuts(..), ModDetails(..), emptyModDetails,
@@ -84,9 +84,9 @@ import Outputable
 #ifdef GHCI
 import HsSyn           ( HsStmtContext(..), Stmt(..), HsExpr(..), 
                          HsLocalBinds(..), HsValBinds(..),
-                         LStmt, LHsExpr, LHsType, mkMatchGroup, mkMatch, emptyLocalBinds,
+                         LStmt, LHsExpr, LHsType, mkMatch, emptyLocalBinds,
                          collectLStmtsBinders, collectLStmtBinders, nlVarPat,
-                         placeHolderType, noSyntaxExpr )
+                         mkFunBind, placeHolderType, noSyntaxExpr )
 import RdrName         ( GlobalRdrElt(..), globalRdrEnvElts,
                          unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv )
 import RnSource                ( addTcgDUs )
@@ -386,6 +386,7 @@ tcRnSrcDecls decls
              TcGblEnv { tcg_type_env = type_env, tcg_binds = binds, 
                         tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
 
+       tcDump tcg_env ;
        (bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
                                                           rules fords ;
 
@@ -560,8 +561,8 @@ check_thing (ATyCon boot_tc) (ATyCon real_tc)
   | tyConKind boot_tc == tyConKind real_tc
   = return ()
   where
-    (tvs1, defn1) = getSynTyConDefn boot_tc
-    (tvs2, defn2) = getSynTyConDefn boot_tc
+    (tvs1, defn1) = synTyConDefn boot_tc
+    (tvs2, defn2) = synTyConDefn boot_tc
 
 check_thing (AnId boot_id) (AnId real_id)
   | idType boot_id `tcEqType` idType real_id
@@ -734,7 +735,7 @@ checkMain
         dflags    <- getDOpts ;
         let { main_mod = mainModIs dflags ;
               main_fn  = case mainFunIs dflags of {
-                               Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
+                               Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) ;
                                Nothing -> main_RDR_Unqual } } ;
        
         check_main ghci_mode tcg_env main_mod main_fn
@@ -776,7 +777,7 @@ check_main ghci_mode tcg_env main_mod main_fn
        -- for 'main' in the interface file!
 
        ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN 
-                                  (mkOccFS varName FSLIT("main")) 
+                                  (mkVarOccFS FSLIT("main")) 
                                   (Just main_name) (getSrcLoc main_name)
              ; root_main_id = mkExportedLocalId root_main_name ty
              ; main_bind    = noLoc (VarBind root_main_id main_expr) }
@@ -948,8 +949,8 @@ mkPlan :: LStmt Name -> TcM PlanResult
 mkPlan (L loc (ExprStmt expr _ _))     -- An expression typed at the prompt 
   = do { uniq <- newUnique             -- is treated very specially
        ; let fresh_it  = itName uniq
-             the_bind  = L loc $ FunBind (L loc fresh_it) False matches emptyNameSet
-             matches   = mkMatchGroup [mkMatch [] expr emptyLocalBinds]
+             the_bind  = L loc $ mkFunBind (L loc fresh_it) matches
+             matches   = [mkMatch [] expr emptyLocalBinds]
              let_stmt  = L loc $ LetStmt (HsValBinds (ValBindsOut [(NonRecursive,unitBag the_bind)] []))
              bind_stmt = L loc $ BindStmt (nlVarPat fresh_it) expr
                                           (HsVar bindIOName) noSyntaxExpr 
@@ -1028,7 +1029,7 @@ tcGhciStmts stmts
        -- OK, we're ready to typecheck the stmts
        traceTc (text "tcs 2") ;
        ((tc_stmts, ids), lie) <- getLIE $ 
-                                 tcStmts DoExpr (tcDoStmt io_ty io_ret_ty) stmts $ 
+                                 tcStmts DoExpr (tcDoStmt io_ty) stmts io_ret_ty $ \ _ ->
                                  mappM tcLookupId names ;
                                        -- Look up the names right in the middle,
                                        -- where they will all be in scope