convert tabs to spaces. strip trailing whitespace.
This commit is contained in:
parent
da0b010b33
commit
7c50a8cb6c
@ -1,25 +1,24 @@
|
|||||||
--
|
--
|
||||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This library is free software; you can redistribute it and/or
|
-- This library is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU Lesser General Public
|
-- modify it under the terms of the GNU Lesser General Public
|
||||||
-- License as published by the Free Software Foundation; either
|
-- License as published by the Free Software Foundation; either
|
||||||
-- version 2.1 of the License, or (at your option) any later version.
|
-- version 2.1 of the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This library is distributed in the hope that it will be useful,
|
-- This library is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- Lesser General Public License for more details.
|
-- Lesser General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU Lesser General Public
|
-- You should have received a copy of the GNU Lesser General Public
|
||||||
-- License along with this library; if not, write to the Free Software
|
-- License along with this library; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||||||
-- USA
|
-- USA
|
||||||
--
|
--
|
||||||
|
|
||||||
module System.Eval (
|
module System.Eval (
|
||||||
module System.Eval.Haskell,
|
module System.Eval.Haskell,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Eval.Haskell {-all-}
|
import System.Eval.Haskell {-all-}
|
||||||
|
|
||||||
|
@ -93,4 +93,3 @@ mkUniqueWith wrapper src mods = do
|
|||||||
--
|
--
|
||||||
cleanup :: String -> String -> IO ()
|
cleanup :: String -> String -> IO ()
|
||||||
cleanup a b = mapM_ removeFile [a, b, replaceSuffix b ".hi"]
|
cleanup a b = mapM_ removeFile [a, b, replaceSuffix b ".hi"]
|
||||||
|
|
||||||
|
@ -1,23 +1,23 @@
|
|||||||
--
|
--
|
||||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This library is free software; you can redistribute it and/or
|
-- This library is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU Lesser General Public
|
-- modify it under the terms of the GNU Lesser General Public
|
||||||
-- License as published by the Free Software Foundation; either
|
-- License as published by the Free Software Foundation; either
|
||||||
-- version 2.1 of the License, or (at your option) any later version.
|
-- version 2.1 of the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This library is distributed in the hope that it will be useful,
|
-- This library is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- Lesser General Public License for more details.
|
-- Lesser General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU Lesser General Public
|
-- You should have received a copy of the GNU Lesser General Public
|
||||||
-- License along with this library; if not, write to the Free Software
|
-- License along with this library; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||||||
-- USA
|
-- USA
|
||||||
--
|
--
|
||||||
|
|
||||||
module System.Plugins (
|
module System.Plugins (
|
||||||
|
|
||||||
-- $Description
|
-- $Description
|
||||||
|
|
||||||
@ -34,4 +34,3 @@ import System.Plugins.Load {-all-}
|
|||||||
--
|
--
|
||||||
-- [@NAME@] hs-plugins library : compile and load Haskell code at runtime
|
-- [@NAME@] hs-plugins library : compile and load Haskell code at runtime
|
||||||
--
|
--
|
||||||
|
|
||||||
|
@ -1,22 +1,22 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
--
|
--
|
||||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This library is free software; you can redistribute it and/or
|
-- This library is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU Lesser General Public
|
-- modify it under the terms of the GNU Lesser General Public
|
||||||
-- License as published by the Free Software Foundation; either
|
-- License as published by the Free Software Foundation; either
|
||||||
-- version 2.1 of the License, or (at your option) any later version.
|
-- version 2.1 of the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This library is distributed in the hope that it will be useful,
|
-- This library is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- Lesser General Public License for more details.
|
-- Lesser General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU Lesser General Public
|
-- You should have received a copy of the GNU Lesser General Public
|
||||||
-- License along with this library; if not, write to the Free Software
|
-- License along with this library; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||||||
-- USA
|
-- USA
|
||||||
--
|
--
|
||||||
|
|
||||||
module System.Plugins.Consts where
|
module System.Plugins.Consts where
|
||||||
|
|
||||||
@ -60,7 +60,7 @@ sysPkgPrefix = "HS"
|
|||||||
|
|
||||||
-- | '_' on a.out, and Darwin
|
-- | '_' on a.out, and Darwin
|
||||||
#if LEADING_UNDERSCORE == 1
|
#if LEADING_UNDERSCORE == 1
|
||||||
prefixUnderscore = "_"
|
prefixUnderscore = "_"
|
||||||
#else
|
#else
|
||||||
prefixUnderscore = ""
|
prefixUnderscore = ""
|
||||||
#endif
|
#endif
|
||||||
|
@ -429,37 +429,37 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
|
|||||||
#else
|
#else
|
||||||
libdirs = libraryDirs pkg ++ ldOptsPaths
|
libdirs = libraryDirs pkg ++ ldOptsPaths
|
||||||
#endif
|
#endif
|
||||||
-- If we're loading dynamic libs we need the cbits to appear before the
|
-- If we're loading dynamic libs we need the cbits to appear before the
|
||||||
-- real packages.
|
-- real packages.
|
||||||
libs <- mapM (findHSlib libdirs) (cbits ++ hslibs)
|
libs <- mapM (findHSlib libdirs) (cbits ++ hslibs)
|
||||||
#if defined(CYGWIN) || defined(__MINGW32__)
|
#if defined(CYGWIN) || defined(__MINGW32__)
|
||||||
windowsos <- catch (getEnv "OS")
|
windowsos <- catch (getEnv "OS")
|
||||||
(\e -> if isDoesNotExistError e then return "Windows_98" else ioError e)
|
(\e -> if isDoesNotExistError e then return "Windows_98" else ioError e)
|
||||||
windowsdir <-
|
windowsdir <-
|
||||||
if windowsos == "Windows_9X" -- I don't know Windows 9X has OS system variable
|
if windowsos == "Windows_9X" -- I don't know Windows 9X has OS system variable
|
||||||
then return "C:/windows"
|
then return "C:/windows"
|
||||||
else return "C:/winnt"
|
else return "C:/winnt"
|
||||||
sysroot <- catch (getEnv "SYSTEMROOT")
|
sysroot <- catch (getEnv "SYSTEMROOT")
|
||||||
(\e -> if isDoesNotExistError e then return windowsdir else ioError e) -- guess at a reasonable default
|
(\e -> if isDoesNotExistError e then return windowsdir else ioError e) -- guess at a reasonable default
|
||||||
let syslibdir = sysroot ++ (if windowsos == "Windows_9X" then "/SYSTEM" else "/SYSTEM32")
|
let syslibdir = sysroot ++ (if windowsos == "Windows_9X" then "/SYSTEM" else "/SYSTEM32")
|
||||||
libs' <- mapM (findDLL $ syslibdir : libdirs) dlls
|
libs' <- mapM (findDLL $ syslibdir : libdirs) dlls
|
||||||
#else
|
#else
|
||||||
libs' <- mapM (findDLL libdirs) dlls
|
libs' <- mapM (findDLL libdirs) dlls
|
||||||
#endif
|
#endif
|
||||||
let slibs = [ lib | Right (Static lib) <- libs ]
|
let slibs = [ lib | Right (Static lib) <- libs ]
|
||||||
dlibs = [ lib | Right (Dynamic lib) <- libs ]
|
dlibs = [ lib | Right (Dynamic lib) <- libs ]
|
||||||
return (deppkgs, (slibs,map (either id id) libs' ++ dlibs) )
|
return (deppkgs, (slibs,map (either id id) libs' ++ dlibs) )
|
||||||
|
|
||||||
#if defined(CYGWIN) || defined(__MINGW32__)
|
#if defined(CYGWIN) || defined(__MINGW32__)
|
||||||
-- replace $topdir
|
-- replace $topdir
|
||||||
fix_topdir [] = []
|
fix_topdir [] = []
|
||||||
fix_topdir (x:xs) = replace_topdir x : fix_topdir xs
|
fix_topdir (x:xs) = replace_topdir x : fix_topdir xs
|
||||||
|
|
||||||
replace_topdir [] = []
|
replace_topdir [] = []
|
||||||
replace_topdir ('$':xs)
|
replace_topdir ('$':xs)
|
||||||
| take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)
|
| take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)
|
||||||
| otherwise = '$' : replace_topdir xs
|
| otherwise = '$' : replace_topdir xs
|
||||||
replace_topdir (x:xs) = x : replace_topdir xs
|
replace_topdir (x:xs) = x : replace_topdir xs
|
||||||
#endif
|
#endif
|
||||||
-- a list elimination form for the Maybe type
|
-- a list elimination form for the Maybe type
|
||||||
--filterRight :: [Either left right] -> [right]
|
--filterRight :: [Either left right] -> [right]
|
||||||
@ -477,31 +477,31 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
|
|||||||
if b then return $ Just l -- found it!
|
if b then return $ Just l -- found it!
|
||||||
else findHSlib' dirs lib
|
else findHSlib' dirs lib
|
||||||
|
|
||||||
findHSslib dirs lib = findHSlib' dirs $ lib ++ sysPkgSuffix
|
findHSslib dirs lib = findHSlib' dirs $ lib ++ sysPkgSuffix
|
||||||
findHSdlib dirs lib = findHSlib' dirs $ mkDynPkgName lib
|
findHSdlib dirs lib = findHSlib' dirs $ mkDynPkgName lib
|
||||||
|
|
||||||
-- Problem: sysPkgSuffix is ".o", but extra libraries could be
|
-- Problem: sysPkgSuffix is ".o", but extra libraries could be
|
||||||
-- ".so"
|
-- ".so"
|
||||||
-- Solution: first look for static library, if we don't find it
|
-- Solution: first look for static library, if we don't find it
|
||||||
-- look for a dynamic version.
|
-- look for a dynamic version.
|
||||||
findHSlib :: [FilePath] -> String -> IO (Either String HSLib)
|
findHSlib :: [FilePath] -> String -> IO (Either String HSLib)
|
||||||
findHSlib dirs lib = do
|
findHSlib dirs lib = do
|
||||||
static <- findHSslib dirs lib
|
static <- findHSslib dirs lib
|
||||||
case static of
|
case static of
|
||||||
Just file -> return $ Right $ Static file
|
Just file -> return $ Right $ Static file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
dynamic <- findHSdlib dirs lib
|
dynamic <- findHSdlib dirs lib
|
||||||
case dynamic of
|
case dynamic of
|
||||||
Just file -> return $ Right $ Dynamic file
|
Just file -> return $ Right $ Dynamic file
|
||||||
Nothing -> return $ Left lib
|
Nothing -> return $ Left lib
|
||||||
|
|
||||||
findDLL :: [FilePath] -> String -> IO (Either String FilePath)
|
findDLL :: [FilePath] -> String -> IO (Either String FilePath)
|
||||||
findDLL [] lib = return (Left lib)
|
findDLL [] lib = return (Left lib)
|
||||||
findDLL (dir:dirs) lib = do
|
findDLL (dir:dirs) lib = do
|
||||||
let l = dir </> lib
|
let l = dir </> lib
|
||||||
b <- doesFileExist l
|
b <- doesFileExist l
|
||||||
if b then return $ Right l
|
if b then return $ Right l
|
||||||
else findDLL dirs lib
|
else findDLL dirs lib
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
-- do we have a Module name for this merge?
|
-- do we have a Module name for this merge?
|
||||||
|
@ -610,7 +610,7 @@ loadPackage p = do
|
|||||||
putStr (' ':show libs) >> hFlush stdout
|
putStr (' ':show libs) >> hFlush stdout
|
||||||
putStr (' ':show dlls) >> hFlush stdout
|
putStr (' ':show dlls) >> hFlush stdout
|
||||||
#endif
|
#endif
|
||||||
mapM_ loadShared dlls
|
mapM_ loadShared dlls
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,22 +1,22 @@
|
|||||||
--
|
--
|
||||||
-- Copyright (c) 2005 Lemmih <lemmih@gmail.com>
|
-- Copyright (c) 2005 Lemmih <lemmih@gmail.com>
|
||||||
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This program is free software; you can redistribute it and/or
|
-- This program is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU General Public License as
|
-- modify it under the terms of the GNU General Public License as
|
||||||
-- published by the Free Software Foundation; either version 2 of
|
-- published by the Free Software Foundation; either version 2 of
|
||||||
-- the License, or (at your option) any later version.
|
-- the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This program is distributed in the hope that it will be useful,
|
-- This program is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- General Public License for more details.
|
-- General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU General Public License
|
-- You should have received a copy of the GNU General Public License
|
||||||
-- along with this program; if not, write to the Free Software
|
-- along with this program; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||||
-- 02111-1307, USA.
|
-- 02111-1307, USA.
|
||||||
--
|
--
|
||||||
|
|
||||||
module System.Plugins.LoadTypes
|
module System.Plugins.LoadTypes
|
||||||
( Key (..)
|
( Key (..)
|
||||||
|
@ -1,27 +1,27 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
--
|
--
|
||||||
-- Copyright (C) 2004..2010 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (C) 2004..2010 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This library is free software; you can redistribute it and/or
|
-- This library is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU Lesser General Public
|
-- modify it under the terms of the GNU Lesser General Public
|
||||||
-- License as published by the Free Software Foundation; either
|
-- License as published by the Free Software Foundation; either
|
||||||
-- version 2.1 of the License, or (at your option) any later version.
|
-- version 2.1 of the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This library is distributed in the hope that it will be useful,
|
-- This library is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- Lesser General Public License for more details.
|
-- Lesser General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU Lesser General Public
|
-- You should have received a copy of the GNU Lesser General Public
|
||||||
-- License along with this library; if not, write to the Free Software
|
-- License along with this library; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||||||
-- USA
|
-- USA
|
||||||
--
|
--
|
||||||
|
|
||||||
-- | An interface to a Haskell compiler, providing the facilities of a
|
-- | An interface to a Haskell compiler, providing the facilities of a
|
||||||
-- compilation manager.
|
-- compilation manager.
|
||||||
|
|
||||||
module System.Plugins.Make (
|
module System.Plugins.Make (
|
||||||
|
|
||||||
-- * The @MakeStatus@ type
|
-- * The @MakeStatus@ type
|
||||||
MakeStatus(..),
|
MakeStatus(..),
|
||||||
@ -30,9 +30,9 @@ module System.Plugins.Make (
|
|||||||
MakeCode(..),
|
MakeCode(..),
|
||||||
|
|
||||||
-- * Compiling Haskell modules
|
-- * Compiling Haskell modules
|
||||||
make,
|
make,
|
||||||
makeAll,
|
makeAll,
|
||||||
makeWith,
|
makeWith,
|
||||||
|
|
||||||
-- * Handling reecompilation
|
-- * Handling reecompilation
|
||||||
hasChanged,
|
hasChanged,
|
||||||
@ -40,12 +40,12 @@ module System.Plugins.Make (
|
|||||||
recompileAll,
|
recompileAll,
|
||||||
recompileAll',
|
recompileAll',
|
||||||
|
|
||||||
-- * Merging together Haskell source files
|
-- * Merging together Haskell source files
|
||||||
MergeStatus(..),
|
MergeStatus(..),
|
||||||
MergeCode,
|
MergeCode,
|
||||||
Args,
|
Args,
|
||||||
Errors,
|
Errors,
|
||||||
merge,
|
merge,
|
||||||
mergeTo,
|
mergeTo,
|
||||||
mergeToDir,
|
mergeToDir,
|
||||||
|
|
||||||
@ -88,16 +88,16 @@ import System.IO.Error ( isDoesNotExistError )
|
|||||||
-- messages produced by the compiler. @MakeSuccess@ returns a @MakeCode@
|
-- messages produced by the compiler. @MakeSuccess@ returns a @MakeCode@
|
||||||
-- value, and the path to the object file produced.
|
-- value, and the path to the object file produced.
|
||||||
--
|
--
|
||||||
data MakeStatus
|
data MakeStatus
|
||||||
= MakeSuccess MakeCode FilePath -- ^ compilation was successful
|
= MakeSuccess MakeCode FilePath -- ^ compilation was successful
|
||||||
| MakeFailure Errors -- ^ compilation failed
|
| MakeFailure Errors -- ^ compilation failed
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
-- | The @MakeCode@ type is used when compilation is successful, to
|
-- | The @MakeCode@ type is used when compilation is successful, to
|
||||||
-- distinguish two cases:
|
-- distinguish two cases:
|
||||||
-- * The source file needed recompiling, and this was done
|
-- * The source file needed recompiling, and this was done
|
||||||
-- * The source file was already up to date, recompilation was skipped
|
-- * The source file was already up to date, recompilation was skipped
|
||||||
data MakeCode
|
data MakeCode
|
||||||
= ReComp -- ^ recompilation was performed
|
= ReComp -- ^ recompilation was performed
|
||||||
| NotReq -- ^ recompilation was not required
|
| NotReq -- ^ recompilation was not required
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
@ -105,12 +105,12 @@ data MakeCode
|
|||||||
--
|
--
|
||||||
-- | An equivalent status for the preprocessor phase
|
-- | An equivalent status for the preprocessor phase
|
||||||
--
|
--
|
||||||
data MergeStatus
|
data MergeStatus
|
||||||
= MergeSuccess MergeCode Args FilePath -- ^ the merge was successful
|
= MergeSuccess MergeCode Args FilePath -- ^ the merge was successful
|
||||||
| MergeFailure Errors -- ^ failure, and any errors returned
|
| MergeFailure Errors -- ^ failure, and any errors returned
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
--
|
--
|
||||||
-- | Merging may be avoided if the source files are older than an
|
-- | Merging may be avoided if the source files are older than an
|
||||||
-- existing merged result. The @MergeCode@ type indicates whether
|
-- existing merged result. The @MergeCode@ type indicates whether
|
||||||
-- merging was performed, or whether it was unneccessary.
|
-- merging was performed, or whether it was unneccessary.
|
||||||
@ -131,7 +131,7 @@ type Errors = [String]
|
|||||||
-- in the 'args' parameter, they will be appended to the argument list.
|
-- in the 'args' parameter, they will be appended to the argument list.
|
||||||
-- @make@ always recompiles its target, whether or not it is out of
|
-- @make@ always recompiles its target, whether or not it is out of
|
||||||
-- date.
|
-- date.
|
||||||
--
|
--
|
||||||
-- A side-effect of calling 'make' is to have GHC produce a @.hi@ file
|
-- A side-effect of calling 'make' is to have GHC produce a @.hi@ file
|
||||||
-- containing a list of package and objects that the source depends on.
|
-- containing a list of package and objects that the source depends on.
|
||||||
-- Subsequent calls to 'load' will use this interface file to load
|
-- Subsequent calls to 'load' will use this interface file to load
|
||||||
@ -147,7 +147,7 @@ make src args = rawMake src ("-c":args) True
|
|||||||
-- the first argument.
|
-- the first argument.
|
||||||
--
|
--
|
||||||
makeAll :: FilePath -> [Arg] -> IO MakeStatus
|
makeAll :: FilePath -> [Arg] -> IO MakeStatus
|
||||||
makeAll src args =
|
makeAll src args =
|
||||||
rawMake src ( "--make":"-no-hs-main":"-c":"-v0":args ) False
|
rawMake src ( "--make":"-no-hs-main":"-c":"-v0":args ) False
|
||||||
|
|
||||||
-- | This is a variety of 'make' that first calls 'merge' to
|
-- | This is a variety of 'make' that first calls 'merge' to
|
||||||
@ -163,7 +163,7 @@ makeAll src args =
|
|||||||
-- > a = 1
|
-- > a = 1
|
||||||
--
|
--
|
||||||
-- and
|
-- and
|
||||||
--
|
--
|
||||||
-- > module B where
|
-- > module B where
|
||||||
-- > a :: Int
|
-- > a :: Int
|
||||||
--
|
--
|
||||||
@ -176,7 +176,7 @@ makeAll src args =
|
|||||||
-- > a :: Int
|
-- > a :: Int
|
||||||
-- > {-# LINE 4 "A.hs" #-}
|
-- > {-# LINE 4 "A.hs" #-}
|
||||||
-- > a = 1
|
-- > a = 1
|
||||||
--
|
--
|
||||||
makeWith :: FilePath -- ^ a src file
|
makeWith :: FilePath -- ^ a src file
|
||||||
-> FilePath -- ^ a syntax stub file
|
-> FilePath -- ^ a syntax stub file
|
||||||
-> [Arg] -- ^ any required args
|
-> [Arg] -- ^ any required args
|
||||||
@ -215,7 +215,7 @@ hasChanged' suffices m@(Module {path = p})
|
|||||||
_ -> return True
|
_ -> return True
|
||||||
|
|
||||||
--
|
--
|
||||||
-- | 'recompileAll' is like 'makeAll', but rather than relying on
|
-- | 'recompileAll' is like 'makeAll', but rather than relying on
|
||||||
-- @ghc --make@, we explicitly check a module\'s dependencies using our
|
-- @ghc --make@, we explicitly check a module\'s dependencies using our
|
||||||
-- internal map of module dependencies. Performance is thus better, and
|
-- internal map of module dependencies. Performance is thus better, and
|
||||||
-- the result is more accurate.
|
-- the result is more accurate.
|
||||||
@ -265,16 +265,16 @@ rawMake src args docheck = do
|
|||||||
; src_changed <- if docheck then src `newer` obj else return True
|
; src_changed <- if docheck then src `newer` obj else return True
|
||||||
; if not src_changed
|
; if not src_changed
|
||||||
then return $ MakeSuccess NotReq obj
|
then return $ MakeSuccess NotReq obj
|
||||||
else do
|
else do
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
putStr "Compiling object ... " >> hFlush stdout
|
putStr "Compiling object ... " >> hFlush stdout
|
||||||
#endif
|
#endif
|
||||||
err <- build src obj args
|
err <- build src obj args
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
putStrLn "done"
|
putStrLn "done"
|
||||||
#endif
|
#endif
|
||||||
return $ if null err
|
return $ if null err
|
||||||
then MakeSuccess ReComp obj
|
then MakeSuccess ReComp obj
|
||||||
else MakeFailure err
|
else MakeFailure err
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -296,7 +296,7 @@ build src obj extra_opts = do
|
|||||||
-- won't handle hier names properly.
|
-- won't handle hier names properly.
|
||||||
|
|
||||||
let ghc_opts = [ "-O0" ]
|
let ghc_opts = [ "-O0" ]
|
||||||
output = [ "-o", obj, "-odir", odir,
|
output = [ "-o", obj, "-odir", odir,
|
||||||
"-hidir", odir, "-i" ++ odir ]
|
"-hidir", odir, "-i" ++ odir ]
|
||||||
|
|
||||||
let flags = ghc_opts ++ output ++ extra_opts ++ [src]
|
let flags = ghc_opts ++ output ++ extra_opts ++ [src]
|
||||||
@ -322,7 +322,7 @@ build src obj extra_opts = do
|
|||||||
-- syntax. An EDSL user then need not worry about declaring module
|
-- syntax. An EDSL user then need not worry about declaring module
|
||||||
-- names, or having required imports. In this way, the stub file can
|
-- names, or having required imports. In this way, the stub file can
|
||||||
-- also be used to provide syntax declarations that would be
|
-- also be used to provide syntax declarations that would be
|
||||||
-- inconvenient to require of the plugin author.
|
-- inconvenient to require of the plugin author.
|
||||||
--
|
--
|
||||||
-- 'merge' will include any import and export declarations written in
|
-- 'merge' will include any import and export declarations written in
|
||||||
-- the stub, as well as any module name, so that plugin author\'s need
|
-- the stub, as well as any module name, so that plugin author\'s need
|
||||||
@ -337,7 +337,7 @@ build src obj extra_opts = do
|
|||||||
-- parse Haskell source files.
|
-- parse Haskell source files.
|
||||||
--
|
--
|
||||||
merge :: FilePath -> FilePath -> IO MergeStatus
|
merge :: FilePath -> FilePath -> IO MergeStatus
|
||||||
merge src stb = do
|
merge src stb = do
|
||||||
m_mod <- lookupMerged src stb
|
m_mod <- lookupMerged src stb
|
||||||
(out,domerge) <- case m_mod of
|
(out,domerge) <- case m_mod of
|
||||||
Nothing -> do out <- mkUnique
|
Nothing -> do out <- mkUnique
|
||||||
@ -347,7 +347,7 @@ merge src stb = do
|
|||||||
rawMerge src stb out domerge
|
rawMerge src stb out domerge
|
||||||
|
|
||||||
-- | 'mergeTo' behaves like 'merge', but we can specify the file in
|
-- | 'mergeTo' behaves like 'merge', but we can specify the file in
|
||||||
-- which to place output.
|
-- which to place output.
|
||||||
mergeTo :: FilePath -> FilePath -> FilePath -> IO MergeStatus
|
mergeTo :: FilePath -> FilePath -> FilePath -> IO MergeStatus
|
||||||
mergeTo src stb out = rawMerge src stb out False
|
mergeTo src stb out = rawMerge src stb out False
|
||||||
|
|
||||||
@ -378,12 +378,12 @@ rawMerge src stb out always_merge = do
|
|||||||
src_exists <- doesFileExist src
|
src_exists <- doesFileExist src
|
||||||
stb_exists <- doesFileExist stb
|
stb_exists <- doesFileExist stb
|
||||||
case () of {_
|
case () of {_
|
||||||
| not src_exists -> return $
|
| not src_exists -> return $
|
||||||
MergeFailure ["Source file does not exist : "++src]
|
MergeFailure ["Source file does not exist : "++src]
|
||||||
| not stb_exists -> return $
|
| not stb_exists -> return $
|
||||||
MergeFailure ["Source file does not exist : "++stb]
|
MergeFailure ["Source file does not exist : "++stb]
|
||||||
| otherwise -> do {
|
| otherwise -> do {
|
||||||
|
|
||||||
;do_merge <- do src_changed <- src `newer` out
|
;do_merge <- do src_changed <- src `newer` out
|
||||||
stb_changed <- stb `newer` out
|
stb_changed <- stb `newer` out
|
||||||
return $ src_changed || stb_changed
|
return $ src_changed || stb_changed
|
||||||
@ -400,7 +400,7 @@ rawMerge src stb out always_merge = do
|
|||||||
|
|
||||||
let e_src_syn = parse src src_str
|
let e_src_syn = parse src src_str
|
||||||
e_stb_syn = parse stb stb_str
|
e_stb_syn = parse stb stb_str
|
||||||
|
|
||||||
-- check if there were parser errors
|
-- check if there were parser errors
|
||||||
case (e_src_syn,e_stb_syn) of
|
case (e_src_syn,e_stb_syn) of
|
||||||
(Left e, _) -> return $ MergeFailure [e]
|
(Left e, _) -> return $ MergeFailure [e]
|
||||||
@ -429,7 +429,7 @@ makeClean f = let f_hi = dropSuffix f <> hiSuf
|
|||||||
|
|
||||||
makeCleaner :: FilePath -> IO ()
|
makeCleaner :: FilePath -> IO ()
|
||||||
makeCleaner f = makeClean f >> rm_f (dropSuffix f <> hsSuf)
|
makeCleaner f = makeClean f >> rm_f (dropSuffix f <> hsSuf)
|
||||||
|
|
||||||
-- internal:
|
-- internal:
|
||||||
-- try to remove a file, ignoring if it didn't exist in the first place
|
-- try to remove a file, ignoring if it didn't exist in the first place
|
||||||
-- Doesn't seem to be able to remove all files in all circumstances, why?
|
-- Doesn't seem to be able to remove all files in all circumstances, why?
|
||||||
@ -446,4 +446,3 @@ readFile' f = do
|
|||||||
length s `seq` return ()
|
length s `seq` return ()
|
||||||
hClose h
|
hClose h
|
||||||
return s
|
return s
|
||||||
|
|
||||||
|
@ -1,25 +1,25 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
--
|
--
|
||||||
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This program is free software; you can redistribute it and/or
|
-- This program is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU General Public License as
|
-- modify it under the terms of the GNU General Public License as
|
||||||
-- published by the Free Software Foundation; either version 2 of
|
-- published by the Free Software Foundation; either version 2 of
|
||||||
-- the License, or (at your option) any later version.
|
-- the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This program is distributed in the hope that it will be useful,
|
-- This program is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- General Public License for more details.
|
-- General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU General Public License
|
-- You should have received a copy of the GNU General Public License
|
||||||
-- along with this program; if not, write to the Free Software
|
-- along with this program; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||||
-- 02111-1307, USA.
|
-- 02111-1307, USA.
|
||||||
--
|
--
|
||||||
|
|
||||||
module System.Plugins.Parser (
|
module System.Plugins.Parser (
|
||||||
parse, mergeModules, pretty, parsePragmas,
|
parse, mergeModules, pretty, parsePragmas,
|
||||||
HsModule(..) ,
|
HsModule(..) ,
|
||||||
replaceModName
|
replaceModName
|
||||||
@ -27,7 +27,7 @@ module System.Plugins.Parser (
|
|||||||
|
|
||||||
#include "../../../config.h"
|
#include "../../../config.h"
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Either ( )
|
import Data.Either ( )
|
||||||
|
|
||||||
@ -41,12 +41,12 @@ import Language.Haskell.Pretty
|
|||||||
|
|
||||||
--
|
--
|
||||||
-- | parse a file (as a string) as Haskell src
|
-- | parse a file (as a string) as Haskell src
|
||||||
--
|
--
|
||||||
parse :: FilePath -- ^ module name
|
parse :: FilePath -- ^ module name
|
||||||
-> String -- ^ haskell src
|
-> String -- ^ haskell src
|
||||||
-> Either String HsModule -- ^ abstract syntax
|
-> Either String HsModule -- ^ abstract syntax
|
||||||
|
|
||||||
parse f fsrc =
|
parse f fsrc =
|
||||||
#if defined(WITH_HSX)
|
#if defined(WITH_HSX)
|
||||||
case parseFileContentsWithMode (ParseMode f) fsrc of
|
case parseFileContentsWithMode (ParseMode f) fsrc of
|
||||||
#else
|
#else
|
||||||
@ -55,8 +55,8 @@ parse f fsrc =
|
|||||||
ParseOk src -> Right src
|
ParseOk src -> Right src
|
||||||
ParseFailed loc _ -> Left $ srcmsg loc
|
ParseFailed loc _ -> Left $ srcmsg loc
|
||||||
where
|
where
|
||||||
srcmsg loc = "parse error in " ++ f ++ "\n" ++
|
srcmsg loc = "parse error in " ++ f ++ "\n" ++
|
||||||
"line: " ++ (show $ srcLine loc) ++
|
"line: " ++ (show $ srcLine loc) ++
|
||||||
", col: " ++ (show $ srcColumn loc)++ "\n"
|
", col: " ++ (show $ srcColumn loc)++ "\n"
|
||||||
|
|
||||||
--
|
--
|
||||||
@ -88,23 +88,23 @@ mergeModules :: HsModule -> -- Configure module
|
|||||||
|
|
||||||
mergeModules (HsModule l _ _ is ds )
|
mergeModules (HsModule l _ _ is ds )
|
||||||
(HsModule _ m' es' is' ds')
|
(HsModule _ m' es' is' ds')
|
||||||
= (HsModule l m' es'
|
= (HsModule l m' es'
|
||||||
(mImps m' is is')
|
(mImps m' is is')
|
||||||
(mDecl ds ds') )
|
(mDecl ds ds') )
|
||||||
|
|
||||||
--
|
--
|
||||||
-- | replace Module name with String.
|
-- | replace Module name with String.
|
||||||
--
|
--
|
||||||
replaceModName :: HsModule -> String -> HsModule
|
replaceModName :: HsModule -> String -> HsModule
|
||||||
replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds)
|
replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds)
|
||||||
|
|
||||||
--
|
--
|
||||||
-- | merge import declarations:
|
-- | merge import declarations:
|
||||||
--
|
--
|
||||||
-- * ensure that the config file doesn't import the stub name
|
-- * ensure that the config file doesn't import the stub name
|
||||||
-- * merge import lists uniquely, and when they match, merge their decls
|
-- * merge import lists uniquely, and when they match, merge their decls
|
||||||
--
|
--
|
||||||
-- TODO * we don't merge imports of the same module from both files.
|
-- TODO * we don't merge imports of the same module from both files.
|
||||||
-- We should, and then merge the decls in their import list
|
-- We should, and then merge the decls in their import list
|
||||||
-- * rename args, too confusing.
|
-- * rename args, too confusing.
|
||||||
--
|
--
|
||||||
@ -115,9 +115,9 @@ mImps :: Module -> -- plugin module name
|
|||||||
[HsImportDecl] -> -- stub file imports
|
[HsImportDecl] -> -- stub file imports
|
||||||
[HsImportDecl]
|
[HsImportDecl]
|
||||||
|
|
||||||
mImps plug_mod cimps timps =
|
mImps plug_mod cimps timps =
|
||||||
case filter (!~ self) cimps of cimps' -> unionBy (=~) cimps' timps
|
case filter (!~ self) cimps of cimps' -> unionBy (=~) cimps' timps
|
||||||
where
|
where
|
||||||
self = ( HsImportDecl undefined plug_mod undefined undefined undefined )
|
self = ( HsImportDecl undefined plug_mod undefined undefined undefined )
|
||||||
|
|
||||||
--
|
--
|
||||||
@ -152,7 +152,7 @@ class SynEq a where
|
|||||||
(=~) :: a -> a -> Bool
|
(=~) :: a -> a -> Bool
|
||||||
(!~) :: a -> a -> Bool
|
(!~) :: a -> a -> Bool
|
||||||
n !~ m = not (n =~ m)
|
n !~ m = not (n =~ m)
|
||||||
|
|
||||||
instance SynEq HsDecl where
|
instance SynEq HsDecl where
|
||||||
(HsPatBind _ (HsPVar n) _ _) =~ (HsPatBind _ (HsPVar m) _ _) = n == m
|
(HsPatBind _ (HsPVar n) _ _) =~ (HsPatBind _ (HsPVar m) _ _) = n == m
|
||||||
(HsTypeSig _ (n:_) _) =~ (HsTypeSig _ (m:_) _) = n == m
|
(HsTypeSig _ (n:_) _) =~ (HsTypeSig _ (m:_) _) = n == m
|
||||||
@ -170,7 +170,7 @@ instance SynEq HsImportDecl where
|
|||||||
-- handle -package options, and other /static/ flags. This is more than
|
-- handle -package options, and other /static/ flags. This is more than
|
||||||
-- GHC.
|
-- GHC.
|
||||||
--
|
--
|
||||||
-- GHC user's guide :
|
-- GHC user's guide :
|
||||||
--
|
--
|
||||||
-- > OPTIONS pragmas are only looked for at the top of your source
|
-- > OPTIONS pragmas are only looked for at the top of your source
|
||||||
-- > files, up to the first (non-literate,non-empty) line not
|
-- > files, up to the first (non-literate,non-empty) line not
|
||||||
|
@ -79,11 +79,11 @@ popen file args minput =
|
|||||||
-- generate 1000s of lines of output.
|
-- generate 1000s of lines of output.
|
||||||
--
|
--
|
||||||
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,P.ProcessID)
|
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,P.ProcessID)
|
||||||
popen f s m =
|
popen f s m =
|
||||||
E.handle (\e -> return ([], show (e::IOException), error $ show e )) $ do
|
E.handle (\e -> return ([], show (e::IOException), error $ show e )) $ do
|
||||||
x@(_,_,pid) <- P.popen f s m
|
x@(_,_,pid) <- P.popen f s m
|
||||||
b <- P.getProcessStatus True False pid -- wait
|
b <- P.getProcessStatus True False pid -- wait
|
||||||
return $ case b of
|
return $ case b of
|
||||||
Nothing -> ([], "process has disappeared", pid)
|
Nothing -> ([], "process has disappeared", pid)
|
||||||
_ -> x
|
_ -> x
|
||||||
|
|
||||||
|
@ -1,24 +1,24 @@
|
|||||||
{-# LANGUAGE CPP, ScopedTypeVariables #-}
|
{-# LANGUAGE CPP, ScopedTypeVariables #-}
|
||||||
--
|
--
|
||||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||||
--
|
--
|
||||||
-- This library is free software; you can redistribute it and/or
|
-- This library is free software; you can redistribute it and/or
|
||||||
-- modify it under the terms of the GNU Lesser General Public
|
-- modify it under the terms of the GNU Lesser General Public
|
||||||
-- License as published by the Free Software Foundation; either
|
-- License as published by the Free Software Foundation; either
|
||||||
-- version 2.1 of the License, or (at your option) any later version.
|
-- version 2.1 of the License, or (at your option) any later version.
|
||||||
--
|
--
|
||||||
-- This library is distributed in the hope that it will be useful,
|
-- This library is distributed in the hope that it will be useful,
|
||||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
-- Lesser General Public License for more details.
|
-- Lesser General Public License for more details.
|
||||||
--
|
--
|
||||||
-- You should have received a copy of the GNU Lesser General Public
|
-- You should have received a copy of the GNU Lesser General Public
|
||||||
-- License along with this library; if not, write to the Free Software
|
-- License along with this library; if not, write to the Free Software
|
||||||
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||||||
-- USA
|
-- USA
|
||||||
--
|
--
|
||||||
|
|
||||||
module System.Plugins.Utils (
|
module System.Plugins.Utils (
|
||||||
Arg,
|
Arg,
|
||||||
|
|
||||||
hWrite,
|
hWrite,
|
||||||
@ -104,7 +104,7 @@ hWrite hdl src = hPutStr hdl src >> hClose hdl >> return ()
|
|||||||
|
|
||||||
{-
|
{-
|
||||||
|
|
||||||
mkstemps path slen = do
|
mkstemps path slen = do
|
||||||
withCString path $ \ ptr -> do
|
withCString path $ \ ptr -> do
|
||||||
let c_slen = fromIntegral $ slen+1
|
let c_slen = fromIntegral $ slen+1
|
||||||
fd <- throwErrnoIfMinus1 "mkstemps" $ c_mkstemps ptr c_slen
|
fd <- throwErrnoIfMinus1 "mkstemps" $ c_mkstemps ptr c_slen
|
||||||
@ -148,18 +148,18 @@ mkUnique = do (t,h) <- hMkUnique
|
|||||||
hMkUnique :: IO (FilePath,Handle)
|
hMkUnique :: IO (FilePath,Handle)
|
||||||
hMkUnique = do (t,h) <- mkTemp
|
hMkUnique = do (t,h) <- mkTemp
|
||||||
alreadyLoaded <- isLoaded t -- not unique!
|
alreadyLoaded <- isLoaded t -- not unique!
|
||||||
if alreadyLoaded
|
if alreadyLoaded
|
||||||
then hClose h >> removeFile t >> hMkUnique
|
then hClose h >> removeFile t >> hMkUnique
|
||||||
else return (t,h)
|
else return (t,h)
|
||||||
|
|
||||||
mkUniqueIn :: FilePath -> IO FilePath
|
mkUniqueIn :: FilePath -> IO FilePath
|
||||||
mkUniqueIn dir = do (t,h) <- hMkUniqueIn dir
|
mkUniqueIn dir = do (t,h) <- hMkUniqueIn dir
|
||||||
hClose h >> return t
|
hClose h >> return t
|
||||||
|
|
||||||
hMkUniqueIn :: FilePath -> IO (FilePath,Handle)
|
hMkUniqueIn :: FilePath -> IO (FilePath,Handle)
|
||||||
hMkUniqueIn dir = do (t,h) <- mkTempIn dir
|
hMkUniqueIn dir = do (t,h) <- mkTempIn dir
|
||||||
alreadyLoaded <- isLoaded t -- not unique!
|
alreadyLoaded <- isLoaded t -- not unique!
|
||||||
if alreadyLoaded
|
if alreadyLoaded
|
||||||
then hClose h >> removeFile t >> hMkUniqueIn dir
|
then hClose h >> removeFile t >> hMkUniqueIn dir
|
||||||
else return (t,h)
|
else return (t,h)
|
||||||
|
|
||||||
@ -307,7 +307,7 @@ isPathSeparator ch =
|
|||||||
--
|
--
|
||||||
replaceSuffix :: FilePath -> String -> FilePath
|
replaceSuffix :: FilePath -> String -> FilePath
|
||||||
replaceSuffix [] _ = [] -- ?
|
replaceSuffix [] _ = [] -- ?
|
||||||
replaceSuffix f suf =
|
replaceSuffix f suf =
|
||||||
case reverse $ dropWhile (/= '.') $ reverse f of
|
case reverse $ dropWhile (/= '.') $ reverse f of
|
||||||
[] -> f ++ suf -- no '.' in file name
|
[] -> f ++ suf -- no '.' in file name
|
||||||
f' -> f' ++ tail suf
|
f' -> f' ++ tail suf
|
||||||
@ -316,7 +316,7 @@ replaceSuffix f suf =
|
|||||||
-- Normally we create the .hi and .o files next to the .hs files.
|
-- Normally we create the .hi and .o files next to the .hs files.
|
||||||
-- For some uses this is annoying (i.e. true EDSL users don't actually
|
-- For some uses this is annoying (i.e. true EDSL users don't actually
|
||||||
-- want to know that their code is compiled at all), and for hmake-like
|
-- want to know that their code is compiled at all), and for hmake-like
|
||||||
-- applications.
|
-- applications.
|
||||||
--
|
--
|
||||||
-- This code checks if "-o foo" or "-odir foodir" are supplied as args
|
-- This code checks if "-o foo" or "-odir foodir" are supplied as args
|
||||||
-- to make(), and if so returns a modified file path, otherwise it
|
-- to make(), and if so returns a modified file path, otherwise it
|
||||||
@ -337,7 +337,7 @@ outFilePath src args =
|
|||||||
| otherwise
|
| otherwise
|
||||||
-> (mk_o src, mk_hi src)
|
-> (mk_o src, mk_hi src)
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
outpath = "-o"
|
outpath = "-o"
|
||||||
outdir = "-odir"
|
outdir = "-odir"
|
||||||
|
|
||||||
@ -414,7 +414,7 @@ decode_upper 'N' = ']'
|
|||||||
decode_upper 'C' = ':'
|
decode_upper 'C' = ':'
|
||||||
decode_upper 'Z' = 'Z'
|
decode_upper 'Z' = 'Z'
|
||||||
decode_upper ch = error $ "decode_upper can't handle this char `"++[ch]++"'"
|
decode_upper ch = error $ "decode_upper can't handle this char `"++[ch]++"'"
|
||||||
|
|
||||||
decode_lower 'z' = 'z'
|
decode_lower 'z' = 'z'
|
||||||
decode_lower 'a' = '&'
|
decode_lower 'a' = '&'
|
||||||
decode_lower 'b' = '|'
|
decode_lower 'b' = '|'
|
||||||
@ -505,4 +505,3 @@ isSublistOf _ [] = False
|
|||||||
isSublistOf x y@(_:ys)
|
isSublistOf x y@(_:ys)
|
||||||
| isPrefixOf x y = True
|
| isPrefixOf x y = True
|
||||||
| otherwise = isSublistOf x ys
|
| otherwise = isSublistOf x ys
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user