+%************************************************************************
+%* *
+ Compiling hs-boot source files, and
+ comparing the hi-boot interface with the real thing
+%* *
+%************************************************************************
+
+\begin{code}
+tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
+tcRnHsBootDecls decls
+ = do { let { (first_group, group_tail) = findSplice decls }
+
+ ; case group_tail of
+ Just stuff -> spliceInHsBootErr stuff
+ Nothing -> return ()
+
+ -- Rename the declarations
+ ; (tcg_env, rn_group) <- rnTopSrcDecls first_group
+ ; setGblEnv tcg_env $ do {
+
+ -- Todo: check no foreign decls, no rules, no default decls
+
+ -- Typecheck type/class decls
+ ; traceTc (text "Tc2")
+ ; let tycl_decls = hs_tyclds rn_group
+ ; tcg_env <- checkNoErrs (tcTyAndClassDecls [{- no boot_names -}] tycl_decls)
+ ; setGblEnv tcg_env $ do {
+
+ -- Typecheck instance decls
+ ; traceTc (text "Tc3")
+ ; (tcg_env, inst_infos, _binds) <- tcInstDecls1 tycl_decls (hs_instds rn_group)
+ ; setGblEnv tcg_env $ do {
+
+ -- Typecheck value declarations
+ ; traceTc (text "Tc5")
+ ; new_ids <- tcHsBootSigs (hs_valds rn_group)
+
+ -- Wrap up
+ -- No simplification or zonking to do
+ ; traceTc (text "Tc7a")
+ ; gbl_env <- getGblEnv
+
+ ; let { final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
+ ; return (gbl_env { tcg_type_env = final_type_env })
+ }}}}
+
+spliceInHsBootErr (SpliceDecl (L loc _), _)
+ = addErrAt loc (ptext SLIT("Splices are not allowed in hs-boot files"))
+\end{code}
+
+In both one-shot mode and GHCi mode, hi-boot interfaces are demand-loaded
+into the External Package Table. Once we've typechecked the body of the
+module, we want to compare what we've found (gathered in a TypeEnv) with
+the hi-boot stuff in the EPT. We do so here, using the export list of
+the hi-boot interface as our checklist.
+
+\begin{code}
+checkHiBootIface :: TypeEnv -> [Name] -> TcM ()
+-- Compare the hi-boot file for this module (if there is one)
+-- with the type environment we've just come up with
+-- In the common case where there is no hi-boot file, the list
+-- of boot_names is empty.
+checkHiBootIface env boot_names
+ = mapM_ (check_one env) boot_names
+
+----------------
+check_one local_env name
+ | isWiredInName name -- No checking for wired-in names. In particular, 'error'
+ = return () -- is handled by a rather gross hack (see comments in GHC.Err.hs-boot)
+ | otherwise
+ = do { (eps,hpt) <- getEpsAndHpt
+
+ -- Look up the hi-boot one;
+ -- it should jolly well be there (else GHC bug)
+ ; case lookupType hpt (eps_PTE eps) name of {
+ Nothing -> pprPanic "checkHiBootIface" (ppr name) ;
+ Just boot_thing ->
+
+ -- Look it up in the local type env
+ -- It should be there, but it's a programmer error if not
+ case lookupTypeEnv local_env name of
+ Nothing -> addErrTc (missingBootThing boot_thing)
+ Just real_thing -> check_thing boot_thing real_thing
+ } }
+
+----------------
+check_thing (ATyCon boot_tc) (ATyCon real_tc)
+ | isSynTyCon boot_tc && isSynTyCon real_tc,
+ defn1 `tcEqType` substTyWith tvs2 (mkTyVarTys tvs1) defn2
+ = return ()
+
+ | tyConKind boot_tc == tyConKind real_tc
+ = return ()
+ where
+ (tvs1, defn1) = getSynTyConDefn boot_tc
+ (tvs2, defn2) = getSynTyConDefn boot_tc
+
+check_thing (AnId boot_id) (AnId real_id)
+ | idType boot_id `tcEqType` idType real_id
+ = return ()
+
+check_thing (ADataCon dc1) (ADataCon dc2)
+ | idType (dataConWrapId dc1) `tcEqType` idType (dataConWrapId dc2)
+ = return ()
+
+ -- Can't declare a class in a hi-boot file
+
+check_thing boot_thing real_thing -- Default case; failure
+ = addErrAt (srcLocSpan (getSrcLoc real_thing))
+ (bootMisMatch real_thing)
+
+----------------
+missingBootThing thing
+ = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
+bootMisMatch thing
+ = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
+\end{code}
+