Ticket #7191: 0001-Use-filepath-s-function-instead-of-own-fixes-7191.patch

File 0001-Use-filepath-s-function-instead-of-own-fixes-7191.patch, 5.8 KB (added by shelarcy, 19 months ago)
  • C.hs

    From b059664aa05247c773ab825be320f42a615be6f8 Mon Sep 17 00:00:00 2001
    From: shelarcy <shelarcy@gmail.com>
    Date: Wed, 3 Oct 2012 13:03:08 +0900
    Subject: [PATCH] Use filepath's function instead of own (fixes #7191)
    
    ---
     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 b compiled and run; the output of that program is the .hs file. 
    88 
    99import Data.Char                ( isSpace, intToDigit, ord ) 
    1010import Data.List                ( intersperse ) 
    11 import HSCParser                ( SourcePos(..), Token(..) ) 
     11import System.FilePath          ( splitFileName ) 
    1212 
    13 import Common 
     13import HSCParser                ( SourcePos(..), Token(..) ) 
    1414import Flags 
    1515 
    1616outTemplateHeaderCProg :: FilePath -> String 
    conditional _ = False 
    181181 
    182182outCLine :: SourcePos -> String 
    183183outCLine (SourcePos name line) = 
    184     "#line "++show line++" \""++showCString (snd (splitName name))++"\"\n" 
     184    "#line "++show line++" \""++showCString (snd (splitFileName name))++"\"\n" 
    185185 
    186186outHsLine :: SourcePos -> String 
    187187outHsLine (SourcePos name line) = 
  • Common.hs

    diff --git a/Common.hs b/Common.hs
    index 0c60ca1..120f744 100644
    a b default_compiler = "gcc" 
    2222------------------------------------------------------------------------ 
    2323-- Write the output files. 
    2424 
    25 splitName :: String -> (String, String) 
    26 splitName name = 
    27     case break (== '/') name of 
    28         (file, [])       -> ([], file) 
    29         (dir,  sep:rest) -> (dir++sep:restDir, restFile) 
    30             where 
    31             (restDir, restFile) = splitName rest 
    32  
    33 splitExt :: String -> (String, String) 
    34 splitExt name = 
    35     case break (== '.') name of 
    36         (base, [])         -> (base, []) 
    37         (base, sepRest@(sep:rest)) 
    38             | null restExt -> (base,               sepRest) 
    39             | otherwise    -> (base++sep:restBase, restExt) 
    40             where 
    41             (restBase, restExt) = splitExt rest 
    42  
    4325writeBinaryFile :: FilePath -> String -> IO () 
    4426writeBinaryFile fp str = withBinaryFile fp WriteMode $ \h -> hPutStr h str 
    4527 
    catchIO = Exception.catch 
    8769onlyOne :: String -> IO a 
    8870onlyOne what = die ("Only one "++what++" may be specified\n") 
    8971 
    90 ----------------------------------------- 
    91 -- Modified version from ghc/compiler/SysTools 
    92 -- Convert paths foo/baz to foo\baz on Windows 
    93  
    94 subst :: Char -> Char -> String -> String 
    95 #if defined(mingw32_HOST_OS) || defined(__CYGWIN32__) 
    96 subst a b = map (\x -> if x == a then b else x) 
    97 #else 
    98 subst _ _ = id 
    99 #endif 
    100  
    101 dosifyPath :: String -> String 
    102 dosifyPath = subst '/' '\\' 
    103  
    104 unDosifyPath :: String -> String 
    105 unDosifyPath = subst '\\' '/' 
    106  
  • DirectCodegen.hs

    diff --git a/DirectCodegen.hs b/DirectCodegen.hs
    index deec791..34df161 100644
    a b compiled and run; the output of that program is the .hs file. 
    99import Data.Char                ( isAlphaNum, toUpper ) 
    1010import Control.Monad            ( when, forM_ ) 
    1111 
     12import System.FilePath          ( normalise ) 
    1213import System.Exit              ( ExitCode(..), exitWith ) 
    1314 
    1415import C 
    outputDirect config outName outDir outBase name toks = do 
    3536        outCName     = outDir++outBase++"_hsc.c" 
    3637 
    3738    let execProgName 
    38             | null outDir = dosifyPath ("./" ++ progName) 
     39            | null outDir = normalise ("./" ++ progName) 
    3940            | otherwise   = progName 
    4041 
    4142    let specials = [(pos, key, arg) | Special pos key arg <- toks] 
  • Main.hs

    diff --git a/Main.hs b/Main.hs
    index 48aede9..671b7c4 100644
    a b import Foreign 
    2323import Foreign.C.String 
    2424#endif 
    2525import System.Directory         ( doesFileExist, findExecutable ) 
     26import System.FilePath          ( normalise, splitFileName, splitExtension ) 
    2627import System.Environment       ( getProgName, getArgs ) 
    2728import System.Exit              ( ExitCode(..), exitWith ) 
    2829import System.IO 
    processFiles configM files usage = do 
    117118                            then return (dir++base++"_out.hs", dir, base) 
    118119                            else return (dir++base++".hs",     dir, base) 
    119120                   where 
    120                     (dir,  file) = splitName name 
    121                     (base, ext)  = splitExt  file 
     121                    (dir,  file) = splitFileName name 
     122                    (base, ext)  = splitExtension file 
    122123             [f] -> let 
    123                  (dir,  file) = splitName f 
    124                  (base, _)    = splitExt file 
     124                 (dir,  file) = splitFileName f 
     125                 (base, _)    = splitExtension file 
    125126                 in return (f, dir, base) 
    126127             _ -> onlyOne "output file" 
    127         let file_name = dosifyPath name 
     128        let file_name = normalise name 
    128129        toks <- parseFile file_name 
    129130        outputter config outName outDir outBase file_name toks) 
    130131 
    getExecDir :: String -> IO (Maybe String) 
    218219getExecDir cmd = 
    219220    getExecPath >>= maybe (return Nothing) removeCmdSuffix 
    220221    where initN n = reverse . drop n . reverse 
    221           removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath 
     222          removeCmdSuffix = return . Just . initN (length cmd) . normalise 
    222223 
    223224getExecPath :: IO (Maybe String) 
    224225#if defined(mingw32_HOST_OS) 
  • hsc2hs.cabal

    diff --git a/hsc2hs.cabal b/hsc2hs.cabal
    index c5a13be..36323b2 100644
    a b Executable hsc2hs 
    3939    Build-Depends: base       >= 4   && < 5, 
    4040                   containers >= 0.2 && < 0.6, 
    4141                   directory  >= 1   && < 1.3, 
     42                   filepath   >= 1   && < 1.4, 
    4243                   process    >= 1   && < 1.2 
    4344