{-# OPTIONS -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.74 2001/06/18 21:45:49 sof Exp $
+-- $Id: Main.hs,v 1.78 2001/06/29 15:30:49 simonmar Exp $
--
-- GHC Driver program
--
getGhcMode, pipeLoop, v_GhcMode
)
import DriverState ( buildCoreToDo, buildStgToDo, defaultHscLang,
- findBuildTag, getPackageInfo, unregFlags, v_Cmdline_libraries,
- v_Keep_tmp_files, v_Ld_inputs, v_OptLevel, v_Output_file,
- v_Output_hi, v_Package_details, v_Ways
+ findBuildTag, getPackageInfo, unregFlags,
+ v_Cmdline_libraries, v_Keep_tmp_files, v_Ld_inputs,
+ v_OptLevel, v_Output_file, v_Output_hi,
+ v_Package_details, v_Ways, getPackageExtraGhcOpts
)
-import DriverFlags ( dynFlag, buildStaticHscOpts, dynamic_flags, processArgs, static_flags)
+import DriverFlags ( dynFlag, buildStaticHscOpts, dynamic_flags,
+ processArgs, static_flags)
import DriverMkDepend ( beginMkDependHS, endMkDependHS )
import DriverPhases ( Phase(Hsc, HCc), haskellish_src_file, objish_file )
-import DriverUtil ( add, handle, handleDyn, later, splitFilename, unknownFlagErr, my_prefix_match )
-import CmdLineOpts ( dynFlag, defaultDynFlags, restoreDynFlags, saveDynFlags, setDynFlags,
- DynFlags(..), HscLang(..),
- v_Static_hsc_opts
+import DriverUtil ( add, handle, handleDyn, later, splitFilename,
+ unknownFlagErr )
+import CmdLineOpts ( dynFlag, defaultDynFlags, restoreDynFlags,
+ saveDynFlags, setDynFlags,
+ DynFlags(..), HscLang(..), v_Static_hsc_opts
)
import Outputable
-import ErrUtils ( dumpIfSet )
import Util
import Panic ( GhcException(..), panic )
import IO
import Directory ( doesFileExist )
import IOExts ( readIORef, writeIORef )
-import Exception ( throwDyn, Exception(DynException) )
+import Exception ( throwDyn, Exception(..) )
import System ( getArgs, exitWith, ExitCode(..) )
import Monad
import List
#ifndef mingw32_TARGET_OS
import Concurrent ( myThreadId )
-#ifdef __GLASGOW_HASKELL__ < 500
+#if __GLASGOW_HASKELL__ < 500
import Exception ( raiseInThread )
#define throwTo raiseInThread
#else
main =
-- top-level exception handler: any unrecognised exception is a compiler bug.
- handle (\exception -> do hPutStr stderr (show (Panic (show exception)))
- exitWith (ExitFailure 1)
+ handle (\exception -> do
+ case exception of
+ -- an IO exception probably isn't our fault, so don't panic
+ IOException _ -> hPutStr stderr (show exception)
+ _other -> hPutStr stderr (show (Panic (show exception)))
+ exitWith (ExitFailure 1)
) $ do
-- all error messages are propagated as exceptions
way_opts <- findBuildTag
let unreg_opts | cGhcUnregisterised == "YES" = unregFlags
| otherwise = []
- way_non_static <- processArgs static_flags (unreg_opts ++ way_opts) []
+ pkg_extra_opts <- getPackageExtraGhcOpts
+ extra_non_static <- processArgs static_flags
+ (unreg_opts ++ way_opts ++ pkg_extra_opts) []
-- give the static flags to hsc
static_opts <- buildStaticHscOpts
})
-- the rest of the arguments are "dynamic"
- srcs <- processArgs dynamic_flags (way_non_static ++ non_static) []
+ srcs <- processArgs dynamic_flags (extra_non_static ++ non_static) []
-- save the "initial DynFlags" away
saveDynFlags
case mods of
[] -> throwDyn (UsageError "no input files")
- [mod] -> do state <- cmInit Batch
- cmLoadModule state mod
+ mod -> do state <- cmInit Batch
+ cmLoadModule state mods
return ()
- _ -> throwDyn (UsageError "only one module allowed with --make")
beginInteractive :: [String] -> IO ()
libs = map Left objs ++ map Right minus_ls
state <- cmInit Interactive
- case mods of
- [] -> interactiveUI state Nothing libs
- [mod] -> interactiveUI state (Just mod) libs
- _ -> throwDyn (UsageError
- "only one module allowed with --interactive")
+ interactiveUI state mods libs
#endif