[project @ 2000-11-14 10:46:39 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / Main.hs

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 1831200..83c8ea6 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -W -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.13 2000/10/27 13:50:25 sewardj Exp $
+-- $Id: Main.hs,v 1.20 2000/11/13 12:43:20 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -15,6 +15,7 @@ module Main (main) where
 
 #include "HsVersions.h"
 
+import CompManager
 import DriverPipeline
 import DriverState
 import DriverFlags
@@ -22,9 +23,10 @@ import DriverMkDepend
 import DriverUtil
 import DriverPhases    ( Phase(..) )
 import CmdLineOpts     ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
+import Module          ( mkModuleName )
 import TmpFiles
 import Finder          ( initFinder )
-import CmStaticInfo    ( mkPCI )
+import CmStaticInfo
 import Config
 import Util
 import Panic
@@ -54,6 +56,7 @@ import Maybe
 -----------------------------------------------------------------------------
 -- ToDo:
 
+-- -nohi doesn't work
 -- new mkdependHS doesn't support all the options that the old one did (-X et al.)
 -- time commands when run with -v
 -- split marker
@@ -147,7 +150,8 @@ main =
        -- read the package configuration
    conf_file <- readIORef v_Path_package_config
    contents <- readFile conf_file
-   writeIORef v_Package_details (read contents)
+   let pkg_details = read contents     -- ToDo: faster
+   writeIORef v_Package_details pkg_details
 
        -- find the phase to stop after (i.e. -E, -C, -c, -S flags)
    (flags2, mode, stop_flag) <- getGhcMode argv'
@@ -162,8 +166,8 @@ main =
 
        -- find the build tag, and re-process the build-specific options
    more_opts <- findBuildTag
-   _ <- processArgs static_flags more_opts []
- 
+   way_non_static <- processArgs static_flags more_opts []
+
        -- give the static flags to hsc
    static_opts <- buildStaticHscOpts
    writeIORef v_Static_hsc_opts static_opts
@@ -192,55 +196,57 @@ main =
                  flags = [] }
 
        -- the rest of the arguments are "dynamic"
-   srcs <- processArgs dynamic_flags non_static []
+   srcs <- processArgs dynamic_flags (way_non_static ++ 
+                                       non_static ++ warn_opts) []
        -- save the "initial DynFlags" away
-   dyn_flags <- readIORef v_DynFlags
-   writeIORef v_InitDynFlags dyn_flags
+   init_dyn_flags <- readIORef v_DynFlags
+   writeIORef v_InitDynFlags init_dyn_flags
 
        -- complain about any unknown flags
-   let unknown_flags = [ f | ('-':f) <- srcs ]
-   mapM unknownFlagErr unknown_flags
+   mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
 
        -- get the -v flag
    verb <- readIORef v_Verbose
 
    when verb (do hPutStr stderr "Glasgow Haskell Compiler, Version "
-                hPutStr stderr version_str
+                hPutStr stderr cProjectVersion
                 hPutStr stderr ", for Haskell 98, compiled by GHC version "
-                hPutStrLn stderr booter_version)
+                hPutStrLn stderr cBooterVersion)
 
    when verb (hPutStrLn stderr ("Using package config file: " ++ conf_file))
 
        -- initialise the finder
-   pkg_details <- readIORef v_Package_details
-   pci         <- mkPCI pkg_details
-   initFinder pci
+   initFinder pkg_details
 
        -- mkdependHS is special
    when (mode == DoMkDependHS) beginMkDependHS
 
-       -- make is special
-   when (mode == DoMake) beginMake
+       -- make/interactive require invoking the compilation manager
+   if (mode == DoMake)        then beginMake pkg_details srcs else do
+   if (mode == DoInteractive) then beginInteractive srcs      else do
 
        -- for each source file, find which phases to run
-   pipelines <- mapM (genPipeline mode stop_flag) srcs
+   pipelines <- mapM (genPipeline mode stop_flag True) srcs
    let src_pipelines = zip srcs pipelines
 
+       -- sanity checking
    o_file <- readIORef v_Output_file
-   if isJust o_file && mode /= DoLink && length srcs > 1
-       then throwDyn (UsageError "can't apply -o option to multiple source files")
+   ohi    <- readIORef v_Output_hi
+   if length srcs > 1 && (isJust ohi || (isJust o_file && mode /= DoLink))
+       then throwDyn (UsageError "can't apply -o or -ohi options to multiple source files")
        else do
 
    if null srcs then throwDyn (UsageError "no input files") else do
 
-       -- save the flag state, because this could be modified by OPTIONS pragmas
-       -- during the compilation, and we'll need to restore it before starting
-       -- the next compilation.
+       -- save the flag state, because this could be modified by OPTIONS 
+       -- pragmas during the compilation, and we'll need to restore it
+       -- before starting the next compilation.
    saved_driver_state <- readIORef v_Driver_state
 
    let compileFile (src, phases) = do
-         r <- runPipeline phases src (mode==DoLink) True
          writeIORef v_Driver_state saved_driver_state
+         writeIORef v_DynFlags init_dyn_flags
+         r <- runPipeline phases src (mode==DoLink) True
          return r
 
    o_files <- mapM compileFile src_pipelines
@@ -258,4 +264,15 @@ setTopDir args = do
     some -> writeIORef v_TopDir (drop 2 (last some)))
   return others
 
-beginMake = panic "`ghc --make' unimplemented"
+beginMake :: PackageConfigInfo -> [String] -> IO ()
+beginMake pkg_details mods
+   | null mods
+   = throwDyn (UsageError "no input files")
+   | not (null (tail mods))
+   = throwDyn (UsageError "only one module allowed with --make")
+   | otherwise
+   = do state <- cmInit pkg_details
+        cmLoadModule state (mkModuleName (head mods))
+        return ()
+
+beginInteractive srcs = panic "`ghc --interactive' unimplemented"