import TcExpr
import TcRnMonad
import TcType
+import Coercion
import Inst
import FamInst
import InstEnv
import NameEnv
import NameSet
import TyCon
+import TysPrim
import TysWiredIn
import SrcLoc
import HscTypes
tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
traceRn (text "rn4b: after exportss") ;
+ -- Check that main is exported (must be after rnExports)
+ checkMainExported tcg_env ;
+
-- Compare the hi-boot iface (if any) with the real thing
-- Must be done after processing the exports
tcg_env <- checkHiBootIface tcg_env boot_iface ;
-- Check the exports of the boot module, one by one
; mapM_ check_export boot_exports
+ -- Check instance declarations
+ ; mb_dfun_prs <- mapM check_inst boot_insts
+ ; let tcg_env' = tcg_env { tcg_binds = binds `unionBags` dfun_binds,
+ tcg_type_env = extendTypeEnvWithIds local_type_env boot_dfuns }
+ 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 ]
+
-- Check for no family instances
; unless (null boot_fam_insts) $
panic ("TcRnDriver.checkHiBootIface: Cannot handle family " ++
final_type_env = extendTypeEnvWithIds local_type_env boot_dfuns
dfun_prs = catMaybes mb_dfun_prs
boot_dfuns = map fst dfun_prs
- dfun_binds = listToBag [ noLoc $ VarBind boot_dfun (nlHsVar dfun)
+ dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
| (boot_dfun, dfun) <- dfun_prs ]
; failIfErrsM
(mkTyConApp ioTyCon [res_ty])
; co = mkWpTyApps [res_ty]
; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
- ; main_bind = noLoc (VarBind root_main_id rhs) }
+ ; main_bind = mkVarBind root_main_id rhs }
- ; return (tcg_env { tcg_binds = tcg_binds tcg_env
+ ; return (tcg_env { tcg_main = Just main_name,
+ tcg_binds = tcg_binds tcg_env
`snocBag` main_bind,
tcg_dus = tcg_dus tcg_env
`plusDU` usesOnly (unitFV main_name)
-- Record the use of 'main', so that we don't
-- complain about it being defined but not used
- })
+ })
}}}
where
mod = tcg_mod tcg_env
mainCtxt = ptext (sLit "When checking the type of the") <+> pp_main_fn
noMainMsg = ptext (sLit "The") <+> pp_main_fn
<+> ptext (sLit "is not defined in module") <+> quotes (ppr main_mod)
- pp_main_fn | main_fn == main_RDR_Unqual = ptext (sLit "function") <+> quotes (ppr main_fn)
- | otherwise = ptext (sLit "main function") <+> quotes (ppr main_fn)
+ pp_main_fn = ppMainFn main_fn
+
+ppMainFn main_fn
+ | main_fn == main_RDR_Unqual
+ = ptext (sLit "function") <+> quotes (ppr main_fn)
+ | otherwise
+ = ptext (sLit "main function") <+> quotes (ppr main_fn)
-- | Get the unqualified name of the function to use as the \"main\" for the main module.
-- Either returns the default name or the one configured on the command line with -main-is
getMainFun dflags = case (mainFunIs dflags) of
Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
Nothing -> main_RDR_Unqual
+
+checkMainExported :: TcGblEnv -> TcM ()
+checkMainExported tcg_env = do
+ dflags <- getDOpts
+ case tcg_main tcg_env of
+ Nothing -> return () -- not the main module
+ Just main_name -> do
+ let main_mod = mainModIs dflags
+ checkTc (main_name `elem` concatMap availNames (tcg_exports tcg_env)) $
+ ptext (sLit "The") <+> ppMainFn (nameRdrName main_name) <+>
+ ptext (sLit "is not exported by module") <+> quotes (ppr main_mod)
\end{code}
Note [Root-main Id]
-> Name
-> IO (Messages, Maybe (TyThing, Fixity, [Instance]))
--- Used to implemnent :info in GHCi
+-- Used to implement :info in GHCi
--
-- Look up a RdrName and return all the TyThings it might be
-- A capitalised RdrName is given to us in the DataName namespace,
where
le_sig tycon1 tycon2 = getOccName tycon1 <= getOccName tycon2
ppr_tycon tycon
- | isCoercionTyCon tycon = ptext (sLit "coercion") <+> ppr tycon
+ | isCoercionTyCon tycon
+ = sep [ptext (sLit "coercion") <+> ppr tycon <+> ppr tvs
+ , nest 2 (dcolon <+> pprEqPred (coercionKind (mkTyConApp tycon (mkTyVarTys tvs))))]
| otherwise = ppr (tyThingToIfaceDecl (ATyCon tycon))
+ where
+ tvs = take (tyConArity tycon) alphaTyVars
ppr_rules :: [CoreRule] -> SDoc
ppr_rules [] = empty