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, 3 years ago)
  • C.hs

    From b059664aa05247c773ab825be320f42a615be6f8 Mon Sep 17 00:00:00 2001
    From: shelarcy <[email protected]>
    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