Check whether the main function is actually exported (#414)
[ghc-hetmet.git] / compiler / typecheck / TcRnMonad.lhs
index ad74133..f4b9131 100644 (file)
@@ -115,7 +115,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
                tcg_dfun_n   = dfun_n_var,
                tcg_keep     = keep_var,
                tcg_doc_hdr  = Nothing,
                tcg_dfun_n   = dfun_n_var,
                tcg_keep     = keep_var,
                tcg_doc_hdr  = Nothing,
-                tcg_hpc      = False
+                tcg_hpc      = False,
+                tcg_main     = Nothing
             } ;
             lcl_env = TcLclEnv {
                tcl_errs       = errs_var,
             } ;
             lcl_env = TcLclEnv {
                tcl_errs       = errs_var,
@@ -454,6 +455,7 @@ wrapLocSndM fn (L loc a) =
     return (b, L loc c)
 \end{code}
 
     return (b, L loc c)
 \end{code}
 
+Reporting errors
 
 \begin{code}
 getErrsVar :: TcRn (TcRef Messages)
 
 \begin{code}
 getErrsVar :: TcRn (TcRef Messages)
@@ -468,49 +470,26 @@ addErr msg = do { loc <- getSrcSpanM ; addErrAt loc msg }
 failWith :: Message -> TcRn a
 failWith msg = addErr msg >> failM
 
 failWith :: Message -> TcRn a
 failWith msg = addErr msg >> failM
 
-addLocErr :: Located e -> (e -> Message) -> TcRn ()
-addLocErr (L loc e) fn = addErrAt loc (fn e)
-
 addErrAt :: SrcSpan -> Message -> TcRn ()
 addErrAt :: SrcSpan -> Message -> TcRn ()
-addErrAt loc msg = addLongErrAt loc msg empty
-
-addLongErrAt :: SrcSpan -> Message -> Message -> TcRn ()
-addLongErrAt loc msg extra
-  = do { traceTc (ptext (sLit "Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ;        
-        errs_var <- getErrsVar ;
-        rdr_env <- getGlobalRdrEnv ;
-         dflags <- getDOpts ;
-        let { err = mkLongErrMsg loc (mkPrintUnqualified dflags rdr_env) msg extra } ;
-        (warns, errs) <- readMutVar errs_var ;
-        writeMutVar errs_var (warns, errs `snocBag` err) }
+-- addErrAt is mainly (exclusively?) used by the renamer, where
+-- tidying is not an issue, but it's all lazy so the extra
+-- work doesn't matter
+addErrAt loc msg = do { ctxt <- getErrCtxt 
+                     ; tidy_env <- tcInitTidyEnv
+                      ; err_info <- mkErrInfo tidy_env ctxt
+                     ; addLongErrAt loc msg err_info }
 
 addErrs :: [(SrcSpan,Message)] -> TcRn ()
 addErrs msgs = mapM_ add msgs
             where
               add (loc,msg) = addErrAt loc msg
 
 
 addErrs :: [(SrcSpan,Message)] -> TcRn ()
 addErrs msgs = mapM_ add msgs
             where
               add (loc,msg) = addErrAt loc msg
 
-addReport :: Message -> Message -> TcRn ()
-addReport msg extra_info = do loc <- getSrcSpanM; addReportAt loc msg extra_info
-
-addReportAt :: SrcSpan -> Message -> Message -> TcRn ()
-addReportAt loc msg extra_info
-  = do { errs_var <- getErrsVar ;
-        rdr_env <- getGlobalRdrEnv ;
-         dflags <- getDOpts ;
-        let { warn = mkLongWarnMsg loc (mkPrintUnqualified dflags rdr_env)
-                                   msg extra_info } ;
-        (warns, errs) <- readMutVar errs_var ;
-        writeMutVar errs_var (warns `snocBag` warn, errs) }
-
 addWarn :: Message -> TcRn ()
 addWarn msg = addReport (ptext (sLit "Warning:") <+> msg) empty
 
 addWarnAt :: SrcSpan -> Message -> TcRn ()
 addWarnAt loc msg = addReportAt loc (ptext (sLit "Warning:") <+> msg) empty
 
 addWarn :: Message -> TcRn ()
 addWarn msg = addReport (ptext (sLit "Warning:") <+> msg) empty
 
 addWarnAt :: SrcSpan -> Message -> TcRn ()
 addWarnAt loc msg = addReportAt loc (ptext (sLit "Warning:") <+> msg) empty
 
-addLocWarn :: Located e -> (e -> Message) -> TcRn ()
-addLocWarn (L loc e) fn = addReportAt loc (fn e) empty
-
 checkErr :: Bool -> Message -> TcRn ()
 -- Add the error if the bool is False
 checkErr ok msg = unless ok (addErr msg)
 checkErr :: Bool -> Message -> TcRn ()
 -- Add the error if the bool is False
 checkErr ok msg = unless ok (addErr msg)
@@ -542,6 +521,38 @@ discardWarnings thing_inside
 \end{code}
 
 
 \end{code}
 
 
+%************************************************************************
+%*                                                                     *
+       Shared error message stuff: renamer and typechecker
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+addReport :: Message -> Message -> TcRn ()
+addReport msg extra_info = do loc <- getSrcSpanM; addReportAt loc msg extra_info
+
+addReportAt :: SrcSpan -> Message -> Message -> TcRn ()
+addReportAt loc msg extra_info
+  = do { errs_var <- getErrsVar ;
+        rdr_env <- getGlobalRdrEnv ;
+         dflags <- getDOpts ;
+        let { warn = mkLongWarnMsg loc (mkPrintUnqualified dflags rdr_env)
+                                   msg extra_info } ;
+        (warns, errs) <- readMutVar errs_var ;
+        writeMutVar errs_var (warns `snocBag` warn, errs) }
+
+addLongErrAt :: SrcSpan -> Message -> Message -> TcRn ()
+addLongErrAt loc msg extra
+  = do { traceTc (ptext (sLit "Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ;        
+        errs_var <- getErrsVar ;
+        rdr_env <- getGlobalRdrEnv ;
+         dflags <- getDOpts ;
+        let { err = mkLongErrMsg loc (mkPrintUnqualified dflags rdr_env) msg extra } ;
+        (warns, errs) <- readMutVar errs_var ;
+        writeMutVar errs_var (warns, errs `snocBag` err) }
+\end{code}
+
+
 \begin{code}
 try_m :: TcRn r -> TcRn (Either IOEnvFailure r)
 -- Does try_m, with a debug-trace on failure
 \begin{code}
 try_m :: TcRn r -> TcRn (Either IOEnvFailure r)
 -- Does try_m, with a debug-trace on failure
@@ -674,8 +685,7 @@ failIfErrsM = ifErrsM failM (return ())
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
-       Context management and error message generation
-                   for the type checker
+       Context management for the type checker
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
@@ -720,6 +730,12 @@ setInstCtxt (InstLoc _ src_loc ctxt) thing_inside
   = setSrcSpan src_loc (setErrCtxt ctxt thing_inside)
 \end{code}
 
   = setSrcSpan src_loc (setErrCtxt ctxt thing_inside)
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+            Error message generation (type checker)
+%*                                                                     *
+%************************************************************************
+
     The addErrTc functions add an error message, but do not cause failure.
     The 'M' variants pass a TidyEnv that has already been used to
     tidy up the message; we then use it to tidy the context messages
     The addErrTc functions add an error message, but do not cause failure.
     The 'M' variants pass a TidyEnv that has already been used to
     tidy up the message; we then use it to tidy the context messages