From: simonmar <unknown>
Date: Mon, 21 Mar 2005 10:50:34 +0000 (+0000)
Subject: [project @ 2005-03-21 10:50:22 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~880
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=50159f6c4a3560662e37c55e64af1fb0b685011e;p=ghc-hetmet.git

[project @ 2005-03-21 10:50:22 by simonmar]
Complete the transition of -split-objs into a dynamic flag (looks like I
half-finished it in the last commit).

Also: complete the transition of -tmpdir into a dynamic flag, which
involves some rearrangement of code from SysTools into DynFlags.

Someday, initSysTools should move wholesale into initDynFlags, because
most of the state that it initialises is now part of the DynFlags
structure, and the rest could be moved in easily.
---

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index 04c8194..02eb902 100644
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -30,6 +30,7 @@ import MachOp
 import ForeignCall
 
 -- Utils
+import DynFlags		( DynFlags, DynFlag(..), dopt )
 import Unique           ( getUnique )
 import UniqSet
 import FiniteMap
@@ -37,7 +38,6 @@ import UniqFM		( eltsUFM )
 import FastString
 import Outputable
 import Constants
-import StaticFlags	( opt_SplitObjs )
 
 -- The rest
 import Data.List        ( intersperse, groupBy )
@@ -59,16 +59,18 @@ import MONAD_ST
 -- --------------------------------------------------------------------------
 -- Top level
 
-pprCs :: [Cmm] -> SDoc
-pprCs cmms = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
-
-writeCs :: Handle -> [Cmm] -> IO ()
-writeCs handle cmms = printForUser handle alwaysQualify (pprCs cmms)
- 			-- ToDo: should be printForC
-
-split_marker
-  | opt_SplitObjs = ptext SLIT("__STG_SPLIT_MARKER")
-  | otherwise     = empty
+pprCs :: DynFlags -> [Cmm] -> SDoc
+pprCs dflags cmms
+ = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
+ where
+   split_marker
+     | dopt Opt_SplitObjs dflags = ptext SLIT("__STG_SPLIT_MARKER")
+     | otherwise     	         = empty
+
+writeCs :: DynFlags -> Handle -> [Cmm] -> IO ()
+writeCs dflags handle cmms 
+  = printForUser handle alwaysQualify (pprCs dflags cmms)
+ 	-- ToDo: should be printForC
 
 -- --------------------------------------------------------------------------
 -- Now do some real work
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index fa92421..11dafdd 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -39,8 +39,8 @@ import MachOp		( wordRep, MachHint(..) )
 
 import StgSyn
 import PrelNames	( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
-import DynFlags		( DynFlags(..), DynFlag(..) )
-import StaticFlags	( opt_SplitObjs, opt_SccProfilingOn )
+import DynFlags		( DynFlags(..), DynFlag(..), dopt )
+import StaticFlags	( opt_SccProfilingOn )
 
 import HscTypes		( ForeignStubs(..), TypeEnv, typeEnvTyCons )
 import CostCentre       ( CollectedCCs )
@@ -281,7 +281,7 @@ variable.
 \begin{code}
 cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
 cgTopBinding dflags (StgNonRec id rhs, srts)
-  = do	{ id' <- maybeExternaliseId id
+  = do	{ id' <- maybeExternaliseId dflags id
 	; mapM_ (mkSRT dflags [id']) srts
 	; (id,info) <- cgTopRhs id' rhs
 	; addBindC id info 	-- Add the *un-externalised* Id to the envt,
@@ -290,7 +290,7 @@ cgTopBinding dflags (StgNonRec id rhs, srts)
 
 cgTopBinding dflags (StgRec pairs, srts)
   = do	{ let (bndrs, rhss) = unzip pairs
-	; bndrs' <- mapFCs maybeExternaliseId bndrs
+	; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
 	; let pairs' = zip bndrs' rhss
 	; mapM_ (mkSRT dflags bndrs')  srts
 	; _new_binds <- fixC (\ new_binds -> do 
@@ -342,9 +342,9 @@ If we're splitting the object, we need to externalise all the top-level names
 which refers to this name).
 
 \begin{code}
-maybeExternaliseId :: Id -> FCode Id
-maybeExternaliseId id
-  | opt_SplitObjs, 	-- Externalise the name for -split-objs
+maybeExternaliseId :: DynFlags -> Id -> FCode Id
+maybeExternaliseId dflags id
+  | dopt Opt_SplitObjs dflags, 	-- Externalise the name for -split-objs
     isInternalName name = do { mod <- moduleName
 			     ; returnFC (setIdName id (externalise mod)) }
   | otherwise		= returnFC id
diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 704a908..723227f 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -152,7 +152,7 @@ outputC dflags filenm flat_absC
 	  hPutStr h cc_injects
 	  when stub_h_exists $ 
 	     hPutStrLn h ("#include \"" ++ (filenameOf (hscStubHOutName dflags)) ++ "\"")
-	  writeCs h flat_absC
+	  writeCs dflags h flat_absC
 \end{code}
 
 
diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
index 3837d2c..fe8ad3c 100644
--- a/ghc/compiler/main/DriverMkDepend.hs
+++ b/ghc/compiler/main/DriverMkDepend.hs
@@ -96,7 +96,7 @@ beginMkDependHS dflags = do
 
      	-- open a new temp file in which to stuff the dependency info
      	-- as we go along.
-  tmp_file <- newTempName "dep"
+  tmp_file <- newTempName dflags "dep"
   tmp_hdl <- openFile tmp_file WriteMode
 
   	-- open the makefile
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 9ffc9db..4c60264 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -410,7 +410,7 @@ genOutputFilenameFunc dflags stop_phase keep_final_output
 		| is_last_phase, Just f <- maybe_output_filename = return f
 		| is_last_phase && keep_final_output = persistent_fn
 		| keep_this_output 		     = persistent_fn
-     		| otherwise        		     = newTempName suffix
+     		| otherwise        		     = newTempName dflags suffix
 
 	   where
 		is_last_phase = next_phase `eqPhase` stop_phase
@@ -802,7 +802,7 @@ runPhase Mangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
 runPhase SplitMangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
   = do  -- tmp_pfx is the prefix used for the split .s files
 	-- We also use it as the file to contain the no. of split .s files (sigh)
-	split_s_prefix <- SysTools.newTempName "split"
+	split_s_prefix <- SysTools.newTempName dflags "split"
 	let n_files_fn = split_s_prefix
 
 	SysTools.runSplit dflags
diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs
index 62d269d..e138f47 100644
--- a/ghc/compiler/main/DynFlags.hs
+++ b/ghc/compiler/main/DynFlags.hs
@@ -37,6 +37,7 @@ module DynFlags (
 	getOpts,			-- (DynFlags -> [a]) -> IO [a]
 	getVerbFlag,
 	updOptLevel,
+	setTmpDir,
 	
 	-- parsing DynFlags
 	parseDynamicFlags,
@@ -54,7 +55,7 @@ import DriverPhases	( Phase(..), phaseInputExt )
 import Config
 import CmdLineParser
 import Panic		( panic, GhcException(..) )
-import Util		( notNull, splitLongestPrefix, split )
+import Util		( notNull, splitLongestPrefix, split, normalisePath )
 
 import DATA_IOREF	( readIORef )
 import EXCEPTION	( throwDyn )
@@ -213,7 +214,7 @@ data DynFlags = DynFlags {
   libraryPaths		:: [String],
   frameworkPaths	:: [String],  	-- used on darwin only
   cmdlineFrameworks	:: [String],	-- ditto
-  tmpDir		:: String,
+  tmpDir		:: String,	-- no trailing '/'
   
   -- options for particular phases
   opt_L			:: [String],
@@ -342,7 +343,7 @@ defaultDynFlags =
 	libraryPaths		= [],
 	frameworkPaths		= [],
 	cmdlineFrameworks	= [],
-	tmpDir			= [],
+	tmpDir			= cDEFAULT_TMPDIR,
 	
 	opt_L			= [],
 	opt_P			= [],
@@ -431,7 +432,6 @@ setObjectSuf  f d = d{ objectSuf  = f}
 setHcSuf      f d = d{ hcSuf      = f}
 setHiSuf      f d = d{ hiSuf      = f}
 setHiDir      f d = d{ hiDir      = f}
-setTmpDir     f d = d{ tmpDir     = f}
 
 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 -- Config.hs should really use Option.
@@ -769,6 +769,10 @@ dynamic_flags = [
   ,  ( "optdll"		, HasArg (upd . addOptdll) )  
   ,  ( "optdep"		, HasArg (upd . addOptdep) )
 
+  ,  ( "split-objs"	, NoArg (if can_split
+				    then setDynFlag Opt_SplitObjs
+				    else return ()) )
+
 	-------- Linking ----------------------------------------------------
   ,  ( "c"		, NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
   ,  ( "no-link"	, NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
@@ -1118,6 +1122,40 @@ splitPathList s = filter notNull (splitUp s)
     dir_markers = ['/', '\\']
 #endif
 
+-- -----------------------------------------------------------------------------
+-- tmpDir, where we store temporary files.
+
+setTmpDir :: FilePath -> DynFlags -> DynFlags
+setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
+  where
+#if !defined(mingw32_HOST_OS)
+     canonicalise p = normalisePath p
+#else
+	-- Canonicalisation of temp path under win32 is a bit more
+	-- involved: (a) strip trailing slash, 
+	-- 	     (b) normalise slashes
+	--	     (c) just in case, if there is a prefix /cygdrive/x/, change to x:
+	-- 
+     canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
+
+        -- if we're operating under cygwin, and TMP/TEMP is of
+	-- the form "/cygdrive/drive/path", translate this to
+	-- "drive:/path" (as GHC isn't a cygwin app and doesn't
+	-- understand /cygdrive paths.)
+     xltCygdrive path
+      | "/cygdrive/" `isPrefixOf` path = 
+	  case drop (length "/cygdrive/") path of
+	    drive:xs@('/':_) -> drive:':':xs
+	    _ -> path
+      | otherwise = path
+
+        -- strip the trailing backslash (awful, but we only do this once).
+     removeTrailingSlash path = 
+       case last path of
+         '/'  -> init path
+         '\\' -> init path
+         _    -> path
+#endif
 
 -----------------------------------------------------------------------------
 -- Via-C compilation stuff
@@ -1228,3 +1266,22 @@ picCCOpts dflags
     | otherwise
         = []
 #endif
+
+-- -----------------------------------------------------------------------------
+-- Splitting
+
+can_split :: Bool
+can_split =  
+#if    defined(i386_TARGET_ARCH)     \
+    || defined(alpha_TARGET_ARCH)    \
+    || defined(hppa_TARGET_ARCH)     \
+    || defined(m68k_TARGET_ARCH)     \
+    || defined(mips_TARGET_ARCH)     \
+    || defined(powerpc_TARGET_ARCH)  \
+    || defined(rs6000_TARGET_ARCH)   \
+    || defined(sparc_TARGET_ARCH) 
+   True
+#else
+   False
+#endif
+
diff --git a/ghc/compiler/main/StaticFlags.hs b/ghc/compiler/main/StaticFlags.hs
index 0bce0d1..0d01001 100644
--- a/ghc/compiler/main/StaticFlags.hs
+++ b/ghc/compiler/main/StaticFlags.hs
@@ -58,7 +58,6 @@ module StaticFlags (
 	opt_IgnoreDotGhci,
 	opt_ErrorSpans,
 	opt_EmitCExternDecls,
-	opt_SplitObjs,
 	opt_GranMacros,
 	opt_HiVersion,
 	opt_HistorySize,
@@ -153,12 +152,6 @@ static_flags = [
 	------- Miscellaneous -----------------------------------------------
   ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
 
-  ,  ( "split-objs"	, NoArg (if can_split
-				    then addOpt "-split-objs"
-				    else hPutStrLn stderr
-					    "warning: don't know how to split object files on this architecture"
-				) )
-
 	----- Linker --------------------------------------------------------
   ,  ( "static" 	, PassFlag addOpt )
   ,  ( "dynamic"        , NoArg (removeOpt "-static") )
@@ -278,7 +271,6 @@ opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold" (10::Int)
 opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)
 
 opt_EmitCExternDecls	        = lookUp  FSLIT("-femit-extern-decls")
-opt_SplitObjs			= lookUp  FSLIT("-split-objs")
 opt_GranMacros			= lookUp  FSLIT("-fgransim")
 opt_HiVersion			= read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
 opt_HistorySize			= lookup_def_int "-fhistory-size" 20
@@ -399,24 +391,6 @@ foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 #endif
 
--- -----------------------------------------------------------------------------
--- Splitting
-
-can_split :: Bool
-can_split =  
-#if    defined(i386_TARGET_ARCH)     \
-    || defined(alpha_TARGET_ARCH)    \
-    || defined(hppa_TARGET_ARCH)     \
-    || defined(m68k_TARGET_ARCH)     \
-    || defined(mips_TARGET_ARCH)     \
-    || defined(powerpc_TARGET_ARCH)  \
-    || defined(rs6000_TARGET_ARCH)   \
-    || defined(sparc_TARGET_ARCH) 
-   True
-#else
-   False
-#endif
-
 -----------------------------------------------------------------------------
 -- Ways
 
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 9710bcb..b18cd8a 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -48,8 +48,10 @@ import DriverPhases     ( isHaskellUserSrcFilename )
 import Config
 import Outputable
 import Panic		( GhcException(..) )
-import Util		( Suffix, global, notNull, consIORef )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, Option(..) )
+import Util		( Suffix, global, notNull, consIORef,
+			  normalisePath, pgmPath, platformPath )
+import DynFlags		( DynFlags(..), DynFlag(..), dopt, Option(..),
+			  setTmpDir, defaultDynFlags )
 
 import EXCEPTION	( throwDyn )
 import DATA_IOREF	( IORef, readIORef, writeIORef )
@@ -237,32 +239,32 @@ initSysTools minusB_args dflags
 		| am_installed = installed_bin cGHC_MANGLER_PGM
 		| otherwise    = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM
 
+	; let dflags0 = defaultDynFlags
 #ifndef mingw32_HOST_OS
 	-- check whether TMPDIR is set in the environment
-	; IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
-	      	     setTmpDir dir
-	      	     return ()
-                 )
+	; e_tmpdir <- IO.try (getEnv "TMPDIR") -- fails if not set
 #else
 	  -- On Win32, consult GetTempPath() for a temp dir.
 	  --  => it first tries TMP, TEMP, then finally the
 	  --   Windows directory(!). The directory is in short-path
 	  --   form.
-	; IO.try (do
+	; e_tmpdir <- 
+            IO.try (do
 	        let len = (2048::Int)
 		buf  <- mallocArray len
 		ret  <- getTempPath len buf
-		tdir <-
-		  if ret == 0 then do
+		if ret == 0 then do
 		      -- failed, consult TMPDIR.
  	             free buf
 		     getEnv "TMPDIR"
-		   else do
+		  else do
 		     s <- peekCString buf
 		     free buf
-		     return s
-		setTmpDir tdir)
+		     return s)
 #endif
+        ; let dflags1 = case e_tmpdir of
+			  Left _  -> dflags0
+			  Right d -> setTmpDir d dflags0
 
 	-- Check that the package config exists
 	; config_exists <- doesFileExist pkgconfig_path
@@ -364,7 +366,7 @@ initSysTools minusB_args dflags
 	; writeIORef v_Pgm_T   	 	   touch_path
 	; writeIORef v_Pgm_CP  	 	   cp_path
 
-	; return dflags{
+	; return dflags1{
 			pgm_L	= unlit_path,
 			pgm_P	= cpp_path,
 			pgm_F	= "",
@@ -518,42 +520,9 @@ getUsageMsgPaths = readIORef v_Path_usages
 
 \begin{code}
 GLOBAL_VAR(v_FilesToClean, [],               [String] )
-GLOBAL_VAR(v_TmpDir,       cDEFAULT_TMPDIR,  String   )
-	-- v_TmpDir has no closing '/'
 \end{code}
 
 \begin{code}
-setTmpDir dir = writeIORef v_TmpDir (canonicalise dir)
-    where
-#if !defined(mingw32_HOST_OS)
-     canonicalise p = normalisePath p
-#else
-	-- Canonicalisation of temp path under win32 is a bit more
-	-- involved: (a) strip trailing slash, 
-	-- 	     (b) normalise slashes
-	--	     (c) just in case, if there is a prefix /cygdrive/x/, change to x:
-	-- 
-     canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-
-        -- if we're operating under cygwin, and TMP/TEMP is of
-	-- the form "/cygdrive/drive/path", translate this to
-	-- "drive:/path" (as GHC isn't a cygwin app and doesn't
-	-- understand /cygdrive paths.)
-     xltCygdrive path
-      | "/cygdrive/" `isPrefixOf` path = 
-	  case drop (length "/cygdrive/") path of
-	    drive:xs@('/':_) -> drive:':':xs
-	    _ -> path
-      | otherwise = path
-
-        -- strip the trailing backslash (awful, but we only do this once).
-     removeTrailingSlash path = 
-       case last path of
-         '/'  -> init path
-         '\\' -> init path
-         _    -> path
-#endif
-
 cleanTempFiles :: DynFlags -> IO ()
 cleanTempFiles dflags
    = do fs <- readIORef v_FilesToClean
@@ -569,10 +538,9 @@ cleanTempFilesExcept dflags dont_delete
 
 
 -- find a temporary name that doesn't already exist.
-newTempName :: Suffix -> IO FilePath
-newTempName extn
+newTempName :: DynFlags -> Suffix -> IO FilePath
+newTempName DynFlags{tmpDir=tmp_dir} extn
   = do x <- getProcessID
-       tmp_dir <- readIORef v_TmpDir
        findTempName tmp_dir x
   where 
     findTempName tmp_dir x
@@ -669,54 +637,6 @@ traceCmd dflags phase_name cmd_line action
 	          	     ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
 \end{code}
 
-
-%************************************************************************
-%*									*
-\subsection{Path names}
-%*									*
-%************************************************************************
-
-We maintain path names in Unix form ('/'-separated) right until 
-the last moment.  On Windows we dos-ify them just before passing them
-to the Windows command.
-
-The alternative, of using '/' consistently on Unix and '\' on Windows,
-proved quite awkward.  There were a lot more calls to platformPath,
-and even on Windows we might invoke a unix-like utility (eg 'sh'), which
-interpreted a command line 'foo\baz' as 'foobaz'.
-
-\begin{code}
------------------------------------------------------------------------------
--- Convert filepath into platform / MSDOS form.
-
-normalisePath :: String -> String
--- Just changes '\' to '/'
-
-pgmPath :: String		-- Directory string in Unix format
-	-> String		-- Program name with no directory separators
-				--	(e.g. copy /y)
-	-> String		-- Program invocation string in native format
-
-
-
-#if defined(mingw32_HOST_OS)
---------------------- Windows version ------------------
-normalisePath xs = subst '\\' '/' xs
-platformPath p   = subst '/' '\\' p
-pgmPath dir pgm  = platformPath dir ++ '\\' : pgm
-
-subst a b ls = map (\ x -> if x == a then b else x) ls
-#else
---------------------- Non-Windows version --------------
-normalisePath xs   = xs
-pgmPath dir pgm    = dir ++ '/' : pgm
-platformPath stuff = stuff
---------------------------------------------------------
-#endif
-
-\end{code}
-
-
 -----------------------------------------------------------------------------
    Path name construction
 
diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 2a7492b..e790991 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -37,7 +37,7 @@ import List		( groupBy, sortBy )
 import CLabel           ( pprCLabel )
 import ErrUtils		( dumpIfSet_dyn )
 import DynFlags		( DynFlags, DynFlag(..), dopt )
-import StaticFlags	( opt_Static, opt_SplitObjs, opt_PIC )
+import StaticFlags	( opt_Static, opt_PIC )
 
 import Digraph
 import qualified Pretty
@@ -133,8 +133,8 @@ nativeCodeGen dflags cmms us
   where
 
     add_split (Cmm tops)
-	| opt_SplitObjs = split_marker : tops
-	| otherwise	= tops
+	| dopt Opt_SplitObjs dflags = split_marker : tops
+	| otherwise		    = tops
 
     split_marker = CmmProc [] mkSplitMarkerLabel [] []
 
diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index d3eb975..d51a09d 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -67,6 +67,7 @@ module Util (
 	replaceFilenameSuffix, directoryOf, filenameOf,
 	replaceFilenameDirectory,
 	escapeSpaces, isPathSeparator,
+	normalisePath, platformPath, pgmPath,
     ) where
 
 #include "HsVersions.h"
@@ -923,4 +924,39 @@ isPathSeparator ch =
 #else
   ch == '/'
 #endif
+
+-----------------------------------------------------------------------------
+-- Convert filepath into platform / MSDOS form.
+
+-- We maintain path names in Unix form ('/'-separated) right until 
+-- the last moment.  On Windows we dos-ify them just before passing them
+-- to the Windows command.
+-- 
+-- The alternative, of using '/' consistently on Unix and '\' on Windows,
+-- proved quite awkward.  There were a lot more calls to platformPath,
+-- and even on Windows we might invoke a unix-like utility (eg 'sh'), which
+-- interpreted a command line 'foo\baz' as 'foobaz'.
+
+normalisePath :: String -> String
+-- Just changes '\' to '/'
+
+pgmPath :: String		-- Directory string in Unix format
+	-> String		-- Program name with no directory separators
+				--	(e.g. copy /y)
+	-> String		-- Program invocation string in native format
+
+#if defined(mingw32_HOST_OS)
+--------------------- Windows version ------------------
+normalisePath xs = subst '\\' '/' xs
+pgmPath dir pgm  = platformPath dir ++ '\\' : pgm
+platformPath p   = subst '/' '\\' p
+
+subst a b ls = map (\ x -> if x == a then b else x) ls
+#else
+--------------------- Non-Windows version --------------
+normalisePath xs   = xs
+pgmPath dir pgm    = dir ++ '/' : pgm
+platformPath stuff = stuff
+--------------------------------------------------------
+#endif
 \end{code}