[project @ 2002-05-01 17:56:52 by sof]

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

diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 01b03e8..1948933 100644 (file)
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.73 2002/03/29 20:14:31 krasimir Exp $
+-- $Id: DriverState.hs,v 1.77 2002/04/22 16:06:36 simonpj Exp $
 --
 -- Settings for the driver
 --
@@ -27,6 +27,7 @@ import Panic
 import List
 import Char  
 import Monad
+import Maybe     ( fromJust, isJust )
 import Directory ( doesDirectoryExist )
 
 -----------------------------------------------------------------------------
@@ -44,7 +45,7 @@ data GhcMode
   | DoMake                             -- ghc --make
   | DoInteractive                      -- ghc --interactive
   | DoLink                             -- [ the default ]
-  deriving (Eq)
+  deriving (Eq,Show)
 
 GLOBAL_VAR(v_GhcMode,     DoLink, GhcMode)
 GLOBAL_VAR(v_GhcModeFlag, "",     String)
@@ -53,7 +54,7 @@ setMode :: GhcMode -> String -> IO ()
 setMode m flag = do
   old_mode <- readIORef v_GhcMode
   old_flag <- readIORef v_GhcModeFlag
-  when (not (null (old_flag))) $
+  when (notNull (old_flag)) $
       throwDyn (UsageError 
           ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
   writeIORef v_GhcMode m
@@ -125,6 +126,36 @@ GLOBAL_VAR(v_Output_dir,  Nothing, Maybe String)
 GLOBAL_VAR(v_Output_file, Nothing, Maybe String)
 GLOBAL_VAR(v_Output_hi,   Nothing, Maybe String)
 
+-- called to verify that the output files & directories
+-- point somewhere valid. 
+--
+-- The assumption is that the directory portion of these output
+-- options will have to exist by the time 'verifyOutputFiles'
+-- is invoked.
+-- 
+verifyOutputFiles :: IO ()
+verifyOutputFiles = do
+  odir <- readIORef v_Output_dir
+  when (isJust odir) $ do
+     let dir = fromJust odir
+     flg <- doesDirectoryExist dir
+     when (not flg) (nonExistentDir "-odir" dir)
+  ofile <- readIORef v_Output_file
+  when (isJust ofile) $ do
+     let fn = fromJust ofile
+     flg <- doesDirNameExist fn
+     when (not flg) (nonExistentDir "-o" fn)
+  ohi <- readIORef v_Output_hi
+  when (isJust ohi) $ do
+     let hi = fromJust ohi
+     flg <- doesDirNameExist hi
+     when (not flg) (nonExistentDir "-ohi" hi)
+ where
+   nonExistentDir flg dir = 
+     throwDyn (CmdLineError ("error: directory portion of " ++ 
+                             show dir ++ " does not exist (used with " ++ 
+                            show flg ++ " option.)"))
+
 GLOBAL_VAR(v_Object_suf,  Nothing, Maybe String)
 GLOBAL_VAR(v_HC_suf,     Nothing, Maybe String)
 GLOBAL_VAR(v_Hi_dir,      Nothing, Maybe String)
@@ -161,9 +192,6 @@ GLOBAL_VAR(v_MaxSimplifierIterations,   4,     Int)
 GLOBAL_VAR(v_StgStats,                  False, Bool)
 GLOBAL_VAR(v_UsageSPInf,               False, Bool)  -- Off by default
 GLOBAL_VAR(v_Strictness,               True,  Bool)
-#ifdef OLD_STRICTNESS
-GLOBAL_VAR(v_CPR,                      True,  Bool)
-#endif
 GLOBAL_VAR(v_CSE,                      True,  Bool)
 GLOBAL_VAR(v_RuleCheck,                Nothing,  Maybe String)
 
@@ -203,9 +231,6 @@ buildCoreToDo = do
    max_iter   <- readIORef v_MaxSimplifierIterations
    usageSP    <- readIORef v_UsageSPInf
    strictness <- readIORef v_Strictness
-#ifdef OLD_STRICTNESS
-   cpr        <- readIORef v_CPR
-#endif
    cse        <- readIORef v_CSE
    rule_check <- readIORef v_RuleCheck
 
@@ -282,7 +307,7 @@ buildCoreToDo = do
        case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 
 #ifdef OLD_STRICTNESS
-       if cpr        then CoreDoCPResult   else CoreDoNothing,
+       CoreDoOldStrictness
 #endif
        if strictness then CoreDoStrictness else CoreDoNothing,
        CoreDoWorkerWrapper,
@@ -358,7 +383,7 @@ addToDirList :: IORef [String] -> String -> IO ()
 addToDirList ref path
   = do paths           <- readIORef ref
        shiny_new_ones  <- splitUp path
-       writeIORef ref (paths ++ filter (not.null) shiny_new_ones)
+       writeIORef ref (paths ++ filter notNull shiny_new_ones)
                -- empty paths are ignored: there might be a trailing
                -- ':' in the initial list, for example.  Empty paths can
                -- cause confusion when they are translated into -I options
@@ -457,23 +482,23 @@ addPackage package
 getPackageImportPath   :: IO [String]
 getPackageImportPath = do
   ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap import_dirs ps)))
+  return (nub (filter notNull (concatMap import_dirs ps)))
 
 getPackageIncludePath   :: IO [String]
 getPackageIncludePath = do
   ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap include_dirs ps)))
+  return (nub (filter notNull (concatMap include_dirs ps)))
 
        -- includes are in reverse dependency order (i.e. rts first)
 getPackageCIncludes   :: IO [String]
 getPackageCIncludes = do
   ps <- getPackageInfo
-  return (reverse (nub (filter (not.null) (concatMap c_includes ps))))
+  return (reverse (nub (filter notNull (concatMap c_includes ps))))
 
 getPackageLibraryPath  :: IO [String]
 getPackageLibraryPath = do
   ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap library_dirs ps)))
+  return (nub (filter notNull (concatMap library_dirs ps)))
 
 getPackageLibraries    :: IO [String]
 getPackageLibraries = do