[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 83c8ea6..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.20 2000/11/13 12:43:20 sewardj Exp $
+-- $Id: Main.hs,v 1.23 2000/11/16 11:39:37 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -16,11 +16,13 @@ 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 )
@@ -29,7 +31,6 @@ import Finder         ( initFinder )
 import CmStaticInfo
 import Config
 import Util
-import Panic
 
 import Concurrent
 #ifndef mingw32_TARGET_OS
@@ -157,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 []
 
@@ -187,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"
@@ -222,11 +229,12 @@ main =
    when (mode == DoMkDependHS) beginMkDependHS
 
        -- 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
+   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 True) srcs
+   let lang = hscLang init_dyn_flags
+   pipelines <- mapM (genPipeline mode stop_flag True lang) srcs
    let src_pipelines = zip srcs pipelines
 
        -- sanity checking
@@ -266,13 +274,20 @@ setTopDir args = do
 
 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"
+  = 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
+
+