Use System.FilePath

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index a0c76ec..11c57aa 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -264,7 +264,7 @@ findEditor = do
     `IO.catch` \_ -> do
 #if mingw32_HOST_OS
        win <- System.Win32.getWindowsDirectory
     `IO.catch` \_ -> do
 #if mingw32_HOST_OS
        win <- System.Win32.getWindowsDirectory

-       return (win `joinFileName` "notepad.exe")
+       return (win </> "notepad.exe")

 #else
        return ""
 #endif
 #else
        return ""
 #endif

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 272d571..5ab7416 100644 (file)
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -73,6 +73,7 @@ import Data.IORef
 import Data.List
 import Foreign
 
 import Data.List
 import Foreign
 

+import System.FilePath

 import System.IO
 import System.Directory
 
 import System.IO
 import System.Directory
 

@@ -657,7 +658,7 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
                        return lnk
 
            adjust_ul osuf (DotO file) = do
                        return lnk
 
            adjust_ul osuf (DotO file) = do

-               let new_file = replaceFilenameSuffix file osuf
+               let new_file = replaceExtension file osuf

                ok <- doesFileExist new_file
                if (not ok)
                   then dieWith span $
                ok <- doesFileExist new_file
                if (not ok)
                   then dieWith span $

@@ -1080,8 +1081,8 @@ locateOneObj dirs lib
                        Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
                        Nothing       -> return (DLL lib) }}            -- We assume
    where
                        Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
                        Nothing       -> return (DLL lib) }}            -- We assume
    where

-     mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
-     mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
+     mk_obj_path dir = dir </> lib <.> "o"
+     mk_dyn_lib_path dir = dir </> mkSOName (lib ++ "-ghc" ++ cProjectVersion)

 #else
 -- When the GHC package was compiled as dynamic library (=__PIC__ set),
 -- we search for .so libraries first.
 #else
 -- When the GHC package was compiled as dynamic library (=__PIC__ set),
 -- we search for .so libraries first.

@@ -1096,8 +1097,8 @@ locateOneObj dirs lib
                        Just obj_path -> return (Object obj_path)
                        Nothing       -> return (DLL lib) }}            -- We assume
    where
                        Just obj_path -> return (Object obj_path)
                        Nothing       -> return (DLL lib) }}            -- We assume
    where

-     mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
-     mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
+     mk_obj_path dir = dir </> (lib <.> "o")
+     mk_dyn_lib_path dir = dir </> mkSOName (lib ++ "-ghc" ++ cProjectVersion)

 #endif
 
 -- ----------------------------------------------------------------------------
 #endif
 
 -- ----------------------------------------------------------------------------

@@ -1112,16 +1113,16 @@ loadDynamic paths rootname
                        -- Tried all our known library paths, so let 
                        -- dlopen() search its own builtin paths now.
   where
                        -- Tried all our known library paths, so let 
                        -- dlopen() search its own builtin paths now.
   where

-    mk_dll_path dir = dir `joinFileName` mkSOName rootname
+    mk_dll_path dir = dir </> mkSOName rootname

 
 #if defined(darwin_TARGET_OS)
 
 #if defined(darwin_TARGET_OS)

-mkSOName root = ("lib" ++ root) `joinFileExt` "dylib"
+mkSOName root = ("lib" ++ root) <.> "dylib"

 #elif defined(mingw32_TARGET_OS)
 -- Win32 DLLs have no .dll extension here, because addDLL tries
 -- both foo.dll and foo.drv
 mkSOName root = root
 #else
 #elif defined(mingw32_TARGET_OS)
 -- Win32 DLLs have no .dll extension here, because addDLL tries
 -- both foo.dll and foo.drv
 mkSOName root = root
 #else

-mkSOName root = ("lib" ++ root) `joinFileExt` "so"
+mkSOName root = ("lib" ++ root) <.> "so"

 #endif
 
 -- Darwin / MacOS X only: load a framework
 #endif
 
 -- Darwin / MacOS X only: load a framework

@@ -1141,7 +1142,7 @@ loadFramework extraPaths rootname
                 -- Tried all our known library paths, but dlopen()
                 -- has no built-in paths for frameworks: give up
    where
                 -- Tried all our known library paths, but dlopen()
                 -- has no built-in paths for frameworks: give up
    where

-     mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname)
+     mk_fwk dir = dir </> (rootname ++ ".framework/" ++ rootname)

         -- sorry for the hardcoded paths, I hope they won't change anytime soon:
      defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
 #endif
         -- sorry for the hardcoded paths, I hope they won't change anytime soon:
      defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
 #endif

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index a7bf168..43bae8f 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -233,6 +233,7 @@ import ListSetOps
 import Control.Monad
 import Data.List
 import Data.IORef
 import Control.Monad
 import Data.List
 import Data.IORef

+import System.FilePath

 \end{code}
 
 
 \end{code}
 
 

@@ -465,7 +466,7 @@ mkIface_ hsc_env maybe_old_iface
 -----------------------------
 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 writeIfaceFile dflags location new_iface
 -----------------------------
 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 writeIfaceFile dflags location new_iface

-    = do createDirectoryHierarchy (directoryOf hi_file_path)
+    = do createDirectoryHierarchy (takeDirectory hi_file_path)

          writeBinIface dflags hi_file_path new_iface
     where hi_file_path = ml_hi_file location
 
          writeBinIface dflags hi_file_path new_iface
     where hi_file_path = ml_hi_file location
 

diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index e7e818f..d6e1309 100644 (file)
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -39,6 +39,7 @@ import Distribution.Package   ( showPackageId )
 import Directory       ( doesFileExist )
 import Monad           ( when )
 import IO
 import Directory       ( doesFileExist )
 import Monad           ( when )
 import IO

+import System.FilePath

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -235,7 +236,7 @@ outputForeignStubs dflags mod location stubs
            stub_h_output_w = showSDoc stub_h_output_d
        -- in
 
            stub_h_output_w = showSDoc stub_h_output_d
        -- in
 

-       createDirectoryHierarchy (directoryOf stub_c)
+       createDirectoryHierarchy (takeDirectory stub_c)

 
        dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export header file" stub_h_output_d
 
        dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export header file" stub_h_output_d

diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index a97101b..aad9b8a 100644 (file)
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -22,7 +22,7 @@ module DriverMkDepend (
 import qualified GHC
 import GHC             ( Session, ModSummary(..) )
 import DynFlags
 import qualified GHC
 import GHC             ( Session, ModSummary(..) )
 import DynFlags

-import Util            ( escapeSpaces, splitFilename, joinFileExt )
+import Util            ( escapeSpaces )

 import HscTypes                ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
 import SysTools                ( newTempName )
 import qualified SysTools
 import HscTypes                ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
 import SysTools                ( newTempName )
 import qualified SysTools

@@ -42,6 +42,7 @@ import Data.IORef     ( IORef, readIORef, writeIORef )
 import Control.Exception
 import System.Exit     ( ExitCode(..), exitWith )
 import System.Directory
 import Control.Exception
 import System.Exit     ( ExitCode(..), exitWith )
 import System.Directory

+import System.FilePath

 import System.IO
 import SYSTEM_IO_ERROR  ( isEOFError )
 import Control.Monad    ( when )
 import System.IO
 import SYSTEM_IO_ERROR  ( isEOFError )
 import Control.Monad    ( when )

@@ -272,9 +273,9 @@ insertSuffixes
        -- Lots of other things will break first!
 
 insertSuffixes file_name extras
        -- Lots of other things will break first!
 
 insertSuffixes file_name extras

-  = file_name : [ basename `joinFileExt` (extra ++ "_" ++ suffix) | extra <- extras ]
+  = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]

   where
   where

-    (basename, suffix) = splitFilename file_name
+    (basename, suffix) = splitExtension file_name

 
 
 -----------------------------------------------------------------
 
 
 -----------------------------------------------------------------

diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs
index 5efb46f..99f6089 100644 (file)
--- a/compiler/main/DriverPhases.hs
+++ b/compiler/main/DriverPhases.hs
@@ -40,8 +40,8 @@ module DriverPhases (
    isSourceFilename         -- :: FilePath -> Bool
  ) where
 
    isSourceFilename         -- :: FilePath -> Bool
  ) where
 

-import Util            ( suffixOf )

 import Panic           ( panic )
 import Panic           ( panic )

+import System.FilePath

 
 -----------------------------------------------------------------------------
 -- Phases
 
 -----------------------------------------------------------------------------
 -- Phases

@@ -220,17 +220,18 @@ isCishSuffix           s = s `elem` cish_suffixes
 isExtCoreSuffix        s = s `elem` extcoreish_suffixes
 isObjectSuffix         s = s `elem` objish_suffixes
 isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
 isExtCoreSuffix        s = s `elem` extcoreish_suffixes
 isObjectSuffix         s = s `elem` objish_suffixes
 isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes

-isDynLibSuffix        s = s `elem` dynlib_suffixes
+isDynLibSuffix         s = s `elem` dynlib_suffixes

 
 isSourceSuffix suff  = isHaskellishSuffix suff || isCishSuffix suff
 
 
 isSourceSuffix suff  = isHaskellishSuffix suff || isCishSuffix suff
 

-isHaskellishFilename     f = isHaskellishSuffix     (suffixOf f)
-isHaskellSrcFilename     f = isHaskellSrcSuffix     (suffixOf f)
-isCishFilename           f = isCishSuffix           (suffixOf f)
-isExtCoreFilename        f = isExtCoreSuffix        (suffixOf f)
-isObjectFilename         f = isObjectSuffix         (suffixOf f)
-isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (suffixOf f)
-isDynLibFilename        f = isDynLibSuffix         (suffixOf f)
-isSourceFilename        f = isSourceSuffix         (suffixOf f)
+-- takeExtension return .foo, so we drop 1 to get rid of the .
+isHaskellishFilename     f = isHaskellishSuffix     (drop 1 $ takeExtension f)
+isHaskellSrcFilename     f = isHaskellSrcSuffix     (drop 1 $ takeExtension f)
+isCishFilename           f = isCishSuffix           (drop 1 $ takeExtension f)
+isExtCoreFilename        f = isExtCoreSuffix        (drop 1 $ takeExtension f)
+isObjectFilename         f = isObjectSuffix         (drop 1 $ takeExtension f)
+isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)
+isDynLibFilename         f = isDynLibSuffix         (drop 1 $ takeExtension f)
+isSourceFilename         f = isSourceSuffix         (drop 1 $ takeExtension f)

 
 
 
 

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 6c86cbf..ef2c239 100644 (file)
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -50,6 +50,7 @@ import Control.Exception as Exception
 import Data.IORef      ( readIORef, writeIORef, IORef )
 import GHC.Exts                ( Int(..) )
 import System.Directory
 import Data.IORef      ( readIORef, writeIORef, IORef )
 import GHC.Exts                ( Int(..) )
 import System.Directory

+import System.FilePath

 import System.IO
 import SYSTEM_IO_ERROR as IO
 import Control.Monad
 import System.IO
 import SYSTEM_IO_ERROR as IO
 import Control.Monad

@@ -57,6 +58,7 @@ import Data.List      ( isSuffixOf )
 import Data.Maybe
 import System.Exit
 import System.Environment
 import Data.Maybe
 import System.Exit
 import System.Environment

+import System.FilePath

 
 -- ---------------------------------------------------------------------------
 -- Pre-process
 
 -- ---------------------------------------------------------------------------
 -- Pre-process

@@ -103,12 +105,14 @@ compile hsc_env summary mod_index nmods mb_old_iface maybe_old_linkable
 
    debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
 
 
    debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
 

-   let (basename, _) = splitFilename input_fn
+   let basename = dropExtension input_fn

 
   -- We add the directory in which the .hs files resides) to the import path.
   -- This is needed when we try to compile the .hc file later, if it
   -- imports a _stub.h file that we created here.
 
   -- We add the directory in which the .hs files resides) to the import path.
   -- This is needed when we try to compile the .hc file later, if it
   -- imports a _stub.h file that we created here.

-   let current_dir = directoryOf basename
+   let current_dir = case takeDirectory basename of
+                     "" -> "." -- XXX Hack
+                     d -> d

        old_paths   = includePaths dflags0
        dflags      = dflags0 { includePaths = current_dir : old_paths }
 
        old_paths   = includePaths dflags0
        dflags      = dflags0 { includePaths = current_dir : old_paths }
 

@@ -227,8 +231,8 @@ compile hsc_env summary mod_index nmods mb_old_iface maybe_old_linkable
 
 compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
 compileStub dflags mod location = do
 
 compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
 compileStub dflags mod location = do

-       let (o_base, o_ext) = splitFilename (ml_obj_file location)
-           stub_o = o_base ++ "_stub" `joinFileExt` o_ext
+       let (o_base, o_ext) = splitExtension (ml_obj_file location)
+           stub_o = (o_base ++ "_stub") <.> o_ext

 
        -- compile the _stub.c file w/ gcc
        let (stub_c,_,_) = mkStubPaths dflags (moduleName mod) location
 
        -- compile the _stub.c file w/ gcc
        let (stub_c,_,_) = mkStubPaths dflags (moduleName mod) location

@@ -420,7 +424,8 @@ runPipeline
 runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
   = do
   let
 runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
   = do
   let

-      (input_basename, suffix) = splitFilename input_fn
+      (input_basename, suffix) = splitExtension input_fn
+      suffix' = drop 1 suffix -- strip off the .

       basename | Just b <- mb_basename = b
                | otherwise             = input_basename
 
       basename | Just b <- mb_basename = b
                | otherwise             = input_basename
 

@@ -428,7 +433,7 @@ runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
       dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
 
        -- If we were given a -x flag, then use that phase to start from
       dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
 
        -- If we were given a -x flag, then use that phase to start from

-      start_phase = fromMaybe (startPhase suffix) mb_phase
+      start_phase = fromMaybe (startPhase suffix') mb_phase

 
   -- We want to catch cases of "you can't get there from here" before
   -- we start the pipeline, because otherwise it will just run off the
 
   -- We want to catch cases of "you can't get there from here" before
   -- we start the pipeline, because otherwise it will just run off the

@@ -449,7 +454,7 @@ runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
   -- Execute the pipeline...
   (dflags', output_fn, maybe_loc) <- 
        pipeLoop dflags start_phase stop_phase input_fn 
   -- Execute the pipeline...
   (dflags', output_fn, maybe_loc) <- 
        pipeLoop dflags start_phase stop_phase input_fn 

-                basename suffix get_output_fn maybe_loc
+                basename suffix' get_output_fn maybe_loc

 
   -- Sometimes, a compilation phase doesn't actually generate any output
   -- (eg. the CPP phase when -fcpp is not turned on).  If we end on this
 
   -- Sometimes, a compilation phase doesn't actually generate any output
   -- (eg. the CPP phase when -fcpp is not turned on).  If we end on this

@@ -538,11 +543,11 @@ getOutputFilename stop_phase output basename
                   | StopLn <- next_phase = return odir_persistent
                   | otherwise            = return persistent
 
                   | StopLn <- next_phase = return odir_persistent
                   | otherwise            = return persistent
 

-               persistent = basename `joinFileExt` suffix
+               persistent = basename <.> suffix

 
                odir_persistent
                   | Just loc <- maybe_location = ml_obj_file loc
 
                odir_persistent
                   | Just loc <- maybe_location = ml_obj_file loc

-                  | Just d <- odir = d `joinFileName` persistent
+                  | Just d <- odir = d </> persistent

                   | otherwise      = persistent
 
 
                   | otherwise      = persistent
 
 

@@ -599,7 +604,7 @@ runPhase (Unlit sf) _stop dflags _basename _suff input_fn get_output_fn maybe_lo
 runPhase (Cpp sf) _stop dflags0 basename suff input_fn get_output_fn maybe_loc
   = do src_opts <- getOptionsFromFile input_fn
        (dflags,unhandled_flags) <- parseDynamicFlags dflags0 (map unLoc src_opts)
 runPhase (Cpp sf) _stop dflags0 basename suff input_fn get_output_fn maybe_loc
   = do src_opts <- getOptionsFromFile input_fn
        (dflags,unhandled_flags) <- parseDynamicFlags dflags0 (map unLoc src_opts)

-       checkProcessArgsResult unhandled_flags (basename `joinFileExt` suff)
+       checkProcessArgsResult unhandled_flags (basename <.> suff)

 
        if not (dopt Opt_Cpp dflags) then
            -- no need to preprocess CPP, just pass input file along
 
        if not (dopt Opt_Cpp dflags) then
            -- no need to preprocess CPP, just pass input file along

@@ -620,7 +625,7 @@ runPhase (HsPp sf) _stop dflags basename suff input_fn get_output_fn maybe_loc
           return (Hsc sf, dflags, maybe_loc, input_fn)
        else do
            let hspp_opts = getOpts dflags opt_F
           return (Hsc sf, dflags, maybe_loc, input_fn)
        else do
            let hspp_opts = getOpts dflags opt_F

-           let orig_fn = basename `joinFileExt` suff
+           let orig_fn = basename <.> suff

            output_fn <- get_output_fn dflags (Hsc sf) maybe_loc
            SysTools.runPp dflags
                           ( [ SysTools.Option     orig_fn
            output_fn <- get_output_fn dflags (Hsc sf) maybe_loc
            SysTools.runPp dflags
                           ( [ SysTools.Option     orig_fn

@@ -642,7 +647,9 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
   -- we add the current directory (i.e. the directory in which
   -- the .hs files resides) to the include path, since this is
   -- what gcc does, and it's probably what you want.
   -- we add the current directory (i.e. the directory in which
   -- the .hs files resides) to the include path, since this is
   -- what gcc does, and it's probably what you want.

-       let current_dir = directoryOf basename
+       let current_dir = case takeDirectory basename of
+                      "" -> "." -- XXX Hack
+                      d -> d

        
            paths = includePaths dflags0
            dflags = dflags0 { includePaths = current_dir : paths }
        
            paths = includePaths dflags0
            dflags = dflags0 { includePaths = current_dir : paths }

@@ -655,7 +662,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
                                  ; return (Nothing, mkModuleName m, [], []) }
 
                _           -> do { buf <- hGetStringBuffer input_fn
                                  ; return (Nothing, mkModuleName m, [], []) }
 
                _           -> do { buf <- hGetStringBuffer input_fn

-                           ; (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename `joinFileExt` suff)
+                           ; (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)

                            ; return (Just buf, mod_name, imps, src_imps) }
 
   -- Build a ModLocation to pass to hscMain.
                            ; return (Just buf, mod_name, imps, src_imps) }
 
   -- Build a ModLocation to pass to hscMain.

@@ -699,7 +706,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
   -- changed (which the compiler itself figures out).
   -- Setting source_unchanged to False tells the compiler that M.o is out of
   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
   -- changed (which the compiler itself figures out).
   -- Setting source_unchanged to False tells the compiler that M.o is out of
   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.

-       src_timestamp <- getModificationTime (basename `joinFileExt` suff)
+       src_timestamp <- getModificationTime (basename <.> suff)

 
        let force_recomp = dopt Opt_ForceRecomp dflags
        source_unchanged <- 
 
        let force_recomp = dopt Opt_ForceRecomp dflags
        source_unchanged <- 

@@ -970,7 +977,7 @@ runPhase As _stop dflags _basename _suff input_fn get_output_fn maybe_loc
 
        -- we create directories for the object file, because it
        -- might be a hierarchical module.
 
        -- we create directories for the object file, because it
        -- might be a hierarchical module.

-       createDirectoryHierarchy (directoryOf output_fn)
+       createDirectoryHierarchy (takeDirectory output_fn)

 
        SysTools.runAs dflags   
                       (map SysTools.Option as_opts
 
        SysTools.runAs dflags   
                       (map SysTools.Option as_opts

@@ -995,62 +1002,60 @@ runPhase As _stop dflags _basename _suff input_fn get_output_fn maybe_loc
 
 
 runPhase SplitAs _stop dflags _basename _suff _input_fn get_output_fn maybe_loc
 
 
 runPhase SplitAs _stop dflags _basename _suff _input_fn get_output_fn maybe_loc

-  = do  
-       output_fn <- get_output_fn dflags StopLn maybe_loc
-
-       let (base_o, _) = splitFilename output_fn
-           split_odir  = base_o ++ "_split"
-           osuf = objectSuf dflags
-
-       createDirectoryHierarchy split_odir
-
-       -- remove M_split/ *.o, because we're going to archive M_split/ *.o
-       -- later and we don't want to pick up any old objects.
-       fs <- getDirectoryContents split_odir 
-       mapM_ removeFile $ map (split_odir `joinFileName`)
-                        $ filter (osuf `isSuffixOf`) fs
-
-       let as_opts = getOpts dflags opt_a
-
-       (split_s_prefix, n) <- readIORef v_Split_info
-
-       let split_s   n = split_s_prefix ++ "__" ++ show n `joinFileExt` "s"
-           split_obj n = split_odir `joinFileName`
-                               filenameOf base_o ++ "__" ++ show n
-                                       `joinFileExt` osuf
-
-       let assemble_file n
-             = SysTools.runAs dflags
-                        (map SysTools.Option as_opts ++
-                        [ SysTools.Option "-c"
-                        , SysTools.Option "-o"
-                        , SysTools.FileOption "" (split_obj n)
-                        , SysTools.FileOption "" (split_s n)
-                        ])
-       
-       mapM_ assemble_file [1..n]
-
-       -- and join the split objects into a single object file:
-       let ld_r args = SysTools.runLink dflags ([ 
-                               SysTools.Option "-nostdlib",
-                               SysTools.Option "-nodefaultlibs",
-                               SysTools.Option "-Wl,-r", 
-                               SysTools.Option ld_x_flag, 
-                               SysTools.Option "-o", 
-                               SysTools.FileOption "" output_fn ] ++ args)
+  = do
+        output_fn <- get_output_fn dflags StopLn maybe_loc
+
+        let base_o = dropExtension output_fn
+            split_odir  = base_o ++ "_split"
+            osuf = objectSuf dflags
+
+        createDirectoryHierarchy split_odir
+
+        -- remove M_split/ *.o, because we're going to archive M_split/ *.o
+        -- later and we don't want to pick up any old objects.
+        fs <- getDirectoryContents split_odir
+        mapM_ removeFile $ map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
+
+        let as_opts = getOpts dflags opt_a
+
+        (split_s_prefix, n) <- readIORef v_Split_info
+
+        let split_s   n = split_s_prefix ++ "__" ++ show n <.> "s"
+            split_obj n = split_odir </>
+                          takeFileName base_o ++ "__" ++ show n <.> osuf
+
+        let assemble_file n
+              = SysTools.runAs dflags
+                         (map SysTools.Option as_opts ++
+                          [ SysTools.Option "-c"
+                          , SysTools.Option "-o"
+                          , SysTools.FileOption "" (split_obj n)
+                          , SysTools.FileOption "" (split_s n)
+                          ])
+
+        mapM_ assemble_file [1..n]
+
+        -- and join the split objects into a single object file:
+        let ld_r args = SysTools.runLink dflags ([
+                            SysTools.Option "-nostdlib",
+                            SysTools.Option "-nodefaultlibs",
+                            SysTools.Option "-Wl,-r",
+                            SysTools.Option ld_x_flag,
+                            SysTools.Option "-o",
+                            SysTools.FileOption "" output_fn ] ++ args)

             ld_x_flag | null cLD_X = ""
             ld_x_flag | null cLD_X = ""

-                     | otherwise  = "-Wl,-x"     
+                      | otherwise  = "-Wl,-x"

 
 

-       if cLdIsGNULd == "YES"
-           then do 
-                 let script = split_odir `joinFileName` "ld.script"
-                 writeFile script $
-                     "INPUT(" ++ unwords (map split_obj [1..n]) ++ ")"
-                 ld_r [SysTools.FileOption "" script]
-           else do
-                 ld_r (map (SysTools.FileOption "" . split_obj) [1..n])
+        if cLdIsGNULd == "YES"
+            then do
+                  let script = split_odir </> "ld.script"
+                  writeFile script $
+                      "INPUT(" ++ unwords (map split_obj [1..n]) ++ ")"
+                  ld_r [SysTools.FileOption "" script]
+            else do
+                  ld_r (map (SysTools.FileOption "" . split_obj) [1..n])

 
 

-       return (StopLn, dflags, maybe_loc, output_fn)
+        return (StopLn, dflags, maybe_loc, output_fn)

 
 -- warning suppression
 runPhase other _stop _dflags _basename _suff _input_fn _get_output_fn _maybe_loc =
 
 -- warning suppression
 runPhase other _stop _dflags _basename _suff _input_fn _get_output_fn _maybe_loc =

@@ -1279,10 +1284,10 @@ linkBinary dflags o_files dep_packages = do
 
 exeFileName :: DynFlags -> FilePath
 exeFileName dflags
 
 exeFileName :: DynFlags -> FilePath
 exeFileName dflags

-  | Just s <- outputFile dflags = 
+  | Just s <- outputFile dflags =

 #if defined(mingw32_HOST_OS)
 #if defined(mingw32_HOST_OS)

-      if null (suffixOf s)
-        then s `joinFileExt` "exe"
+      if null (takeExtension s)
+        then s <.> "exe"

         else s
 #else
       s
         else s
 #else
       s

@@ -1305,14 +1310,14 @@ maybeCreateManifest _ _ = do
 maybeCreateManifest dflags exe_filename = do
   if not (dopt Opt_GenManifest dflags) then return [] else do
 
 maybeCreateManifest dflags exe_filename = do
   if not (dopt Opt_GenManifest dflags) then return [] else do
 

-  let manifest_filename = exe_filename `joinFileExt` "manifest"
+  let manifest_filename = exe_filename <.> "manifest"

 
   writeFile manifest_filename $ 
       "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
       "  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
       "  <assemblyIdentity version=\"1.0.0.0\"\n"++
       "     processorArchitecture=\"X86\"\n"++
 
   writeFile manifest_filename $ 
       "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
       "  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
       "  <assemblyIdentity version=\"1.0.0.0\"\n"++
       "     processorArchitecture=\"X86\"\n"++

-      "     name=\"" ++ basenameOf exe_filename ++ "\"\n"++
+      "     name=\"" ++ dropExtension exe_filename ++ "\"\n"++

       "     type=\"win32\"/>\n\n"++
       "  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
       "    <security>\n"++
       "     type=\"win32\"/>\n\n"++
       "  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
       "    <security>\n"++

@@ -1433,7 +1438,7 @@ linkDynLib dflags o_files dep_packages = do
         ++ map SysTools.Option (
            md_c_flags
         ++ o_files
         ++ map SysTools.Option (
            md_c_flags
         ++ o_files

-        ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd `joinFileName` output_fn) ]
+        ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd </> output_fn) ]

         ++ extra_ld_inputs
         ++ lib_path_opts
         ++ extra_ld_opts
         ++ extra_ld_inputs
         ++ lib_path_opts
         ++ extra_ld_opts

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2afa91d..7d692ec 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -93,6 +93,7 @@ import Util           ( split )
 #endif
 
 import Data.Char
 #endif
 
 import Data.Char

+import System.FilePath

 import System.IO        ( hPutStrLn, stderr )
 
 -- -----------------------------------------------------------------------------
 import System.IO        ( hPutStrLn, stderr )
 
 -- -----------------------------------------------------------------------------

@@ -1573,32 +1574,28 @@ setTmpDir :: FilePath -> DynFlags -> DynFlags
 setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
   where
 #if !defined(mingw32_HOST_OS)
 setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
   where
 #if !defined(mingw32_HOST_OS)

-     canonicalise p = normalisePath p
+     canonicalise p = normalise p

 #else
 #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
+     -- 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 = removeTrailingSlash $ normalise $ xltCygdrive 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.)
+     cygdrivePrefix = [pathSeparator] ++ "/cygdrive/" ++ [pathSeparator]
+     xltCygdrive path = case maybePrefixMatch cygdrivePrefix path of
+                        Just (drive:sep:xs))
+                         | isPathSeparator sep -> drive:':':pathSeparator:xs
+                        _ -> path
+
+     -- strip the trailing backslash (awful, but we only do this once).
+     removeTrailingSlash path
+      | isPathSeparator (last path) = init path
+      | othwerwise                  = path

 #endif
 
 -----------------------------------------------------------------------------
 #endif
 
 -----------------------------------------------------------------------------

diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index 206d118..61bf196 100644 (file)
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -42,6 +42,7 @@ import Maybes         ( expectJust )
 import Data.IORef      ( IORef, writeIORef, readIORef, modifyIORef )
 import Data.List
 import System.Directory
 import Data.IORef      ( IORef, writeIORef, readIORef, modifyIORef )
 import Data.List
 import System.Directory

+import System.FilePath

 import System.IO
 import Control.Monad
 import System.Time     ( ClockTime )
 import System.IO
 import Control.Monad
 import System.Time     ( ClockTime )

@@ -346,8 +347,8 @@ searchPathExts paths mod exts
                | path <- paths, 
                  (ext,fn) <- exts,
                  let base | path == "." = basename
                | path <- paths, 
                  (ext,fn) <- exts,
                  let base | path == "." = basename

-                          | otherwise   = path `joinFileName` basename
-                     file = base `joinFileExt` ext
+                          | otherwise   = path </> basename
+                     file = base <.> ext

                ]
 
     search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
                ]
 
     search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))

@@ -360,7 +361,7 @@ searchPathExts paths mod exts
 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
                          -> FilePath -> BaseName -> IO ModLocation
 mkHomeModLocationSearched dflags mod suff path basename = do
 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
                          -> FilePath -> BaseName -> IO ModLocation
 mkHomeModLocationSearched dflags mod suff path basename = do

-   mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
+   mkHomeModLocation2 dflags mod (path </> basename) suff

 
 -- -----------------------------------------------------------------------------
 -- Constructing a home module location
 
 -- -----------------------------------------------------------------------------
 -- Constructing a home module location

@@ -397,7 +398,7 @@ mkHomeModLocationSearched dflags mod suff path basename = do
 
 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
 mkHomeModLocation dflags mod src_filename = do
 
 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
 mkHomeModLocation dflags mod src_filename = do

-   let (basename,extension) = splitFilename src_filename
+   let (basename,extension) = splitExtension src_filename

    mkHomeModLocation2 dflags mod basename extension
 
 mkHomeModLocation2 :: DynFlags
    mkHomeModLocation2 dflags mod basename extension
 
 mkHomeModLocation2 :: DynFlags

@@ -411,17 +412,17 @@ mkHomeModLocation2 dflags mod src_basename ext = do
    obj_fn  <- mkObjPath  dflags src_basename mod_basename
    hi_fn   <- mkHiPath   dflags src_basename mod_basename
 
    obj_fn  <- mkObjPath  dflags src_basename mod_basename
    hi_fn   <- mkHiPath   dflags src_basename mod_basename
 

-   return (ModLocation{ ml_hs_file   = Just (src_basename `joinFileExt` ext),
+   return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),

                        ml_hi_file   = hi_fn,
                        ml_obj_file  = obj_fn })
 
 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
                    -> IO ModLocation
 mkHiOnlyModLocation dflags hisuf path basename
                        ml_hi_file   = hi_fn,
                        ml_obj_file  = obj_fn })
 
 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
                    -> IO ModLocation
 mkHiOnlyModLocation dflags hisuf path basename

- = do let full_basename = path `joinFileName` basename
+ = do let full_basename = path </> basename

       obj_fn  <- mkObjPath  dflags full_basename basename
       return ModLocation{    ml_hs_file   = Nothing,
       obj_fn  <- mkObjPath  dflags full_basename basename
       return ModLocation{    ml_hs_file   = Nothing,

-                            ml_hi_file   = full_basename  `joinFileExt` hisuf,
+                            ml_hi_file   = full_basename <.> hisuf,

                                -- Remove the .hi-boot suffix from
                                -- hi_file, if it had one.  We always
                                -- want the name of the real .hi file
                                -- Remove the .hi-boot suffix from
                                -- hi_file, if it had one.  We always
                                -- want the name of the real .hi file

@@ -441,10 +442,10 @@ mkObjPath dflags basename mod_basename
                odir = objectDir dflags
                osuf = objectSuf dflags
        
                odir = objectDir dflags
                osuf = objectSuf dflags
        

-               obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
+               obj_basename | Just dir <- odir = dir </> mod_basename

                             | otherwise        = basename
 
                             | otherwise        = basename
 

-        return (obj_basename `joinFileExt` osuf)
+        return (obj_basename <.> osuf)

 
 -- | Constructs the filename of a .hi file for a given source file.
 -- Does /not/ check whether the .hi file exists
 
 -- | Constructs the filename of a .hi file for a given source file.
 -- Does /not/ check whether the .hi file exists

@@ -458,10 +459,10 @@ mkHiPath dflags basename mod_basename
                hidir = hiDir dflags
                hisuf = hiSuf dflags
 
                hidir = hiDir dflags
                hisuf = hiSuf dflags
 

-               hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
+               hi_basename | Just dir <- hidir = dir </> mod_basename

                            | otherwise         = basename
 
                            | otherwise         = basename
 

-        return (hi_basename `joinFileExt` hisuf)
+        return (hi_basename <.> hisuf)

 
 
 -- -----------------------------------------------------------------------------
 
 
 -- -----------------------------------------------------------------------------

@@ -478,35 +479,35 @@ mkStubPaths
 
 mkStubPaths dflags mod location
   = let
 
 mkStubPaths dflags mod location
   = let

-               stubdir = stubDir dflags
+        stubdir = stubDir dflags

 
 

-               mod_basename = moduleNameSlashes mod
+               mod_basename = dots_to_slashes (moduleNameString mod)

                src_basename = basenameOf (expectJust "mkStubPaths" 
                                                (ml_hs_file location))
 
                src_basename = basenameOf (expectJust "mkStubPaths" 
                                                (ml_hs_file location))
 

-               stub_basename0
-                       | Just dir <- stubdir = dir `joinFileName` mod_basename
-                       | otherwise           = src_basename
-
-               stub_basename = stub_basename0 ++ "_stub"
-
-                -- this is the filename we're going to use when
-                -- #including the stub_h file from the .hc file.
-                -- Without -stubdir, we just #include the basename
-                -- (eg. for a module A.B, we #include "B_stub.h"),
-                -- relying on the fact that we add an implicit -I flag
-                -- for the directory in which the source file resides
-                -- (see DriverPipeline.hs).  With -stubdir, we
-                -- #include "A/B.h", assuming that the user has added
-                -- -I<dir> along with -stubdir <dir>.
-                include_basename
-                        | Just _ <- stubdir = mod_basename 
-                        | otherwise         = filenameOf src_basename
+        stub_basename0
+            | Just dir <- stubdir = dir </> mod_basename
+            | otherwise           = src_basename
+
+        stub_basename = stub_basename0 ++ "_stub"
+
+        -- this is the filename we're going to use when
+        -- #including the stub_h file from the .hc file.
+        -- Without -stubdir, we just #include the basename
+        -- (eg. for a module A.B, we #include "B_stub.h"),
+        -- relying on the fact that we add an implicit -I flag
+        -- for the directory in which the source file resides
+        -- (see DriverPipeline.hs).  With -stubdir, we
+        -- #include "A/B.h", assuming that the user has added
+        -- -I<dir> along with -stubdir <dir>.
+        include_basename
+                | Just _ <- stubdir = mod_basename 
+                | otherwise         = takeFileName src_basename

      in
      in

-        (stub_basename `joinFileExt` "c",
-        stub_basename `joinFileExt` "h",
-         (include_basename ++ "_stub") `joinFileExt` "h")
-       -- the _stub.o filename is derived from the ml_obj_file.
+        (stub_basename <.> "c",
+         stub_basename <.> "h",
+         (include_basename ++ "_stub") <.> "h")
+        -- the _stub.o filename is derived from the ml_obj_file.

 
 -- -----------------------------------------------------------------------------
 -- findLinkable isn't related to the other stuff in here, 
 
 -- -----------------------------------------------------------------------------
 -- findLinkable isn't related to the other stuff in here, 

@@ -524,14 +525,19 @@ findObjectLinkableMaybe mod locn
 -- its modification time.
 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
 findObjectLinkable mod obj_fn obj_time = do
 -- its modification time.
 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
 findObjectLinkable mod obj_fn obj_time = do

-  let stub_fn = case splitFilename3 obj_fn of
-                       (dir, base, _ext) -> dir ++ "/" ++ base ++ "_stub.o"
+  let stub_fn = (dropExtension obj_fn ++ "_stub") <.> "o"

   stub_exist <- doesFileExist stub_fn
   if stub_exist
        then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
        else return (LM obj_time mod [DotO obj_fn])
 
 -- -----------------------------------------------------------------------------
   stub_exist <- doesFileExist stub_fn
   if stub_exist
        then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
        else return (LM obj_time mod [DotO obj_fn])
 
 -- -----------------------------------------------------------------------------

+-- Utils
+
+dots_to_slashes :: String -> String
+dots_to_slashes = map (\c -> if c == '.' then '/' else c)
+
+-- -----------------------------------------------------------------------------

 -- Error messages
 
 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
 -- Error messages
 
 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index c44cc83..ec62de5 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -218,7 +218,8 @@ import TcRnMonad        ( initIfaceCheck )
 import Packages
 import NameSet
 import RdrName
 import Packages
 import NameSet
 import RdrName

-import HsSyn 
+import qualified HsSyn -- hack as we want to reexport the whole module
+import HsSyn hiding ((<.>))

 import Type             hiding (typeKind)
 import TcType           hiding (typeKind)
 import Id
 import Type             hiding (typeKind)
 import TcType           hiding (typeKind)
 import Id

@@ -277,6 +278,7 @@ import System.Exit  ( exitWith, ExitCode(..) )
 import System.Time     ( ClockTime, getClockTime )
 import Control.Exception as Exception hiding (handle)
 import Data.IORef
 import System.Time     ( ClockTime, getClockTime )
 import Control.Exception as Exception hiding (handle)
 import Data.IORef

+import System.FilePath

 import System.IO
 import System.IO.Error ( try, isDoesNotExistError )
 import Prelude hiding (init)
 import System.IO
 import System.IO.Error ( try, isDoesNotExistError )
 import Prelude hiding (init)

@@ -395,7 +397,7 @@ guessOutputFile s = modifySession s $ \env ->
             let isMain = (== mainModIs dflags) . ms_mod
             [ms] <- return (filter isMain mod_graph)
             ml_hs_file (ms_location ms)
             let isMain = (== mainModIs dflags) . ms_mod
             [ms] <- return (filter isMain mod_graph)
             ml_hs_file (ms_location ms)

-        guessedName = fmap basenameOf mainModuleSrcPath
+        guessedName = fmap dropExtension mainModuleSrcPath

     in
     case outputFile dflags of
         Just _ -> env
     in
     case outputFile dflags of
         Just _ -> env

@@ -456,8 +458,8 @@ guessTarget file Nothing
           else do
        return (Target (TargetModule (mkModuleName file)) Nothing)
      where 
           else do
        return (Target (TargetModule (mkModuleName file)) Nothing)
      where 

-        hs_file  = file `joinFileExt` "hs"
-        lhs_file = file `joinFileExt` "lhs"
+        hs_file  = file <.> "hs"
+        lhs_file = file <.> "lhs"

 
 -- -----------------------------------------------------------------------------
 -- Extending the program scope
 
 -- -----------------------------------------------------------------------------
 -- Extending the program scope

diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs
index f96b085..7c77caf 100644 (file)
--- a/compiler/main/Main.hs
+++ b/compiler/main/Main.hs
@@ -54,6 +54,7 @@ import System.IO
 import System.Directory        ( doesDirectoryExist )
 import System.Environment
 import System.Exit
 import System.Directory        ( doesDirectoryExist )
 import System.Environment
 import System.Exit

+import System.FilePath

 import Control.Monad
 import Data.List
 import Data.Maybe
 import Control.Monad
 import Data.List
 import Data.Maybe

@@ -147,7 +148,7 @@ main =
      -- To simplify the handling of filepaths, we normalise all filepaths right 
      -- away - e.g., for win32 platforms, backslashes are converted
      -- into forward slashes.
      -- To simplify the handling of filepaths, we normalise all filepaths right 
      -- away - e.g., for win32 platforms, backslashes are converted
      -- into forward slashes.

-    normal_fileish_paths = map normalisePath fileish_args
+    normal_fileish_paths = map normalise fileish_args

     (srcs, objs)         = partition_args normal_fileish_paths [] []
 
   -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on 
     (srcs, objs)         = partition_args normal_fileish_paths [] []
 
   -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on 

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 0b77983..d5cfbd1 100644 (file)
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -66,6 +66,7 @@ import FastString
 import ErrUtils         ( debugTraceMsg, putMsg, Message )
 
 import System.Directory
 import ErrUtils         ( debugTraceMsg, putMsg, Message )
 
 import System.Directory

+import System.FilePath

 import Data.Maybe
 import Control.Monad
 import Data.List
 import Data.Maybe
 import Control.Monad
 import Data.List

@@ -210,14 +211,14 @@ getSystemPackageConfigs dflags = do
        -- to maintain the package database on systems with a package
        -- management system, or systems that don't want to run ghc-pkg
        -- to register or unregister packages.  Undocumented feature for now.
        -- to maintain the package database on systems with a package
        -- management system, or systems that don't want to run ghc-pkg
        -- to register or unregister packages.  Undocumented feature for now.

-   let system_pkgconf_dir = system_pkgconf ++ ".d"
+   let system_pkgconf_dir = system_pkgconf <.> "d"

    system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
    system_pkgconfs <-
      if system_pkgconf_dir_exists
        then do files <- getDirectoryContents system_pkgconf_dir
    system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
    system_pkgconfs <-
      if system_pkgconf_dir_exists
        then do files <- getDirectoryContents system_pkgconf_dir

-               return [ system_pkgconf_dir ++ '/' : file
+               return [ system_pkgconf_dir </> file

                       | file <- files
                       | file <- files

-                      , isSuffixOf ".conf" file]
+                      , takeExtension file == ".conf" ]

        else return []
 
        -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
        else return []
 
        -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)

@@ -228,8 +229,8 @@ getSystemPackageConfigs dflags = do
       appdir <- getAppUserDataDirectory "ghc"
       let 
         pkgconf = appdir
       appdir <- getAppUserDataDirectory "ghc"
       let 
         pkgconf = appdir

-                  `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
-                  `joinFileName` "package.conf"
+                  </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+                  </> "package.conf"

       flg <- doesFileExist pkgconf
       if (flg && dopt Opt_ReadUserPackageConf dflags)
        then return [pkgconf]
       flg <- doesFileExist pkgconf
       if (flg && dopt Opt_ReadUserPackageConf dflags)
        then return [pkgconf]

diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index f5812f4..41421d6 100644 (file)
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -29,7 +29,6 @@ module SysTools (
        touch,                  -- String -> String -> IO ()
        copy,
         copyWithHeader,
        touch,                  -- String -> String -> IO ()
        copy,
         copyWithHeader,

-       normalisePath,          -- FilePath -> FilePath

         getExtraViaCOpts,
        
        -- Temporary-file management
         getExtraViaCOpts,
        
        -- Temporary-file management

@@ -58,6 +57,7 @@ import Data.IORef
 import Control.Monad
 import System.Exit
 import System.Environment
 import Control.Monad
 import System.Exit
 import System.Environment

+import System.FilePath

 import System.IO
 import SYSTEM_IO_ERROR as IO
 import System.Directory
 import System.IO
 import SYSTEM_IO_ERROR as IO
 import System.Directory

@@ -172,10 +172,9 @@ initSysTools mbMinusB dflags
                -- format, '/' separated
 
        ; let installed, installed_bin :: FilePath -> FilePath
                -- format, '/' separated
 
        ; let installed, installed_bin :: FilePath -> FilePath

-              installed_bin pgm   =  pgmPath top_dir pgm
-             installed     file  =  pgmPath top_dir file
-             inplace dir   pgm   =  pgmPath (top_dir `joinFileName` 
-                                               cPROJECT_DIR `joinFileName` dir) pgm
+              installed_bin pgm   =  top_dir </> pgm
+             installed     file  =  top_dir </> file
+             inplace dir   pgm   =  top_dir </> cPROJECT_DIR </> dir </> pgm

 
        ; let pkgconfig_path
                | am_installed = installed "package.conf"
 
        ; let pkgconfig_path
                | am_installed = installed "package.conf"

@@ -281,9 +280,9 @@ initSysTools mbMinusB dflags
 
        ; let (mkdll_prog, mkdll_args)
                | am_installed = 
 
        ; let (mkdll_prog, mkdll_args)
                | am_installed = 

-                   (pgmPath (installed "gcc-lib/") cMKDLL,
+                   (installed "gcc-lib/" </> cMKDLL,

                     [ Option "--dlltool-name",
                     [ Option "--dlltool-name",

-                      Option (pgmPath (installed "gcc-lib/") "dlltool"),
+                      Option (installed "gcc-lib/" </> "dlltool"),

                       Option "--driver-name",
                       Option gcc_prog, gcc_b_arg ])
                | otherwise    = (cMKDLL, [])
                       Option "--driver-name",
                       Option gcc_prog, gcc_b_arg ])
                | otherwise    = (cMKDLL, [])

@@ -374,14 +373,14 @@ findTopDir mbMinusB
   = do { top_dir <- get_proto
         -- Discover whether we're running in a build tree or in an installation,
        -- by looking for the package configuration file.
   = do { top_dir <- get_proto
         -- Discover whether we're running in a build tree or in an installation,
        -- by looking for the package configuration file.

-       ; am_installed <- doesFileExist (top_dir `joinFileName` "package.conf")
+       ; am_installed <- doesFileExist (top_dir </> "package.conf")

 
        ; return (am_installed, top_dir)
        }
   where
     -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
     get_proto = case mbMinusB of
 
        ; return (am_installed, top_dir)
        }
   where
     -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
     get_proto = case mbMinusB of

-                  Just minusb -> return (normalisePath minusb)
+                  Just minusb -> return (normalise minusb)

                   Nothing
                       -> do maybe_exec_dir <- getBaseDir -- Get directory of executable
                            case maybe_exec_dir of       -- (only works on Windows; 
                   Nothing
                       -> do maybe_exec_dir <- getBaseDir -- Get directory of executable
                            case maybe_exec_dir of       -- (only works on Windows; 

@@ -573,7 +572,7 @@ copyWithHeader dflags purpose maybe_header from to = do
 
 getExtraViaCOpts :: DynFlags -> IO [String]
 getExtraViaCOpts dflags = do
 
 getExtraViaCOpts :: DynFlags -> IO [String]
 getExtraViaCOpts dflags = do

-  f <- readFile (topDir dflags `joinFileName` "extra-gcc-opts")
+  f <- readFile (topDir dflags </> "extra-gcc-opts")

   return (words f)
 \end{code}
 
   return (words f)
 \end{code}
 

@@ -621,11 +620,11 @@ newTempName dflags extn
   where
     findTempName :: FilePath -> Integer -> IO FilePath
     findTempName prefix x
   where
     findTempName :: FilePath -> Integer -> IO FilePath
     findTempName prefix x

-      = do let filename = (prefix ++ show x) `joinFileExt` extn
-          b  <- doesFileExist filename
-          if b then findTempName prefix (x+1)
-               else do consIORef v_FilesToClean filename -- clean it up later
-                       return filename
+      = do let filename = (prefix ++ show x) <.> extn
+           b  <- doesFileExist filename
+           if b then findTempName prefix (x+1)
+                else do consIORef v_FilesToClean filename -- clean it up later
+                        return filename

 
 -- return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet
 
 -- return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet

@@ -862,7 +861,7 @@ data BuildMessage
   | EOF
 #endif
 
   | EOF
 #endif
 

-showOpt (FileOption pre f) = pre ++ platformPath f
+showOpt (FileOption pre f) = pre ++ f

 showOpt (Option s)  = s
 
 traceCmd :: DynFlags -> String -> String -> IO () -> IO ()
 showOpt (Option s)  = s
 
 traceCmd :: DynFlags -> String -> String -> IO () -> IO ()

@@ -908,7 +907,12 @@ getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
                                    free buf
                                    return (Just (rootDir s))
   where
                                    free buf
                                    return (Just (rootDir s))
   where

-    rootDir s = reverse (dropList "/bin/ghc.exe" (reverse (normalisePath s)))
+    rootDir s = case splitFileName $ normalise s of
+                (d, "ghc.exe") ->
+                    case splitFileName $ takeDirectory d of
+                    (d', "bin") -> takeDirectory d'
+                    _ -> panic ("Expected \"bin\" in " ++ show s)
+                _ -> panic ("Expected \"ghc.exe\" in " ++ show s)

 
 foreign import stdcall unsafe "GetModuleFileNameA"
   getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
 
 foreign import stdcall unsafe "GetModuleFileNameA"
   getModuleFileName :: Ptr () -> CString -> Int -> IO Int32

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 6cefad6..862b46a 100644 (file)
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -73,16 +73,10 @@ module Util (
        later, handleDyn, handle,
 
        -- Filename utils
        later, handleDyn, handle,
 
        -- Filename utils

-       Suffix,
-       splitFilename, suffixOf, basenameOf, joinFileExt,
-       splitFilenameDir, joinFileName,
-       splitFilename3,
+    Suffix,

        splitLongestPrefix,
        splitLongestPrefix,

-       replaceFilenameSuffix, directoryOf, filenameOf,
-       replaceFilenameDirectory,
-       escapeSpaces, isPathSeparator,
+       escapeSpaces,

        parseSearchPath,
        parseSearchPath,

-       normalisePath, platformPath, pgmPath,

     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

@@ -106,10 +100,11 @@ import qualified Data.List as List ( elem )
 import qualified Data.List as List ( notElem )
 #endif
 
 import qualified Data.List as List ( notElem )
 #endif
 

-import Control.Monad   ( when )
+import Control.Monad   ( unless )

 import SYSTEM_IO_ERROR as IO ( catch, isDoesNotExistError )
 import System.Directory        ( doesDirectoryExist, createDirectory,
                           getModificationTime )
 import SYSTEM_IO_ERROR as IO ( catch, isDoesNotExistError )
 import System.Directory        ( doesDirectoryExist, createDirectory,
                           getModificationTime )

+import System.FilePath hiding ( searchPathSeparator )

 import Data.Char       ( isUpper, isAlphaNum, isSpace, ord, isDigit )
 import Data.Ratio      ( (%) )
 import System.Time     ( ClockTime )
 import Data.Char       ( isUpper, isAlphaNum, isSpace, ord, isDigit )
 import Data.Ratio      ( (%) )
 import System.Time     ( ClockTime )

@@ -761,17 +756,20 @@ readRational top_s
 -- Create a hierarchy of directories
 
 createDirectoryHierarchy :: FilePath -> IO ()
 -- Create a hierarchy of directories
 
 createDirectoryHierarchy :: FilePath -> IO ()

+createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack

 createDirectoryHierarchy dir = do
   b <- doesDirectoryExist dir
 createDirectoryHierarchy dir = do
   b <- doesDirectoryExist dir

-  when (not b) $ do
-       createDirectoryHierarchy (directoryOf dir)
+  unless b $ do
+       createDirectoryHierarchy (takeDirectory dir)

        createDirectory dir
 
 -----------------------------------------------------------------------------
 -- Verify that the 'dirname' portion of a FilePath exists.
 -- 
 doesDirNameExist :: FilePath -> IO Bool
        createDirectory dir
 
 -----------------------------------------------------------------------------
 -- Verify that the 'dirname' portion of a FilePath exists.
 -- 
 doesDirNameExist :: FilePath -> IO Bool

-doesDirNameExist fpath = doesDirectoryExist (directoryOf fpath)
+doesDirNameExist fpath = case takeDirectory fpath of
+                         ""  -> return True -- XXX Hack
+                         dir -> doesDirectoryExist (takeDirectory fpath)

 
 -- -----------------------------------------------------------------------------
 -- Exception utils
 
 -- -----------------------------------------------------------------------------
 -- Exception utils

@@ -796,49 +794,6 @@ modificationTimeIfExists f = do
                        then return Nothing 
                        else ioError e
 
                        then return Nothing 
                        else ioError e
 

--- --------------------------------------------------------------
--- Filename manipulation
-               
--- Filenames are kept "normalised" inside GHC, using '/' as the path
--- separator.  On Windows these functions will also recognise '\\' as
--- the path separator, but will generally construct paths using '/'.
-
-type Suffix = String
-
-splitFilename :: String -> (String,Suffix)
-splitFilename f = splitLongestPrefix f (=='.')
-
-basenameOf :: FilePath -> String
-basenameOf = fst . splitFilename
-
-suffixOf :: FilePath -> Suffix
-suffixOf = snd . splitFilename
-
-joinFileExt :: String -> String -> FilePath
-joinFileExt path ""  = path
-joinFileExt path ext = path ++ '.':ext
-
--- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
-splitFilenameDir :: String -> (String,String)
-splitFilenameDir str
-   = let (dir, rest) = splitLongestPrefix str isPathSeparator
-        (dir', rest') | null rest = (".", dir)
-                      | otherwise = (dir, rest)
-     in  (dir', rest')
-
--- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
-splitFilename3 :: String -> (String,String,Suffix)
-splitFilename3 str
-   = let (dir, rest) = splitFilenameDir str
-        (name, ext) = splitFilename rest
-     in  (dir, name, ext)
-
-joinFileName :: String -> String -> FilePath
-joinFileName ""  fname = fname
-joinFileName "." fname = fname
-joinFileName dir ""    = dir
-joinFileName dir fname = dir ++ '/':fname
-

 -- split a string at the last character where 'pred' is True,
 -- returning a pair of strings. The first component holds the string
 -- up (but not including) the last character for which 'pred' returned
 -- split a string at the last character where 'pred' is True,
 -- returning a pair of strings. The first component holds the string
 -- up (but not including) the last character for which 'pred' returned

@@ -856,32 +811,10 @@ splitLongestPrefix str pred
   where 
     (r_suf, r_pre) = break pred (reverse str)
 
   where 
     (r_suf, r_pre) = break pred (reverse str)
 

-replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
-replaceFilenameSuffix file suf = basenameOf file `joinFileExt` suf
-
--- directoryOf strips the filename off the input string, returning
--- the directory.
-directoryOf :: FilePath -> String
-directoryOf = fst . splitFilenameDir
-
--- filenameOf strips the directory off the input string, returning
--- the filename.
-filenameOf :: FilePath -> String
-filenameOf = snd . splitFilenameDir
-
-replaceFilenameDirectory :: FilePath -> String -> FilePath
-replaceFilenameDirectory path dir = dir `joinFileName` filenameOf path
-

 escapeSpaces :: String -> String
 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
 
 escapeSpaces :: String -> String
 escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
 

-isPathSeparator :: Char -> Bool
-isPathSeparator ch =
-#ifdef mingw32_TARGET_OS
-  ch == '/' || ch == '\\'
-#else
-  ch == '/'
-#endif
+type Suffix = String

 
 --------------------------------------------------------------
 -- * Search path
 
 --------------------------------------------------------------
 -- * Search path

@@ -916,39 +849,4 @@ searchPathSeparator = ';'
 #else
 searchPathSeparator = ':'
 #endif
 #else
 searchPathSeparator = ':'
 #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}
 \end{code}