[project @ 2000-11-16 11:39:36 by simonmar]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index d81b9fe..8283eb5 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.17 2000/11/03 10:42:39 simonmar Exp $
+-- $Id: Main.hs,v 1.23 2000/11/16 11:39:37 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -16,19 +16,21 @@ module Main (main) where
 #include "HsVersions.h"
 
 import CompManager
+import InteractiveUI
 import DriverPipeline
 import DriverState
 import DriverFlags
 import DriverMkDepend
 import DriverUtil
+import Panic
 import DriverPhases    ( Phase(..) )
 import CmdLineOpts     ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
+import Module          ( mkModuleName )
 import TmpFiles
 import Finder          ( initFinder )
 import CmStaticInfo
 import Config
 import Util
-import Panic
 
 import Concurrent
 #ifndef mingw32_TARGET_OS
@@ -156,10 +158,6 @@ main =
    (flags2, mode, stop_flag) <- getGhcMode argv'
    writeIORef v_GhcMode mode
 
-       -- force lang to "C" if the -C flag was given
-   case mode of StopBefore HCc -> writeIORef v_Hsc_Lang HscC
-               _ -> return ()
-
        -- process all the other arguments, and get the source files
    non_static <- processArgs static_flags flags2 []
 
@@ -186,12 +184,22 @@ main =
    core_todo <- buildCoreToDo
    stg_todo  <- buildStgToDo
 
-   lang <- readIORef v_Hsc_Lang
+   -- 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.
+   opt_level  <- readIORef v_OptLevel
+   let lang = case mode of 
+                StopBefore HCc -> HscC
+                DoInteractive  -> HscInterpreted
+                _other        | opt_level >= 1  -> HscC  -- -O implies -fvia-C 
+                              | otherwise       -> defaultHscLang
+
    writeIORef v_DynFlags 
        DynFlags{ coreToDo = core_todo,
                  stgToDo  = stg_todo,
                   hscLang  = lang,
                  -- leave out hscOutName for now
+                  hscOutName = panic "Main.main:hscOutName not set",
                  flags = [] }
 
        -- the rest of the arguments are "dynamic"
@@ -208,9 +216,9 @@ main =
    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))
 
@@ -221,16 +229,19 @@ main =
    when (mode == DoMkDependHS) beginMkDependHS
 
        -- make/interactive require invoking the compilation manager
-   if (mode == DoMake)        then beginMake srcs        else do
-   if (mode == DoInteractive) then beginInteractive srcs else do
+   if (mode == DoMake)        then beginMake pkg_details srcs        else do
+   if (mode == DoInteractive) then beginInteractive pkg_details srcs else do
 
        -- for each source file, find which phases to run
-   pipelines <- mapM (genPipeline mode stop_flag) srcs
+   let lang = hscLang init_dyn_flags
+   pipelines <- mapM (genPipeline mode stop_flag True lang) 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
@@ -261,12 +272,22 @@ setTopDir args = do
     some -> writeIORef v_TopDir (drop 2 (last some)))
   return others
 
-beginMake [] = throwDyn (UsageError "no input files")
-beginMake (_:_:_) = throwDyn (UsageError "only one module allowed with --make")
-{-
-beginMake [mod] = do
-  state <- cmInit ""{-ToDo:remove-} pkg_details
-  cmLoadModule state (mkModuleName mod)
--}
+beginMake :: PackageConfigInfo -> [String] -> IO ()
+beginMake pkg_details mods
+  = do case mods of
+        []    -> throwDyn (UsageError "no input files")
+        [mod] -> do state <- cmInit pkg_details Batch
+                    cmLoadModule state (mkModuleName mod)
+                    return ()
+        _     -> throwDyn (UsageError "only one module allowed with --make")
+
+beginInteractive pkg_details mods
+  = do state <- cmInit pkg_details Interactive
+       case mods of
+          []    -> return ()
+          [mod] -> do cmLoadModule state (mkModuleName mod); return ()
+          _     -> throwDyn (UsageError 
+                               "only one module allowed with --interactive")
+       interactiveUI state
+
 
-beginInteractive srcs = panic "`ghc --interactive' unimplemented"