Repository : ssh://darcs.haskell.org//srv/darcs/hsc2hs On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/67b8c663216690150b6f762e09b32ebbe6334ddd >--------------------------------------------------------------- commit 67b8c663216690150b6f762e09b32ebbe6334ddd Author: shelarcy <shela...@gmail.com> Date: Wed Oct 3 13:33:48 2012 +0900 Use filepath's function instead of own (fixes #7191) MERGED from commit 2f1d9d3009d6193cc664d85ec24de20ce0380db4 >--------------------------------------------------------------- C.hs | 6 +++--- Common.hs | 35 ----------------------------------- DirectCodegen.hs | 3 ++- Main.hs | 13 +++++++------ hsc2hs.cabal | 1 + 5 files changed, 13 insertions(+), 45 deletions(-) diff --git a/C.hs b/C.hs index 537d77a..11d31f2 100644 --- a/C.hs +++ b/C.hs @@ -8,9 +8,9 @@ compiled and run; the output of that program is the .hs file. import Data.Char ( isSpace, intToDigit, ord ) import Data.List ( intersperse ) -import HSCParser ( SourcePos(..), Token(..) ) +import System.FilePath ( splitFileName ) -import Common +import HSCParser ( SourcePos(..), Token(..) ) import Flags outTemplateHeaderCProg :: FilePath -> String @@ -181,7 +181,7 @@ conditional _ = False outCLine :: SourcePos -> String outCLine (SourcePos name line) = - "#line "++show line++" \""++showCString (snd (splitName name))++"\"\n" + "#line "++show line++" \""++showCString (snd (splitFileName name))++"\"\n" outHsLine :: SourcePos -> String outHsLine (SourcePos name line) = diff --git a/Common.hs b/Common.hs index 0c60ca1..120f744 100644 --- a/Common.hs +++ b/Common.hs @@ -22,24 +22,6 @@ default_compiler = "gcc" ------------------------------------------------------------------------ -- Write the output files. -splitName :: String -> (String, String) -splitName name = - case break (== '/') name of - (file, []) -> ([], file) - (dir, sep:rest) -> (dir++sep:restDir, restFile) - where - (restDir, restFile) = splitName rest - -splitExt :: String -> (String, String) -splitExt name = - case break (== '.') name of - (base, []) -> (base, []) - (base, sepRest@(sep:rest)) - | null restExt -> (base, sepRest) - | otherwise -> (base++sep:restBase, restExt) - where - (restBase, restExt) = splitExt rest - writeBinaryFile :: FilePath -> String -> IO () writeBinaryFile fp str = withBinaryFile fp WriteMode $ \h -> hPutStr h str @@ -87,20 +69,3 @@ catchIO = Exception.catch onlyOne :: String -> IO a onlyOne what = die ("Only one "++what++" may be specified\n") ------------------------------------------ --- Modified version from ghc/compiler/SysTools --- Convert paths foo/baz to foo\baz on Windows - -subst :: Char -> Char -> String -> String -#if defined(mingw32_HOST_OS) || defined(__CYGWIN32__) -subst a b = map (\x -> if x == a then b else x) -#else -subst _ _ = id -#endif - -dosifyPath :: String -> String -dosifyPath = subst '/' '\\' - -unDosifyPath :: String -> String -unDosifyPath = subst '\\' '/' - diff --git a/DirectCodegen.hs b/DirectCodegen.hs index deec791..42b31a5 100644 --- a/DirectCodegen.hs +++ b/DirectCodegen.hs @@ -10,6 +10,7 @@ import Data.Char ( isAlphaNum, toUpper ) import Control.Monad ( when, forM_ ) import System.Exit ( ExitCode(..), exitWith ) +import System.FilePath ( normalise ) import C import Common @@ -35,7 +36,7 @@ outputDirect config outName outDir outBase name toks = do outCName = outDir++outBase++"_hsc.c" let execProgName - | null outDir = dosifyPath ("./" ++ progName) + | null outDir = normalise ("./" ++ progName) | otherwise = progName let specials = [(pos, key, arg) | Special pos key arg <- toks] diff --git a/Main.hs b/Main.hs index 48aede9..30b3a2d 100644 --- a/Main.hs +++ b/Main.hs @@ -25,6 +25,7 @@ import Foreign.C.String import System.Directory ( doesFileExist, findExecutable ) import System.Environment ( getProgName, getArgs ) import System.Exit ( ExitCode(..), exitWith ) +import System.FilePath ( normalise, splitFileName, splitExtension ) import System.IO #ifdef BUILD_NHC @@ -117,14 +118,14 @@ processFiles configM files usage = do then return (dir++base++"_out.hs", dir, base) else return (dir++base++".hs", dir, base) where - (dir, file) = splitName name - (base, ext) = splitExt file + (dir, file) = splitFileName name + (base, ext) = splitExtension file [f] -> let - (dir, file) = splitName f - (base, _) = splitExt file + (dir, file) = splitFileName f + (base, _) = splitExtension file in return (f, dir, base) _ -> onlyOne "output file" - let file_name = dosifyPath name + let file_name = normalise name toks <- parseFile file_name outputter config outName outDir outBase file_name toks) @@ -218,7 +219,7 @@ getExecDir :: String -> IO (Maybe String) getExecDir cmd = getExecPath >>= maybe (return Nothing) removeCmdSuffix where initN n = reverse . drop n . reverse - removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath + removeCmdSuffix = return . Just . initN (length cmd) . normalise getExecPath :: IO (Maybe String) #if defined(mingw32_HOST_OS) diff --git a/hsc2hs.cabal b/hsc2hs.cabal index c5a13be..36323b2 100644 --- a/hsc2hs.cabal +++ b/hsc2hs.cabal @@ -39,5 +39,6 @@ Executable hsc2hs Build-Depends: base >= 4 && < 5, containers >= 0.2 && < 0.6, directory >= 1 && < 1.3, + filepath >= 1 && < 1.4, process >= 1 && < 1.2 _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
