ghc-make 0.1 → 0.2
raw patch · 8 files changed
+378/−71 lines, 8 filesdep +processdep +unordered-containersdep ~shake
Dependencies added: process, unordered-containers
Dependency ranges changed: shake
Files
- Arguments.hs +139/−0
- Build.hs +104/−0
- CHANGES.txt +13/−0
- LICENSE +1/−1
- Main.hs +1/−61
- Makefile.hs +55/−0
- README.md +41/−0
- ghc-make.cabal +24/−9
+ Arguments.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE PatternGuards, RecordWildCards #-}++module Arguments(Arguments(..), getArguments) where++import Control.Monad+import Data.Char+import Data.Either+import Data.List+import Data.Maybe+import System.Environment+import System.Exit+import Development.Shake.FilePath+import Makefile+++data Arguments = Arguments+ {argsGHC :: [String] -- ^ Arguments to pass to ghc, does not include --make+ ,argsShake :: [String] -- ^ Arguments to pass to shake+ ,threads :: Int -- ^ Number of threads to use+ -- Interpretation of the flags+ ,modeGHC :: Bool -- ^ Are these flags which should go direct to GHC, not a --make/-M mode+ ,prefix :: FilePath -- ^ Where make should put its files, e.g. .ghc-make+ -- Where should things live+ ,outputFile :: FilePath -> FilePath -- ^ Root source file, .exe file+ ,hiDir :: FilePath -- ^ -hidir+ ,oDir :: FilePath -- ^ -odir+ ,hiFile :: Module -> FilePath -- ^ .hi files+ ,oFile :: Module -> FilePath -- ^ .o files+ ,hiModule :: FilePath -> Maybe Module+ ,oModule :: FilePath -> Maybe Module+ }++helpMessage =+ ["ghc-make, (C) Neil Mitchell"+ ,""+ ," ghc-make [ghc-options] --shake[shake-options] [-jN]"+ ,""+ ,"ghc-make is a drop-in replacement for 'ghc', and accepts GHC arugments."+ ,"For GHC arguments, see 'ghc --help' or <http://haskell.org/haskellwiki/GHC>."+ ,""+ ,"ghc-make uses 'shake', and accepts Shake arguments prefixed by '--shake'."+ ,"For Shake arguments, see 'ghc-make --shake--help'."+ ,"As an example, to write a profile report to stdout pass '--shake--report=-'."+ ,""+ ,"In addition, 'ghc-make' accepts the following option:"+ ,""+ ," -jN --threads=N Allow N modules to compile in parallel (defaults to 1)."+ ]+++getArguments :: IO Arguments+getArguments = do+ args <- getArgs+ when (any (`elem` helpFlags) args) $ do+ putStrLn $ unlines helpMessage+ exitSuccess++ let (argsThreads, argsRest) = partition (isJust . parseThreads) args+ let threads = max 1 $ fromMaybe 1 $ msum $ map parseThreads argsThreads+ let (argsShake, argsGHC) = splitFlags $ delete "--make" argsRest+ let hasArg x = x `elem` argsGHC+ let getArg b x = findArg b x argsGHC++ let modeGHC = any hasArg $ "--version" : "--numeric-version" : flagsConflictingWithM+ let prefix = fromMaybe "" (getArg True ["-outputdir","-odir"] `mplus` getArg True ["-outputdir","-hidir"]) </> ".ghc-make"+ let outputFile file = let s = fromMaybe (dropExtension file) (getArg False ["-o"])+ in if null $ takeExtension s then s <.> exe else s+ + let (hiDir, hiFile, hiModule) = extFileModule getArg "hi"+ let ( oDir, oFile, oModule) = extFileModule getArg "o"+ return Arguments{..}+++extFileModule :: (Bool -> [String] -> Maybe String) -> String -> (FilePath, Module -> FilePath, FilePath -> Maybe Module)+extFileModule getArg ext = (extDir, extFile, extModule)+ where+ extDir = fromMaybe "" $ getArg True ["-outputdir","-" ++ ext ++ "dir"]+ extSuf = fromMaybe ext $ getArg True ["-" ++ ext ++ "suf"]+ extFile (Module name boot) = extDir </> joinPath name <.> extSuf ++ (if boot then "-boot" else "")+ extModule s+ | "-boot" `isSuffixOf` s, Just (Module name _) <- extModule $ take (length s - 5) s = newModule name True+ | extDir `isPrefixOf` s && extSuf `isSuffixOf` s+ = newModule (splitDirectories $ dropWhile isPathSeparator $ dropExtensions $ drop (length extDir) s) False+ | otherwise = Nothing++newModule :: [String] -> Bool -> Maybe Module+newModule xs y = if all isValid xs then Just $ Module xs y else Nothing+ where isValid (x:xs) = isUpper x && all (\x -> isAlphaNum x || x `elem` "\'_") xs+ isValid [] = False+++parseThreads :: String -> Maybe Int+parseThreads x = do+ x <- msum $ map (`stripPrefix` x) ["-threads","--threads","-j"]+ x <- return $ fromMaybe x $ stripPrefix "=" x+ [(i,"")] <- return $ reads x+ return i+++-- | -odir is implicit since -odirfoo works, but -o is explicit+findArg :: Bool -> [String] -> [String] -> Maybe String+findArg implicit flags xs+ | x1:x2:xs <- xs, x1 `elem` flags = add x2 $ rec xs+ | implicit, x:xs <- xs, Just x <- msum $ map (`stripPrefix` x) flags+ = add (if "=" `isPrefixOf` x then drop 1 x else x) $ rec xs+ | x:xs <- xs = rec xs+ | otherwise = Nothing+ where add a b = Just $ fromMaybe a b+ rec = findArg implicit flags+++helpFlags = words "-? --help"++-- Obtained from the man page (listed in the same order as they appear there)+-- and ghc/Main.hs, `data PostLoadMode`:+flagsConflictingWithM = words $+ -- "Help and verbosity options"+ "-? --help -V " +++ "--supported-extensions --supported-languages " +++ "--info --version --numeric-version --print-libdir " +++ -- "Which phases to run"+ "-E -C -S -c " +++ -- "Alternative modes of operation"+ "--interactive -e " +++ -- "Interface file options"+ "--show-iface " +++ -- Undocumented?+ "--abi-hash"++++-- | Split flags into (Shake flags, GHC flags)+splitFlags :: [String] -> ([String], [String])+splitFlags = partitionEithers . map f+ where+ f x | Just x <- stripPrefix "--shake-" x = Left $ '-':x+ | Just x <- stripPrefix "-shake-" x = Left $ '-':x+ | otherwise = Right x+
+ Build.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}++module Build(main) where++import Control.Monad+import Data.Either+import Data.Maybe+import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import System.Environment+import System.Exit+import System.Process+import qualified Data.HashMap.Strict as Map+import Arguments+import Makefile+++-- | Increment every time I change the rules in an incompatible way+ghcMakeVer :: Int+ghcMakeVer = 3+++newtype AskImports = AskImports Module deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++newtype AskSource = AskSource Module deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+++main :: IO ()+main = do+ Arguments{..} <- getArguments++ when modeGHC $+ exitWith =<< rawSystem "ghc" argsGHC++ let opts = shakeOptions+ {shakeThreads=threads+ ,shakeFiles=prefix+ ,shakeVerbosity=if threads == 1 then Quiet else Normal+ ,shakeVersion=show ghcMakeVer}+ withArgs argsShake $ shakeArgs opts $ do+ want [prefix <.> "result"]++ -- A file containing the GHC arguments+ prefix <.> "args" *> \out -> do+ alwaysRerun+ writeFileChanged out $ unlines argsGHC+ needArgs <- return $ do need [prefix <.> "args"]; return argsGHC++ -- A file containing the ghc-pkg list output+ prefix <.> "pkgs" *> \out -> do+ alwaysRerun+ (Stdout s, Stderr _) <- cmd "ghc-pkg list --verbose"+ writeFileChanged out s+ needPkgs <- return $ need [prefix <.> "pkgs"]++ -- A file containing the output of -M+ prefix <.> "makefile" *> \out -> do+ args <- needArgs+ needPkgs+ -- Use the default o/hi settings so we can parse the makefile properly+ () <- cmd "ghc -M -include-pkg-deps -dep-makefile" [out] args "-odir. -hidir. -hisuf=_hi_ -osuf=_o_"+ mk <- liftIO $ makefile out+ need $ Map.elems $ source mk+ needMk <- do cache <- newCache (\x -> do need [x]; liftIO $ makefile x); return $ cache $ prefix <.> "makefile"+ askImports <- addOracle $ \(AskImports x) -> do mk <- needMk; return $ Map.lookupDefault [] x $ imports mk+ askSource <- addOracle $ \(AskSource x) -> do mk <- needMk; return $ source mk Map.! x+++ -- The result, we can't want the object directly since it is painful to+ -- define a build rule for it because its name depends on both args and makefile+ prefix <.> "result" *> \out -> do+ args <- needArgs+ mk <- needMk+ let output = fmap outputFile $ Map.lookup (Module ["Main"] False) $ source mk++ -- if you don't specify an odir/hidir then impossible to reverse from the file name to the module+ let exec = when (isJust output || threads == 1) $+ cmd "ghc --make -odir. -hidir." args+ grab = need $ map oFile $ Map.keys $ source mk+ if threads == 1 then exec >> grab else grab >> exec++ case output of+ Nothing -> return ()+ Just output -> do+ -- ensure that if the file gets deleted we rerun this rule without first trying to+ -- need the output, since we don't have a rule to build the output+ b <- doesFileExist output+ unless b $+ error $ "Failed to build output file: " ++ output ++ "\n" +++ "Most likely ghc-make has guessed the output location wrongly."+ need [output]+ writeFile' out ""++ let match x = do m <- oModule x `mplus` hiModule x; return [oFile m, hiFile m]+ match &?> \[o,hi] -> do+ let Just m = oModule o+ source <- askSource (AskSource m)+ (files,mods) <- fmap partitionEithers $ askImports (AskImports m)+ need $ source : map hiFile mods ++ files+ when (threads /= 1) $ do+ args <- needArgs+ let isRoot x = x == "Main" || takeExtension x `elem` [".hs",".lhs"]+ cmd "ghc -odir. -hidir." (filter (not . isRoot) args) (if hiDir == "" then [] else ["-i" ++ hiDir]) "-o" [o] "-c" [source]
+ CHANGES.txt view
@@ -0,0 +1,13 @@+Changelog for ghc-make++0.2+ Support the -hidir flag in conjunction with -j+ Support the -o flag in conjunction with -j+ Override --help+ #2, detect package upgrades and recompile+ Add parallelism+ Upgrade to shake-0.13+ Add test suite+ Support other GHC modes such as --version+0.1+ Initial version
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2013.+Copyright Neil Mitchell 2013-2014. All rights reserved. Redistribution and use in source and binary forms, with or without
Main.hs view
@@ -1,64 +1,4 @@-{-# LANGUAGE PatternGuards #-} module Main(main) where -import Development.Shake-import Development.Shake.Command-import Development.Shake.FilePath-import System.Environment-import Data.Either-import Data.List-import Data.Maybe---main :: IO ()-main = do- args <- getArgs- let (argsShake, argsGHC) = splitFlags $ delete "--make" args- let prefix = maybe ".ghc-make" (</> ".ghc-make") $ dumpDir argsGHC-- withArgs argsShake $ shakeArgs shakeOptions{shakeFiles=prefix, shakeVerbosity=Quiet} $ do- want [prefix <.> "makefile"]-- prefix <.> "args" *> \out -> do- alwaysRerun- writeFileChanged out $ unlines argsGHC-- prefix <.> "makefile" *> \out -> do- need [prefix <.> "args"]- () <- cmd "ghc -M -dep-makefile" [out] argsGHC- opts <- liftIO $ fmap parseMakefile $ readFile out- () <- cmd "ghc --make" argsGHC- need $ nub $ concatMap (uncurry (:)) opts----- | Split flags into (Shake flags, GHC flags)-splitFlags :: [String] -> ([String], [String])-splitFlags = partitionEithers . map f- where- f x | Just x <- stripPrefix "--shake-" x = Left $ '-':x- | Just x <- stripPrefix "-shake-" x = Left $ '-':x- | otherwise = Right x----- | Where does the user want to dump temp files (-odir, -hidir)--- GHC accepts -odir foo, -odirfoo, -odir=foo-dumpDir :: [String] -> Maybe FilePath-dumpDir (flag:x:xs) | flag `elem` dirFlags = Just $ fromMaybe x $ dumpDir xs-dumpDir (x:xs) | x:_ <- mapMaybe (`stripPrefix` x) dirFlags = Just $ fromMaybe (if "=" `isPrefixOf` x then drop 1 x else x) $ dumpDir xs-dumpDir (x:xs) = dumpDir xs-dumpDir [] = Nothing---dirFlags = ["-odir","-hidir"]---parseMakefile :: String -> [(FilePath, [FilePath])]-parseMakefile = concatMap f . join . lines- where- join (x1:x2:xs) | "\\" `isSuffixOf` x1 = join $ (init x1 ++ x2) : xs- join (x:xs) = x : join xs- join [] = []-- f x = [(a, words $ drop 1 b) | a <- words a]- where (a,b) = break (== ':') $ takeWhile (/= '#') x+import Build
+ Makefile.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE RecordWildCards, PatternGuards, DeriveDataTypeable #-}++module Makefile(Makefile(..), Module(..), makefile) where++import Data.List+import Development.Shake.FilePath+import Development.Shake.Classes+import Development.Shake.Util+import Data.Bits+import qualified Data.HashMap.Strict as Map+++data Module = Module {moduleName :: [String], moduleBoot :: Bool}+ deriving (Typeable, Eq)++instance Show Module where+ show (Module name boot) = intercalate "." name ++ (if boot then "[boot]" else "")++instance Hashable Module where+ hashWithSalt salt (Module a b) = hashWithSalt salt a `xor` hashWithSalt salt b++instance NFData Module where+ rnf (Module a b) = rnf (a,b)++instance Binary Module where+ put (Module a b) = put a >> put b+ get = do a <- get; b <- get; return $ Module a b++data Makefile = Makefile+ {imports :: !(Map.HashMap Module [Either FilePath Module]) -- What does a module import+ ,source :: !(Map.HashMap Module FilePath) -- Where is that modules source located+ }+ deriving Show+++makefile :: FilePath -> IO Makefile+makefile file = fmap (foldl' f z . parseMakefile) $ readFile file+ where+ z = Makefile Map.empty Map.empty++ -- We rely on the order of the generated makefile, in particular+ -- * The Foo.o : Foo.hs line is always the first with Foo.o on the LHS+ -- * The root module (often Main.o) is always last+ f m (a,[b])+ | Just o <- fromExt "_o_" a, not $ Map.member o $ source m = m{source=Map.insert o b $ source m}+ | Just o <- fromExt "_o_" a, Just hi <- fromExt "_hi_" b = m{imports = Map.insertWith (++) o [Right hi] $ imports m}+ | Just o <- fromExt "_o_" a = m{imports = Map.insertWith (++) o [Left b] $ imports m}+ | otherwise = m+ f m (a,bs) = foldl' f m [(a,[b]) | b <- bs]+++fromExt ext x+ | "-boot" `isSuffixOf` x, Just (Module m _) <- fromExt ext $ take (length x - 5) x = Just $ Module m True+ | takeExtension x == "." ++ ext = Just $ Module (splitDirectories $ dropExtension x) False+ | otherwise = Nothing
+ README.md view
@@ -0,0 +1,41 @@+# ghc-make [](https://travis-ci.org/ndmitchell/ghc-make)++An alternative to `ghc --make` which supports parallel compilation of modules and runs faster when nothing needs compiling.++#### How do I use it?++Install `ghc-make` (`cabal update && cabal install ghc-make`). Then replace your calls to `ghc my -arguments` with `ghc-make my -arguments`. Almost all arguments and flags supported by `ghc` are supported by `ghc-make` - it is intended as a drop-in replacement.++#### What should I see?++Imagine you have a script that runs `ghc --make MyCode && ./MyCode` and that running `ghc --make` when nothing needs compiling takes 5 seconds (I have projects that take as long as 23 seconds). If you switch to `ghc-make MyCode && ./MyCode` then when nothing needs compiling it will take almost no time (less than 0.2 seconds). If things need compiling it will take the compilation time plus the time with `ghc --make` when nothing needs compiling (in this example, 5 seconds extra). If the source changes on less than half the executions you will see a speedup.++The `ghc-make` program produces a handful of metadata files which are stored with the `.ghc-make` prefix. These files will be placed in the current directory, or the `-hidir`/`-odir` directory if specified.++#### How do I turn on parallel module compilation?++Pass `-j4` to build using 4 cores. In my experience you usually need a parallel factor of 3x to match `ghc --make` on a single core, since `ghc --make` does a lot of caching that is unavailable to `ghc-make`.++To use `ghc-make` with Cabal, try `cabal build --with-ghc=ghc-make --ghc-options=-j4`. (This technique is due to the [`ghc-parmake`](https://github.com/23Skidoo/ghc-parmake) project, which also does parallel `ghc --make` compiles.)++#### What GHC features are unsupported?++Anything not captured by `ghc -M` will not be tracked, including dependencies registered by Template Haskell and `#include` files.++#### Why is it faster?++When GHC does a compilation check it runs any preprocessors and parses the Haskell files, which can be slow. When `ghc-make` does a compilation check it reads a list of file names and modification times from a database and checks the times still match, and if they do, it does nothing.++#### Why is it slower?++When things have changed `ghc-make` also runs `ghc-pkg list` and `ghc -M` to get a list of dependencies. To produce that list, GHC has to run any preprocessors and parse the Haskell files. If GHC was able to produce the dependencies while building (as `gcc` is able to do) then `ghc-make` would never be noticeably slower.++#### How is it implemented?++This program uses the [Shake library](https://github.com/ndmitchell/shake#readme) for dependency tracking and `ghc --make` for building.++To pass options to the underlying Shake build system prefix them with `--shake`, for example `--shake--report=-` will write a profile report to stdout and `--shake--help` will list the available Shake options.++#### Should GHC just use Shake directly?++Should _large and important project_ use _authors pet library_? Yes, of course :smiley:. If `ghc --make` used Shake it is likely their builds with no recompilation would be just as fast as `ghc-make`, and they could take advantage of parallel compilation with no additional overhead. However, integrating Shake into such a large code base would be a lot of work - perhaps you should offer to help the GHC team?
ghc-make.cabal view
@@ -1,30 +1,45 @@ cabal-version: >= 1.8 build-type: Simple name: ghc-make-version: 0.1+version: 0.2 license: BSD3 license-file: LICENSE category: Development author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>-copyright: Neil Mitchell 2013+copyright: Neil Mitchell 2013-2014 synopsis: Accelerated version of ghc --make description:- The @ghc-make@ program can be used as an alternative to @ghc --make@. When the build has some- work to do it will perform slower than @ghc --make@ alone. When there is no work to do, the build- will run faster, sometimes significantly so.+ The @ghc-make@ program can be used as a drop-in replacement for @ghc@. This program+ targets two use cases: .- See the readme for full details <https://github.com/ndmitchell/ghc-make#readme>+ * If a flag such as @-j4@ is passed, the modules will be compiled in parallel.+ If the available parallelism is greater than a factor of 3, the build will probably run faster.+ .+ * If there is no work to do (i.e. the compiled files are up-to-date), the build will run faster,+ sometimes significantly so.+ .+ See the readme for full details: <https://github.com/ndmitchell/ghc-make#readme>. homepage: https://github.com/ndmitchell/ghc-make#readme-stability: Beta+bug-reports: https://github.com/ndmitchell/ghc-make/issues+extra-source-files:+ README.md+ CHANGES.txt+tested-with: GHC==7.8.2, GHC==7.6.3, GHC==7.4.2 source-repository head type: git- location: git://github.com/ndmitchell/ghc-make.git+ location: https://github.com/ndmitchell/ghc-make.git executable ghc-make main-is: Main.hs ghc-options: -threaded build-depends: base == 4.*,- shake == 0.10.*+ shake >= 0.13,+ unordered-containers >= 0.2.1,+ process >= 1.0+ other-modules:+ Arguments+ Build+ Makefile