[project @ 2000-10-24 16:08:16 by simonmar]

StgToDo done

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index fb34b4c..d973a93 100644 (file)
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.7 2000/10/24 15:58:02 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.8 2000/10/24 16:08:16 simonmar Exp $
 --
 -- Driver flags
 --
@@ -424,17 +424,10 @@ floatOpt ref str
 -----------------------------------------------------------------------------
 -- Build the Hsc static command line opts
 
-build_hsc_opts :: IO [String]
-build_hsc_opts = do
-  opt_C_ <- getStaticOpts opt_C                -- misc hsc opts
+buildStaticHscOpts :: IO [String]
+buildStaticHscOpts = do
 
-       -- warnings
-  warn_level <- readIORef warning_opt
-  let warn_opts =  case warn_level of
-                       W_default -> standardWarnings
-                       W_        -> minusWOpts
-                       W_all     -> minusWallOpts
-                       W_not     -> []
+  opt_C_ <- getStaticOpts opt_C                -- misc hsc opts
 
        -- optimisation
   minus_o <- readIORef v_OptLevel
@@ -446,44 +439,19 @@ build_hsc_opts = do
            _ -> error "unknown opt level"
            -- ToDo: -Ofile
  
-       -- STG passes
-  ways_ <- readIORef ways
-  let stg_massage | WayProf `elem` ways_ =  "-fmassage-stg-for-profiling"
-                 | otherwise            = ""
-
-  stg_stats <- readIORef v_StgStats
-  let stg_stats_flag | stg_stats = "-dstg-stats"
-                    | otherwise = ""
-
-  let stg_opts = [ stg_massage, stg_stats_flag, "-flet-no-escape" ]
+  let stg_opts = [ "-flet-no-escape" ]
        -- let-no-escape always on for now
 
        -- take into account -fno-* flags by removing the equivalent -f*
        -- flag from our list.
   anti_flags <- getStaticOpts anti_opt_C
-  let basic_opts = opt_C_ ++ warn_opts ++ optimisation_opts ++ stg_opts
+  let basic_opts = opt_C_ ++ optimisation_opts ++ stg_opts
       filtered_opts = filter (`notElem` anti_flags) basic_opts
 
   verb <- is_verbose
   let hi_vers = "-fhi-version="++cProjectVersionInt
 
-  static <- (do s <- readIORef static; if s then return "-static" else return "")
+  static <- (do s <- readIORef static; if s then return "-static" 
+                                           else return "")
 
-  -- get hi-file suffix
-  hisuf <- readIORef hi_suf
-
-  -- hi-suffix for packages depends on the build tag.
-  package_hisuf <-
-       do tag <- readIORef build_tag
-          if null tag
-               then return "hi"
-               else return (tag ++ "_hi")
-
-  import_dirs <- readIORef import_paths
-  package_import_dirs <- getPackageImportPath
-  
-  return 
-       (  
-       filtered_opts
-       ++ [ hi_vers, static, verb ]
-       )
+  return ( filtered_opts ++ [ hi_vers, static, verb ] )

diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 7842780..852c92c 100644 (file)
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.5 2000/10/24 15:58:02 simonmar Exp $
+-- $Id: DriverState.hs,v 1.6 2000/10/24 16:08:16 simonmar Exp $
 --
 -- Settings for the driver
 --
@@ -393,6 +393,19 @@ buildCoreToDo = do
        ])
      ]
 
+buildStgToDo :: IO [ StgToDo ]
+buildStgToDo = do
+  stg_stats <- readIORef v_StgStats
+  let flags1 | stg_stats = [ D_stg_stats ]
+            | otherwise = [ ]
+
+       -- STG passes
+  ways_ <- readIORef ways
+  let flags2 | WayProf `elem` ways_ = StgDoMassageForProfiling : flags1
+            | otherwise            = flags1
+
+  return flags2
+
 -----------------------------------------------------------------------------
 -- Paths & Libraries
 

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 6a331f7..b0886ce 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.7 2000/10/24 15:58:02 simonmar Exp $
+-- $Id: Main.hs,v 1.8 2000/10/24 16:08:16 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -157,21 +157,31 @@ main =
    _ <- processArgs static_flags more_opts []
  
        -- give the static flags to hsc
-   build_hsc_opts
+   static_opts <- buildStaticHscOpts
+   writeIORef static_hsc_opts static_opts
 
        -- build the default DynFlags (these may be adjusted on a per
        -- module basis by OPTIONS pragmas and settings in the interpreter).
 
    core_todo <- buildCoreToDo
+   stg_todo  <- buildStgToDo
 
    lang <- readIORef hsc_lang
    writeIORef v_DynFlags 
-       DynFlags{ coreToDo =  core_todo,
-                 stgToDo  = error "ToDo: stgToDo"
+       DynFlags{ coreToDo = core_todo,
+                 stgToDo  = stg_todo,
                   hscLang  = lang,
                  -- leave out hscOutName for now
                  flags = [] }
 
+       -- warnings
+    warn_level <- readIORef warning_opt
+    let warn_opts =  case warn_level of
+                       W_default -> standardWarnings
+                       W_        -> minusWOpts
+                       W_all     -> minusWallOpts
+                       W_not     -> []
+
        -- the rest of the arguments are "dynamic"
    srcs <- processArgs dynamic_flags non_static []
        -- save the "initial DynFlags" away