X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=298107cae26994f043741890ba2112f46381d9c8;hb=06fa575f4b4c51ab48fc4e7f5bd512b8c30325f9;hp=03ab8a596ec8d96b03377258f6f734c2a5afdedd;hpb=d254a44b8392ff0a4327f1916ef921887ce78769;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 03ab8a5..298107c 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.104 2002/04/05 23:24:29 sof Exp $ +-- $Id: Main.hs,v 1.114 2002/10/25 16:54:59 simonpj Exp $ -- -- GHC Driver program -- @@ -18,7 +18,8 @@ module Main (main) where #ifdef GHCI -import InteractiveUI(ghciWelcomeMsg, interactiveUI) +import InteractiveUI +import DriverPhases( objish_file ) #endif @@ -29,20 +30,20 @@ import Config ( cBooterVersion, cGhcUnregisterised, cProjectVersion ) import SysTools ( getPackageConfigPath, initSysTools, cleanTempFiles ) import Packages ( showPackages ) -import DriverPipeline ( doLink, doMkDLL, genPipeline, pipeLoop ) +import DriverPipeline ( staticLink, doMkDLL, genPipeline, pipeLoop ) import DriverState ( buildCoreToDo, buildStgToDo, - findBuildTag, getPackageInfo, unregFlags, + findBuildTag, getPackageInfo, getPackageConfigMap, + getPackageExtraGhcOpts, unregFlags, v_GhcMode, v_GhcModeFlag, GhcMode(..), - v_Cmdline_libraries, v_Keep_tmp_files, v_Ld_inputs, + v_Keep_tmp_files, v_Ld_inputs, v_Ways, v_OptLevel, v_Output_file, v_Output_hi, - v_Package_details, v_Ways, getPackageExtraGhcOpts, readPackageConf, verifyOutputFiles ) import DriverFlags ( buildStaticHscOpts, dynamic_flags, processArgs, static_flags) import DriverMkDepend ( beginMkDependHS, endMkDependHS ) -import DriverPhases ( Phase(HsPp, Hsc), haskellish_src_file, objish_file ) +import DriverPhases ( Phase(HsPp, Hsc), haskellish_src_file, isSourceFile ) import DriverUtil ( add, handle, handleDyn, later, splitFilename, unknownFlagsErr, getFileSuffix ) @@ -51,34 +52,41 @@ import CmdLineOpts ( dynFlag, restoreDynFlags, DynFlags(..), HscLang(..), v_Static_hsc_opts, defaultHscLang ) +import BasicTypes ( failed ) import Outputable import Util import Panic ( GhcException(..), panic ) --- Standard Haskell libraries -import IO -import Directory ( doesFileExist ) -import IOExts ( readIORef, writeIORef ) -import Exception ( throwDyn, Exception(..), +import DATA_IOREF ( readIORef, writeIORef ) +import EXCEPTION ( throwDyn, Exception(..), AsyncException(StackOverflow) ) -import System ( getArgs, exitWith, ExitCode(..) ) -import Monad -import List -import Maybe #ifndef mingw32_HOST_OS -import Concurrent ( myThreadId ) +import CONCURRENT ( myThreadId ) # if __GLASGOW_HASKELL__ < 500 -import Exception ( raiseInThread ) +import EXCEPTION ( raiseInThread ) #define throwTo raiseInThread # else -import Exception ( throwTo ) +import EXCEPTION ( throwTo ) # endif +#if __GLASGOW_HASKELL__ > 504 +import System.Posix.Signals +#else import Posix ( Handler(Catch), installHandler, sigINT, sigQUIT ) -import Dynamic ( toDyn ) #endif +import DYNAMIC ( toDyn ) +#endif + +-- Standard Haskell libraries +import IO +import Directory ( doesFileExist ) +import System ( getArgs, exitWith, ExitCode(..) ) +import Monad +import List +import Maybe + ----------------------------------------------------------------------------- -- ToDo: @@ -232,7 +240,7 @@ main = when (verb >= 2) (hPutStrLn stderr ("Using package config file: " ++ conf_file)) - pkg_details <- readIORef v_Package_details + pkg_details <- getPackageConfigMap showPackages pkg_details when (verb >= 3) @@ -257,8 +265,9 @@ main = if (mode == DoInteractive) then beginInteractive srcs else do -- -o sanity checking + let real_srcs = filter isSourceFile srcs -- filters out .a and .o that might appear o_file <- readIORef v_Output_file - if (srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL) + if (real_srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL) then throwDyn (UsageError "can't apply -o to multiple source files") else do @@ -280,19 +289,15 @@ main = let not_hs_file = not (haskellish_src_file src) pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp then return src_and_suff else do --- hPutStrLn stderr "before" >> hFlush stderr phases <- genPipeline (StopBefore Hsc) stop_flag False{-not persistent-} defaultHscLang src_and_suff --- hPutStrLn stderr "after" >> hFlush stderr pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-} basename suffix -- rest of compilation hsc_lang <- dynFlag hscLang --- hPutStrLn stderr ("before-1 " ++ show (pp,mode)) >> hFlush stderr phases <- genPipeline mode stop_flag True hsc_lang pp --- hPutStrLn stderr "after" >> hFlush stderr (r,_) <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL) True{-use -o flag-} basename suffix return r @@ -300,24 +305,28 @@ main = o_files <- mapM compileFile srcs when (mode == DoMkDependHS) endMkDependHS - when (mode == DoLink) (doLink o_files) + when (mode == DoLink) (staticLink o_files) when (mode == DoMkDLL) (doMkDLL o_files) beginMake :: [String] -> IO () -beginMake fileish_args - = do let (objs, mods) = partition objish_file fileish_args - mapM (add v_Ld_inputs) objs - - case mods of - [] -> throwDyn (UsageError "no input files") - _ -> do dflags <- getDynFlags - state <- cmInit Batch - graph <- cmDepAnal state dflags mods - (_, ok, _) <- cmLoadModules state dflags graph - when (not ok) (exitWith (ExitFailure 1)) - return () +beginMake fileish_args = do + -- anything that doesn't look like a Haskell source filename or + -- a module name is passed straight through to the linker + let (inputs, objects) = partition looks_like_an_input fileish_args + mapM_ (add v_Ld_inputs) objects + + case inputs of + [] -> throwDyn (UsageError "no input files") + _ -> do dflags <- getDynFlags + state <- cmInit Batch + graph <- cmDepAnal state dflags inputs + (_, ok_flag, _) <- cmLoadModules state dflags graph + when (failed ok_flag) (exitWith (ExitFailure 1)) + return () + where + looks_like_an_input m = haskellish_src_file m || '.' `notElem` m beginInteractive :: [String] -> IO () @@ -325,13 +334,11 @@ beginInteractive :: [String] -> IO () beginInteractive = throwDyn (CmdLineError "not built for interactive use") #else beginInteractive fileish_args - = do minus_ls <- readIORef v_Cmdline_libraries + = do state <- cmInit Interactive let (objs, mods) = partition objish_file fileish_args - libs = map Left objs ++ map Right minus_ls - state <- cmInit Interactive - interactiveUI state mods libs + interactiveUI state mods objs #endif checkOptions :: [String] -> IO ()