[project @ 2000-12-05 12:09:43 by sewardj]

[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs

diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index b61562b..a825926 100644 (file)
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.15 2000/11/19 19:40:08 simonmar Exp $
+-- $Id: DriverState.hs,v 1.18 2000/12/05 12:09:43 sewardj Exp $
 --
 -- Settings for the driver
 --
@@ -116,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)
@@ -531,7 +527,6 @@ GLOBAL_VAR(v_Build_tag, "", String)
 data WayName
   = WayProf
   | WayUnreg
-  | WayDll
   | WayTicky
   | WayPar
   | WayGran
@@ -558,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
@@ -576,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) 
@@ -620,9 +613,6 @@ way_details =
        , "-funregisterised"
        , "-fvia-C" ]),
 
-    (WayDll, Way  "dll" "DLLized"
-        [ ]),
-
     (WayPar, Way  "mp" "Parallel" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
@@ -718,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 ]
                    )
@@ -731,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 ()
-