remove old .NET related code
[ghc.git] / compiler / typecheck / TcRnDriver.lhs
index 59dc175..b628591 100644 (file)
@@ -5,6 +5,8 @@
 \section[TcMovectle]{Typechecking a whole module}
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 module TcRnDriver (
 #ifdef GHCI
         tcRnStmt, tcRnExpr, tcRnType,
@@ -13,12 +15,12 @@ module TcRnDriver (
         getModuleInterface,
         tcRnDeclsi,
         isGHCiMonad,
+        runTcInteractive,    -- Used by GHC API clients (Trac #8878)
 #endif
         tcRnLookupName,
         tcRnGetInfo,
         tcRnModule, tcRnModuleTcRnM,
-        tcTopSrcDecls,
-        tcRnExtCore
+        tcTopSrcDecls
     ) where
 
 #ifdef GHCI
@@ -57,10 +59,9 @@ import LoadIface
 import RnNames
 import RnEnv
 import RnSource
-import PprCore
-import CoreSyn
 import ErrUtils
 import Id
+import IdInfo( IdDetails( VanillaId ) )
 import VarEnv
 import Module
 import UniqFM
@@ -73,16 +74,15 @@ import SrcLoc
 import HscTypes
 import ListSetOps
 import Outputable
+import ConLike
 import DataCon
 import Type
 import Class
 import CoAxiom
-import Inst     ( tcGetInstEnvs, tcGetInsts )
+import Inst     ( tcGetInstEnvs )
 import Annotations
 import Data.List ( sortBy )
-import Data.IORef ( readIORef )
 import Data.Ord
-
 #ifdef GHCI
 import BasicTypes hiding( SuccessFlag(..) )
 import TcType   ( isUnitTy, isTauTy )
@@ -94,6 +94,7 @@ import MkId
 import TidyPgm    ( globaliseAndTidyId )
 import TysWiredIn ( unitTy, mkListTy )
 #endif
+import TidyPgm    ( mkBootModDetailsTc )
 
 import FastString
 import Maybes
@@ -136,6 +137,124 @@ tcRnModule hsc_env hsc_src save_rn_syntax
       ; initTc hsc_env hsc_src save_rn_syntax this_mod $
         tcRnModuleTcRnM hsc_env hsc_src parsedModule pair }
 
+-- To be called at the beginning of renaming hsig files.
+-- If we're processing a signature, load up the RdrEnv
+-- specified by sig-of so that
+-- when we process top-level bindings, we pull in the right
+-- original names.  We also need to add in dependencies from
+-- the implementation (orphans, family instances, packages),
+-- similar to how rnImportDecl handles things.
+-- ToDo: Handle SafeHaskell
+tcRnSignature :: DynFlags -> HscSource -> TcRn TcGblEnv
+tcRnSignature dflags hsc_src
+ = do { tcg_env <- getGblEnv ;
+        case tcg_sig_of tcg_env of {
+          Just sof
+           | hsc_src /= HsigFile -> do
+                { addErr (ptext (sLit "Illegal -sig-of specified for non hsig"))
+                ; return tcg_env
+                }
+           | otherwise -> do
+            { sig_iface <- initIfaceTcRn $ loadSysInterface (text "sig-of") sof
+            ; let { gr = mkGlobalRdrEnv
+                              (gresFromAvails LocalDef (mi_exports sig_iface))
+                  ; avails = calculateAvails dflags
+                                    sig_iface False{- safe -} False{- boot -} }
+            ; return (tcg_env
+                { tcg_impl_rdr_env = Just gr
+                , tcg_imports = tcg_imports tcg_env `plusImportAvails` avails
+                })
+            } ;
+            Nothing
+             | HsigFile <- hsc_src
+             , HscNothing <- hscTarget dflags -> do
+                { return tcg_env
+                }
+             | HsigFile <- hsc_src -> do
+                { addErr (ptext (sLit "Missing -sig-of for hsig"))
+                ; failM }
+             | otherwise -> return tcg_env
+        }
+      }
+
+checkHsigIface :: HscEnv -> TcGblEnv -> TcRn ()
+checkHsigIface hsc_env tcg_env
+  = case tcg_impl_rdr_env tcg_env of
+      Just gr -> do { sig_details <- liftIO $ mkBootModDetailsTc hsc_env tcg_env
+                    ; checkHsigIface' gr sig_details
+                    }
+      Nothing -> return ()
+
+checkHsigIface' :: GlobalRdrEnv -> ModDetails -> TcRn ()
+checkHsigIface' gr
+  ModDetails { md_insts = sig_insts, md_fam_insts = sig_fam_insts,
+               md_types = sig_type_env, md_exports = sig_exports}
+  = do { traceTc "checkHsigIface" $ vcat
+           [ ppr sig_type_env, ppr sig_insts, ppr sig_exports ]
+       ; mapM_ check_export sig_exports
+       ; unless (null sig_fam_insts) $
+           panic ("TcRnDriver.checkHsigIface: Cannot handle family " ++
+                  "instances in hsig files yet...")
+       ; mapM_ check_inst sig_insts
+       ; failIfErrsM
+       }
+  where
+    check_export sig_avail
+      -- Skip instances, we'll check them later
+      | name `elem` dfun_names = return ()
+      | otherwise = do
+        { -- Lookup local environment only (don't want to accidentally pick
+          -- up the backing copy.)  We consult tcg_type_env because we want
+          -- to pick up wired in names too (which get dropped by the iface
+          -- creation process); it's OK for a signature file to mention
+          -- a wired in name.
+          env <- getGblEnv
+        ; case lookupNameEnv (tcg_type_env env) name of
+            Nothing
+                -- All this means is no local definition is available: but we
+                -- could have created the export this way:
+                --
+                -- module ASig(f) where
+                --      import B(f)
+                --
+                -- In this case, we have to just lookup the identifier in
+                -- the backing implementation and make sure it matches.
+                | [GRE { gre_name = name' }]
+                    <- lookupGlobalRdrEnv gr (nameOccName name)
+                , name == name' -> return ()
+                -- TODO: Possibly give a different error if the identifier
+                -- is exported, but it's a different original name
+                | otherwise -> addErrAt (nameSrcSpan name)
+                                (missingBootThing False name "exported by")
+            Just sig_thing -> do {
+          -- We use tcLookupImported_maybe because we want to EXCLUDE
+          -- tcg_env.
+        ; r <- tcLookupImported_maybe name
+        ; case r of
+            Failed err -> addErr err
+            Succeeded real_thing ->
+              when (not (checkBootDecl sig_thing real_thing))
+               $ addErrAt (nameSrcSpan (getName sig_thing))
+                          (bootMisMatch False real_thing sig_thing)
+        }}
+      where
+        name          = availName sig_avail
+
+    dfun_names = map getName sig_insts
+
+    -- In general, for hsig files we can't assume that the implementing
+    -- file actually implemented the instances (they may be reexported
+    -- from elsewhere.  Where should we look for the instances?  We do
+    -- the same as we would otherwise: consult the EPS.  This isn't
+    -- perfect (we might conclude the module exports an instance
+    -- when it doesn't, see #9422), but we will never refuse to compile
+    -- something
+    check_inst :: ClsInst -> TcM ()
+    check_inst sig_inst
+        = do eps <- getEps
+             when (not (memberInstEnv (eps_inst_env eps) sig_inst)) $
+               addErrTc (instMisMatch False sig_inst)
+
 tcRnModuleTcRnM :: HscEnv
                 -> HscSource
                 -> HsParsedModule
@@ -153,7 +272,12 @@ tcRnModuleTcRnM hsc_env hsc_src
                 })
                 (this_mod, prel_imp_loc)
  = setSrcSpan loc $
-   do {         -- Deal with imports; first add implicit prelude
+   do { let { dflags = hsc_dflags hsc_env } ;
+
+        tcg_env <- tcRnSignature dflags hsc_src ;
+        setGblEnv tcg_env $ do {
+
+        -- Deal with imports; first add implicit prelude
         implicit_prelude <- xoptM Opt_ImplicitPrelude;
         let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
                                          implicit_prelude import_decls } ;
@@ -186,8 +310,8 @@ tcRnModuleTcRnM hsc_env hsc_src
 
                 -- Rename and type check the declarations
         traceRn (text "rn1a") ;
-        tcg_env <- if isHsBoot hsc_src then
-                        tcRnHsBootDecls local_decls
+        tcg_env <- if isHsBootOrSig hsc_src then
+                        tcRnHsBootDecls hsc_src local_decls
                    else
                         {-# SCC "tcRnSrcDecls" #-}
                         tcRnSrcDecls boot_iface local_decls ;
@@ -205,6 +329,21 @@ tcRnModuleTcRnM hsc_env hsc_src
         -- Must be done after processing the exports
         tcg_env <- checkHiBootIface tcg_env boot_iface ;
 
+        -- Compare the hsig tcg_env with the real thing
+        checkHsigIface hsc_env tcg_env ;
+
+        -- Nub out type class instances now that we've checked them,
+        -- if we're compiling an hsig with sig-of.
+        -- See Note [Signature files and type class instances]
+        tcg_env <- (case tcg_sig_of tcg_env of
+            Just _ -> return tcg_env {
+                        tcg_inst_env = emptyInstEnv,
+                        tcg_fam_inst_env = emptyFamInstEnv,
+                        tcg_insts = [],
+                        tcg_fam_insts = []
+                        }
+            Nothing -> return tcg_env) ;
+
         -- The new type env is already available to stuff slurped from
         -- interface files, via TcEnv.updateGlobalTypeEnv
         -- It's important that this includes the stuff in checkHiBootIface,
@@ -224,8 +363,7 @@ tcRnModuleTcRnM hsc_env hsc_src
                 -- Dump output and return
         tcDump tcg_env ;
         return tcg_env
-    }}}
-
+    }}}}
 
 implicitPreludeWarn :: SDoc
 implicitPreludeWarn
@@ -305,106 +443,6 @@ tcRnImports hsc_env import_decls
 
 %************************************************************************
 %*                                                                      *
-        Type-checking external-core modules
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-tcRnExtCore :: HscEnv
-            -> HsExtCore RdrName
-            -> IO (Messages, Maybe ModGuts)
-        -- Nothing => some error occurred
-
-tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
-        -- The decls are IfaceDecls; all names are original names
- = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
-
-   initTc hsc_env ExtCoreFile False this_mod $ do {
-
-   let { ldecls  = map noLoc decls } ;
-
-       -- 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)
-   (tc_envs, _bndrs) <- getLocalNonValBinders emptyFsEnv {- no fixity decls -}
-                                              (mkFakeGroup ldecls) ;
-   setEnvs tc_envs $ do {
-
-   (rn_decls, _fvs) <- checkNoErrs $ rnTyClDecls [] [mkTyClGroup ldecls] ;
-   -- The empty list is for extra dependencies coming from .hs-boot files
-   -- See Note [Extra dependencies from .hs-boot files] in RnSource
-
-        -- Dump trace of renaming part
-   rnDump (ppr rn_decls) ;
-
-        -- Typecheck them all together so that
-        -- any mutually recursive types are done right
-        -- Just discard the auxiliary bindings; they are generated
-        -- only for Haskell source code, and should already be in Core
-   tcg_env   <- tcTyAndClassDecls emptyModDetails rn_decls ;
-   safe_mode <- liftIO $ finalSafeMode (hsc_dflags hsc_env) tcg_env ;
-   dep_files <- liftIO $ readIORef (tcg_dependent_files tcg_env) ;
-
-   setGblEnv tcg_env $ do {
-        -- Make the new type env available to stuff slurped from interface files
-
-        -- Now the core bindings
-   core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
-
-
-        -- Wrap up
-   let {
-        bndrs      = bindersOfBinds core_binds ;
-        my_exports = map (Avail . idName) bndrs ;
-                -- ToDo: export the data types also?
-
-        mod_guts = ModGuts {    mg_module    = this_mod,
-                                mg_boot      = False,
-                                mg_used_names = emptyNameSet, -- ToDo: compute usage
-                                mg_used_th   = False,
-                                mg_dir_imps  = emptyModuleEnv, -- ??
-                                mg_deps      = noDependencies,  -- ??
-                                mg_exports   = my_exports,
-                                mg_tcs       = tcg_tcs tcg_env,
-                                mg_insts     = tcg_insts tcg_env,
-                                mg_fam_insts = tcg_fam_insts tcg_env,
-                                mg_inst_env  = tcg_inst_env tcg_env,
-                                mg_fam_inst_env = tcg_fam_inst_env tcg_env,
-                                mg_rules        = [],
-                                mg_vect_decls   = [],
-                                mg_anns         = [],
-                                mg_binds        = core_binds,
-
-                                -- Stubs
-                                mg_rdr_env      = emptyGlobalRdrEnv,
-                                mg_fix_env      = emptyFixityEnv,
-                                mg_warns        = NoWarnings,
-                                mg_foreign      = NoStubs,
-                                mg_hpc_info     = emptyHpcInfo False,
-                                mg_modBreaks    = emptyModBreaks,
-                                mg_vect_info    = noVectInfo,
-                                mg_safe_haskell = safe_mode,
-                                mg_trust_pkg    = False,
-                                mg_dependent_files = dep_files
-                            } } ;
-
-   tcCoreDump mod_guts ;
-
-   return mod_guts
-   }}}}
-
-mkFakeGroup :: [LTyClDecl a] -> HsGroup a
-mkFakeGroup decls -- Rather clumsy; lots of unused fields
-  = emptyRdrGroup { hs_tyclds = [mkTyClGroup decls] }
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
         Type-checking the top level of a module
 %*                                                                      *
 %************************************************************************
@@ -565,8 +603,8 @@ tc_rn_src_decls boot_details ds
 %************************************************************************
 
 \begin{code}
-tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
-tcRnHsBootDecls decls
+tcRnHsBootDecls :: HscSource -> [LHsDecl RdrName] -> TcM TcGblEnv
+tcRnHsBootDecls hsc_src decls
    = do { (first_group, group_tail) <- findSplice decls
 
                 -- Rename the declarations
@@ -587,12 +625,12 @@ tcRnHsBootDecls decls
 
                 -- Check for illegal declarations
         ; case group_tail of
-             Just (SpliceDecl d _, _) -> badBootDecl "splice" d
+             Just (SpliceDecl d _, _) -> badBootDecl hsc_src "splice" d
              Nothing                  -> return ()
-        ; mapM_ (badBootDecl "foreign") for_decls
-        ; mapM_ (badBootDecl "default") def_decls
-        ; mapM_ (badBootDecl "rule")    rule_decls
-        ; mapM_ (badBootDecl "vect")    vect_decls
+        ; mapM_ (badBootDecl hsc_src "foreign") for_decls
+        ; mapM_ (badBootDecl hsc_src "default") def_decls
+        ; mapM_ (badBootDecl hsc_src "rule")    rule_decls
+        ; mapM_ (badBootDecl hsc_src "vect")    vect_decls
 
                 -- Typecheck type/class/isntance decls
         ; traceTc "Tc2 (boot)" empty
@@ -614,7 +652,10 @@ tcRnHsBootDecls decls
                 -- are written into the interface file.
         ; let { type_env0 = tcg_type_env gbl_env
               ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
-              ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
+              -- Don't add the dictionaries for hsig, we don't actually want
+              -- to /define/ the instance
+              ; type_env2 | HsigFile <- hsc_src = type_env1
+                          | otherwise = extendTypeEnvWithIds type_env1 dfun_ids
               ; dfun_ids = map iDFunId inst_infos
               }
 
@@ -622,10 +663,15 @@ tcRnHsBootDecls decls
    }}
    ; traceTc "boot" (ppr lie); return gbl_env }
 
-badBootDecl :: String -> Located decl -> TcM ()
-badBootDecl what (L loc _)
+badBootDecl :: HscSource -> String -> Located decl -> TcM ()
+badBootDecl hsc_src what (L loc _)
   = addErrAt loc (char 'A' <+> text what
-      <+> ptext (sLit "declaration is not (currently) allowed in a hs-boot file"))
+      <+> ptext (sLit "declaration is not (currently) allowed in a")
+      <+> (case hsc_src of
+            HsBootFile -> ptext (sLit "hs-boot")
+            HsigFile -> ptext (sLit "hsig")
+            _ -> panic "badBootDecl: should be an hsig or hs-boot file")
+      <+> ptext (sLit "file"))
 \end{code}
 
 Once we've typechecked the body of the module, we want to compare what
@@ -645,12 +691,35 @@ checkHiBootIface
         tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds,
                             tcg_insts = local_insts,
                             tcg_type_env = local_type_env, tcg_exports = local_exports })
-        (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts,
-                      md_types = boot_type_env, md_exports = boot_exports })
-  | isHsBoot hs_src     -- Current module is already a hs-boot file!
+        boot_details
+  | HsBootFile <- hs_src     -- Current module is already a hs-boot file!
   = return tcg_env
 
   | otherwise
+  = do  { mb_dfun_prs <- checkHiBootIface' local_insts local_type_env
+                                           local_exports boot_details
+        ; let dfun_prs   = catMaybes mb_dfun_prs
+              boot_dfuns = map fst dfun_prs
+              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
+                                     | (boot_dfun, dfun) <- dfun_prs ]
+              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
+              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
+
+        ; setGlobalTypeEnv tcg_env' type_env' }
+             -- Update the global type env *including* the knot-tied one
+             -- so that if the source module reads in an interface unfolding
+             -- mentioning one of the dfuns from the boot module, then it
+             -- can "see" that boot dfun.   See Trac #4003
+
+checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]
+                  -> ModDetails -> TcM [Maybe (Id, Id)]
+-- Variant which doesn't require a full TcGblEnv; you could get the
+-- local components from another ModDetails.
+
+checkHiBootIface'
+        local_insts local_type_env local_exports
+        (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts,
+                      md_types = boot_type_env, md_exports = boot_exports })
   = do  { traceTc "checkHiBootIface" $ vcat
              [ ppr boot_type_env, ppr boot_insts, ppr boot_exports]
 
@@ -667,19 +736,11 @@ checkHiBootIface
 
                 -- Check instance declarations
         ; mb_dfun_prs <- mapM check_inst boot_insts
-        ; let dfun_prs   = catMaybes mb_dfun_prs
-              boot_dfuns = map fst dfun_prs
-              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
-                                     | (boot_dfun, dfun) <- dfun_prs ]
-              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
-              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
 
         ; failIfErrsM
-        ; setGlobalTypeEnv tcg_env' type_env' }
-             -- Update the global type env *including* the knot-tied one
-             -- so that if the source module reads in an interface unfolding
-             -- mentioning one of the dfuns from the boot module, then it
-             -- can "see" that boot dfun.   See Trac #4003
+
+        ; return mb_dfun_prs }
+
   where
     check_export boot_avail     -- boot_avail is exported by the boot iface
       | name `elem` dfun_names = return ()
@@ -690,7 +751,7 @@ checkHiBootIface
         -- Check that the actual module exports the same thing
       | not (null missing_names)
       = addErrAt (nameSrcSpan (head missing_names))
-                 (missingBootThing (head missing_names) "exported by")
+                 (missingBootThing True (head missing_names) "exported by")
 
         -- If the boot module does not *define* the thing, we are done
         -- (it simply re-exports it, and names match, so nothing further to do)
@@ -702,10 +763,10 @@ checkHiBootIface
         Just boot_thing <- mb_boot_thing
       = when (not (checkBootDecl boot_thing real_thing))
             $ addErrAt (nameSrcSpan (getName boot_thing))
-                       (bootMisMatch real_thing boot_thing)
+                       (bootMisMatch True real_thing boot_thing)
 
       | otherwise
-      = addErrTc (missingBootThing name "defined in")
+      = addErrTc (missingBootThing True name "defined in")
       where
         name          = availName boot_avail
         mb_boot_thing = lookupTypeEnv boot_type_env name
@@ -728,12 +789,12 @@ checkHiBootIface
                                                   , text "boot_inst"   <+> ppr boot_inst
                                                   , text "boot_inst_ty" <+> ppr boot_inst_ty
                                                   ])
-                     ; addErrTc (instMisMatch boot_inst); return Nothing }
+                     ; addErrTc (instMisMatch True boot_inst); return Nothing }
             (dfun:_) -> return (Just (local_boot_dfun, dfun))
         where
           boot_dfun = instanceDFunId boot_inst
           boot_inst_ty = idType boot_dfun
-          local_boot_dfun = Id.mkExportedLocalId (idName boot_dfun) boot_inst_ty
+          local_boot_dfun = Id.mkExportedLocalId VanillaId (idName boot_dfun) boot_inst_ty
 
 
 -- This has to compare the TyThing from the .hi-boot file to the TyThing
@@ -752,7 +813,7 @@ checkBootDecl (AnId id1) (AnId id2)
 checkBootDecl (ATyCon tc1) (ATyCon tc2)
   = checkBootTyCon tc1 tc2
 
-checkBootDecl (ADataCon dc1) (ADataCon _)
+checkBootDecl (AConLike (RealDataCon dc1)) (AConLike (RealDataCon _))
   = pprPanic "checkBootDecl" (ppr dc1)
 
 checkBootDecl _ _ = False -- probably shouldn't happen
@@ -781,17 +842,14 @@ checkBootTyCon tc1 tc2
           (_, rho_ty2) = splitForAllTys (idType id2)
           op_ty2 = funResultTy rho_ty2
 
-       eqAT (tc1, def_ats1) (tc2, def_ats2)
+       eqAT (ATI tc1 def_ats1) (ATI tc2 def_ats2)
          = checkBootTyCon tc1 tc2 &&
-           eqListBy eqATDef def_ats1 def_ats2
+           eqATDef def_ats1 def_ats2
 
        -- Ignore the location of the defaults
-       eqATDef (CoAxBranch { cab_tvs = tvs1, cab_lhs =  ty_pats1, cab_rhs = ty1 })
-               (CoAxBranch { cab_tvs = tvs2, cab_lhs =  ty_pats2, cab_rhs = ty2 })
-         | Just env <- eqTyVarBndrs emptyRnEnv2 tvs1 tvs2
-         = eqListBy (eqTypeX env) ty_pats1 ty_pats2 &&
-           eqTypeX env ty1 ty2
-         | otherwise = False
+       eqATDef Nothing    Nothing    = True
+       eqATDef (Just ty1) (Just ty2) = eqTypeX env ty1 ty2
+       eqATDef _ _ = False           
 
        eqFD (as1,bs1) (as2,bs2) =
          eqListBy (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&
@@ -830,10 +888,6 @@ checkBootTyCon tc1 tc2
     eqListBy (eqPredX env) (tyConStupidTheta tc1) (tyConStupidTheta tc2) &&
     eqAlgRhs (algTyConRhs tc1) (algTyConRhs tc2)
 
-  | isForeignTyCon tc1 && isForeignTyCon tc2
-  = eqKind (tyConKind tc1) (tyConKind tc2) &&
-    tyConExtName tc1 == tyConExtName tc2
-
   | otherwise = False
   where
     roles1 = tyConRoles tc1
@@ -873,23 +927,32 @@ emptyRnEnv2 :: RnEnv2
 emptyRnEnv2 = mkRnEnv2 emptyInScopeSet
 
 ----------------
-missingBootThing :: Name -> String -> SDoc
-missingBootThing name what
-  = ppr name <+> ptext (sLit "is exported by the hs-boot file, but not")
+missingBootThing :: Bool -> Name -> String -> SDoc
+missingBootThing is_boot name what
+  = ppr name <+> ptext (sLit "is exported by the") <+>
+              (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "hsig"))
+              <+> ptext (sLit "file, but not")
               <+> text what <+> ptext (sLit "the module")
 
-bootMisMatch :: TyThing -> TyThing -> SDoc
-bootMisMatch real_thing boot_thing
+bootMisMatch :: Bool -> TyThing -> TyThing -> SDoc
+bootMisMatch is_boot real_thing boot_thing
   = vcat [ppr real_thing <+>
           ptext (sLit "has conflicting definitions in the module"),
-          ptext (sLit "and its hs-boot file"),
+          ptext (sLit "and its") <+>
+            (if is_boot then ptext (sLit "hs-boot file")
+                       else ptext (sLit "hsig file")),
           ptext (sLit "Main module:") <+> PprTyThing.pprTyThing real_thing,
-          ptext (sLit "Boot file:  ") <+> PprTyThing.pprTyThing boot_thing]
+          (if is_boot
+            then ptext (sLit "Boot file:  ")
+            else ptext (sLit "Hsig file: "))
+            <+> PprTyThing.pprTyThing boot_thing]
 
-instMisMatch :: ClsInst -> SDoc
-instMisMatch inst
+instMisMatch :: Bool -> ClsInst -> SDoc
+instMisMatch is_boot inst
   = hang (ppr inst)
-       2 (ptext (sLit "is defined in the hs-boot file, but not in the module itself"))
+       2 (ptext (sLit "is defined in the") <+>
+        (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "hsig"))
+       <+> ptext (sLit "file, but not in the module itself"))
 \end{code}
 
 
@@ -937,218 +1000,6 @@ rnTopSrcDecls extra_deps group
 
 %************************************************************************
 %*                                                                      *
-                AMP warnings
-     The functions defined here issue warnings according to
-     the 2013 Applicative-Monad proposal. (Trac #8004)
-%*                                                                      *
-%************************************************************************
-
-Note [No AMP warning with NoImplicitPrelude]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If you have -XNoImplicitPrelude, then we suppress the AMP warnings.
-The AMP warnings need access to Monad, Applicative, etc, and they
-are defined in 'base'. If, when compiling package 'ghc-prim' (say),
-you try to load Monad (from 'base'), chaos results because 'base'
-depends on 'ghc-prim'.  See Note [Home module load error] in LoadIface,
-and Trac #8320.
-
-Using -XNoImplicitPrelude is a proxy for ensuring that all the
-'base' modules are below the home module in the dependency tree.
-
-\begin{code}
--- | Main entry point for generating AMP warnings
-tcAmpWarn :: TcM ()
-tcAmpWarn =
-    do { implicit_prel <- xoptM Opt_ImplicitPrelude
-       ; warnFlag <- woptM Opt_WarnAMP
-       ; when (warnFlag && implicit_prel) $ do {
-              -- See Note [No AMP warning with NoImplicitPrelude]
-
-         -- Monad without Applicative
-       ; tcAmpMissingParentClassWarn monadClassName
-                                     applicativeClassName
-
-         -- MonadPlus without Alternative
-       ; tcAmpMissingParentClassWarn monadPlusClassName
-                                     alternativeClassName
-
-         -- Custom local definitions of join/pure/<*>
-       ; mapM_ tcAmpFunctionWarn [joinMName, apAName, pureAName]
-    }}
-
-
-
--- | Warn on local definitions of names that would clash with Prelude versions,
---   i.e. join/pure/<*>
---
---   A name clashes if the following criteria are met:
---       1. It would is imported (unqualified) from Prelude
---       2. It is locally defined in the current module
---       3. It has the same literal name as the reference function
---       4. It is not identical to the reference function
-tcAmpFunctionWarn :: Name -- ^ Name to check, e.g. joinMName for join
-                  -> TcM ()
-tcAmpFunctionWarn name = do
-    { traceTc "tcAmpFunctionWarn/wouldBeImported" empty
-    -- Is the name imported (unqualified) from Prelude? (Point 4 above)
-    ; rnImports <- fmap (map unLoc . tcg_rn_imports) getGblEnv
-    -- (Note that this automatically handles -XNoImplicitPrelude, as Prelude
-    -- will not appear in rnImports automatically if it is set.)
-
-    -- Continue only the name is imported from Prelude
-    ; when (tcAmpImportViaPrelude name rnImports) $ do
-      -- Handle 2.-4.
-    { rdrElts <- fmap (concat . occEnvElts . tcg_rdr_env) getGblEnv
-
-    ; let clashes :: GlobalRdrElt -> Bool
-          clashes x = and [ gre_prov x == LocalDef
-                          , nameOccName (gre_name x) == nameOccName name
-                          , gre_name x /= name
-                          ]
-
-          -- List of all offending definitions
-          clashingElts :: [GlobalRdrElt]
-          clashingElts = filter clashes rdrElts
-
-    ; traceTc "tcAmpFunctionWarn/amp_prelude_functions"
-                (hang (ppr name) 4 (sep [ppr clashingElts]))
-
-    ; let warn_msg x = addWarnAt (nameSrcSpan $ gre_name x) . hsep $
-              [ ptext (sLit "Local definition of")
-              , quotes . ppr . nameOccName $ gre_name x
-              , ptext (sLit "clashes with a future Prelude name")
-              , ptext (sLit "- this will become an error in GHC 7.10,")
-              , ptext (sLit "under the Applicative-Monad Proposal.")
-              ]
-    ; mapM_ warn_msg clashingElts
-    }}
-
--- | Is the given name imported via Prelude?
---
---   This function makes sure that e.g. "import Prelude (map)" should silence
---   AMP warnings about "join" even when they are locally defined.
---
---   Possible scenarios:
---     a) Prelude is imported implicitly, issue warnings.
---     b) Prelude is imported explicitly, but without mentioning the name in
---        question. Issue no warnings.
---     c) Prelude is imported hiding the name in question. Issue no warnings.
---     d) Qualified import of Prelude, no warnings.
-tcAmpImportViaPrelude :: Name
-                      -> [ImportDecl Name]
-                      -> Bool
-tcAmpImportViaPrelude name = any importViaPrelude
-  where
-    isPrelude :: ImportDecl Name -> Bool
-    isPrelude imp = unLoc (ideclName imp) == pRELUDE_NAME
-
-    -- Implicit (Prelude) import?
-    isImplicit :: ImportDecl Name -> Bool
-    isImplicit = ideclImplicit
-
-    -- Unqualified import?
-    isUnqualified :: ImportDecl Name -> Bool
-    isUnqualified = not . ideclQualified
-
-    second :: (a -> b) -> (x, a) -> (x, b)
-    second f (x, y) = (x, f y)
-
-    -- List of explicitly imported (or hidden) Names from a single import.
-    --   Nothing -> No explicit imports
-    --   Just (False, <names>) -> Explicit import list of <names>
-    --   Just (True , <names>) -> Explicit hiding of <names>
-    importList :: ImportDecl Name -> Maybe (Bool, [Name])
-    importList = fmap (second (map (ieName . unLoc))) . ideclHiding
-
-    -- Check whether the given name would be imported (unqualified) from
-    -- an import declaration.
-    importViaPrelude :: ImportDecl Name -> Bool
-    importViaPrelude x = isPrelude x && isUnqualified x && or [
-        -- Whole Prelude imported -> potential clash
-          isImplicit x
-        -- Explicit import/hiding list, if applicable
-        , case importList x of
-            Just (False, explicit) -> nameOccName name `elem`    map nameOccName explicit
-            Just (True , hidden  ) -> nameOccName name `notElem` map nameOccName hidden
-            Nothing                -> False
-        ]
-
--- | Issue a warning for instance definitions lacking a should-be parent class.
---   Used for Monad without Applicative and MonadPlus without Alternative.
-tcAmpMissingParentClassWarn :: Name -- ^ Class instance is defined for
-                            -> Name -- ^ Class it should also be instance of
-                            -> TcM ()
-
--- Notation: is* is for classes the type is an instance of, should* for those
---           that it should also be an instance of based on the corresponding
---           is*.
---           Example: in case of Applicative/Monad: is = Monad,
---                                                  should = Applicative
-tcAmpMissingParentClassWarn isName shouldName
-  = do { isClass'     <- tcLookupClass_maybe isName
-       ; shouldClass' <- tcLookupClass_maybe shouldName
-       ; case (isClass', shouldClass') of
-              (Just isClass, Just shouldClass) -> do
-                  { localInstances <- tcGetInsts
-                  ; let isInstance m = is_cls m == isClass
-                        isInsts = filter isInstance localInstances
-                  ; traceTc "tcAmpMissingParentClassWarn/isInsts" (ppr isInsts)
-                  ; forM_ isInsts $ checkShouldInst isClass shouldClass
-                  }
-              _ -> return ()
-       }
-  where
-    -- Checks whether the desired superclass exists in a given environment.
-    checkShouldInst :: Class   -- ^ Class of existing instance
-                    -> Class   -- ^ Class there should be an instance of
-                    -> ClsInst -- ^ Existing instance
-                    -> TcM ()
-    checkShouldInst isClass shouldClass isInst
-      = do { instEnv <- tcGetInstEnvs
-           ; let (instanceMatches, shouldInsts, _)
-                    = lookupInstEnv instEnv shouldClass (is_tys isInst)
-
-           ; traceTc "tcAmpMissingParentClassWarn/checkShouldInst"
-                     (hang (ppr isInst) 4
-                         (sep [ppr instanceMatches, ppr shouldInsts]))
-
-           -- "<location>: Warning: <type> is an instance of <is> but not <should>"
-           -- e.g. "Foo is an instance of Monad but not Applicative"
-           ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst
-                 warnMsg (Just name:_) =
-                      addWarnAt instLoc . hsep $
-                           [ quotes (ppr $ nameOccName name)
-                           , ptext (sLit "is an instance of")
-                           , ppr . nameOccName $ className isClass
-                           , ptext (sLit "but not")
-                           , ppr . nameOccName $ className shouldClass
-                           , ptext (sLit "- this will become an error in GHC 7.10,")
-                           , ptext (sLit "under the Applicative-Monad Proposal.")
-                           ]
-                 warnMsg _ = return ()
-           ; when (null shouldInsts && null instanceMatches) $
-                  warnMsg (is_tcs isInst)
-           }
-
-
--- | Looks up a class, returning Nothing on failure. Similar to
---   TcEnv.tcLookupClass, but does not issue any error messages.
---
--- In particular, it may be called by the AMP check on, say, 
--- Control.Applicative.Applicative, well before Control.Applicative 
--- has been compiled.  In this case we just return Nothing, and the
--- AMP test is silently dropped.
-tcLookupClass_maybe :: Name -> TcM (Maybe Class)
-tcLookupClass_maybe name
-  = do { mb_thing <- tcLookupImported_maybe name
-       ; case mb_thing of
-            Succeeded (ATyCon tc) | Just cls <- tyConClass_maybe tc -> return (Just cls)
-            _ -> return Nothing }
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
                 tcTopSrcDecls
 %*                                                                      *
 %************************************************************************
@@ -1180,7 +1031,6 @@ tcTopSrcDecls boot_details
 
                 -- Generate Applicative/Monad proposal (AMP) warnings
         traceTc "Tc3b" empty ;
-        tcAmpWarn ;
 
                 -- Foreign import declarations next.
         traceTc "Tc4" empty ;
@@ -1359,7 +1209,7 @@ check_main dflags tcg_env
         ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN
                                    (mkVarOccFS (fsLit "main"))
                                    (getSrcSpan main_name)
-              ; root_main_id = Id.mkExportedLocalId root_main_name
+              ; root_main_id = Id.mkExportedLocalId VanillaId root_main_name
                                                     (mkTyConApp ioTyCon [res_ty])
               ; co  = mkWpTyApps [res_ty]
               ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
@@ -1602,7 +1452,7 @@ tcUserStmt (L loc (BodyStmt expr _ _ _))
         ; let fresh_it  = itName uniq loc
               matches   = [mkMatch [] rn_expr emptyLocalBinds]
               -- [it = expr]
-              the_bind  = L loc $ (mkTopFunBind (L loc fresh_it) matches) { bind_fvs = fvs }
+              the_bind  = L loc $ (mkTopFunBind FromSource (L loc fresh_it) matches) { bind_fvs = fvs }
                           -- Care here!  In GHCi the expression might have
                           -- free variables, and they in turn may have free type variables
                           -- (if we are at a breakpoint, say).  We must put those free vars
@@ -1686,7 +1536,8 @@ tcUserStmt rdr_stmt@(L loc _)
            ; return stuff }
       where
         print_v  = L loc $ BodyStmt (nlHsApp (nlHsVar printName) (nlHsVar v))
-                                    (HsVar thenIOName) noSyntaxExpr placeHolderType
+                                    (HsVar thenIOName) noSyntaxExpr
+                                    placeHolderType
 
 -- | Typecheck the statements given and then return the results of the
 -- statement in the form 'IO [()]'.
@@ -2039,7 +1890,7 @@ loadUnqualIfaces hsc_env ictxt
                   , let name = gre_name gre
                   , not (isInternalName name)
                   , let mod = nameModule name
-                  , not (modulePackageId mod == this_pkg || isInteractiveModule mod)
+                  , not (modulePackageKey mod == this_pkg || isInteractiveModule mod)
                       -- Don't attempt to load an interface for stuff
                       -- from the command line, or from the home package
                   , isTcOcc (nameOccName name)   -- Types and classes only
@@ -2075,17 +1926,6 @@ tcDump env
         -- NB: foreign x-d's have undefined's in their types;
         --     hence can't show the tc_fords
 
-tcCoreDump :: ModGuts -> TcM ()
-tcCoreDump mod_guts
- = do { dflags <- getDynFlags ;
-        when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
-             (dumpTcRn (pprModGuts mod_guts)) ;
-
-        -- Dump bindings if -ddump-tc
-        dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
-  where
-    full_dump = pprCoreBindings (mg_binds mod_guts)
-
 -- It's unpleasant having both pprModGuts and pprModDetails here
 pprTcGblEnv :: TcGblEnv -> SDoc
 pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
@@ -2103,7 +1943,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
          , ptext (sLit "Dependent modules:") <+>
                 ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports))
          , ptext (sLit "Dependent packages:") <+>
-                ppr (sortBy stablePackageIdCmp $ imp_dep_pkgs imports)]
+                ppr (sortBy stablePackageKeyCmp $ imp_dep_pkgs imports)]
   where         -- The two uses of sortBy are just to reduce unnecessary
                 -- wobbling in testsuite output
     cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2)
@@ -2111,12 +1951,6 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                   `thenCmp`
           (is_boot1 `compare` is_boot2)
 
-pprModGuts :: ModGuts -> SDoc
-pprModGuts (ModGuts { mg_tcs = tcs
-                    , mg_rules = rules })
-  = vcat [ ppr_types [] (mkTypeEnv (map ATyCon tcs)),
-           ppr_rules rules ]
-
 ppr_types :: [ClsInst] -> TypeEnv -> SDoc
 ppr_types insts type_env
   = text "TYPE SIGNATURES" $$ nest 2 (ppr_sigs ids)
@@ -2167,13 +2001,5 @@ ppr_tydecls tycons
         -- Print type constructor info; sort by OccName
   = vcat (map ppr_tycon (sortBy (comparing getOccName) tycons))
   where
-    ppr_tycon tycon = vcat [ ppr (tyConName tycon) <+> dcolon <+> ppr (tyConKind tycon)
-                              -- Temporarily print the kind signature too
-                           , ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
-
-ppr_rules :: [CoreRule] -> SDoc
-ppr_rules [] = empty
-ppr_rules rs = vcat [ptext (sLit "{-# RULES"),
-                      nest 2 (pprRules rs),
-                      ptext (sLit "#-}")]
+    ppr_tycon tycon = vcat [ ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
 \end{code}