Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
58e4f838
Commit
58e4f838
authored
Apr 15, 2013
by
Simon Peyton Jones
Browse files
Improve the "main is not defined in Main" message a bit further
parent
1aa7ae3f
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/typecheck/TcRnDriver.lhs
View file @
58e4f838
...
...
@@ -1099,32 +1099,36 @@ check_main dflags tcg_env
<+> ptext (sLit "is not defined in module") <+> quotes (ppr main_mod)
pp_main_fn = ppMainFn 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 :: DynFlags -> RdrName
getMainFun dflags = case mainFunIs dflags of
Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
Nothing -> main_RDR_Unqual
checkMainExported :: TcGblEnv -> TcM ()
checkMainExported tcg_env
= case tcg_main tcg_env of
Nothing -> return () -- not the main module
Just main_name ->
do { dflags <- getDynFlags
; 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) }
ppMainFn :: RdrName -> SDoc
ppMainFn main_fn
| main_fn == main
_RDR_Unqual
|
rdrNameOcc
main_fn == main
Occ
= ptext (sLit "IO action") <+> quotes (ppr main_fn)
| otherwise
= ptext (sLit "main IO action") <+> 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 :: DynFlags -> RdrName
getMainFun dflags = case (mainFunIs dflags) of
Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
Nothing -> main_RDR_Unqual
checkMainExported :: TcGblEnv -> TcM ()
checkMainExported tcg_env = do
dflags <- getDynFlags
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)
mainOcc :: OccName
mainOcc = mkVarOccFS (fsLit "main")
\end{code}
Note [Root-main Id]
~~~~~~~~~~~~~~~~~~~
The function that the RTS invokes is always :Main.main, which we call
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment