From a2e3f6683cce81c5a34e5f353ff35e20754555e2 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 24 Oct 2000 16:08:16 +0000
Subject: [PATCH] [project @ 2000-10-24 16:08:16 by simonmar] StgToDo done

---
 ghc/compiler/main/DriverFlags.hs |   50 +++++++-------------------------------
 ghc/compiler/main/DriverState.hs |   15 +++++++++++-
 ghc/compiler/main/Main.hs        |   18 +++++++++++---
 3 files changed, 37 insertions(+), 46 deletions(-)

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index fb34b4c..d973a93 100644
--- 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
--- 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
--- 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
-- 
1.7.10.4