From: sof <unknown>
Date: Sat, 13 Oct 2001 16:02:47 +0000 (+0000)
Subject: [project @ 2001-10-13 16:02:47 by sof]
X-Git-Tag: Approximately_9120_patches~842
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=af03f11679b3ff43c8c29141f9e3ba3497c09f6a;p=ghc-hetmet.git

[project @ 2001-10-13 16:02:47 by sof]
- unpackProgName: recognise '/' and '\\' as path separators under Win32.
- donated in-house version of basename, it's cool (== doesn't use reverse).
---

diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs
index e237b19..6d8efd3 100644
--- a/ghc/lib/std/System.lhs
+++ b/ghc/lib/std/System.lhs
@@ -1,10 +1,11 @@
 -- -----------------------------------------------------------------------------
--- $Id: System.lhs,v 1.35 2001/09/21 13:24:37 simonmar Exp $
+-- $Id: System.lhs,v 1.36 2001/10/13 16:02:47 sof Exp $
 --
 -- (c) The University of Glasgow, 1994-2000
 --
 
 \begin{code}
+#include "config.h"
 module System 
     ( 
       ExitCode(ExitSuccess,ExitFailure)
@@ -120,11 +121,21 @@ exitFailure = exitWith (ExitFailure 1)
 unpackProgName	:: Ptr (Ptr CChar) -> IO String   -- argv[0]
 unpackProgName argv = do 
   s <- peekElemOff argv 0 >>= peekCString
-  return (de_slash "" s)
+  return (basename s)
   where
-    -- re-start accumulating at every '/'
-    de_slash :: String -> String -> String
-    de_slash  acc []	   = reverse acc
-    de_slash _acc ('/':xs) = de_slash []      xs
-    de_slash  acc (x:xs)   = de_slash (x:acc) xs
+   basename :: String -> String
+   basename f = go f f
+    where
+      go acc [] = acc
+      go acc (x:xs) 
+        | isPathSeparator x = go xs xs
+        | otherwise         = go acc xs
+
+   isPathSeparator :: Char -> Bool
+   isPathSeparator '/'  = True
+#ifdef mingw32_TARGET_OS 
+   isPathSeparator '\\' = True
+#endif
+   isPathSeparator _    = False
+
 \end{code}