ghc/compiler/main/Main.hs

   1 {-# OPTIONS -W -fno-warn-incomplete-patterns #-}
   2 -----------------------------------------------------------------------------
   3 -- $Id: Main.hs,v 1.13 2000/10/27 13:50:25 sewardj Exp $
   4 --
   5 -- GHC Driver program
   6 --
   7 -- (c) Simon Marlow 2000
   8 --
   9 -----------------------------------------------------------------------------
  10
  11 -- with path so that ghc -M can find config.h
  12 #include "../includes/config.h"
  13
  14 module Main (main) where
  15
  16 #include "HsVersions.h"
  17
  18 import DriverPipeline
  19 import DriverState
  20 import DriverFlags
  21 import DriverMkDepend
  22 import DriverUtil
  23 import DriverPhases     ( Phase(..) )
  24 import CmdLineOpts      ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
  25 import TmpFiles
  26 import Finder           ( initFinder )
  27 import CmStaticInfo     ( mkPCI )
  28 import Config
  29 import Util
  30 import Panic
  31
  32 import Concurrent
  33 #ifndef mingw32_TARGET_OS
  34 import Posix
  35 #endif
  36 import Directory
  37 import IOExts
  38 import Exception
  39 import Dynamic
  40
  41 import IO
  42 import Monad
  43 import List
  44 import System
  45 import Maybe
  46
  47
  48 -----------------------------------------------------------------------------
  49 -- Changes:
  50
  51 -- * -fglasgow-exts NO LONGER IMPLIES -package lang!!!  (-fglasgow-exts is a
  52 --   dynamic flag whereas -package is a static flag.)
  53
  54 -----------------------------------------------------------------------------
  55 -- ToDo:
  56
  57 -- new mkdependHS doesn't support all the options that the old one did (-X et al.)
  58 -- time commands when run with -v
  59 -- split marker
  60 -- mkDLL
  61 -- java generation
  62 -- user ways
  63 -- Win32 support: proper signal handling
  64 -- make sure OPTIONS in .hs file propogate to .hc file if -C or -keep-hc-file-too
  65 -- reading the package configuration file is too slow
  66 -- -H, -K, -Rghc-timing
  67 -- hi-diffs
  68
  69 -----------------------------------------------------------------------------
  70 -- Differences vs. old driver:
  71
  72 -- No more "Enter your Haskell program, end with ^D (on a line of its own):"
  73 -- consistency checking removed (may do this properly later)
  74 -- removed -noC
  75 -- no hi diffs (could be added later)
  76 -- no -Ofile
  77
  78 -----------------------------------------------------------------------------
  79 -- Main loop
  80
  81 main =
  82   -- all error messages are propagated as exceptions
  83   handleDyn (\dyn -> case dyn of
  84                           PhaseFailed _phase code -> exitWith code
  85                           Interrupted -> exitWith (ExitFailure 1)
  86                           _ -> do hPutStrLn stderr (show (dyn :: BarfKind))
  87                                   exitWith (ExitFailure 1)
  88               ) $ do
  89
  90    -- make sure we clean up after ourselves
  91    later (do  forget_it <- readIORef v_Keep_tmp_files
  92               unless forget_it $ do
  93               verb <- readIORef v_Verbose
  94               cleanTempFiles verb
  95      ) $ do
  96         -- exceptions will be blocked while we clean the temporary files,
  97         -- so there shouldn't be any difficulty if we receive further
  98         -- signals.
  99
 100         -- install signal handlers
 101    main_thread <- myThreadId
 102 #ifndef mingw32_TARGET_OS
 103    let sig_handler = Catch (throwTo main_thread
 104                                 (DynException (toDyn Interrupted)))
 105    installHandler sigQUIT sig_handler Nothing
 106    installHandler sigINT  sig_handler Nothing
 107 #endif
 108
 109    pgm    <- getProgName
 110    writeIORef v_Prog_name pgm
 111
 112    argv   <- getArgs
 113
 114         -- grab any -B options from the command line first
 115    argv'  <- setTopDir argv
 116    top_dir <- readIORef v_TopDir
 117
 118    let installed s = top_dir ++ '/':s
 119        inplace s   = top_dir ++ '/':cCURRENT_DIR ++ '/':s
 120
 121        installed_pkgconfig = installed ("package.conf")
 122        inplace_pkgconfig   = inplace (cGHC_DRIVER_DIR ++ "/package.conf.inplace")
 123
 124         -- discover whether we're running in a build tree or in an installation,
 125         -- by looking for the package configuration file.
 126    am_installed <- doesFileExist installed_pkgconfig
 127
 128    if am_installed
 129         then writeIORef v_Path_package_config installed_pkgconfig
 130         else do am_inplace <- doesFileExist inplace_pkgconfig
 131                 if am_inplace
 132                     then writeIORef v_Path_package_config inplace_pkgconfig
 133                     else throwDyn (OtherError "can't find package.conf")
 134
 135         -- set the location of our various files
 136    if am_installed
 137         then do writeIORef v_Path_usage (installed "ghc-usage.txt")
 138                 writeIORef v_Pgm_L (installed "unlit")
 139                 writeIORef v_Pgm_m (installed "ghc-asm")
 140                 writeIORef v_Pgm_s (installed "ghc-split")
 141
 142         else do writeIORef v_Path_usage (inplace (cGHC_DRIVER_DIR ++ "/ghc-usage.txt"))
 143                 writeIORef v_Pgm_L (inplace cGHC_UNLIT)
 144                 writeIORef v_Pgm_m (inplace cGHC_MANGLER)
 145                 writeIORef v_Pgm_s (inplace cGHC_SPLIT)
 146
 147         -- read the package configuration
 148    conf_file <- readIORef v_Path_package_config
 149    contents <- readFile conf_file
 150    writeIORef v_Package_details (read contents)
 151
 152         -- find the phase to stop after (i.e. -E, -C, -c, -S flags)
 153    (flags2, mode, stop_flag) <- getGhcMode argv'
 154    writeIORef v_GhcMode mode
 155
 156         -- force lang to "C" if the -C flag was given
 157    case mode of StopBefore HCc -> writeIORef v_Hsc_Lang HscC
 158                 _ -> return ()
 159
 160         -- process all the other arguments, and get the source files
 161    non_static <- processArgs static_flags flags2 []
 162
 163         -- find the build tag, and re-process the build-specific options
 164    more_opts <- findBuildTag
 165    _ <- processArgs static_flags more_opts []
 166
 167         -- give the static flags to hsc
 168    static_opts <- buildStaticHscOpts
 169    writeIORef v_Static_hsc_opts static_opts
 170
 171         -- warnings
 172    warn_level <- readIORef v_Warning_opt
 173
 174    let warn_opts =  case warn_level of
 175                         W_default -> standardWarnings
 176                         W_        -> minusWOpts
 177                         W_all     -> minusWallOpts
 178                         W_not     -> []
 179
 180         -- build the default DynFlags (these may be adjusted on a per
 181         -- module basis by OPTIONS pragmas and settings in the interpreter).
 182
 183    core_todo <- buildCoreToDo
 184    stg_todo  <- buildStgToDo
 185
 186    lang <- readIORef v_Hsc_Lang
 187    writeIORef v_DynFlags
 188         DynFlags{ coreToDo = core_todo,
 189                   stgToDo  = stg_todo,
 190                   hscLang  = lang,
 191                   -- leave out hscOutName for now
 192                   flags = [] }
 193
 194         -- the rest of the arguments are "dynamic"
 195    srcs <- processArgs dynamic_flags non_static []
 196         -- save the "initial DynFlags" away
 197    dyn_flags <- readIORef v_DynFlags
 198    writeIORef v_InitDynFlags dyn_flags
 199
 200         -- complain about any unknown flags
 201    let unknown_flags = [ f | ('-':f) <- srcs ]
 202    mapM unknownFlagErr unknown_flags
 203
 204         -- get the -v flag
 205    verb <- readIORef v_Verbose
 206
 207    when verb (do hPutStr stderr "Glasgow Haskell Compiler, Version "
 208                  hPutStr stderr version_str
 209                  hPutStr stderr ", for Haskell 98, compiled by GHC version "
 210                  hPutStrLn stderr booter_version)
 211
 212    when verb (hPutStrLn stderr ("Using package config file: " ++ conf_file))
 213
 214         -- initialise the finder
 215    pkg_details <- readIORef v_Package_details
 216    pci         <- mkPCI pkg_details
 217    initFinder pci
 218
 219         -- mkdependHS is special
 220    when (mode == DoMkDependHS) beginMkDependHS
 221
 222         -- make is special
 223    when (mode == DoMake) beginMake
 224
 225         -- for each source file, find which phases to run
 226    pipelines <- mapM (genPipeline mode stop_flag) srcs
 227    let src_pipelines = zip srcs pipelines
 228
 229    o_file <- readIORef v_Output_file
 230    if isJust o_file && mode /= DoLink && length srcs > 1
 231         then throwDyn (UsageError "can't apply -o option to multiple source files")
 232         else do
 233
 234    if null srcs then throwDyn (UsageError "no input files") else do
 235
 236         -- save the flag state, because this could be modified by OPTIONS pragmas
 237         -- during the compilation, and we'll need to restore it before starting
 238         -- the next compilation.
 239    saved_driver_state <- readIORef v_Driver_state
 240
 241    let compileFile (src, phases) = do
 242           r <- runPipeline phases src (mode==DoLink) True
 243           writeIORef v_Driver_state saved_driver_state
 244           return r
 245
 246    o_files <- mapM compileFile src_pipelines
 247
 248    when (mode == DoMkDependHS) endMkDependHS
 249    when (mode == DoLink) (doLink o_files)
 250
 251         -- grab the last -B option on the command line, and
 252         -- set topDir to its value.
 253 setTopDir :: [String] -> IO [String]
 254 setTopDir args = do
 255   let (minusbs, others) = partition (prefixMatch "-B") args
 256   (case minusbs of
 257     []   -> writeIORef v_TopDir clibdir
 258     some -> writeIORef v_TopDir (drop 2 (last some)))
 259   return others
 260
 261 beginMake = panic "`ghc --make' unimplemented"