convert tabs to spaces. strip trailing whitespace.

This commit is contained in:
Jeremy Shaw 2015-10-09 19:35:06 -05:00
parent da0b010b33
commit 7c50a8cb6c
11 changed files with 129 additions and 134 deletions

View File

@ -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-}

View File

@ -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"]

View File

@ -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
-- --

View File

@ -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

View File

@ -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?

View File

@ -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

View File

@ -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 (..)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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