[project @ 2000-11-24 17:02:01 by simonpj]

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

diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index 69173aa..764be3f 100644 (file)
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.2 2000/10/11 14:08:52 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.11 2000/11/20 16:28:29 simonmar Exp $
 --
 -- Utils for the driver
 --
@@ -11,7 +11,6 @@ module DriverUtil where
 
 #include "HsVersions.h"
 
-import Config
 import Util
 
 import IOExts
@@ -21,7 +20,6 @@ import RegexString
 
 import IO
 import System
-import Directory
 import List
 import Char
 import Monad
@@ -31,20 +29,18 @@ import Monad
 
 short_usage = "Usage: For basic information, try the `--help' option."
    
-GLOBAL_VAR(path_usage,  "",  String)
+GLOBAL_VAR(v_Path_usage,  "",  String)
 
 long_usage = do
-  usage_path <- readIORef path_usage
+  usage_path <- readIORef v_Path_usage
   usage <- readFile usage_path
   dump usage
   exitWith ExitSuccess
   where
      dump "" = return ()
-     dump ('$':'$':s) = hPutStr stderr get_prog_name >> dump s
+     dump ('$':'$':s) = hPutStr stderr prog_name >> dump s
      dump (c:s) = hPutChar stderr c >> dump s
 
-version_str = cProjectVersion
-
 data BarfKind
   = PhaseFailed String ExitCode
   | Interrupted
@@ -52,22 +48,25 @@ data BarfKind
   | OtherError String                  -- just prints the error message
   deriving Eq
 
-GLOBAL_VAR(prog_name, "ghc", String)
-
-get_prog_name = unsafePerformIO (readIORef prog_name) -- urk!
+prog_name = unsafePerformIO (getProgName)
+{-# NOINLINE prog_name #-}
 
 instance Show BarfKind where
-  showsPrec _ e = showString get_prog_name . showString ": " . showBarf e
+  showsPrec _ e = showString prog_name . showString ": " . showBarf e
 
-showBarf (UsageError str) = showString str . showChar '\n' . showString short_usage
-showBarf (OtherError str) = showString str
-showBarf (PhaseFailed phase code) = 
-       showString phase . showString " failed, code = " . shows code
-showBarf (Interrupted) = showString "interrupted"
+showBarf (UsageError str)
+   = showString str . showChar '\n' . showString short_usage
+showBarf (OtherError str)
+   = showString str
+showBarf (PhaseFailed phase code)
+   = showString phase . showString " failed, code = " . shows code
+showBarf (Interrupted)
+   = showString "interrupted"
 
 unknownFlagErr f = throwDyn (UsageError ("unrecognised flag: " ++ f))
 
 barfKindTc = mkTyCon "BarfKind"
+{-# NOINLINE barfKindTc #-}
 instance Typeable BarfKind where
   typeOf _ = mkAppTy barfKindTc []
 
@@ -133,6 +132,18 @@ addNoDups var x = do
   xs <- readIORef var
   unless (x `elem` xs) $ writeIORef var (x:xs)
 
+splitFilename :: String -> (String,String)
+splitFilename f = split_longest_prefix f '.'
+
+-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
+splitFilename3 :: String -> (String,String,String)
+splitFilename3 str
+   = let (dir, rest) = split_longest_prefix str '/'
+        (name, ext) = splitFilename rest
+        real_dir | null dir  = "."
+                 | otherwise = dir
+     in  (real_dir, name, ext)
+
 remove_suffix :: Char -> String -> String
 remove_suffix c s
   | null pre  = reverse suf
@@ -147,6 +158,16 @@ take_longest_prefix :: String -> Char -> String
 take_longest_prefix s c = reverse pre
   where (_suf,pre) = break (==c) (reverse s)
 
+-- split a string at the last occurence of 'c', returning the two
+-- parts of the string with the 'c' removed.  If the string contains
+-- no 'c's, the entire string is returned in the second component.
+split_longest_prefix :: String -> Char -> (String,String)
+split_longest_prefix s c
+  = case pre of
+       []      -> ([], reverse suf)
+       (_:pre) -> (reverse pre, reverse suf)
+  where (suf,pre) = break (==c) (reverse s)
+
 newsuf :: String -> String -> String
 newsuf suf s = remove_suffix '.' s ++ suf
 
@@ -160,10 +181,3 @@ newdir dir s = dir ++ '/':drop_longest_prefix s '/'
 
 remove_spaces :: String -> String
 remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
-
-booter_version
- = case "\ 
-       \ __GLASGOW_HASKELL__" of
-    ' ':n:ns -> n:'.':ns
-    ' ':m    -> m
-