[project @ 2002-04-05 23:24:25 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..cd4f1fb 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.76 2002/04/05 23:24:29 sof 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)
@@ -358,7 +389,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 +488,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