[project @ 2000-12-05 12:09:43 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs
index 4b94d28..a825926 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.14 2000/11/16 11:39:37 simonmar Exp $
+-- $Id: DriverState.hs,v 1.18 2000/12/05 12:09:43 sewardj Exp $
 --
 -- Settings for the driver
 --
@@ -67,7 +67,15 @@ initDriverState = DriverState {
        opt_m                   = [],
    }
        
-GLOBAL_VAR(v_Driver_state, initDriverState, DriverState)
+-- The driver state is first initialized from the command line options,
+-- and then reset to this initial state before each compilation.
+-- v_InitDriverState contains the saved initial state, and v_DriverState
+-- contains the current state (modified by any OPTIONS pragmas, for example).
+--
+-- v_InitDriverState may also be modified from the GHCi prompt, using :set.
+--
+GLOBAL_VAR(v_InitDriverState, initDriverState, DriverState)
+GLOBAL_VAR(v_Driver_state,    initDriverState, DriverState)
 
 readState :: (DriverState -> a) -> IO a
 readState f = readIORef v_Driver_state >>= return . f
@@ -75,11 +83,11 @@ readState f = readIORef v_Driver_state >>= return . f
 updateState :: (DriverState -> DriverState) -> IO ()
 updateState f = readIORef v_Driver_state >>= writeIORef v_Driver_state . f
 
-addOpt_L     a = updateState (\s -> s{opt_L      =  a : opt_L      s})
-addOpt_P     a = updateState (\s -> s{opt_P      =  a : opt_P      s})
-addOpt_c     a = updateState (\s -> s{opt_c      =  a : opt_c      s})
-addOpt_a     a = updateState (\s -> s{opt_a      =  a : opt_a      s})
-addOpt_m     a = updateState (\s -> s{opt_m      =  a : opt_m      s})
+addOpt_L     a = updateState (\s -> s{opt_L =  a : opt_L s})
+addOpt_P     a = updateState (\s -> s{opt_P =  a : opt_P s})
+addOpt_c     a = updateState (\s -> s{opt_c =  a : opt_c s})
+addOpt_a     a = updateState (\s -> s{opt_a =  a : opt_a s})
+addOpt_m     a = updateState (\s -> s{opt_m =  a : opt_m s})
 
 addCmdlineHCInclude a = 
    updateState (\s -> s{cmdline_hc_includes =  a : cmdline_hc_includes s})
@@ -98,7 +106,6 @@ cHaskell1Version = "5" -- i.e., Haskell 98
 
 -- location of compiler-related files
 GLOBAL_VAR(v_TopDir,  clibdir, String)
-GLOBAL_VAR(v_Inplace, False,   Bool)
 
 -- Cpp-related flags
 v_Hs_source_cpp_opts = global
@@ -109,10 +116,6 @@ v_Hs_source_cpp_opts = global
        ]
 {-# NOINLINE v_Hs_source_cpp_opts #-}
 
--- Verbose
-GLOBAL_VAR(v_Verbose, False, Bool)
-is_verbose = do v <- readIORef v_Verbose; if v then return "-v" else return ""
-
 -- Keep output from intermediate phases
 GLOBAL_VAR(v_Keep_hi_diffs,            False,          Bool)
 GLOBAL_VAR(v_Keep_hc_files,            False,          Bool)
@@ -142,14 +145,14 @@ GLOBAL_VAR(v_Split_prefix,                "",             String)
 GLOBAL_VAR(v_N_split_files,            0,              Int)
        
 can_split :: Bool
-can_split =  prefixMatch "i386" cTARGETPLATFORM
-         || prefixMatch "alpha" cTARGETPLATFORM
-         || prefixMatch "hppa" cTARGETPLATFORM
-         || prefixMatch "m68k" cTARGETPLATFORM
-         || prefixMatch "mips" cTARGETPLATFORM
+can_split =  prefixMatch "i386"    cTARGETPLATFORM
+         || prefixMatch "alpha"   cTARGETPLATFORM
+         || prefixMatch "hppa"    cTARGETPLATFORM
+         || prefixMatch "m68k"    cTARGETPLATFORM
+         || prefixMatch "mips"    cTARGETPLATFORM
          || prefixMatch "powerpc" cTARGETPLATFORM
-         || prefixMatch "rs6000" cTARGETPLATFORM
-         || prefixMatch "sparc" cTARGETPLATFORM
+         || prefixMatch "rs6000"  cTARGETPLATFORM
+         || prefixMatch "sparc"   cTARGETPLATFORM
 
 -----------------------------------------------------------------------------
 -- Compiler output options
@@ -264,6 +267,10 @@ hsc_minusO_flags =
        "-flet-to-case"
    ]
 
+getStaticOptimisationFlags 0 = hsc_minusNoO_flags
+getStaticOptimisationFlags 1 = hsc_minusO_flags
+getStaticOptimisationFlags n = hsc_minusO2_flags
+
 buildCoreToDo :: IO [CoreToDo]
 buildCoreToDo = do
    opt_level  <- readIORef v_OptLevel
@@ -520,7 +527,6 @@ GLOBAL_VAR(v_Build_tag, "", String)
 data WayName
   = WayProf
   | WayUnreg
-  | WayDll
   | WayTicky
   | WayPar
   | WayGran
@@ -547,12 +553,10 @@ data WayName
 
 GLOBAL_VAR(v_Ways, [] ,[WayName])
 
--- ToDo: allow WayDll with any other allowed combination
-
-allowed_combinations = 
-   [  [WayProf,WayUnreg],
-      [WayProf,WaySMP]    -- works???
-   ]
+allowed_combination way = way `elem` combs
+  where  -- the sub-lists must be ordered according to WayName, 
+         -- because findBuildTag sorts them
+    combs                = [ [WayProf,WayUnreg], [WayProf,WaySMP] ]
 
 findBuildTag :: IO [String]  -- new options
 findBuildTag = do
@@ -565,7 +569,7 @@ findBuildTag = do
               writeIORef v_Build_tag (wayTag details)
               return (wayOpts details)
 
-     ws  -> if  ws `notElem` allowed_combinations
+     ws  -> if not (allowed_combination ws)
                then throwDyn (OtherError $
                                "combination not supported: "  ++
                                foldr1 (\a b -> a ++ '/':b) 
@@ -609,9 +613,6 @@ way_details =
        , "-funregisterised"
        , "-fvia-C" ]),
 
-    (WayDll, Way  "dll" "DLLized"
-        [ ]),
-
     (WayPar, Way  "mp" "Parallel" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
@@ -707,7 +708,8 @@ machdepCCOpts
       --   the fp (%ebp) for our register maps.
        = do n_regs <- readState stolen_x86_regs
             sta    <- readIORef v_Static
-            return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ],
+            return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
+                        if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
                      [ "-fno-defer-pop", "-fomit-frame-pointer",
                        "-DSTOLEN_X86_REGS="++show n_regs ]
                    )
@@ -720,40 +722,3 @@ machdepCCOpts
 
    | otherwise
        = return ( [], [] )
-
-
------------------------------------------------------------------------------
--- Running an external program
-
-run_something phase_name cmd
- = do
-   verb <- readIORef v_Verbose
-   when verb $ do
-       putStr phase_name
-       putStrLn ":"
-       putStrLn cmd
-       hFlush stdout
-
-   -- test for -n flag
-   n <- readIORef v_Dry_run
-   unless n $ do 
-
-   -- and run it!
-#ifndef mingw32_TARGET_OS
-   exit_code <- system cmd `catchAllIO` 
-                  (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
-#else
-   tmp <- newTempName "sh"
-   h <- openFile tmp WriteMode
-   hPutStrLn h cmd
-   hClose h
-   exit_code <- system ("sh - " ++ tmp) `catchAllIO` 
-                  (\e -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
-   removeFile tmp
-#endif
-
-   if exit_code /= ExitSuccess
-       then throwDyn (PhaseFailed phase_name exit_code)
-       else do when verb (putStr "\n")
-               return ()
-