import qualified GHC
import GHC ( Session, verbosity, dopt, DynFlag(..),
mkModule, pprModule, Type, Module, SuccessFlag(..),
- TyThing(..), Name, LoadHowMuch(..),
+ TyThing(..), Name, LoadHowMuch(..), Phase,
GhcException(..), showGhcException,
CheckedModule(..) )
import Outputable
" (eg. -v2, -fglasgow-exts, etc.)\n"
-interactiveUI :: Session -> [FilePath] -> Maybe String -> IO ()
+interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
interactiveUI session srcs maybe_expr = do
-- HACK! If we happen to get into an infinite loop (eg the user
return ()
-runGHCi :: [FilePath] -> Maybe String -> GHCi ()
+runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
runGHCi paths maybe_expr = do
let read_dot_files = not opt_IgnoreDotGhci
addModule files = do
io (revertCAFs) -- always revert CAFs on load/add.
files <- mapM expandPath files
- targets <- mapM (io . GHC.guessTarget) files
+ targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
session <- getSession
io (mapM_ (GHC.addTarget session) targets)
ok <- io (GHC.load session LoadAllTargets)
io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
-loadModule :: [FilePath] -> GHCi SuccessFlag
+loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
loadModule fs = timeIt (loadModule' fs)
loadModule_ :: [FilePath] -> GHCi ()
-loadModule_ fs = do loadModule fs; return ()
+loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
-loadModule' :: [FilePath] -> GHCi SuccessFlag
+loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
loadModule' files = do
session <- getSession
io (GHC.load session LoadAllTargets)
-- expand tildes
- files <- mapM expandPath files
- targets <- io (mapM GHC.guessTarget files)
+ let (filenames, phases) = unzip files
+ exp_filenames <- mapM expandPath filenames
+ let files' = zip exp_filenames phases
+ targets <- io (mapM (uncurry GHC.guessTarget) files')
-- NOTE: we used to do the dependency anal first, so that if it
-- fails we didn't throw away the current set of modules. This would
; files <- beginMkDependHS dflags
-- Do the downsweep to find all the modules
- ; targets <- mapM GHC.guessTarget srcs
+ ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
; GHC.setTargets session targets
; excl_mods <- readIORef v_Dep_exclude_mods
; GHC.depanal session excl_mods
-----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.36 2005/03/31 10:16:38 simonmar Exp $
+-- $Id: DriverPhases.hs,v 1.37 2005/05/16 13:47:58 simonmar Exp $
--
-- GHC Driver
--
startPhase, -- :: String -> Phase
phaseInputExt, -- :: Phase -> String
+ isHaskellishSuffix,
+ isHaskellSrcSuffix,
+ isObjectSuffix,
+ isCishSuffix,
+ isExtCoreSuffix,
+ isDynLibSuffix,
+ isHaskellUserSrcSuffix,
+ isSourceSuffix,
+
isHaskellishFilename,
isHaskellSrcFilename,
isObjectFilename,
-- The final phase is a pseudo-phase that tells the pipeline to stop.
-- There is no runPhase case for it.
| StopLn -- Stop, but linking will follow, so generate .o file
- deriving (Show)
+ deriving (Eq, Show)
anyHsc :: Phase
anyHsc = Hsc (panic "anyHsc")
dynlib_suffixes = ["so"]
#endif
-isHaskellishFilename f = getFileSuffix f `elem` haskellish_suffixes
-isHaskellSrcFilename f = getFileSuffix f `elem` haskellish_src_suffixes
-isCishFilename f = getFileSuffix f `elem` cish_suffixes
-isExtCoreFilename f = getFileSuffix f `elem` extcoreish_suffixes
-isObjectFilename f = getFileSuffix f `elem` objish_suffixes
-isHaskellUserSrcFilename f = getFileSuffix f `elem` haskellish_user_src_suffixes
-isDynLibFilename f = getFileSuffix f `elem` dynlib_suffixes
-
-isSourceFilename :: FilePath -> Bool
-isSourceFilename f =
- isHaskellishFilename f ||
- isCishFilename f
+isHaskellishSuffix s = s `elem` haskellish_suffixes
+isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes
+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
+isDynLibSuffix s = s `elem` dynlib_suffixes
+
+isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff
+
+isHaskellishFilename f = isHaskellishSuffix (getFileSuffix f)
+isHaskellSrcFilename f = isHaskellSrcSuffix (getFileSuffix f)
+isCishFilename f = isCishSuffix (getFileSuffix f)
+isExtCoreFilename f = isExtCoreSuffix (getFileSuffix f)
+isObjectFilename f = isObjectSuffix (getFileSuffix f)
+isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (getFileSuffix f)
+isDynLibFilename f = isDynLibSuffix (getFileSuffix f)
+isSourceFilename f = isSourceSuffix (getFileSuffix f)
+
+
module DriverPipeline (
-- Run a series of compilation steps in a pipeline, for a
-- collection of source files.
- oneShot,
+ oneShot, compileFile,
-- Interfaces for the batch-mode driver
staticLink,
-- We return the augmented DynFlags, because they contain the result
-- of slurping in the OPTIONS pragmas
-preprocess :: DynFlags -> FilePath -> IO (DynFlags, FilePath)
-preprocess dflags filename =
- ASSERT2(isHaskellSrcFilename filename, text filename)
- runPipeline anyHsc dflags filename Temporary Nothing{-no ModLocation-}
+preprocess :: DynFlags -> (FilePath, Maybe Phase) -> IO (DynFlags, FilePath)
+preprocess dflags (filename, mb_phase) =
+ ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)
+ runPipeline anyHsc dflags (filename, mb_phase) Temporary Nothing{-no ModLocation-}
-- ---------------------------------------------------------------------------
-- Compile
-- We're in --make mode: finish the compilation pipeline.
_other
- -> do runPipeline StopLn dflags output_fn Persistent
+ -> do runPipeline StopLn dflags (output_fn,Nothing) Persistent
(Just location)
-- The object filename comes from the ModLocation
-- compile the _stub.c file w/ gcc
let stub_c = hscStubCOutName dflags
(_, stub_o) <- runPipeline StopLn dflags
- stub_c Persistent Nothing{-no ModLocation-}
+ (stub_c,Nothing) Persistent Nothing{-no ModLocation-}
return (Just stub_o)
-- -----------------------------------------------------------------------------
-- Compile files in one-shot mode.
-oneShot :: DynFlags -> Phase -> [String] -> IO ()
+oneShot :: DynFlags -> Phase -> [(String, Maybe Phase)] -> IO ()
oneShot dflags stop_phase srcs = do
o_files <- mapM (compileFile dflags stop_phase) srcs
doLink dflags stop_phase o_files
-compileFile :: DynFlags -> Phase -> FilePath -> IO FilePath
-compileFile dflags stop_phase src = do
+compileFile :: DynFlags -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
+compileFile dflags stop_phase (src, mb_phase) = do
exists <- doesFileExist src
when (not exists) $
throwDyn (CmdLineError ("does not exist: " ++ src))
other -> stop_phase
(_, out_file) <- runPipeline stop_phase' dflags
- src output Nothing{-no ModLocation-}
+ (src, mb_phase) output Nothing{-no ModLocation-}
return out_file
-- the output must go into the specified file.
runPipeline
- :: Phase -- When to stop
- -> DynFlags -- Dynamic flags
- -> FilePath -- Input filename
- -> PipelineOutput -- Output filename
- -> Maybe ModLocation -- A ModLocation, if this is a Haskell module
+ :: Phase -- When to stop
+ -> DynFlags -- Dynamic flags
+ -> (FilePath,Maybe Phase) -- Input filename (and maybe -x suffix)
+ -> PipelineOutput -- Output filename
+ -> Maybe ModLocation -- A ModLocation, if this is a Haskell module
-> IO (DynFlags, FilePath) -- (final flags, output filename)
-runPipeline stop_phase dflags input_fn output maybe_loc
+runPipeline stop_phase dflags (input_fn, mb_phase) output maybe_loc
= do
let (basename, suffix) = splitFilename input_fn
- start_phase = startPhase suffix
+
+ -- If we were given a -x flag, then use that phase to start from
+ start_phase
+ | Just x_phase <- mb_phase = x_phase
+ | otherwise = startPhase suffix
-- 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
| StopLn <- next_phase = return odir_persistent
| otherwise = return persistent
- persistent = basename ++ '.':suffix
+ persistent = basename `joinFileExt` suffix
odir_persistent
| Just loc <- maybe_location = ml_obj_file loc
runPhase (Cpp sf) _stop dflags0 basename suff input_fn get_output_fn maybe_loc
= do src_opts <- getOptionsFromSource input_fn
(dflags,unhandled_flags) <- parseDynamicFlags dflags0 src_opts
- checkProcessArgsResult unhandled_flags (basename++'.':suff)
+ checkProcessArgsResult unhandled_flags (basename `joinFileExt` suff)
if not (dopt Opt_Cpp dflags) then
-- no need to preprocess CPP, just pass input file along
return (Hsc sf, dflags, maybe_loc, input_fn)
else do
let hspp_opts = getOpts dflags opt_F
- let orig_fn = basename ++ '.':suff
+ let orig_fn = basename `joinFileExt` suff
output_fn <- get_output_fn (Hsc sf) maybe_loc
SysTools.runPp dflags
( [ SysTools.Option orig_fn
| otherwise = location3
-- Make the ModSummary to hand to hscMain
- src_timestamp <- getModificationTime (basename ++ '.':suff)
+ src_timestamp <- getModificationTime (basename `joinFileExt` suff)
let
unused_field = panic "runPhase:ModSummary field"
-- Some fields are not looked at by hscMain
| otherwise = As
output_fn <- get_output_fn next_phase maybe_loc
- -- force the C compiler to interpret this file as C when
- -- compiling .hc files, by adding the -x c option.
- let langopt | hcc = [ SysTools.Option "-x", SysTools.Option "c"]
- | otherwise = [ ]
-
- SysTools.runCc dflags (langopt ++
+ SysTools.runCc dflags (
+ -- force the C compiler to interpret this file as C when
+ -- compiling .hc files, by adding the -x c option.
+ -- Also useful for plain .c files, just in case GHC saw a
+ -- -x c option.
+ [ SysTools.Option "-x", SysTools.Option "c"] ++
[ SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
(ext,fn) <- exts,
let base | path == "." = basename
| otherwise = path ++ '/':basename
- file = base ++ '.':ext
+ file = base `joinFileExt` ext
]
search [] = return (Failed (map fst to_search))
obj_fn <- mkObjPath dflags src_basename mod_basename
hi_fn <- mkHiPath dflags src_basename mod_basename
- return (ModLocation{ ml_hs_file = Just (src_basename ++ '.':ext),
+ return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext),
ml_hi_file = hi_fn,
ml_obj_file = obj_fn })
= do let full_basename = path++'/':basename
obj_fn <- mkObjPath dflags full_basename basename
return ModLocation{ ml_hs_file = Nothing,
- ml_hi_file = full_basename ++ '.':hisuf,
+ ml_hi_file = full_basename `joinFileExt` hisuf,
-- Remove the .hi-boot suffix from
-- hi_file, if it had one. We always
-- want the name of the real .hi file
obj_basename | Just dir <- odir = dir ++ '/':mod_basename
| otherwise = basename
- return (obj_basename ++ '.':osuf)
+ return (obj_basename `joinFileExt` osuf)
-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
hi_basename | Just dir <- hidir = dir ++ '/':mod_basename
| otherwise = basename
- return (hi_basename ++ '.':hisuf)
+ return (hi_basename `joinFileExt` hisuf)
-- -----------------------------------------------------------------------------
setMsgHandler,
-- * Targets
- Target(..), TargetId(..),
+ Target(..), TargetId(..), Phase,
setTargets,
getTargets,
addTarget,
-- then use that
-- - otherwise interpret the string as a module name
--
-guessTarget :: String -> IO Target
-guessTarget file
+guessTarget :: String -> Maybe Phase -> IO Target
+guessTarget file (Just phase)
+ = return (Target (TargetFile file (Just phase)) Nothing)
+guessTarget file Nothing
| isHaskellSrcFilename file
- = return (Target (TargetFile file) Nothing)
+ = return (Target (TargetFile file Nothing) Nothing)
| otherwise
= do exists <- doesFileExist hs_file
- if exists then return (Target (TargetFile hs_file) Nothing) else do
+ if exists
+ then return (Target (TargetFile hs_file Nothing) Nothing)
+ else do
exists <- doesFileExist lhs_file
- if exists then return (Target (TargetFile lhs_file) Nothing) else do
+ if exists
+ then return (Target (TargetFile lhs_file Nothing) Nothing)
+ else do
return (Target (TargetModule (mkModule file)) Nothing)
where
hs_file = file ++ ".hs"
old_summary_map = mkNodeMap old_summaries
getRootSummary :: Target -> IO ModSummary
- getRootSummary (Target (TargetFile file) maybe_buf)
+ getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
= do exists <- doesFileExist file
if exists
- then summariseFile hsc_env old_summaries file maybe_buf
- else do
+ then summariseFile hsc_env old_summaries file mb_phase maybe_buf
+ else do
throwDyn (CmdLineError ("can't find file: " ++ file))
getRootSummary (Target (TargetModule modl) maybe_buf)
= do maybe_summary <- summariseModule hsc_env old_summary_map Nothing False
:: HscEnv
-> [ModSummary] -- old summaries
-> FilePath -- source file name
+ -> Maybe Phase -- start phase
-> Maybe (StringBuffer,ClockTime)
-> IO ModSummary
-summariseFile hsc_env old_summaries file maybe_buf
+summariseFile hsc_env old_summaries file mb_phase maybe_buf
-- we can use a cached summary if one is available and the
-- source file hasn't changed, But we have to look up the summary
-- by source file, rather than module name as we do in summarise.
let dflags = hsc_dflags hsc_env
(dflags', hspp_fn, buf)
- <- preprocessFile dflags file maybe_buf
+ <- preprocessFile dflags file mb_phase maybe_buf
(srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
= do
-- Preprocess the source file and get its imports
-- The dflags' contains the OPTIONS pragmas
- (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn maybe_buf
+ (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
(srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
when (mod_name /= wanted_mod) $
else modificationTimeIfExists (ml_obj_file location)
-preprocessFile :: DynFlags -> FilePath -> Maybe (StringBuffer,ClockTime)
+preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
-> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile dflags src_fn Nothing
+preprocessFile dflags src_fn mb_phase Nothing
= do
- (dflags', hspp_fn) <- preprocess dflags src_fn
+ (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
buf <- hGetStringBuffer hspp_fn
return (dflags', hspp_fn, buf)
-preprocessFile dflags src_fn (Just (buf, time))
+preprocessFile dflags src_fn mb_phase (Just (buf, time))
= do
-- case we bypass the preprocessing stage?
let
let
needs_preprocessing
- | Unlit _ <- startPhase src_fn = True
+ | Just (Unlit _) <- mb_phase = True
+ | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
-- note: local_opts is only required if there's no Unlit phase
| dopt Opt_Cpp dflags' = True
| dopt Opt_Pp dflags' = True
import DataCon ( dataConImplicitIds )
import Packages ( PackageIdH, PackageId, PackageConfig )
import DynFlags ( DynFlags(..), isOneShot )
-import DriverPhases ( HscSource(..), isHsBoot, hscSourceString )
+import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
data TargetId
- = TargetModule Module -- ^ A module name: search for the file
- | TargetFile FilePath -- ^ A filename: parse it to find the module name.
+ = TargetModule Module
+ -- ^ A module name: search for the file
+ | TargetFile FilePath (Maybe Phase)
+ -- ^ A filename: preprocess & parse it to find the module name.
+ -- If specified, the Phase indicates how to compile this file
+ -- (which phase to start from). Nothing indicates the starting phase
+ -- should be determined from the suffix of the filename.
deriving Eq
pprTarget :: Target -> SDoc
pprTarget (Target id _) = pprTargetId id
pprTargetId (TargetModule m) = ppr m
-pprTargetId (TargetFile f) = text f
+pprTargetId (TargetFile f _) = text f
type FinderCache = ModuleEnv FinderCacheEntry
type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool))
-- Implementations of the various modes (--show-iface, mkdependHS. etc.)
import MkIface ( showIface )
-import DriverPipeline ( oneShot )
+import DriverPipeline ( oneShot, compileFile )
import DriverMkDepend ( doMkDependHS )
import SysTools ( getTopDir, getUsageMsgPaths )
#ifdef GHCI
-- Various other random stuff that we need
import Config ( cProjectVersion, cBooterVersion, cProjectName )
import Packages ( dumpPackages, initPackages )
-import DriverPhases ( Phase(..), isSourceFilename, anyHsc )
+import DriverPhases ( Phase(..), isSourceSuffix, isSourceFilename, anyHsc,
+ startPhase, isHaskellSrcFilename )
import StaticFlags ( staticFlags, v_Ld_inputs )
import BasicTypes ( failed )
import Util
GHC.setSessionDynFlags session dflags
let
- {-
- We split out the object files (.o, .dll) and add them
- to v_Ld_inputs for use by the linker.
-
- The following things should be considered compilation manager inputs:
-
- - haskell source files (strings ending in .hs, .lhs or other
- haskellish extension),
-
- - module names (not forgetting hierarchical module names),
-
- - and finally we consider everything not containing a '.' to be
- a comp manager input, as shorthand for a .hs or .lhs filename.
-
- Everything else is considered to be a linker object, and passed
- straight through to the linker.
- -}
- looks_like_an_input m = isSourceFilename m
- || looksLikeModuleName m
- || '.' `notElem` m
-
-- 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
- (srcs, objs) = partition looks_like_an_input normal_fileish_paths
+ (srcs, objs) = partition_args normal_fileish_paths [] []
-- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on
-- the command-line.
ShowNumVersion -> putStrLn cProjectVersion
ShowInterface f -> showIface f
DoMake -> doMake session srcs
- DoMkDependHS -> doMkDependHS session srcs
+ DoMkDependHS -> doMkDependHS session (map fst srcs)
StopBefore p -> oneShot dflags p srcs
DoInteractive -> interactiveUI session srcs Nothing
DoEval expr -> interactiveUI session srcs (Just expr)
throwDyn (CmdLineError "not built for interactive use")
#endif
+-- -----------------------------------------------------------------------------
+-- Splitting arguments into source files and object files. This is where we
+-- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
+-- file indicating the phase specified by the -x option in force, if any.
+
+partition_args [] srcs objs = (reverse srcs, reverse objs)
+partition_args ("-x":suff:args) srcs objs
+ | "none" <- suff = partition_args args srcs objs
+ | StopLn <- phase = partition_args args srcs (slurp ++ objs)
+ | otherwise = partition_args rest (these_srcs ++ srcs) objs
+ where phase = startPhase suff
+ (slurp,rest) = break (== "-x") args
+ these_srcs = zip slurp (repeat (Just phase))
+partition_args (arg:args) srcs objs
+ | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
+ | otherwise = partition_args args srcs (arg:objs)
+
+ {-
+ We split out the object files (.o, .dll) and add them
+ to v_Ld_inputs for use by the linker.
+
+ The following things should be considered compilation manager inputs:
+
+ - haskell source files (strings ending in .hs, .lhs or other
+ haskellish extension),
+
+ - module names (not forgetting hierarchical module names),
+
+ - and finally we consider everything not containing a '.' to be
+ a comp manager input, as shorthand for a .hs or .lhs filename.
+
+ Everything else is considered to be a linker object, and passed
+ straight through to the linker.
+ -}
+looks_like_an_input m = isSourceFilename m
+ || looksLikeModuleName m
+ || '.' `notElem` m
-- -----------------------------------------------------------------------------
-- Option sanity checks
-checkOptions :: CmdLineMode -> DynFlags -> [String] -> [String] -> IO ()
+checkOptions :: CmdLineMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()
-- Final sanity checking before kicking off a compilation (pipeline).
checkOptions cli_mode dflags srcs objs = do
-- Complain about any unknown flags
- let unknown_opts = [ f | f@('-':_) <- srcs ]
+ let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
-- -prof and --interactive are not a good combination
-- ----------------------------------------------------------------------------
-- Run --make mode
-doMake :: Session -> [String] -> IO ()
+doMake :: Session -> [(String,Maybe Phase)] -> IO ()
doMake sess [] = throwDyn (UsageError "no input files")
doMake sess srcs = do
- targets <- mapM GHC.guessTarget srcs
+ let (hs_srcs, non_hs_srcs) = partition haskellish srcs
+
+ haskellish (f,Nothing) = looksLikeModuleName f || isHaskellSrcFilename f
+ haskellish (f,Just phase) =
+ phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn]
+
+ dflags <- GHC.getSessionDynFlags sess
+ o_files <- mapM (compileFile dflags StopLn) non_hs_srcs
+ mapM_ (consIORef v_Ld_inputs) (reverse o_files)
+
+ targets <- mapM (uncurry GHC.guessTarget) hs_srcs
GHC.setTargets sess targets
ok_flag <- GHC.load sess LoadAllTargets
when (failed ok_flag) (exitWith (ExitFailure 1))
-- Filename utils
Suffix,
- splitFilename, getFileSuffix, splitFilenameDir,
+ splitFilename, getFileSuffix, splitFilenameDir, joinFileExt,
splitFilename3, removeSuffix,
dropLongestPrefix, takeLongestPrefix, splitLongestPrefix,
replaceFilenameSuffix, directoryOf, filenameOf,
getFileSuffix :: String -> Suffix
getFileSuffix f = dropLongestPrefix f (=='.')
+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
- real_dir | null dir = "."
- | otherwise = dir
- in (real_dir, rest)
+ = 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) = splitLongestPrefix str isPathSeparator
- (name, ext) = splitFilename rest
- real_dir | null dir = "."
- | otherwise = dir
- in (real_dir, name, ext)
+ (dir', rest') | null rest = (".", dir)
+ | otherwise = (dir, rest)
+ (name, ext) = splitFilename rest'
+ in (dir', name, ext)
removeSuffix :: Char -> String -> Suffix
-removeSuffix c s
- | null pre = s
- | otherwise = reverse pre
- where (suf,pre) = break (==c) (reverse s)
+removeSuffix c s = takeLongestPrefix s (==c)
dropLongestPrefix :: String -> (Char -> Bool) -> String
-dropLongestPrefix s pred = reverse suf
- where (suf,_pre) = break pred (reverse s)
+dropLongestPrefix s pred = snd (splitLongestPrefix s pred)
takeLongestPrefix :: String -> (Char -> Bool) -> String
-takeLongestPrefix s pred = reverse pre
- where (_suf,pre) = break pred (reverse s)
+takeLongestPrefix s pred = fst (splitLongestPrefix s pred)
-- split a string at the last character where 'pred' is True,
-- returning a pair of strings. The first component holds the string
splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
splitLongestPrefix s pred
= case pre of
- [] -> ([], reverse suf)
+ [] -> (reverse suf, [])
(_:pre) -> (reverse pre, reverse suf)
where (suf,pre) = break pred (reverse s)
projects / ghc-hetmet.git / commitdiff