- -- top-level exception handler: any unrecognised exception is a compiler bug.
- handle (\exception -> do
- hFlush stdout
- case exception of
- -- an IO exception probably isn't our fault, so don't panic
- IOException _ -> hPutStr stderr (show exception)
- AsyncException StackOverflow ->
- hPutStrLn stderr "stack overflow: use +RTS -K<size> \
- \to increase it"
- _other -> hPutStr stderr (show (Panic (show exception)))
- exitWith (ExitFailure 1)
- ) $ do
-
- -- all error messages are propagated as exceptions
- handleDyn (\dyn -> do
- hFlush stdout
- case dyn of
- PhaseFailed _ code -> exitWith code
- Interrupted -> exitWith (ExitFailure 1)
- _ -> do hPutStrLn stderr (show (dyn :: GhcException))
- exitWith (ExitFailure 1)
- ) $ do
-
- -- make sure we clean up after ourselves
- later (do forget_it <- readIORef v_Keep_tmp_files
- unless forget_it $ do
- verb <- dynFlag verbosity
- cleanTempFiles verb
- ) $ do
- -- exceptions will be blocked while we clean the temporary files,
- -- so there shouldn't be any difficulty if we receive further
- -- signals.
-
- installSignalHandlers
-
- argv <- getArgs
- let (minusB_args, argv') = partition (prefixMatch "-B") argv
- top_dir <- initSysTools minusB_args
-
- -- Read the package configuration
- conf_file <- getPackageConfigPath
- readPackageConf conf_file
-
- -- Process all the other arguments, and get the source files
- non_static <- processArgs static_flags argv' []
- mode <- readIORef v_GhcMode
-
- -- -O and --interactive are not a good combination
- -- ditto with any kind of way selection
- orig_opt_level <- readIORef v_OptLevel
- when (orig_opt_level > 0 && mode == DoInteractive) $
- do putStr "warning: -O conflicts with --interactive; -O turned off.\n"
- writeIORef v_OptLevel 0
- orig_ways <- readIORef v_Ways
- when (notNull orig_ways && mode == DoInteractive) $
- do throwDyn (UsageError
- "--interactive can't be used with -prof, -ticky, -unreg or -smp.")
-
- -- Find the build tag, and re-process the build-specific options.
- -- Also add in flags for unregisterised compilation, if
- -- GhcUnregisterised=YES.
- way_opts <- findBuildTag
- let unreg_opts | cGhcUnregisterised == "YES" = unregFlags
- | otherwise = []
- 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
- writeIORef v_Static_hsc_opts static_opts
-
- -- build the default DynFlags (these may be adjusted on a per
- -- module basis by OPTIONS pragmas and settings in the interpreter).
-
- core_todo <- buildCoreToDo
- stg_todo <- buildStgToDo
-
- -- set the "global" HscLang. The HscLang can be further adjusted on a module
- -- by module basis, using only the -fvia-C and -fasm flags. If the global
- -- HscLang is not HscC or HscAsm, -fvia-C and -fasm have no effect.
- dyn_flags <- getDynFlags
- build_tag <- readIORef v_Build_tag
- let lang = case mode of
+ GHC.defaultErrorHandler $ do
+
+ argv0 <- getArgs
+ argv1 <- GHC.init argv0
+
+ -- 2. Parse the "mode" flags (--make, --interactive etc.)
+ (cli_mode, argv2) <- parseModeFlags argv1
+
+ let mode = case cli_mode of
+ DoInteractive -> Interactive
+ DoEval _ -> Interactive
+ DoMake -> BatchCompile
+ DoMkDependHS -> MkDepend
+ _ -> OneShot
+
+ -- start our GHC session
+ session <- GHC.newSession mode
+
+ dflags0 <- GHC.getSessionDynFlags session
+
+ -- set the default HscTarget. The HscTarget can be further
+ -- adjusted on a module by module basis, using only the -fvia-C and
+ -- -fasm flags. If the default HscTarget is not HscC or HscAsm,
+ -- -fvia-C and -fasm have no effect.
+ let lang = case cli_mode of