[project @ 2000-11-21 09:30:16 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 efaf532..46aec68 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.19 2000/11/10 14:29:21 simonmar Exp $
+-- $Id: Main.hs,v 1.28 2000/11/20 16:37:42 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -16,19 +16,24 @@ module Main (main) where
 #include "HsVersions.h"
 
 import CompManager
+import Interpreter
+#ifdef GHCI
+import InteractiveUI
+#endif
 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
@@ -67,6 +72,7 @@ import Maybe
 -- reading the package configuration file is too slow
 -- -H, -K, -Rghc-timing
 -- hi-diffs
+-- -ddump-all doesn't do anything
 
 -----------------------------------------------------------------------------
 -- Differences vs. old driver:
@@ -108,9 +114,6 @@ main =
    installHandler sigINT  sig_handler Nothing
 #endif
 
-   pgm    <- getProgName
-   writeIORef v_Prog_name pgm
-
    argv   <- getArgs
 
        -- grab any -B options from the command line first
@@ -156,10 +159,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 +185,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"
@@ -204,6 +213,12 @@ main =
        -- complain about any unknown flags
    mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
 
+       -- 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
+   writeIORef v_InitDriverState saved_driver_state
+
        -- get the -v flag
    verb <- readIORef v_Verbose
 
@@ -221,11 +236,12 @@ 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
@@ -237,11 +253,6 @@ main =
 
    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.
-   saved_driver_state <- readIORef v_Driver_state
-
    let compileFile (src, phases) = do
          writeIORef v_Driver_state saved_driver_state
          writeIORef v_DynFlags init_dyn_flags
@@ -263,12 +274,24 @@ 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)
--}
-
-beginInteractive srcs = panic "`ghc --interactive' unimplemented"
+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 mod
+                    return ()
+        _     -> throwDyn (UsageError "only one module allowed with --make")
+
+#ifndef GHCI
+beginInteractive = throwDyn (OtherError "not build for interactive use")
+#else
+beginInteractive pkg_details mods
+  = do state <- cmInit pkg_details Interactive
+       case mods of
+          []    -> return ()
+          [mod] -> do cmLoadModule state mod; return ()
+          _     -> throwDyn (UsageError 
+                               "only one module allowed with --interactive")
+       interactiveUI state
+#endif