diff --git a/Development/Make/Rules.hs b/Development/Make/Rules.hs
--- a/Development/Make/Rules.hs
+++ b/Development/Make/Rules.hs
@@ -11,7 +11,7 @@
 import System.Directory
 
 import Development.Shake.Core
-import Development.Shake.Types
+import Development.Shake.Util
 import Development.Shake.Classes
 import Development.Shake.FilePath
 import Development.Shake.FileTime
@@ -24,25 +24,25 @@
 -- Which matches the (insane) semantics of make
 -- If a file is not produced, it will rebuild forever
 
-newtype File_Q = File_Q BS
+newtype File_Q = File_Q BSU
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
-instance Show File_Q where show (File_Q x) = unpack x
+instance Show File_Q where show (File_Q x) = unpackU x
 
 newtype File_A = File_A (Maybe FileTime)
     deriving (Typeable,Eq,Hashable,Binary,Show,NFData)
 
 instance Rule File_Q File_A where
-    storedValue (File_Q x) = fmap (fmap (File_A . Just)) $ getModTimeMaybe $ unpack_ x
+    storedValue (File_Q x) = fmap (fmap (File_A . Just)) $ getModTimeMaybe x
 
 
 defaultRuleFile_ :: Rules ()
 defaultRuleFile_ = defaultRule $ \(File_Q x) -> Just $
-    liftIO $ fmap (File_A . Just) $ getModTimeError "Error, file does not exist and no rule available:" $ unpack_ x
+    liftIO $ fmap (File_A . Just) $ getModTimeError "Error, file does not exist and no rule available:" x
 
 
 need_ :: [FilePath] -> Action ()
-need_ xs = (apply $ map (File_Q . pack) xs :: Action [File_A]) >> return ()
+need_ xs = (apply $ map (File_Q . packU) xs :: Action [File_A]) >> return ()
 
 want_ :: [FilePath] -> Rules ()
 want_ = action . need_
@@ -50,10 +50,10 @@
 data Phony = Phony | NotPhony deriving Eq
 
 (??>) :: (FilePath -> Bool) -> (FilePath -> Action Phony) -> Rules ()
-(??>) test act = rule $ \(File_Q x_) -> let x = unpack x_ in
+(??>) test act = rule $ \(File_Q x_) -> let x = unpackU x_ in
     if not $ test x then Nothing else Just $ do
         liftIO $ createDirectoryIfMissing True $ takeDirectory x
         res <- act x
         liftIO $ fmap File_A $ if res == Phony
             then return Nothing
-            else getModTimeMaybe $ unpack_ x_
+            else getModTimeMaybe x_
diff --git a/Development/Ninja/All.hs b/Development/Ninja/All.hs
--- a/Development/Ninja/All.hs
+++ b/Development/Ninja/All.hs
@@ -12,6 +12,7 @@
 
 import System.Directory
 import qualified Data.HashMap.Strict as Map
+import Control.Arrow
 import Control.Monad
 import Data.List
 import Data.Char
@@ -23,8 +24,8 @@
     ninja@Ninja{..} <- parse file
     return $ do
         phonys <- return $ Map.fromList phonys
-        singles <- return $ Map.fromList singles
-        multiples <- return $ Map.fromList [(x,(xs,b)) | (xs,b) <- multiples, x <- xs]
+        singles <- return $ Map.fromList $ map (first norm) singles
+        multiples <- return $ Map.fromList [(x,(xs,b)) | (xs,b) <- map (first $ map norm) multiples, x <- xs]
         rules <- return $ Map.fromList rules
         pools <- fmap Map.fromList $ forM pools $ \(name,depth) ->
             fmap ((,) name) $ newResource (BS.unpack name) depth
@@ -41,6 +42,11 @@
             build phonys rules pools [out2] $ singles Map.! out2
 
 
+-- Normalise the LHS of build rules, so that normalised RHS still match
+norm :: Str -> Str
+norm = BS.pack . normalise . BS.unpack
+
+
 resolvePhony :: Map.HashMap Str [Str] -> Str -> [Str]
 resolvePhony mp = f $ Left 100
     where
@@ -51,6 +57,11 @@
             Just xs -> concatMap (f $ either (Left . subtract 1) (Right . (x:)) a) xs
 
 
+quote :: Str -> Str
+quote x | BS.any isSpace x = let q = BS.singleton '\"' in BS.concat [q,x,q]
+        | otherwise = x
+
+
 build :: Map.HashMap Str [Str] -> Map.HashMap Str Rule -> Map.HashMap Str Resource -> [Str] -> Build -> Action ()
 build phonys rules pools out Build{..} = do
     need $ map (normalise . BS.unpack) $ concatMap (resolvePhony phonys) $ depsNormal ++ depsImplicit ++ depsOrderOnly
@@ -60,8 +71,8 @@
             env <- liftIO $ scopeEnv env
             liftIO $ do
                 -- the order of adding new environment variables matters
-                addEnv env (BS.pack "out") (BS.unwords out)
-                addEnv env (BS.pack "in") (BS.unwords depsNormal)
+                addEnv env (BS.pack "out") (BS.unwords $ map quote out)
+                addEnv env (BS.pack "in") (BS.unwords $ map quote depsNormal)
                 addEnv env (BS.pack "in_newline") (BS.unlines depsNormal)
                 addBinds env buildBind
                 addBinds env ruleBind
diff --git a/Development/Ninja/Parse.hs b/Development/Ninja/Parse.hs
--- a/Development/Ninja/Parse.hs
+++ b/Development/Ninja/Parse.hs
@@ -20,14 +20,18 @@
 startsSpace :: Str -> Bool
 startsSpace = BS.isPrefixOf (BS.pack " ")
 
+-- | This is a hot-spot, so optimised
 linesCR :: Str -> [Str]
-linesCR x | BS.null x = []
-          | otherwise = case BS.elemIndex '\n' x of
-                Nothing -> [x]
-                Just i | i >= 1 && BS.index x (i-1) == '\r' -> BS.take (i-1) x : linesCR (BS.drop (i+1) x)
-                       | otherwise -> BS.take i x : linesCR (BS.drop (i+1) x)
+linesCR x = case BS.split '\n' x of
+    x:xs | Just ('\r',x) <- unsnoc x -> x : map (\x -> case unsnoc x of Just ('\r',x) -> x; _ -> x) xs
+    xs -> xs
+    where
+        -- the ByteString unsnoc was introduced in a newer version
+        unsnoc x | BS.null x = Nothing
+                 | otherwise = Just (BS.last x, BS.init x)
 
 
+
 word1 :: Str -> (Str, Str)
 word1 x = (a, dropSpace b)
     where (a,b) = BS.break isSpace x
@@ -122,8 +126,9 @@
         exprs [x] = x
         exprs xs = Exprs xs
 
-        f x = Lit a : g (BS.drop 1 b)
-            where (a,b) = BS.break (== '$') x
+        f x = case BS.elemIndex '$' x of
+            Nothing -> [Lit x]
+            Just i -> Lit (BS.take i x) : g (BS.drop (i+1) x)
 
         g x = case BS.uncons x of
             Nothing -> []
diff --git a/Development/Shake.hs b/Development/Shake.hs
--- a/Development/Shake.hs
+++ b/Development/Shake.hs
@@ -28,6 +28,12 @@
 --   Finally we call the @tar@ program. If either @result.txt@ changes, or any of the files listed by @result.txt@
 --   change, then @result.tar@ will be rebuilt.
 --
+--   The theory behind Shake is described in an ICFP 2012 paper, Shake Before Building -- Replacing Make with Haskell
+--   <http://community.haskell.org/~ndm/downloads/paper-shake_before_building-10_sep_2012.pdf>. The associated talk
+--   forms a short overview of Shake <http://www.youtube.com/watch?v=xYCPpXVlqFM>.
+--
+--   /== WRITING A BUILD SYSTEM ==============================/
+--
 --   When writing a Shake build system, start by defining what you 'want', then write rules
 --   with '*>' to produce the results. Before calling 'cmd' you should ensure that any files the command
 --   requires are demanded with calls to 'need'. We offer the following advice to Shake users:
@@ -40,8 +46,7 @@
 -- * Put all result files in a distinguished directory, for example @_make@. You can implement a @clean@
 --   command by removing that directory, using @'removeFilesAfter' \"_make\" [\"\/\/\*\"]@.
 --
--- * To obtain parallel builds set 'shakeThreads' to a number greater than 1. You may also need to
---   compile with @-threaded@.
+-- * To obtain parallel builds set 'shakeThreads' to a number greater than 1.
 --
 -- * Lots of compilers produce @.o@ files. To avoid overlapping rules, use @.c.o@ for C compilers,
 --   @.hs.o@ for Haskell compilers etc.
@@ -54,10 +59,26 @@
 --   that you suspect will change regularly (perhaps @ghc@ version number), either write the information to
 --   a file with 'alwaysRerun' and 'writeFileChanged', or use 'addOracle'.
 --
---   The theory behind Shake is described in an ICFP 2012 paper, Shake Before Building -- Replacing Make with Haskell
---   <http://community.haskell.org/~ndm/downloads/paper-shake_before_building-10_sep_2012.pdf>. The associated talk
---   forms a short overview of Shake <http://www.youtube.com/watch?v=xYCPpXVlqFM>.
+--   /== GHC BUILD FLAGS ==============================/
 --
+--   For large build systems the choice of GHC flags can have a significant impact. We recommend:
+--
+-- > ghc --make MyBuildSystem -rtsopts "-with-rtsopts=-I0 -qg -qb"
+--
+--   * Compile without @-threaded@: In GHC 7.6 and earlier bug 7646 <http://ghc.haskell.org/trac/ghc/ticket/7646>
+--     can cause a race condition in build systems that write files then read them. Omitting @-threaded@ will
+--     still allow your 'cmd' actions to run in parallel, so most build systems will still run in parallel.
+--
+--   * Compile with @-rtsopts@: Allow the setting of further GHC options at runtime.
+--
+--   * Run with @-I0@: Disable idle garbage collection. In a build system regularly running many system
+--     commands the program appears \"idle\" very often, triggering regular unnecessary garbage collection, stealing
+--     resources from the program doing actual work.
+--
+--   * Run with @-qg -qb@: Disable parallel garbage collection. Parallel garbage collection in Shake
+--     programs typically goes slower than sequential garbage collection, while occupying many cores that
+--     can be used for running system commands.
+--
 --   /Acknowledgements/: Thanks to Austin Seipp for properly integrating the profiling code.
 module Development.Shake(
     -- * Core
@@ -75,7 +96,7 @@
     -- ** Command line
     shakeArgs, shakeArgsWith, shakeOptDescrs,
     -- ** Progress reporting
-    Progress(..), progressSimple, progressDisplay, progressTitlebar,
+    Progress(..), progressSimple, progressDisplay, progressTitlebar, progressProgram,
     -- ** Verbosity
     Verbosity(..), getVerbosity, putLoud, putNormal, putQuiet, quietly,
     -- * Running commands
@@ -86,7 +107,7 @@
     module Development.Shake.Derived,
     removeFiles, removeFilesAfter,
     -- * File rules
-    need, want, (*>), (**>), (?>), phony,
+    need, want, (*>), (**>), (?>), phony, (~>),
     module Development.Shake.Files,
     FilePattern, (?==),
     -- * Directory rules
@@ -97,8 +118,10 @@
     addOracle, askOracle, askOracleWith,
     -- * Special rules
     alwaysRerun,
-    -- * Finite resources
+    -- * Resources
     Resource, newResource, newResourceIO, withResource, withResources,
+    newThrottle, newThrottleIO,
+    unsafeExtraThread,
     -- * Cached file contents
     newCache, newCacheIO
     ) where
diff --git a/Development/Shake/Args.hs b/Development/Shake/Args.hs
--- a/Development/Shake/Args.hs
+++ b/Development/Shake/Args.hs
@@ -112,7 +112,7 @@
         assumeOld = [x | AssumeOld x <- flagsExtra]
         changeDirectory = listToMaybe [x | ChangeDirectory x <- flagsExtra]
         printDirectory = last $ False : [x | PrintDirectory x <- flagsExtra]
-        shakeOpts = foldl (flip ($)) baseOpts flagsShake
+        shakeOpts = foldl' (flip ($)) baseOpts flagsShake
 
     -- error if you pass some clean and some dirty with specific flags
     errs <- return $ errs ++ flagsError ++ ["cannot mix " ++ a ++ " and " ++ b | a:b:_ <-
@@ -248,7 +248,7 @@
     ,no  $ Option ""  ["sleep"] (NoArg $ Right ([Sleep],id)) "Sleep for a second before building."
     ,yes $ Option "S" ["no-keep-going","stop"] (noArg $ \s -> s{shakeStaunch=False}) "Turns off -k."
     ,yes $ Option ""  ["storage"] (noArg $ \s -> s{shakeStorageLog=True}) "Write a storage log."
-    ,yes $ Option "p" ["progress"] (optIntArg "progress" "N" (\i s -> s{shakeProgress=progressDisplay (fromMaybe 5 i) progressTitlebar})) "Show progress messages [every N seconds, default 5]."
+    ,yes $ Option "p" ["progress"] (optIntArg "progress" "N" (\i s -> s{shakeProgress=prog $ fromMaybe 5 i})) "Show progress messages [every N seconds, default 5]."
     ,yes $ Option " " ["no-progress"] (noArg $ \s -> s{shakeProgress=const $ return ()}) "Don't show progress messages."
     ,yes $ Option "q" ["quiet"] (noArg $ \s -> s{shakeVerbosity=move (shakeVerbosity s) pred}) "Don't print much."
     ,no  $ Option ""  ["no-time"] (NoArg $ Right ([NoTime],id)) "Don't print build time."
@@ -286,3 +286,7 @@
             appendFile file $ unescape msg
 
         outputColor output v msg = output v $ escape "34" msg
+
+        prog i p = do
+            program <- progressProgram
+            progressDisplay i (\s -> progressTitlebar s >> program s) p
diff --git a/Development/Shake/Command.hs b/Development/Shake/Command.hs
--- a/Development/Shake/Command.hs
+++ b/Development/Shake/Command.hs
@@ -75,22 +75,26 @@
             bin inh; bin outh; bin errh
 
         -- fork off a thread to start consuming stdout
-        (out,waitOut) <- case outh of
-            Nothing -> return ("", return ())
+        (out,waitOut,waitOutEcho) <- case outh of
+            Nothing -> return ("", return (), return ())
             Just outh -> do
                 out <- hGetContents outh
                 waitOut <- forkWait $ C.evaluate $ rnf out
-                when stdoutEcho $ forkIO (hPutStr stdout out) >> return ()
-                return (out,waitOut)
+                waitOutEcho <- if stdoutEcho
+                                 then forkWait (hPutStr stdout out)
+                                 else return (return ())
+                return (out,waitOut,waitOutEcho)
 
         -- fork off a thread to start consuming stderr
-        (err,waitErr) <- case errh of
-            Nothing -> return ("", return ())
+        (err,waitErr,waitErrEcho) <- case errh of
+            Nothing -> return ("", return (), return ())
             Just errh -> do
                 err <- hGetContents errh
                 waitErr <- forkWait $ C.evaluate $ rnf err
-                when stderrEcho $ forkIO (hPutStr stderr err) >> return ()
-                return (err,waitErr)
+                waitErrEcho <- if stderrEcho
+                                 then forkWait (hPutStr stderr err)
+                                 else return (return ())
+                return (err,waitErr,waitErrEcho)
 
         -- now write and flush any input
         let writeInput = do
@@ -111,6 +115,9 @@
         waitOut
         waitErr
 
+        waitOutEcho
+        waitErrEcho
+
         close outh
         close errh
 
@@ -217,7 +224,7 @@
     cmdResult = ([], \[] -> ())
 
 instance (CmdResult x1, CmdResult x2) => CmdResult (x1,x2) where
-    cmdResult = (a1++a2, \rs -> let (r1,r2) = splitAt (length a2) rs in (b1 r1, b2 r2))
+    cmdResult = (a1++a2, \rs -> let (r1,r2) = splitAt (length a1) rs in (b1 r1, b2 r2))
         where (a1,b1) = cmdResult
               (a2,b2) = cmdResult
 
diff --git a/Development/Shake/Core.hs b/Development/Shake/Core.hs
--- a/Development/Shake/Core.hs
+++ b/Development/Shake/Core.hs
@@ -14,7 +14,8 @@
     Rule(..), Rules, defaultRule, rule, action, withoutActions,
     Action, actionOnException, actionFinally, apply, apply1, traced,
     getVerbosity, putLoud, putNormal, putQuiet, quietly,
-    Resource, newResource, newResourceIO, withResource, withResources,
+    Resource, newResource, newResourceIO, withResource, withResources, newThrottle, newThrottleIO,
+    unsafeExtraThread,
     -- Internal stuff
     rulesIO, runAfter
     ) where
@@ -39,12 +40,13 @@
 import Development.Shake.Classes
 import Development.Shake.Pool
 import Development.Shake.Database
-import Development.Shake.Locks
+import Development.Shake.Resource
 import Development.Shake.Value
 import Development.Shake.Report
 import Development.Shake.Types
 import Development.Shake.Errors
 import Development.Shake.Timing
+import Development.Shake.Util
 
 
 ---------------------------------------------------------------------
@@ -178,6 +180,20 @@
 
 
 -- | Run an action, usually used for specifying top-level requirements.
+--
+-- @
+-- main = 'Development.Shake.shake' 'shakeOptions' $ do
+--    'action' $ do
+--        b <- 'Development.Shake.doesFileExist' \"file.src\"
+--        when b $ 'Development.Shake.need' [\"file.out\"]
+-- @
+--
+--   This 'action' builds @file.out@, but only if @file.src@ exists. The 'action'
+--   will be run in every build execution (unless 'withoutActions' is used), so only cheap
+--   operations should be performed.
+--
+--   For the standard requirement of only 'Development.Shake.need'ing a fixed list of files in the 'action',
+--   see 'Development.Shake.want'.
 action :: Action a -> Rules ()
 action a = newRules mempty{actions=[a >> return ()]}
 
@@ -214,6 +230,7 @@
     ,depends :: [Depends] -- built up in reverse
     ,discount :: !Duration
     ,traces :: [Trace] -- in reverse
+    ,blockapply ::  Maybe String -- reason to block apply, or Nothing to allow
     }
 
 -- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'Development.Shake.need' to execute files.
@@ -242,7 +259,7 @@
 -- | Internal main function (not exported publicly)
 run :: ShakeOptions -> Rules () -> IO ()
 run opts@ShakeOptions{..} rs = (if shakeLineBuffering then lineBuffering else id) $ do
-    start <- startTime
+    start <- offsetTime
     rs <- getRules rs
     registerWitnesses rs
 
@@ -269,27 +286,33 @@
         dir <- getCurrentDirectory
         return $ \msg -> do
             now <- getCurrentDirectory
-            when (dir /= now) $ error $
-                "Lint checking failed, current directory has changed\n" ++
-                "When:   " ++ msg ++ "\n" ++
-                "Wanted: " ++ dir ++ "\n" ++
-                "Got:    " ++ now
+            when (dir /= now) $ errorStructured
+                "Lint checking error - current directory has changed"
+                [("When", Just msg)
+                ,("Wanted",Just dir)
+                ,("Got",Just now)]
+                ""
 
-    let ruleinfo = createRuleinfo rs
-    running <- newIORef True
+    progressThread <- newIORef Nothing
     after <- newIORef []
-    flip finally (writeIORef running False >> if shakeTimings then printTimings else resetTimings) $
+    let cleanup = do
+            flip whenJust killThread =<< readIORef progressThread
+            when shakeTimings printTimings
+            resetTimings -- so we don't leak memory
+    flip finally cleanup $
         withCapabilities shakeThreads $ do
             withDatabase opts diagnostic $ \database -> do
-                forkIO $ shakeProgress $ do
-                    running <- readIORef running
+                tid <- forkIO $ shakeProgress $ do
                     failure <- fmap (fmap fst) $ readIORef except
                     stats <- progress database
-                    return stats{isRunning=running, isFailure=failure}
+                    return stats{isFailure=failure}
+                writeIORef progressThread $ Just tid
+                let ruleinfo = createRuleinfo rs
                 addTiming "Running rules"
                 runPool (shakeThreads == 1) shakeThreads $ \pool -> do
-                    let s0 = SAction database pool start ruleinfo output shakeVerbosity diagnostic lint after emptyStack [] 0 []
+                    let s0 = SAction database pool start ruleinfo output shakeVerbosity diagnostic lint after emptyStack [] 0 [] Nothing
                     mapM_ (addPool pool . staunch . runAction s0) (actions rs)
+
                 when shakeLint $ do
                     addTiming "Lint checking"
                     checkValid database (runStored ruleinfo)
@@ -396,9 +419,11 @@
         -- We don't want the forall in the Haddock docs
         f :: forall key value . Rule key value => [key] -> Action [value]
         f ks = do
-            ruleinfo <- Action $ State.gets ruleinfo
             let tk = typeOf (err "apply key" :: key)
                 tv = typeOf (err "apply type" :: value)
+            ruleinfo <- Action $ State.gets ruleinfo
+            block <- Action $ State.gets blockapply
+            whenJust block $ errorNoApply tk (fmap show $ listToMaybe ks)
             case Map.lookup tk ruleinfo of
                 Nothing -> errorNoRuleToBuildType tk (fmap show $ listToMaybe ks) (Just tv)
                 Just RuleInfo{resultType=tv2} | tv /= tv2 -> errorRuleTypeMismatch tk (fmap show $ listToMaybe ks) tv2 tv
@@ -411,11 +436,12 @@
     let exec stack k = try $ wrapStack (showStack (database s) stack) $ do
             evaluate $ rnf k
             let s2 = s{depends=[], stack=stack, discount=0, traces=[]}
-            lint s "before building"
+            let top = topStack stack
+            lint s $ "before building " ++ top
             (dur,(res,s2)) <- duration $ runAction s2 $ do
                 putWhen Chatty $ "# " ++ show k
                 runExecute (ruleinfo s) k
-            lint s "after building"
+            lint s $ "after building " ++ top
             let ans = (res, reverse $ depends s2, dur - discount s2, reverse $ traces s2)
             evaluate $ rnf ans
             return ans
@@ -486,13 +512,83 @@
 quietly = withVerbosity Quiet
 
 
--- | Create a new finite resource, given a name (for error messages) and a quantity of the resource that exists.
---   For an example see 'Resource'.
+-- | Create a finite resource, given a name (for error messages) and a quantity of the resource that exists.
+--   Shake will ensure that actions using the same finite resource do not execute in parallel.
+--   As an example, only one set of calls to the Excel API can occur at one time, therefore
+--   Excel is a finite resource of quantity 1. You can write:
+--
+-- @
+-- 'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=2} $ do
+--    'Development.Shake.want' [\"a.xls\",\"b.xls\"]
+--    excel <- 'Development.Shake.newResource' \"Excel\" 1
+--    \"*.xls\" 'Development.Shake.*>' \\out ->
+--        'Development.Shake.withResource' excel 1 $
+--            'Development.Shake.cmd' \"excel\" out ...
+-- @
+--
+--   Now the two calls to @excel@ will not happen in parallel.
+--
+--   As another example, calls to compilers are usually CPU bound but calls to linkers are usually
+--   disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit
+--   ourselves to 4 linkers with:
+--
+-- @
+-- disk <- 'Development.Shake.newResource' \"Disk\" 4
+-- 'Development.Shake.want' [show i 'Development.Shake.FilePath.<.>' \"exe\" | i <- [1..100]]
+-- \"*.exe\" 'Development.Shake.*>' \\out ->
+--     'Development.Shake.withResource' disk 1 $
+--         'Development.Shake.cmd' \"ld -o\" [out] ...
+-- \"*.o\" 'Development.Shake.*>' \\out ->
+--     'Development.Shake.cmd' \"cl -o\" [out] ...
+-- @
 newResource :: String -> Int -> Rules Resource
 newResource name mx = rulesIO $ newResourceIO name mx
 
 
--- | Run an action which uses part of a finite resource. For an example see 'Resource'.
+-- | Create a throttled resource, given a name (for error messages) and a number of resources (the 'Int') that can be
+--   used per time period (the 'Double' in seconds). Shake will ensure that actions using the same throttled resource
+--   do not exceed the limits. As an example, let us assume that making more than 1 request every 5 seconds to
+--   Google results in our client being blacklisted, we can write:
+--
+-- @
+-- google <- 'Development.Shake.newThrottle' \"Google\" 1 5
+-- \"*.url\" 'Development.Shake.*>' \\out -> do
+--     'Development.Shake.withResource' google 1 $
+--         'Development.Shake.cmd' \"wget\" [\"http:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out]
+-- @
+--
+--   Now we will wait at least 5 seconds after querying Google before performing another query. If Google change the rules to
+--   allow 12 requests per minute we can instead use @'Development.Shake.newThrottle' \"Google\" 12 60@, which would allow
+--   greater parallelisation, and avoid throttling entirely if only a small number of requests are necessary.
+--
+--   In the original example we never make a fresh request until 5 seconds after the previous request has /completed/. If we instead
+--   want to throttle requests since the previous request /started/ we can write:
+--
+-- @
+-- google <- 'Development.Shake.newThrottle' \"Google\" 1 5
+-- \"*.url\" 'Development.Shake.*>' \\out -> do
+--     'Development.Shake.withResource' google 1 $ return ()
+--     'Development.Shake.cmd' \"wget\" [\"http:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out]
+-- @
+--
+--   However, the rule may not continue running immediately after 'Development.Shake.withResource' completes, so while
+--   we will never exceed an average of 1 request every 5 seconds, we may end up running an unbounded number of
+--   requests simultaneously. If this limitation causes a problem in practice it can be fixed.
+newThrottle :: String -> Int -> Double -> Rules Resource
+newThrottle name count period = rulesIO $ newThrottleIO name count period
+
+
+blockApply :: String -> Action a -> Action a
+blockApply msg act = do
+    s0 <- Action State.get
+    Action $ State.put s0{blockapply=Just msg}
+    res <- act
+    Action $ State.modify $ \s -> s{blockapply=blockapply s0}
+    return res
+
+
+-- | Run an action which uses part of a finite resource. For more details see 'Resource'.
+--   You cannot call 'apply' / 'need' while the resource is acquired.
 withResource :: Resource -> Int -> Action a -> Action a
 withResource r i act = do
     s <- Action State.get
@@ -506,7 +602,7 @@
                     diagnostic s $ show r ++ " acquired " ++ show i ++ " after waiting")
         (do releaseResource r i
             diagnostic s $ show r ++ " released " ++ show i)
-        (runAction s act)
+        (runAction s $ blockApply ("Within withResource using " ++ show r) act)
     Action $ State.put s
     return res
 
@@ -521,3 +617,14 @@
     where
         f [] = act
         f (r:rs) = withResource (fst $ head r) (sum $ map snd r) $ f rs
+
+
+-- | Run an action without counting to the thread limit, typically used for actions that execute
+--   on remote machines using barely any local CPU resources. Unsafe as it allows the 'shakeThreads' limit to be exceeded.
+--   You cannot call 'apply' / 'Development.Shake.need' while the extra thread is executing.
+unsafeExtraThread :: Action a -> Action a
+unsafeExtraThread act = do
+    s <- Action State.get
+    (res,s) <- liftIO $ blockPool (pool s) $ fmap ((,) False) $ runAction s act
+    Action $ State.put s
+    return res
diff --git a/Development/Shake/Database.hs b/Development/Shake/Database.hs
--- a/Development/Shake/Database.hs
+++ b/Development/Shake/Database.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 
 module Development.Shake.Database(
-    Time, startTime, Duration, duration, Trace,
+    Time, offsetTime, Duration, duration, Trace,
     Database, withDatabase,
     Ops(..), build, Depends,
     progress,
@@ -16,10 +16,10 @@
 import Development.Shake.Pool
 import Development.Shake.Value
 import Development.Shake.Errors
-import Development.Shake.Locks
 import Development.Shake.Storage
 import Development.Shake.Types
 import Development.Shake.Special
+import Development.Shake.Util
 import Development.Shake.Intern as Intern
 
 import Control.Exception
@@ -30,7 +30,6 @@
 import Data.Maybe
 import Data.List
 import Data.Monoid
-import Data.Time
 
 type Map = Map.HashMap
 
@@ -43,54 +42,29 @@
 incStep (Step i) = Step $ i + 1
 
 
-type Duration = Double -- duration in seconds
-
-duration :: IO a -> IO (Duration, a)
-duration act = do
-    start <- getCurrentTime
-    res <- act
-    end <- getCurrentTime
-    return (fromRational $ toRational $ end `diffUTCTime` start, res)
-
-
-type Time = Double -- how far you are through this run, in seconds
-
--- | Call once at the start, then call repeatedly to get Time values out
-startTime :: IO (IO Time)
-startTime = do
-    start <- getCurrentTime
-    return $ do
-        end <- getCurrentTime
-        return $ fromRational $ toRational $ end `diffUTCTime` start
-
-whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
-whenJust (Just a) f = f a
-whenJust Nothing f = return ()
-
-
 ---------------------------------------------------------------------
 -- CALL STACK
 
-data Stack = Stack (Maybe Key) [Id]
+data Stack = Stack (Maybe Key) [Id] !(Set.HashSet Id)
 
 showStack :: Database -> Stack -> IO [String]
-showStack Database{..} (Stack _ xs) = do
+showStack Database{..} (Stack _ xs _) = do
     status <- withLock lock $ readIORef status
     return $ reverse $ map (maybe "<unknown>" (show . fst) . flip Map.lookup status) xs
 
 addStack :: Id -> Key -> Stack -> Stack
-addStack x key (Stack _ xs) = Stack (Just key) $ x : xs
+addStack x key (Stack _ xs set) = Stack (Just key) (x:xs) (Set.insert x set)
 
 topStack :: Stack -> String
-topStack (Stack key _) = maybe "<unknown>" show key
+topStack (Stack key _ _) = maybe "<unknown>" show key
 
 checkStack :: [Id] -> Stack -> Maybe Id
-checkStack new (Stack _ old)
-    | bad:_ <- old `intersect` new = Just bad
+checkStack new (Stack _ old set)
+    | bad:_ <- filter (`Set.member` set) new = Just bad
     | otherwise = Nothing
 
 emptyStack :: Stack
-emptyStack = Stack Nothing []
+emptyStack = Stack Nothing [] Set.empty
 
 
 ---------------------------------------------------------------------
@@ -148,7 +122,7 @@
 type Waiting = Status
 
 afterWaiting :: Waiting -> IO () -> IO ()
-afterWaiting (Waiting (Pending p) _) act = modifyIORef p (>> act)
+afterWaiting (Waiting (Pending p) _) act = modifyIORef'' p (>> act)
 
 newWaiting :: Maybe Result -> IO Waiting
 newWaiting r = do ref <- newIORef $ return (); return $ Waiting (Pending ref) r
@@ -166,7 +140,7 @@
         t <- readIORef todo
         when (t /= 0) $ do
             b <- act (t == 1) k
-            writeIORef todo $ if b then 0 else t - 1
+            writeIORef'' todo $ if b then 0 else t - 1
 
 
 getResult :: Status -> Maybe Result
@@ -200,8 +174,8 @@
                 Just i -> return i
                 Nothing -> do
                     (is, i) <- return $ Intern.add k is
-                    writeIORef intern is
-                    modifyIORef status $ Map.insert i (k,Missing)
+                    writeIORef'' intern is
+                    modifyIORef'' status $ Map.insert i (k,Missing)
                     return i
 
         whenJust (checkStack is stack) $ \bad -> do
@@ -234,7 +208,7 @@
         (#=) :: Id -> (Key, Status) -> IO Status
         i #= (k,v) = do
             s <- readIORef status
-            writeIORef status $ Map.insert i (k,v) s
+            writeIORef'' status $ Map.insert i (k,v) s
             diagnostic $ maybe "Missing" (statusType . snd) (Map.lookup i s) ++ " -> " ++ statusType v ++ ", " ++ maybe "<unknown>" (show . fst) (Map.lookup i s)
             return v
 
@@ -417,16 +391,21 @@
 checkValid Database{..} stored = do
     status <- readIORef status
     diagnostic "Starting validity/lint checking"
-    bad <- fmap concat $ forM (Map.toList status) $ \(i,v) -> case v of
+    -- Do not use a forM here as you use too much stack space
+    bad <- (\f -> foldM f [] (Map.toList status)) $ \seen (i,v) -> case v of
         (key, Ready Result{..}) -> do
-            good <- fmap (== Just result) $ stored key
+            now <- stored key
+            let good = now == Just result
             diagnostic $ "Checking if " ++ show key ++ " is " ++ show result ++ ", " ++ if good then "passed" else "FAILED"
-            return [show key ++ " is no longer " ++ show result | not good && not (specialAlwaysRebuilds result)]
-        _ -> return []
-    if null bad
-        then diagnostic "Validity/lint check passed"
-        else error $ unlines $ "Error: Dependencies have changed since being built:" : bad
-
+            return $ [(key, result, now) | not good && not (specialAlwaysRebuilds result)] ++ seen
+        _ -> return seen
+    if null bad then diagnostic "Validity/lint check passed" else do
+        let n = length bad
+        errorStructured
+            ("Lint checking error - " ++ (if n == 1 then "value has" else show n ++ " values have")  ++ " changed since being depended upon")
+            (intercalate [("",Just "")] [ [("Key", Just $ show key),("Old", Just $ show result),("New", Just $ maybe "<missing>" show now)]
+                                        | (key, result, now) <- bad])
+            ""
 
 ---------------------------------------------------------------------
 -- STORAGE
diff --git a/Development/Shake/Directory.hs b/Development/Shake/Directory.hs
--- a/Development/Shake/Directory.hs
+++ b/Development/Shake/Directory.hs
@@ -15,7 +15,6 @@
 import System.IO.Error
 import Data.Binary
 import Data.List
-import Data.Maybe
 import qualified System.Directory as IO
 import qualified System.Environment as IO
 
@@ -23,13 +22,14 @@
 import Development.Shake.Classes
 import Development.Shake.FilePath
 import Development.Shake.FilePattern
+import Development.Shake.Util
 
 
 newtype DoesFileExistQ = DoesFileExistQ FilePath
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
 instance Show DoesFileExistQ where
-    show (DoesFileExistQ a) = "Exists? " ++ a
+    show (DoesFileExistQ a) = "doesFileExist " ++ showQuote a
 
 newtype DoesFileExistA = DoesFileExistA Bool
     deriving (Typeable,Eq,Hashable,Binary,NFData)
@@ -42,7 +42,7 @@
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
 instance Show DoesDirectoryExistQ where
-    show (DoesDirectoryExistQ a) = "Exists dir? " ++ a
+    show (DoesDirectoryExistQ a) = "doesDirectoryExist " ++ showQuote a
 
 newtype DoesDirectoryExistA = DoesDirectoryExistA Bool
     deriving (Typeable,Eq,Hashable,Binary,NFData)
@@ -55,13 +55,13 @@
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
 instance Show GetEnvQ where
-    show (GetEnvQ a) = "getEnv " ++ a
+    show (GetEnvQ a) = "getEnv " ++ showQuote a
 
 newtype GetEnvA = GetEnvA (Maybe String)
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
 instance Show GetEnvA where
-    show (GetEnvA a) = fromMaybe "<unset>" a
+    show (GetEnvA a) = maybe "<unset>" showQuote a
 
 
 data GetDirectoryQ
@@ -69,14 +69,17 @@
     | GetDirFiles {dir :: FilePath, pat :: [FilePattern]}
     | GetDirDirs {dir :: FilePath}
     deriving (Typeable,Eq)
+
 newtype GetDirectoryA = GetDirectoryA [FilePath]
-    deriving (Typeable,Show,Eq,Hashable,Binary,NFData)
+    deriving (Typeable,Eq,Hashable,Binary,NFData)
 
 instance Show GetDirectoryQ where
-    show (GetDir x) = "Listing " ++ x
-    show (GetDirFiles a b) = "Files " ++ a </> ['{'|m] ++ unwords b ++ ['}'|m]
-        where m = length b > 1
-    show (GetDirDirs x) = "Dirs " ++ x
+    show (GetDir x) = "getDirectoryContents " ++ showQuote x
+    show (GetDirFiles a b) = "getDirectoryFiles " ++ showQuote a ++ " [" ++ unwords (map showQuote b) ++ "]"
+    show (GetDirDirs x) = "getDirectoryDirs " ++ showQuote x
+
+instance Show GetDirectoryA where
+    show (GetDirectoryA xs) = unwords $ map showQuote xs
 
 instance NFData GetDirectoryQ where
     rnf (GetDir a) = rnf a
diff --git a/Development/Shake/Errors.hs b/Development/Shake/Errors.hs
--- a/Development/Shake/Errors.hs
+++ b/Development/Shake/Errors.hs
@@ -3,9 +3,9 @@
 -- | Errors seen by the user
 module Development.Shake.Errors(
     ShakeException(..),
+    errorStructured, err,
     errorNoRuleToBuildType, errorRuleTypeMismatch, errorIncompatibleRules,
-    errorMultipleRulesMatch, errorRuleRecursion,
-    err
+    errorMultipleRulesMatch, errorRuleRecursion, errorNoApply,
     ) where
 
 import Control.Arrow
@@ -27,25 +27,27 @@
     ,"_rule/defaultRule_" * "addOracle"
     ,"_apply_" * "askOracle"]
 
+
+errorStructured :: String -> [(String, Maybe String)] -> String -> a
+errorStructured msg args hint = error $ unlines $
+        [msg ++ ":"] ++
+        ["  " ++ a ++ [':' | a /= ""] ++ replicate (as - length a + 2) ' ' ++ b | (a,b) <- args2] ++
+        [hint | hint /= ""]
+    where
+        as = maximum $ 0 : map (length . fst) args2
+        args2 = [(a,b) | (a,Just b) <- args]
+
+
+
 structured :: Bool -> String -> [(String, Maybe String)] -> String -> a
-structured alt msg args hint = structured_ (f msg) (map (first f) args) (f hint)
+structured alt msg args hint = errorStructured (f msg) (map (first f) args) (f hint)
     where
         f = filter (/= '_') . (if alt then g else id)
         g xs | (a,b):_ <- filter (\(a,b) -> a `isPrefixOf` xs) alternatives = b ++ g (drop (length a) xs)
         g (x:xs) = x : g xs
         g [] = []
 
-structured_ :: String -> [(String, Maybe String)] -> String -> a
-structured_ msg args hint = error $
-        msg ++ ":\n" ++ unlines ["  " ++ a ++ ":" ++ replicate (as - length a + 2) ' ' ++ drp b | (a,b) <- args2] ++ hint
-    where
-        drp x | "OracleA " `isPrefixOf` x = drop 8 x
-              | "OracleQ " `isPrefixOf` x = drop 8 x
-              | otherwise = x
-        as = maximum $ 0 : map (length . fst) args2
-        args2 = [(a,b) | (a,Just b) <- args]
 
-
 errorNoRuleToBuildType :: TypeRep -> Maybe String -> Maybe TypeRep -> a
 errorNoRuleToBuildType tk k tv = structured (specialIsOracleKey tk)
     "Build system error - no _rule_ matches the _key_ type"
@@ -64,7 +66,7 @@
     "Either the function passed to _rule/defaultRule_ has the wrong _result_ type, or the result of _apply_ is used at the wrong type"
 
 errorIncompatibleRules :: TypeRep -> TypeRep -> TypeRep -> a
-errorIncompatibleRules tk tv1 tv2 = if specialIsOracleKey tk then errorDuplicateOracle tk Nothing [tv1,tv2] else structured_
+errorIncompatibleRules tk tv1 tv2 = if specialIsOracleKey tk then errorDuplicateOracle tk Nothing [tv1,tv2] else errorStructured
     "Build system error - rule has multiple result types"
     [("Key type", Just $ show tk)
     ,("First result type", Just $ show tv1)
@@ -74,7 +76,7 @@
 errorMultipleRulesMatch :: TypeRep -> String -> Int -> a
 errorMultipleRulesMatch tk k count
     | specialIsOracleKey tk = if count == 0 then err $ "no oracle match for " ++ show tk else errorDuplicateOracle tk (Just k) []
-    | otherwise = structured_
+    | otherwise = errorStructured
     ("Build system error - key matches " ++ (if count == 0 then "no" else "multiple") ++ " rules")
     [("Key type",Just $ show tk)
     ,("Key value",Just k)
@@ -83,19 +85,27 @@
      else "Modify your rules/defaultRules so only one can produce the above key")
 
 errorRuleRecursion :: Maybe TypeRep -> Maybe String -> a
-errorRuleRecursion tk k = structured_ -- may involve both rules and oracle, so report as a rule
+errorRuleRecursion tk k = errorStructured -- may involve both rules and oracle, so report as a rule
     "Build system error - recursion detected"
     [("Key type",fmap show tk)
     ,("Key value",k)]
     "Rules may not be recursive"
 
 errorDuplicateOracle :: TypeRep -> Maybe String -> [TypeRep] -> a
-errorDuplicateOracle tk k tvs = structured_
+errorDuplicateOracle tk k tvs = errorStructured
     "Build system error - duplicate oracles for the same question type"
     ([("Question type",Just $ show tk)
      ,("Question value",k)] ++
      [("Answer type " ++ show i, Just $ show tv) | (i,tv) <- zip [1..] tvs])
     "Only one call to addOracle is allowed per question type"
+
+errorNoApply :: TypeRep -> Maybe String -> String -> a
+errorNoApply tk k msg = structured (specialIsOracleKey tk)
+    ("Build system error - cannot currently call _apply_")
+    [("Reason", Just msg)
+    ,("_Key_ type", Just $ show tk)
+    ,("_Key_ value", k)]
+    "Move the _apply_ call earlier/later"
 
 
 -- Should be in Special, but then we get an import cycle
diff --git a/Development/Shake/File.hs b/Development/Shake/File.hs
--- a/Development/Shake/File.hs
+++ b/Development/Shake/File.hs
@@ -3,7 +3,7 @@
 module Development.Shake.File(
     need, want,
     defaultRuleFile,
-    (*>), (**>), (?>), phony,
+    (*>), (**>), (?>), phony, (~>),
     newCache, newCacheIO
     ) where
 
@@ -14,28 +14,31 @@
 import System.Directory
 
 import Development.Shake.Core
-import Development.Shake.Types
+import Development.Shake.Util
 import Development.Shake.Classes
 import Development.Shake.FilePattern
 import Development.Shake.FileTime
-import Development.Shake.Locks
 
 import System.FilePath(takeDirectory) -- important that this is the system local filepath, or wrong slashes go wrong
 
 
-infix 1 *>, ?>, **>
+infix 1 *>, ?>, **>, ~>
 
 
-newtype FileQ = FileQ BS
+newtype FileQ = FileQ BSU
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
-instance Show FileQ where show (FileQ x) = unpack x
+instance Show FileQ where show (FileQ x) = unpackU x
 
 newtype FileA = FileA FileTime
-    deriving (Typeable,Eq,Hashable,Binary,Show,NFData)
+    deriving (Typeable,Hashable,Binary,NFData)
 
+instance Eq FileA where FileA x == FileA y = x /= fileTimeNone && x == y
+
+instance Show FileA where show (FileA x) = "FileTimeHash " ++ show x
+
 instance Rule FileQ FileA where
-    storedValue (FileQ x) = fmap (fmap FileA) $ getModTimeMaybe $ unpack_ x
+    storedValue (FileQ x) = fmap (fmap FileA) $ getModTimeMaybe x
 
 {-
     observed act = do
@@ -95,7 +98,7 @@
 -- | This function is not actually exported, but Haddock is buggy. Please ignore.
 defaultRuleFile :: Rules ()
 defaultRuleFile = defaultRule $ \(FileQ x) -> Just $
-    liftIO $ fmap FileA $ getModTimeError "Error, file does not exist and no rule available:" $ unpack_ x
+    liftIO $ fmap FileA $ getModTimeError "Error, file does not exist and no rule available:" x
 
 
 -- | Require that the following files are built before continuing. Particularly
@@ -108,7 +111,7 @@
 --     'Development.Shake.cmd' \"rot13\" [src] \"-o\" [out]
 -- @
 need :: [FilePath] -> Action ()
-need xs = (apply $ map (FileQ . pack) xs :: Action [FileA]) >> return ()
+need xs = (apply $ map (FileQ . packU) xs :: Action [FileA]) >> return ()
 
 -- | Require that the following are built by the rules, used to specify the target.
 --
@@ -119,28 +122,38 @@
 -- @
 --
 --   This program will build @Main.exe@, given sufficient rules.
+--
+--   This function is defined in terms of 'action' and 'need', use 'action' if you need more complex
+--   targets than 'want' allows.
 want :: [FilePath] -> Rules ()
 want = action . need
 
 
 root :: String -> (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()
-root help test act = rule $ \(FileQ x_) -> let x = unpack x_ in
+root help test act = rule $ \(FileQ x_) -> let x = unpackU x_ in
     if not $ test x then Nothing else Just $ do
         liftIO $ createDirectoryIfMissing True $ takeDirectory x
         act x
-        liftIO $ fmap FileA $ getModTimeError ("Error, rule " ++ help ++ " failed to build file:") $ unpack_ x_
+        liftIO $ fmap FileA $ getModTimeError ("Error, rule " ++ help ++ " failed to build file:") x_
 
 
--- | Declare a phony action, this is an action that does not produce a file, and will be rerun
+-- | Declare a phony action -- an action that does not produce a file, and will be rerun
 --   in every execution that requires it. You can demand 'phony' rules using 'want' \/ 'need'.
+--   Phony actions are never executed more than once in a single build run.
 --
---   Phony actions are intended to define command-line abbreviations. You should not 'need' phony actions
---   as dependencies of rules, as that will cause excessive rebuilding.
+--   Phony actions are intended to define command-line abbreviations. If you 'need' a phony action
+--   in a rule then every execution where that rule is required will rerun both the rule and the phony
+--   action.
 phony :: String -> Action () -> Rules ()
-phony name act = rule $ \(FileQ x_) -> let x = unpack x_ in
+phony name act = rule $ \(FileQ x_) -> let x = unpackU x_ in
     if name /= x then Nothing else Just $ do
         act
         return $ FileA fileTimeNone
+
+-- | Infix operator alias for 'phony', for sake of consistency with normal
+--   rules.
+(~>) :: String -> Action () -> Rules ()
+(~>) = phony 
 
 
 -- | Define a rule to build files. If the first argument returns 'True' for a given file,
diff --git a/Development/Shake/FilePattern.hs b/Development/Shake/FilePattern.hs
--- a/Development/Shake/FilePattern.hs
+++ b/Development/Shake/FilePattern.hs
@@ -9,6 +9,7 @@
 import System.FilePath(pathSeparators)
 import Data.List
 import Control.Arrow
+import Development.Shake.Util
 
 
 ---------------------------------------------------------------------
@@ -97,8 +98,9 @@
 -- \"foo\/bar\" '?==' \"foo\\\\bar\"
 -- @
 (?==) :: FilePattern -> FilePath -> Bool
-(?==) p x = not $ null $ match (pattern $ lexer p) (True, x)
-
+(?==) "//*" = const True
+(?==) p = \x -> not $ null $ match pat (True, x)
+    where pat = pattern $ lexer p
 
 ---------------------------------------------------------------------
 -- DIRECTORY PATTERNS
@@ -130,7 +132,7 @@
 directories :: [FilePattern] -> [(FilePath,Bool)]
 directories ps = foldl f xs xs
     where
-        xs = nub $ map directories1 ps 
+        xs = fastNub $ map directories1 ps
 
         -- Eliminate anything which is a strict subset
         f xs (x,True) = filter (\y -> not $ (x,False) == y || (x ++ "/") `isPrefixOf` fst y) xs
diff --git a/Development/Shake/FileTime.hs b/Development/Shake/FileTime.hs
--- a/Development/Shake/FileTime.hs
+++ b/Development/Shake/FileTime.hs
@@ -6,41 +6,34 @@
     ) where
 
 import Development.Shake.Classes
+import Development.Shake.Util
+import Data.Char
 import Data.Int
+import Data.Word
 import qualified Data.ByteString.Char8 as BS
-
-#ifdef PORTABLE
-
 import System.IO.Error
 import Control.Exception
-import System.Directory
+import Numeric
 
-#if __GLASGOW_HASKELL__ >= 706
+-- Required for Portable
+import System.Directory
 import Data.Time
-#else
 import System.Time
-#endif
 
-#elif defined mingw32_HOST_OS
-
+-- Required for non-portable Windows
+#if defined(mingw32_HOST_OS)
 import Foreign
 import Foreign.C.Types
-
 type WIN32_FILE_ATTRIBUTE_DATA = Ptr ()
 type LPCSTR = Ptr CChar
-
 foreign import stdcall unsafe "Windows.h GetFileAttributesExA" c_getFileAttributesEx :: LPCSTR -> Int32 -> WIN32_FILE_ATTRIBUTE_DATA -> IO Bool
-
 size_WIN32_FILE_ATTRIBUTE_DATA = 36
-
 index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime = 20
-
-#else
+#endif
 
-import System.IO.Error
-import Control.Exception
+-- Required for non-portable Unix (since it requires a non-standard library, only require if not portable)
+#if !defined(PORTABLE) && !defined(mingw32_HOST_OS)
 import System.Posix.Files.ByteString
-
 #endif
 
 
@@ -48,8 +41,11 @@
 -- or maxBound to indicate there is no valid time. The moral type is @Maybe Datetime@
 -- but it needs to be more efficient.
 newtype FileTime = FileTime Int32
-    deriving (Typeable,Eq,Hashable,Binary,Show,NFData)
+    deriving (Typeable,Eq,Hashable,Binary,NFData)
 
+instance Show FileTime where
+    show (FileTime x) = "0x" ++ replicate (length s - 8) '0' ++ map toUpper s
+        where s = showHex (fromIntegral x :: Word32) ""
 
 fileTime :: Int32 -> FileTime
 fileTime x = FileTime $ if x == maxBound then maxBound - 1 else x
@@ -58,45 +54,59 @@
 fileTimeNone = FileTime maxBound
 
 
-getModTimeMaybe :: BS.ByteString -> IO (Maybe FileTime)
+getModTimeError :: String -> BSU -> IO FileTime
+getModTimeError msg x = do
+    res <- getModTimeMaybe x
+    case res of
+        -- Make sure you raise an error in IO, not return a value which will error later
+        Nothing -> error $ msg ++ "\n  " ++ unpackU x
+        Just x -> return x
 
-#ifdef PORTABLE
 
--- Portable fallback
-getModTimeMaybe x = handleJust (\e -> if isDoesNotExistError e then Just () else Nothing) (const $ return Nothing) $ do
-    time <- getModificationTime $ BS.unpack x
-#if __GLASGOW_HASKELL__ >= 706
-    return $ Just $ fileTime $ floor $ utctDayTime time
+getModTimeMaybe :: BSU -> IO (Maybe FileTime)
+#if defined(PORTABLE)
+getModTimeMaybe x = getModTimeMaybePortable x
+#elif defined(mingw32_HOST_OS)
+getModTimeMaybe x = getModTimeMaybeWindows x
 #else
-    let TOD t _ = time
-    return $ Just $ fileTime $ fromIntegral t
+getModTimeMaybe x = getModTimeMaybeUnix x
 #endif
 
-#elif defined mingw32_HOST_OS
 
+
+-- Portable fallback
+getModTimeMaybePortable :: BSU -> IO (Maybe FileTime)
+getModTimeMaybePortable x = handleJust (\e -> if isDoesNotExistError e then Just () else Nothing) (const $ return Nothing) $ do
+    time <- getModificationTime $ unpackU x
+    return $ Just $ extractFileTime time
+
+-- deal with difference in return type of getModificationTime between directory versions
+class ExtractFileTime a where extractFileTime :: a -> FileTime
+instance ExtractFileTime ClockTime where extractFileTime (TOD t _) = fileTime $ fromIntegral t
+instance ExtractFileTime UTCTime where extractFileTime = fileTime . floor . fromRational . toRational . utctDayTime
+
+
 -- Directly against the Win32 API, twice as fast as the portable version
-getModTimeMaybe x = BS.useAsCString x $ \file ->
+#if defined(mingw32_HOST_OS)
+getModTimeMaybeWindows :: BSU -> IO (Maybe FileTime)
+getModTimeMaybeWindows x = BS.useAsCString (unpackU_ x) $ \file ->
     allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA $ \info -> do
         res <- c_getFileAttributesEx file 0 info
-        if not res then return Nothing else do
+        if res then do
             -- Technically a Word32, but we can treak it as an Int32 for peek
             dword <- peekByteOff info index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime :: IO Int32
             return $ Just $ fileTime dword
+         else if requireU x then
+            getModTimeMaybePortable x
+         else
+            return Nothing
+#endif
 
-#else
 
--- Directly against the unix library
-getModTimeMaybe x = handleJust (\e -> if isDoesNotExistError e then Just () else Nothing) (const $ return Nothing) $ do
-    t <- fmap modificationTime $ getFileStatus x
+-- Unix version
+#if !defined(PORTABLE) && !defined(mingw32_HOST_OS)
+getModTimeMaybeUnix :: BSU -> IO (Maybe FileTime)
+getModTimeMaybeUnix x = handleJust (\e -> if isDoesNotExistError e then Just () else Nothing) (const $ return Nothing) $ do
+    t <- fmap modificationTime $ getFileStatus $ unpackU_ x
     return $ Just $ fileTime $ fromIntegral $ fromEnum t
-
 #endif
-
-
-getModTimeError :: String -> BS.ByteString -> IO FileTime
-getModTimeError msg x = do
-    res <- getModTimeMaybe x
-    case res of
-        -- Make sure you raise an error in IO, not return a value which will error later
-        Nothing -> error $ msg ++ "\n  " ++ BS.unpack x
-        Just x -> return x
diff --git a/Development/Shake/Files.hs b/Development/Shake/Files.hs
--- a/Development/Shake/Files.hs
+++ b/Development/Shake/Files.hs
@@ -7,28 +7,34 @@
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.Maybe
+import System.Directory
 
 import Development.Shake.Core
-import Development.Shake.Types
+import Development.Shake.Util
 import Development.Shake.Classes
 import Development.Shake.File
 import Development.Shake.FilePattern
 import Development.Shake.FileTime
 
+import System.FilePath(takeDirectory) -- important that this is the system local filepath, or wrong slashes go wrong
+
+
 infix 1 ?>>, *>>
 
 
-newtype FilesQ = FilesQ [BS]
+newtype FilesQ = FilesQ [BSU]
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
 newtype FilesA = FilesA [FileTime]
-    deriving (Typeable,Show,Eq,Hashable,Binary,NFData)
+    deriving (Typeable,Eq,Hashable,Binary,NFData)
 
-instance Show FilesQ where show (FilesQ xs) = unwords $ map unpack xs
+instance Show FilesA where show (FilesA xs) = unwords $ "FileTimeHashes" : map show xs
 
+instance Show FilesQ where show (FilesQ xs) = unwords $ map (showQuote . unpackU) xs
 
+
 instance Rule FilesQ FilesA where
-    storedValue (FilesQ xs) = fmap (fmap FilesA . sequence) $ mapM getModTimeMaybe $ map unpack_ xs
+    storedValue (FilesQ xs) = fmap (fmap FilesA . sequence) $ mapM getModTimeMaybe xs
 
 
 -- | Define a rule for building multiple files at the same time.
@@ -52,10 +58,11 @@
     | otherwise = do
         forM_ ps $ \p ->
             p *> \file -> do
-                _ :: FilesA <- apply1 $ FilesQ $ map (pack . substitute (extract p file)) ps
+                _ :: FilesA <- apply1 $ FilesQ $ map (packU . substitute (extract p file)) ps
                 return ()
-        rule $ \(FilesQ xs_) -> let xs = map unpack xs_ in
+        rule $ \(FilesQ xs_) -> let xs = map unpackU xs_ in
             if not $ length xs == length ps && and (zipWith (?==) ps xs) then Nothing else Just $ do
+                liftIO $ mapM_ (createDirectoryIfMissing True) $ fastNub $ map takeDirectory xs
                 act xs
                 liftIO $ getFileTimes "*>>" xs_
 
@@ -86,25 +93,26 @@
                     | otherwise -> error $ "Invariant broken in ?>> when trying on " ++ x
 
     isJust . checkedTest ?> \x -> do
-        _ :: FilesA <- apply1 $ FilesQ $ map pack $ fromJust $ test x
+        _ :: FilesA <- apply1 $ FilesQ $ map packU $ fromJust $ test x
         return ()
 
-    rule $ \(FilesQ xs_) -> let xs@(x:_) = map unpack xs_ in
+    rule $ \(FilesQ xs_) -> let xs@(x:_) = map unpackU xs_ in
         case checkedTest x of
             Just ys | ys == xs -> Just $ do
+                liftIO $ mapM_ (createDirectoryIfMissing True) $ fastNub $ map takeDirectory xs
                 act xs
                 liftIO $ getFileTimes "?>>" xs_
             Just ys -> error $ "Error, ?>> is incompatible with " ++ show xs ++ " vs " ++ show ys
             Nothing -> Nothing
 
 
-getFileTimes :: String -> [BS] -> IO FilesA
+getFileTimes :: String -> [BSU] -> IO FilesA
 getFileTimes name xs = do
-    ys <- mapM (getModTimeMaybe . unpack_) xs
+    ys <- mapM getModTimeMaybe xs
     case sequence ys of
         Just ys -> return $ FilesA ys
         Nothing -> do
             let missing = length $ filter isNothing ys
             error $ "Error, " ++ name ++ " rule failed to build " ++ show missing ++
                     " file" ++ (if missing == 1 then "" else "s") ++ " (out of " ++ show (length xs) ++ ")" ++
-                    concat ["\n  " ++ unpack x ++ if isNothing y then " - MISSING" else "" | (x,y) <- zip xs ys]
+                    concat ["\n  " ++ unpackU x ++ if isNothing y then " - MISSING" else "" | (x,y) <- zip xs ys]
diff --git a/Development/Shake/Intern.hs b/Development/Shake/Intern.hs
--- a/Development/Shake/Intern.hs
+++ b/Development/Shake/Intern.hs
@@ -9,6 +9,7 @@
 import Development.Shake.Classes
 import Prelude hiding (lookup)
 import qualified Data.HashMap.Strict as Map
+import Data.List(foldl')
 
 
 -- Invariant: The first field is the highest value in the Map
@@ -44,4 +45,4 @@
 
 
 fromList :: (Eq a, Hashable a) => [(a, Id)] -> Intern a
-fromList xs = Intern (maximum $ 0 : [i | (_, Id i) <- xs]) (Map.fromList xs)
+fromList xs = Intern (foldl' max 0 [i | (_, Id i) <- xs]) (Map.fromList xs)
diff --git a/Development/Shake/Locks.hs b/Development/Shake/Locks.hs
deleted file mode 100644
--- a/Development/Shake/Locks.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
-module Development.Shake.Locks(
-    Lock, newLock, withLock,
-    Var, newVar, readVar, modifyVar, modifyVar_, withVar,
-    Barrier, newBarrier, signalBarrier, waitBarrier,
-    Resource, newResourceIO, acquireResource, releaseResource
-    ) where
-
-import Control.Concurrent
-import Control.Monad
-import Data.Function
-import System.IO.Unsafe
-
-
----------------------------------------------------------------------
--- LOCK
-
--- | Like an MVar, but has no value
-newtype Lock = Lock (MVar ())
-instance Show Lock where show _ = "Lock"
-
-newLock :: IO Lock
-newLock = fmap Lock $ newMVar ()
-
-withLock :: Lock -> IO a -> IO a
-withLock (Lock x) = withMVar x . const
-
-
----------------------------------------------------------------------
--- VAR
-
--- | Like an MVar, but must always be full
-newtype Var a = Var (MVar a)
-instance Show (Var a) where show _ = "Var"
-
-newVar :: a -> IO (Var a)
-newVar = fmap Var . newMVar
-
-readVar :: Var a -> IO a
-readVar (Var x) = readMVar x
-
-modifyVar :: Var a -> (a -> IO (a, b)) -> IO b
-modifyVar (Var x) f = modifyMVar x f
-
-modifyVar_ :: Var a -> (a -> IO a) -> IO ()
-modifyVar_ (Var x) f = modifyMVar_ x f
-
-withVar :: Var a -> (a -> IO b) -> IO b
-withVar (Var x) f = withMVar x f
-
-
----------------------------------------------------------------------
--- BARRIER
-
--- | Starts out empty, then is filled exactly once
-newtype Barrier a = Barrier (MVar a)
-instance Show (Barrier a) where show _ = "Barrier"
-
-newBarrier :: IO (Barrier a)
-newBarrier = fmap Barrier newEmptyMVar
-
-signalBarrier :: Barrier a -> a -> IO ()
-signalBarrier (Barrier x) = putMVar x
-
-waitBarrier :: Barrier a -> IO a
-waitBarrier (Barrier x) = readMVar x
-
-
----------------------------------------------------------------------
--- RESOURCE
-
-{-# NOINLINE resourceIds #-}
-resourceIds :: Var Int
-resourceIds = unsafePerformIO $ newVar 0
-
-resourceId :: IO Int
-resourceId = modifyVar resourceIds $ \i -> let j = i + 1 in j `seq` return (j, j)
-
-
--- | A type representing a finite resource, which multiple build actions should respect.
---   Created with 'Development.Shake.newResource' and used with 'Development.Shake.withResource'
---   when defining rules.
---
---   As an example, only one set of calls to the Excel API can occur at one time, therefore
---   Excel is a finite resource of quantity 1. You can write:
---
--- @
--- 'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=2} $ do
---    'Development.Shake.want' [\"a.xls\",\"b.xls\"]
---    excel <- 'Development.Shake.newResource' \"Excel\" 1
---    \"*.xls\" 'Development.Shake.*>' \\out ->
---        'Development.Shake.withResource' excel 1 $
---            'Development.Shake.cmd' \"excel\" out ...
--- @
---
---   Now the two calls to @excel@ will not happen in parallel. Using 'Resource'
---   is better than 'MVar' as it will not block any other threads from executing. Be careful that the
---   actions run within 'Development.Shake.withResource' do not themselves require further quantities of this resource, or
---   you may get a \"thread blocked indefinitely in an MVar operation\" exception. Typically only
---   system commands (such as 'Development.Shake.cmd') should be run inside 'Development.Shake.withResource',
---   not commands such as 'Development.Shake.need'. If an action requires multiple resources, use
---   'Development.Shake.withResources' to avoid deadlock.
---
---   As another example, calls to compilers are usually CPU bound but calls to linkers are usually
---   disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit
---   ourselves to 4 linkers with:
---
--- @
--- disk <- 'Development.Shake.newResource' \"Disk\" 4
--- 'Development.Shake.want' [show i 'Development.Shake.FilePath.<.>' \"exe\" | i <- [1..100]]
--- \"*.exe\" 'Development.Shake.*>' \\out ->
---     'Development.Shake.withResource' disk 1 $
---         'Development.Shake.cmd' \"ld -o\" [out] ...
--- \"*.o\" 'Development.Shake.*>' \\out ->
---     'Development.Shake.cmd' \"cl -o\" [out] ...
--- @
-data Resource = Resource {resourceKey :: Int, resourceName :: String, resourceMax :: Int, resourceVar :: Var (Int,[(Int,IO ())])}
-instance Show Resource where show Resource{..} = "Resource " ++ resourceName
-
-instance Eq Resource where (==) = (==) `on` resourceKey
-instance Ord Resource where compare = compare `on` resourceKey
-
-
--- | A version of 'newResource' that runs in IO, and can be called before calling 'Development.Shake.shake'.
---   Most people should use 'Development.Shake.newResource' instead.
-newResourceIO :: String -> Int -> IO Resource
-newResourceIO name mx = do
-    when (mx < 0) $
-        error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx
-    key <- resourceId
-    var <- newVar (mx, [])
-    return $ Resource key name mx var
-
-
--- | Try to acquire a resource. Returns Nothing to indicate you have acquired with no blocking, or Just act to
---   say after act completes (which will block) then you will have the resource.
-acquireResource :: Resource -> Int -> IO (Maybe (IO ()))
-acquireResource r@Resource{..} want
-    | want < 0 = error $ "You cannot acquire a negative quantity of " ++ show r ++ ", requested " ++ show want
-    | want > resourceMax = error $ "You cannot acquire more than " ++ show resourceMax ++ " of " ++ show r ++ ", requested " ++ show want
-    | otherwise = modifyVar resourceVar $ \(available,waiting) ->
-        if want <= available then
-            return ((available - want, waiting), Nothing)
-        else do
-            bar <- newBarrier
-            return ((available, waiting ++ [(want,signalBarrier bar ())]), Just $ waitBarrier bar)
-
-
--- | You should only ever releaseResource that you obtained with acquireResource.
-releaseResource :: Resource -> Int -> IO ()
-releaseResource Resource{..} i = modifyVar_ resourceVar $ \(available,waiting) -> f (available+i) waiting
-    where
-        f i ((wi,wa):ws) | wi <= i = wa >> f (i-wi) ws
-                         | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)
-        f i [] = return (i, [])
diff --git a/Development/Shake/Oracle.hs b/Development/Shake/Oracle.hs
--- a/Development/Shake/Oracle.hs
+++ b/Development/Shake/Oracle.hs
@@ -39,7 +39,7 @@
 -- @
 -- newtype GhcVersion = GhcVersion () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
 -- rules = do
---     'addOracle' $ \\(GhcVersion _) -> fmap (last . words . 'Development.Shake.fromStdout') $ 'Development.Shake.cmd' \"ghc --version\"
+--     'addOracle' $ \\(GhcVersion _) -> fmap 'Development.Shake.fromStdout' $ 'Development.Shake.cmd' \"ghc --numeric-version\"
 --     ... rules ...
 -- @
 --
diff --git a/Development/Shake/Pool.hs b/Development/Shake/Pool.hs
--- a/Development/Shake/Pool.hs
+++ b/Development/Shake/Pool.hs
@@ -4,7 +4,8 @@
 
 import Control.Concurrent
 import Control.Exception hiding (blocked)
-import Development.Shake.Locks
+import Development.Shake.Util
+import Development.Shake.Timing
 import qualified Data.HashSet as Set
 import System.IO.Unsafe
 import System.Random
@@ -72,10 +73,12 @@
 If any worker throws an exception, must signal to all the other workers
 -}
 
-data Pool = Pool {-# UNPACK #-} !Int !(Var (Maybe S)) !(Barrier (Maybe SomeException))
+data Pool = Pool {-# UNPACK #-} !Int !(Var (Maybe S)) !(Barrier (Either SomeException S))
 
 data S = S
     {threads :: !(Set.HashSet ThreadId) -- IMPORTANT: Must be strict or we leak thread stackssss
+    ,threadsMax :: {-# UNPACK #-} !Int -- high water mark of Set.size threads
+    ,threadsSum :: {-# UNPACK #-} !Int -- number of threads we have been through
     ,working :: {-# UNPACK #-} !Int -- threads which are actively working
     ,blocked :: {-# UNPACK #-} !Int -- threads which are blocked
     ,todo :: !(Queue (IO ()))
@@ -83,7 +86,7 @@
 
 
 emptyS :: Bool -> S
-emptyS deterministic = S Set.empty 0 0 $ newQueue deterministic
+emptyS deterministic = S Set.empty 0 0 0 0 $ newQueue deterministic
 
 
 -- | Given a pool, and a function that breaks the S invariants, restore them
@@ -103,12 +106,14 @@
                     case res of
                         Left e -> onVar $ \s -> do
                             mapM_ killThread $ Set.toList $ Set.delete t $ threads s
-                            signalBarrier done $ Just e
+                            signalBarrier done $ Left e
                             return Nothing
                         Right _ -> step pool $ \s -> return s{working = working s - 1, threads = Set.delete t $ threads s}
-                return $ Just s{working = working s + 1, todo = todo2, threads = Set.insert t $ threads s}
+                let threads2 = Set.insert t $ threads s
+                return $ Just s{working = working s + 1, todo = todo2, threads = threads2
+                               ,threadsSum = threadsSum s + 1, threadsMax = threadsMax s `max` Set.size threads2}
             Nothing | working s == 0 && blocked s == 0 -> do
-                signalBarrier done Nothing
+                signalBarrier done $ Right s
                 return Nothing
             _ -> return $ Just s
 
@@ -160,5 +165,5 @@
         addPool pool $ act pool
         res <- waitBarrier res
         case res of
-            Nothing -> return ()
-            Just e -> throw e
+            Left e -> throw e
+            Right s -> addTiming $ "Pool finished (" ++ show (threadsSum s) ++ " threads, " ++ show (threadsMax s) ++ " max)"
diff --git a/Development/Shake/Progress.hs b/Development/Shake/Progress.hs
--- a/Development/Shake/Progress.hs
+++ b/Development/Shake/Progress.hs
@@ -3,7 +3,7 @@
 -- | Progress tracking
 module Development.Shake.Progress(
     Progress(..),
-    progressSimple, progressDisplay, progressTitlebar,
+    progressSimple, progressDisplay, progressTitlebar, progressProgram,
     progressDisplayTester -- INTERNAL FOR TESTING ONLY
     ) where
 
@@ -13,7 +13,12 @@
 import Control.Exception
 import Control.Monad
 import System.Environment
+import System.Directory
+import System.Process
+import Data.Char
 import Data.Data
+import Data.IORef
+import Data.List
 import Data.Maybe
 import Data.Monoid
 import qualified Data.ByteString.Char8 as BS
@@ -38,8 +43,7 @@
 --   to 'Development.Shake.shakeProgress'. Typically a program will use 'progressDisplay' to poll this value and produce
 --   status messages, which is implemented using this data type.
 data Progress = Progress
-    {isRunning :: !Bool -- ^ Starts out 'True', becomes 'False' once the build has completed.
-    ,isFailure :: !(Maybe String) -- ^ Starts out 'Nothing', becomes 'Just' if a rule fails.
+    {isFailure :: !(Maybe String) -- ^ Starts out 'Nothing', becomes 'Just' a target name if a rule fails.
     ,countSkipped :: {-# UNPACK #-} !Int -- ^ Number of rules which were required, but were already in a valid state.
     ,countBuilt :: {-# UNPACK #-} !Int -- ^ Number of rules which were have been built in this run.
     ,countUnknown :: {-# UNPACK #-} !Int -- ^ Number of rules which have been built previously, but are not yet known to be required.
@@ -52,10 +56,9 @@
     deriving (Eq,Ord,Show,Data,Typeable)
 
 instance Monoid Progress where
-    mempty = Progress True Nothing 0 0 0 0 0 0 0 (0,0)
+    mempty = Progress Nothing 0 0 0 0 0 0 0 (0,0)
     mappend a b = Progress
-        {isRunning = isRunning a && isRunning b
-        ,isFailure = isFailure a `mappend` isFailure b
+        {isFailure = isFailure a `mplus` isFailure b
         ,countSkipped = countSkipped a + countSkipped b
         ,countBuilt = countBuilt a + countBuilt b
         ,countUnknown = countUnknown a + countUnknown b
@@ -197,24 +200,22 @@
 progressDisplayer :: Bool -> Double -> (String -> IO ()) -> IO Progress -> IO ()
 progressDisplayer sleep sample disp prog = do
     disp "Starting..." -- no useful info at this stage
-    loop $ message sample idStream
+    catchJust (\x -> if x == ThreadKilled then Just () else Nothing) (loop $ message sample idStream) (const $ disp "Finished")
     where
         loop :: Stream Progress String -> IO ()
         loop stream = do
             when sleep $ threadDelay $ ceiling $ sample * 1000000
             p <- prog
-            if not $ isRunning p then
-                disp "Finished"
-             else do
-                (msg, stream) <- return $ runStream stream p
-                disp $ msg ++ maybe "" (\err -> ", Failure! " ++ err) (isFailure p)
-                loop stream
+            (msg, stream) <- return $ runStream stream p
+            disp $ msg ++ maybe "" (\err -> ", Failure! " ++ err) (isFailure p)
+            loop stream
 
 
 {-# NOINLINE xterm #-}
 xterm :: Bool
 xterm = System.IO.Unsafe.unsafePerformIO $
-    Control.Exception.catch (fmap (== "xterm") $ getEnv "TERM") $
+    -- Terminal.app uses "xterm-256color" as its env variable
+    Control.Exception.catch (fmap ("xterm" `isPrefixOf`) $ getEnv "TERM") $
     \(e :: SomeException) -> return False
 
 
@@ -231,12 +232,42 @@
 #endif
 
 
--- | A simple method for displaying progress messages, suitable for using as
---   'Development.Shake.shakeProgress'. This function writes the current progress to
---   the titlebar every five seconds. The function is defined as:
+-- | Call the program @shake-progress@ if it is on the @$PATH@. The program is called with
+--   the following arguments:
 --
--- @
---progressSimple = 'progressDisplay' 5 'progressTitlebar'
--- @
+-- * @--title=string@ - the string passed to @progressProgram@.
+--
+-- * @--state=Normal@, or one of @NoProgress@, @Normal@, or @Error@ to indicate
+--   what state the progress bar should be in.
+--
+-- * @--value=25@ - the percent of the build that has completed, if not in @NoProgress@ state.
+--
+--   The program will not be called consecutively with the same @--state@ and @--value@ options.
+--
+--   Windows 7 or higher users can get taskbar progress notifications by placing the following
+--   program in their @$PATH@: <https://github.com/ndmitchell/shake/releases>.
+progressProgram :: IO (String -> IO ())
+progressProgram = do
+    exe <- findExecutable "shake-progress"
+    case exe of
+        Nothing -> return $ const $ return ()
+        Just exe -> do
+            ref <- newIORef Nothing
+            return $ \msg -> do
+                let failure = " Failure! " `isInfixOf` msg
+                let perc = let (a,b) = break (== '%') msg
+                           in if null b then "" else reverse $ takeWhile isDigit $ reverse a
+                let key = (failure, perc)
+                same <- atomicModifyIORef ref $ \old -> (Just key, old == Just key)
+                let state = if perc == "" then "NoProgress" else if failure then "Error" else "Normal"
+                rawSystem exe $ ["--title=" ++ msg, "--state=" ++ state] ++ ["--value=" ++ perc | perc /= ""]
+                return ()
+
+
+-- | A simple method for displaying progress messages, suitable for using as 'Development.Shake.shakeProgress'.
+--   This function writes the current progress to the titlebar every five seconds using 'progressTitlebar',
+--   and calls any @shake-progress@ program on the @$PATH@ using 'progressProgram'.
 progressSimple :: IO Progress -> IO ()
-progressSimple = progressDisplay 5 progressTitlebar
+progressSimple p = do
+    program <- progressProgram
+    progressDisplay 5 (\s -> progressTitlebar s >> program s) p
diff --git a/Development/Shake/Rerun.hs b/Development/Shake/Rerun.hs
--- a/Development/Shake/Rerun.hs
+++ b/Development/Shake/Rerun.hs
@@ -10,11 +10,11 @@
 
 newtype AlwaysRerunQ = AlwaysRerunQ ()
     deriving (Typeable,Eq,Hashable,Binary,NFData)
-instance Show AlwaysRerunQ where show _ = "AlwaysRerunQ"
+instance Show AlwaysRerunQ where show _ = "alwaysRerun"
 
 newtype AlwaysRerunA = AlwaysRerunA ()
     deriving (Typeable,Hashable,Binary,NFData)
-instance Show AlwaysRerunA where show _ = "AlwaysRerunA"
+instance Show AlwaysRerunA where show _ = "<none>"
 instance Eq AlwaysRerunA where a == b = False
 
 instance Rule AlwaysRerunQ AlwaysRerunA where
@@ -27,7 +27,7 @@
 -- @
 -- \"ghcVersion.txt\" 'Development.Shake.*>' \\out -> do
 --     'alwaysRerun'
---     Stdout stdout <- 'Development.Shake.cmd' \"ghc --version\"
+--     'Development.Shake.Stdout' stdout <- 'Development.Shake.cmd' \"ghc --numeric-version\"
 --     'Development.Shake.writeFileChanged' out stdout
 -- @
 alwaysRerun :: Action ()
diff --git a/Development/Shake/Resource.hs b/Development/Shake/Resource.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Resource.hs
@@ -0,0 +1,169 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Development.Shake.Resource(
+    Resource, newResourceIO, newThrottleIO, acquireResource, releaseResource
+    ) where
+
+import Development.Shake.Errors
+import Development.Shake.Util
+import Data.Function
+import System.IO.Unsafe
+import Control.Arrow
+import Control.Monad
+
+
+{-# NOINLINE resourceIds #-}
+resourceIds :: Var Int
+resourceIds = unsafePerformIO $ newVar 0
+
+resourceId :: IO Int
+resourceId = modifyVar resourceIds $ \i -> let j = i + 1 in j `seq` return (j, j)
+
+
+-- | A type representing an external resource which the build system should respect. There
+--   are two ways to create 'Resource's in Shake:
+--
+-- * 'Development.Shake.newResource' creates a finite resource, stopping too many actions running
+--   simultaneously.
+--
+-- * 'Development.Shake.newThrottle' creates a throttled resource, stopping too many actions running
+--   over a short time period.
+--
+--   These resources are used with 'Development.Shake.withResource' when defining rules. Typically only
+--   system commands (such as 'Development.Shake.cmd') should be run inside 'Development.Shake.withResource',
+--   not commands such as 'Development.Shake.need'.
+--
+--   Be careful that the actions run within 'Development.Shake.withResource' do not themselves require further
+--   resources, or you may get a \"thread blocked indefinitely in an MVar operation\" exception.
+--   If an action requires multiple resources, use 'Development.Shake.withResources' to avoid deadlock.
+data Resource = Resource
+    {resourceOrd :: Int
+        -- ^ Key used for Eq/Ord operations. To make withResources work, we require newResourceIO < newThrottleIO
+    ,resourceShow :: String
+        -- ^ String used for Show
+    ,acquireResource :: Int -> IO (Maybe (IO ()))
+        -- ^ Try to acquire a resource. Returns Nothing to indicate you have acquired with no blocking, or Just act to
+        --   say after act completes (which will block) then you will have the resource.
+    ,releaseResource :: Int -> IO ()
+        -- ^ You should only ever releaseResource that you obtained with acquireResource.
+    }
+
+instance Show Resource where show = resourceShow
+instance Eq Resource where (==) = (==) `on` resourceOrd
+instance Ord Resource where compare = compare `on` resourceOrd
+
+
+---------------------------------------------------------------------
+-- FINITE RESOURCES
+
+-- | (number available, queue of people with how much they want and a barrier to signal when it is allocated to them)
+type Finite = Var (Int, [(Int,Barrier ())])
+
+-- | A version of 'Development.Shake.newResource' that runs in IO, and can be called before calling 'Development.Shake.shake'.
+--   Most people should use 'Development.Shake.newResource' instead.
+newResourceIO :: String -> Int -> IO Resource
+newResourceIO name mx = do
+    when (mx < 0) $
+        error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx
+    key <- resourceId
+    var <- newVar (mx, [])
+    return $ Resource (negate key) shw (acquire var) (release var)
+    where
+        shw = "Resource " ++ name
+
+        acquire :: Finite -> Int -> IO (Maybe (IO ()))
+        acquire var want
+            | want < 0 = error $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want
+            | want > mx = error $ "You cannot acquire more than " ++ show mx ++ " of " ++ shw ++ ", requested " ++ show want
+            | otherwise = modifyVar var $ \(available,waiting) ->
+                if want <= available then
+                    return ((available - want, waiting), Nothing)
+                else do
+                    bar <- newBarrier
+                    return ((available, waiting ++ [(want,bar)]), Just $ waitBarrier bar)
+
+        release :: Finite -> Int -> IO ()
+        release var i = modifyVar_ var $ \(available,waiting) -> f (available+i) waiting
+            where
+                f i ((wi,wa):ws) | wi <= i = signalBarrier wa () >> f (i-wi) ws
+                                 | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)
+                f i [] = return (i, [])
+
+
+---------------------------------------------------------------------
+-- THROTTLE RESOURCES
+
+data Throttle = Throttle
+    {throttleLock :: Lock
+        -- people queue up to grab from replenish, full means no one is queued
+    ,throttleVal :: Var (Either (Barrier ()) [(Time, Int)])
+        -- either someone waiting for resources, or the time to wait until before N resources become available
+        -- anyone who puts a Barrier in the Left must be holding the Lock
+    ,throttleTime :: IO Time
+    }
+
+-- | A version of 'Development.Shake.newThrottle' that runs in IO, and can be called before calling 'Development.Shake.shake'.
+--   Most people should use 'Development.Shake.newResource' instead.
+newThrottleIO :: String -> Int -> Double -> IO Resource
+newThrottleIO name count period = do
+    when (count < 0) $
+        error $ "You cannot create a throttle named " ++ name ++ " with a negative quantity, you used " ++ show count
+    key <- resourceId
+    lock <- newLock
+    time <- offsetTime
+    rep <- newVar $ Right [(0, count)]
+    let s = Throttle lock rep time
+    return $ Resource key shw (acquire s) (release s)
+    where
+        shw = "Throttle " ++ name
+
+        release :: Throttle -> Int -> IO ()
+        release Throttle{..} n = do
+            t <- throttleTime
+            modifyVar_ throttleVal $ \v -> case v of
+                Left b -> signalBarrier b () >> return (Right [(t+period, n)])
+                Right ts -> return $ Right $ ts ++ [(t+period, n)]
+
+        acquire :: Throttle -> Int -> IO (Maybe (IO ()))
+        acquire Throttle{..} want
+            | want < 0 = error $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want
+            | want > count = error $ "You cannot acquire more than " ++ show count ++ " of " ++ shw ++ ", requested " ++ show want
+            | otherwise = do
+                let grab t vs = do
+                        let (a,b) = span ((<= t) . fst) vs
+                        -- renormalise for clock skew, nothing can ever be > t+period away
+                        return (sum $ map snd a, map (first $ min $ t+period) b)
+                let push i vs = [(0,i) | i > 0] ++ vs
+
+                -- attempt to grab without locking
+                res <- withLockTry throttleLock $ do
+                    modifyVar throttleVal $ \v -> case v of
+                        Right vs -> do
+                            t <- throttleTime
+                            (got,vs) <- grab t vs
+                            if got >= want then
+                                return (Right $ push (got - want) vs, True)
+                             else
+                                return (Right $ push got vs, False)
+                        _ -> return (v, False)
+                if res == Just True then
+                    return Nothing
+                 else
+                    return $ Just $ withLock throttleLock $ do
+                        -- keep trying to acquire more resources until you have everything you need
+                        let f want = join $ modifyVar throttleVal $ \v -> case v of
+                                Left _ -> err "newThrottle, invariant failed, Left while holding throttleLock"
+                                Right vs -> do
+                                    t <- throttleTime
+                                    (got,vs) <- grab t vs
+                                    case vs of
+                                        _ | got >= want -> return (Right $ push (got - want) vs, return ())
+                                        [] -> do
+                                            b <- newBarrier
+                                            return (Left b, waitBarrier b >> f (want - got))
+                                        (t2,n):vs -> do
+                                            -- be robust to clock skew - only ever sleep for 'period' at most and always mark the next as good.
+                                            return $ (,) (Right $ (0,n):vs) $ do
+                                                sleep $ min period (t2-t)
+                                                f $ want - got
+                        f want
diff --git a/Development/Shake/Special.hs b/Development/Shake/Special.hs
--- a/Development/Shake/Special.hs
+++ b/Development/Shake/Special.hs
@@ -7,13 +7,12 @@
     ) where
 
 import Development.Shake.Value
-import Data.List
 import Data.Typeable
 
 
 specialAlwaysRebuilds :: Value -> Bool
-specialAlwaysRebuilds v = sv == "AlwaysRerunA" || "OracleA " `isPrefixOf` sv || sv == "FileA (FileTime 2147483647)"
-    where sv = show v
+specialAlwaysRebuilds v = con `elem` ["AlwaysRerunA","OracleA"] || (con == "FileA" && show v == "FileTimeHash 0x7FFFFFFF")
+    where con = show $ fst $ splitTyConApp $ typeValue v
 
 
 specialIsFileKey :: TypeRep -> Bool
diff --git a/Development/Shake/Storage.hs b/Development/Shake/Storage.hs
--- a/Development/Shake/Storage.hs
+++ b/Development/Shake/Storage.hs
@@ -10,7 +10,7 @@
     ) where
 
 import Development.Shake.Binary
-import Development.Shake.Locks
+import Development.Shake.Util
 import Development.Shake.Types
 import Development.Shake.Timing
 
@@ -36,9 +36,14 @@
 type Map = Map.HashMap
 
 -- Increment every time the on-disk format/semantics change,
--- @i@ is for the users version number
+-- @x@ is for the users version number
 databaseVersion :: String -> String
-databaseVersion x = "SHAKE-DATABASE-8-" ++ tail (init $ show x) ++ "\r\n"
+-- THINGS I WANT TO DO ON THE NEXT CHANGE
+-- * Change FileTime to be a Word32, not an Int32, with maxBound for fileNone
+-- * Change filepaths to store a 1 byte prefix saying 8bit ASCII or UTF8
+databaseVersion x = "SHAKE-DATABASE-8-" ++ s ++ "\r\n"
+    where s = tail $ init $ show x -- call show, then take off the leading/trailing quotes
+                                   -- ensures we do not get \r or \n in the user portion
 
 
 withStorage
@@ -70,13 +75,13 @@
 
         if not $ ver `LBS.isPrefixOf` src then do
             unless (LBS.null src) $ do
-                let good x = isAlphaNum x || x `elem` "-_ "
-                let bad = LBS.takeWhile good $ LBS.take 50 src
+                let limit x = let (a,b) = splitAt 200 x in a ++ (if null b then "" else "...")
+                let disp = map (\x -> if isPrint x && isAscii x then x else '?') . takeWhile (`notElem` "\r\n")
                 outputErr $ unlines
-                    ["Error when reading Shake database " ++ dbfile
-                    ,"  Invalid version stamp detected"
-                    ,"  Expected: " ++ takeWhile good (LBS.unpack ver)
-                    ,"  Found   : " ++ LBS.unpack bad
+                    ["Error when reading Shake database - invalid version stamp detected:"
+                    ,"  File:      " ++ dbfile
+                    ,"  Expected:  " ++ disp (LBS.unpack ver)
+                    ,"  Found:     " ++ disp (limit $ LBS.unpack src)
                     ,"All rules will be rebuilt"]
             continue h Map.empty
          else
diff --git a/Development/Shake/Types.hs b/Development/Shake/Types.hs
--- a/Development/Shake/Types.hs
+++ b/Development/Shake/Types.hs
@@ -3,14 +3,12 @@
 -- | Types exposed to the user
 module Development.Shake.Types(
     Progress(..), Verbosity(..), Assume(..),
-    ShakeOptions(..), shakeOptions,
-    BS, pack, unpack, pack_, unpack_
+    ShakeOptions(..), shakeOptions
     ) where
 
 import Data.Data
 import Data.List
 import Development.Shake.Progress
-import Development.Shake.Classes
 import qualified Data.ByteString.Char8 as BS
 
 
@@ -51,7 +49,6 @@
         --   All metadata files will be named @'shakeFiles'./extension/@, for some @/extension/@.
     ,shakeThreads :: Int
         -- ^ Defaults to @1@. Maximum number of rules to run in parallel, similar to @make --jobs=/N/@.
-        --   To enable parallelism you may need to compile with @-threaded@.
         --   For many build systems, a number equal to or slightly less than the number of physical processors
         --   works well.
     ,shakeVersion :: String
@@ -89,7 +86,8 @@
     ,shakeTimings :: Bool
         -- ^ Default to 'False'. Print timing information for each stage at the end.
     ,shakeProgress :: IO Progress -> IO ()
-        -- ^ Defaults to no action. A function called on a separate thread when the build starts, allowing progress to be reported.
+        -- ^ Defaults to no action. A function called when the build starts, allowing progress to be reported.
+        --   The function is called on a separate thread, and that thread is killed when the build completes.
         --   For applications that want to display progress messages, 'progressSimple' is often sufficient, but more advanced
         --   users should look at the 'Progress' data type.
     ,shakeOutput :: Verbosity -> String -> IO ()
@@ -162,28 +160,3 @@
     | Chatty -- ^ Print errors, full command line and status messages when starting a rule.
     | Diagnostic -- ^ Print messages for virtually everything (mostly for debugging).
       deriving (Eq,Ord,Bounded,Enum,Show,Read,Typeable,Data)
-
-
----------------------------------------------------------------------
--- BYTESTRING WRAPPER
--- Only purpose is because ByteString does not have an NFData instance in older GHC
-
-newtype BS = BS BS.ByteString
-    deriving (Hashable, Binary, Eq)
-
-instance NFData BS where
-    -- some versions of ByteString do not have NFData instances, but seq is equivalent
-    -- for a strict bytestring. Therefore, we write our own instance.
-    rnf (BS x) = x `seq` ()
-
-pack :: String -> BS
-pack = pack_ . BS.pack
-
-unpack :: BS -> String
-unpack = BS.unpack . unpack_
-
-pack_ :: BS.ByteString -> BS
-pack_ = BS
-
-unpack_ :: BS -> BS.ByteString
-unpack_ (BS x) = x
diff --git a/Development/Shake/Util.hs b/Development/Shake/Util.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Util.hs
@@ -0,0 +1,209 @@
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
+
+module Development.Shake.Util(
+    Lock, newLock, withLock, withLockTry,
+    Var, newVar, readVar, modifyVar, modifyVar_, withVar,
+    Barrier, newBarrier, signalBarrier, waitBarrier,
+    Duration, duration, Time, offsetTime, sleep,
+    modifyIORef'', writeIORef'',
+    whenJust, loop,
+    fastNub, showQuote,
+    BS, pack, unpack, pack_, unpack_,
+    BSU, packU, unpackU, packU_, unpackU_, requireU
+    ) where
+
+import Control.Concurrent
+import Control.Exception
+import Data.Char
+import Data.IORef
+import Data.Time
+import qualified Data.ByteString as BS (any)
+import qualified Data.ByteString.Char8 as BS hiding (any)
+import qualified Data.ByteString.UTF8 as UTF8
+import qualified Data.HashSet as Set
+import Development.Shake.Classes
+
+
+---------------------------------------------------------------------
+-- LOCK
+
+-- | Like an MVar, but has no value
+newtype Lock = Lock (MVar ())
+instance Show Lock where show _ = "Lock"
+
+newLock :: IO Lock
+newLock = fmap Lock $ newMVar ()
+
+withLock :: Lock -> IO a -> IO a
+withLock (Lock x) = withMVar x . const
+
+withLockTry :: Lock -> IO a -> IO (Maybe a)
+withLockTry (Lock m) act =
+    mask $ \restore -> do
+        a <- tryTakeMVar m
+        case a of
+            Nothing -> return Nothing
+            Just _ -> restore (fmap Just act) `finally` putMVar m ()
+
+
+---------------------------------------------------------------------
+-- VAR
+
+-- | Like an MVar, but must always be full
+newtype Var a = Var (MVar a)
+instance Show (Var a) where show _ = "Var"
+
+newVar :: a -> IO (Var a)
+newVar = fmap Var . newMVar
+
+readVar :: Var a -> IO a
+readVar (Var x) = readMVar x
+
+modifyVar :: Var a -> (a -> IO (a, b)) -> IO b
+modifyVar (Var x) f = modifyMVar x f
+
+modifyVar_ :: Var a -> (a -> IO a) -> IO ()
+modifyVar_ (Var x) f = modifyMVar_ x f
+
+withVar :: Var a -> (a -> IO b) -> IO b
+withVar (Var x) f = withMVar x f
+
+
+---------------------------------------------------------------------
+-- BARRIER
+
+-- | Starts out empty, then is filled exactly once
+newtype Barrier a = Barrier (MVar a)
+instance Show (Barrier a) where show _ = "Barrier"
+
+newBarrier :: IO (Barrier a)
+newBarrier = fmap Barrier newEmptyMVar
+
+signalBarrier :: Barrier a -> a -> IO ()
+signalBarrier (Barrier x) = putMVar x
+
+waitBarrier :: Barrier a -> IO a
+waitBarrier (Barrier x) = readMVar x
+
+
+---------------------------------------------------------------------
+-- Data.Time
+
+type Time = Double -- how far you are through this run, in seconds
+
+-- | Call once at the start, then call repeatedly to get Time values out
+offsetTime :: IO (IO Time)
+offsetTime = do
+    start <- getCurrentTime
+    return $ do
+        end <- getCurrentTime
+        return $ fromRational $ toRational $ end `diffUTCTime` start
+
+
+type Duration = Double -- duration in seconds
+
+duration :: IO a -> IO (Duration, a)
+duration act = do
+    time <- offsetTime
+    res <- act
+    time <- time
+    return (time, res)
+
+
+sleep :: Duration -> IO ()
+sleep x = threadDelay $ ceiling $ x * 1000000
+
+
+---------------------------------------------------------------------
+-- Data.IORef
+
+-- Two 's because GHC 7.6 has a strict modifyIORef
+modifyIORef'' :: IORef a -> (a -> a) -> IO ()
+modifyIORef'' ref f = do
+    x <- readIORef ref
+    writeIORef'' ref $ f x
+
+writeIORef'' :: IORef a -> a -> IO ()
+writeIORef'' ref !x = writeIORef ref x
+
+
+---------------------------------------------------------------------
+-- Data.List
+
+-- | Like 'nub', but the results may be in any order.
+fastNub :: (Eq a, Hashable a) => [a] -> [a]
+fastNub = f Set.empty
+    where f seen [] = []
+          f seen (x:xs) | x `Set.member` seen = f seen xs
+                        | otherwise = x : f (Set.insert x seen) xs
+
+
+showQuote :: String -> String
+showQuote xs | any isSpace xs = "\"" ++ concatMap (\x -> if x == '\"' then "\"\"" else [x]) xs ++ "\""
+             | otherwise = xs
+
+
+---------------------------------------------------------------------
+-- Control.Monad
+
+whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenJust (Just a) f = f a
+whenJust Nothing f = return ()
+
+loop :: Monad m => (a -> m (Either a b)) -> a -> m b
+loop act x = do
+    res <- act x
+    case res of
+        Left x -> loop act x
+        Right v -> return v
+
+
+---------------------------------------------------------------------
+-- Data.ByteString
+-- Mostly because ByteString does not have an NFData instance in older GHC
+
+-- | ASCII ByteString
+newtype BS = BS BS.ByteString
+    deriving (Hashable, Binary, Eq)
+
+instance NFData BS where
+    -- some versions of ByteString do not have NFData instances, but seq is equivalent
+    -- for a strict bytestring. Therefore, we write our own instance.
+    rnf (BS x) = x `seq` ()
+
+
+-- | UTF8 ByteString
+newtype BSU = BSU BS.ByteString
+    deriving (Hashable, Binary, Eq)
+
+instance NFData BSU where
+    rnf (BSU x) = x `seq` ()
+
+
+
+pack :: String -> BS
+pack = pack_ . BS.pack
+
+unpack :: BS -> String
+unpack = BS.unpack . unpack_
+
+pack_ :: BS.ByteString -> BS
+pack_ = BS
+
+unpack_ :: BS -> BS.ByteString
+unpack_ (BS x) = x
+
+packU :: String -> BSU
+packU = packU_ . UTF8.fromString
+
+unpackU :: BSU -> String
+unpackU = UTF8.toString . unpackU_
+
+unpackU_ :: BSU -> BS.ByteString
+unpackU_ (BSU x) = x
+
+packU_ :: BS.ByteString -> BSU
+packU_ = BSU
+
+requireU :: BSU -> Bool
+requireU = BS.any (>= 0x80) . unpackU_
diff --git a/Examples/Ninja/Main.hs b/Examples/Ninja/Main.hs
--- a/Examples/Ninja/Main.hs
+++ b/Examples/Ninja/Main.hs
@@ -39,3 +39,10 @@
     assertNonSpace (obj "out3.2") "g4++++i1"
     assertNonSpace (obj "out3.3") "g4++++i1"
     assertNonSpace (obj "out3.4") "g4+++s1+s2"
+
+    run "-f../../Examples/Ninja/test4.ninja out"
+    assertExists $ obj "out.txt"
+    assertExists $ obj "out2.txt"
+
+    run "-f../../Examples/Ninja/test5.ninja"
+    assertExists $ obj "output file"
diff --git a/Examples/Ninja/test4.ninja b/Examples/Ninja/test4.ninja
new file mode 100644
--- /dev/null
+++ b/Examples/Ninja/test4.ninja
@@ -0,0 +1,9 @@
+
+rule run
+    command = touch $out
+
+build ./out.txt: run
+
+build dir/../out2.txt: run
+
+build out: phony ./out.txt out2.txt
diff --git a/Examples/Ninja/test5.ninja b/Examples/Ninja/test5.ninja
new file mode 100644
--- /dev/null
+++ b/Examples/Ninja/test5.ninja
@@ -0,0 +1,5 @@
+
+rule run
+    command = touch $out
+
+build output$ file: run
diff --git a/Examples/Self/Main.hs b/Examples/Self/Main.hs
--- a/Examples/Self/Main.hs
+++ b/Examples/Self/Main.hs
@@ -19,7 +19,7 @@
 
 main = shaken noTest $ \args obj -> do
     let moduleToFile ext xs = map (\x -> if x == '.' then '/' else x) xs <.> ext
-    want $ if null args then [obj "Main.exe"] else args
+    want $ if null args then [obj "Main" <.> exe] else args
 
     -- fixup to cope with Cabal's generated files
     let fixPaths x = if x == "Paths_shake.hs" then "Paths.hs" else x
@@ -38,7 +38,7 @@
             flags <- ghcFlags $ GhcFlags ()
             cmd "ghc" flags args
 
-    obj "/*.exe" *> \out -> do
+    obj "Main" <.> exe *> \out -> do
         src <- readFileLines $ out -<.> "deps"
         let os = map (obj . moduleToFile "o") $ "Main":src
         need os
@@ -85,4 +85,4 @@
 
 packages = words $
     "base transformers binary unordered-containers hashable time old-time bytestring " ++
-    "filepath directory process deepseq random"
+    "filepath directory process deepseq random utf8-string"
diff --git a/Examples/Test/Basic.hs b/Examples/Test/Basic.hs
--- a/Examples/Test/Basic.hs
+++ b/Examples/Test/Basic.hs
@@ -39,7 +39,14 @@
         need [obj "configure",obj "once.txt"]
         liftIO $ appendFile (obj "install") "1"
 
+    phony "dummy" $ do
+        liftIO $ appendFile (obj "dummy") "1"
 
+    obj "dummer.txt" *> \out -> do
+        need ["dummy","dummy"]
+        need ["dummy"]
+        liftIO $ appendFile out "1"
+
 test build obj = do
     writeFile (obj "A.txt") "AAA"
     writeFile (obj "B.txt") "BBB"
@@ -82,3 +89,17 @@
     build ["!install"]
     assertContents (obj "configure") "111"
     assertContents (obj "install") "11"
+
+    writeFile (obj "dummy.txt") ""
+    build ["!dummy"]
+    assertContents (obj "dummy") "1"
+    build ["!dummy"]
+    assertContents (obj "dummy") "11"
+    build ["!dummy","!dummy"]
+    assertContents (obj "dummy") "111"
+
+    writeFile (obj "dummer.txt") ""
+    build ["dummer.txt"]
+    assertContents (obj "dummer.txt") "1"
+    build ["dummer.txt"]
+    assertContents (obj "dummer.txt") "11"
diff --git a/Examples/Test/Command.hs b/Examples/Test/Command.hs
--- a/Examples/Test/Command.hs
+++ b/Examples/Test/Command.hs
@@ -26,6 +26,10 @@
         () <- cmd (EchoStderr False) "ghc --random"
         return ""
 
+    "triple" !> do
+        (Exit exit, Stdout stdout, Stderr stderr) <- cmd "ghc --random"
+        return $ show (exit, stdout, stderr) -- must force all three parts
+
     "pwd" !> do
         writeFileLines (obj "pwd space.hs") ["import System.Directory","main = putStrLn =<< getCurrentDirectory"]
         Stdout out <- cmd (Cwd $ obj "") "runhaskell" ["pwd space.hs"]
@@ -58,3 +62,5 @@
 
     build ["env"]
     assertContentsInfix (obj "env") "HELLO SHAKE"
+
+    build ["triple"]
diff --git a/Examples/Test/Docs.hs b/Examples/Test/Docs.hs
--- a/Examples/Test/Docs.hs
+++ b/Examples/Test/Docs.hs
@@ -29,7 +29,8 @@
     obj "Part_*.hs" *> \out -> do
         need ["Examples/Test/Docs.hs"] -- so much of the generator is in this module
         src <- readFile' $ "dist/doc/html/shake/" ++ reps '_' '-' (drop 5 $ takeBaseName out) ++ ".html"
-        let f i (Stmt x) = restmt i $ map undefDots x
+        let f i (Stmt x) | all whitelist x = []
+                         | otherwise = restmt i $ map undefDots x
             f i (Expr x) | x `elem` types = ["type Expr_" ++ show i ++ " = " ++ x]
                          | otherwise = ["expr_" ++ show i ++ " = (" ++ undefDots x2 ++ ")" | let x2 = trim $ dropComment x, not $ whitelist x2]
             code = concat $ zipWith f [1..] (nub $ findCode src)
@@ -38,6 +39,7 @@
             ["{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, ExtendedDefaultRules, GeneralizedNewtypeDeriving, NoMonomorphismRestriction #-}"
             ,"module " ++ takeBaseName out ++ "() where"
             ,"import Control.Concurrent"
+            ,"import Control.Monad"
             ,"import Data.Char"
             ,"import Data.Data"
             ,"import Data.List"
@@ -148,20 +150,24 @@
     "newtype do MyFile.txt.digits excel a q value key gcc make contents tar ghc cabal clean _make distcc ghc " ++
     ".. /./ /.. ./ // \\ ../ " ++
     "ConstraintKinds GeneralizedNewtypeDeriving DeriveDataTypeable SetConsoleTitle " ++
-    ".make/i586-linux-gcc/output _make/.database foo/.. " ++
-    "-threaded Function extension $OUT $PATH xterm $TERM main opts result flagValues argValues "
+    "NoProgress Error " ++
+    ".make/i586-linux-gcc/output _make/.database foo/.. file.src file.out " ++
+    "-threaded -rtsopts -I0 Function extension $OUT $PATH xterm $TERM main opts result flagValues argValues "
     = True
 whitelist x = x `elem`
     ["[Foo.hi, Foo.o]"
+    ,"shake-progress"
     ,"main -j6"
     ,"main clean"
     ,"1m25s (15%)"
     ,"getPkgVersion $ GhcPkgVersion \"shake\""
     ,"# command-name file-name"
+    ,"ghc --make MyBuildSystem -rtsopts \"-with-rtsopts=-I0 -qg -qb\""
+    ,"-qg -qb"
     ]
 
 types = words $
     "MVar IO Monad Monoid String FilePath Data [String] Eq Typeable Char ExitCode " ++
-    "Action Resource Assume FilePattern Verbosity Rules Rule CmdOption CmdResult"
+    "Action Resource Assume FilePattern Verbosity Rules Rule CmdOption CmdResult Int Double"
 
 dupes = words "main progressSimple rules"
diff --git a/Examples/Test/Errors.hs b/Examples/Test/Errors.hs
--- a/Examples/Test/Errors.hs
+++ b/Examples/Test/Errors.hs
@@ -45,7 +45,12 @@
     catcher "exception1" actionOnException True
     catcher "exception2" actionOnException False
 
+    res <- newResource "resource_name" 1
+    obj "resource" *> \out -> do
+        withResource res 1 $
+            need ["resource-dep"]
 
+
 test build obj = do
     let crash args parts = do
             res <- try $ build $ "--quiet" : args
@@ -78,3 +83,5 @@
     assertContents (obj "exception1") "1"
     build ["exception2"]
     assertContents (obj "exception2") "0"
+
+    crash ["resource"] ["cannot currently call apply","withResource","resource_name"]
diff --git a/Examples/Test/Files.hs b/Examples/Test/Files.hs
--- a/Examples/Test/Files.hs
+++ b/Examples/Test/Files.hs
@@ -8,23 +8,31 @@
 
 
 main = shaken test $ \args obj -> do
-    want $ map obj ["even.txt","odd.txt"]
+    let fun = "@" `elem` args
+    let rest = delete "@" args
+    want $ map obj $ if null rest then ["even.txt","odd.txt"] else rest
 
-    let deps = map obj ["even.txt","odd.txt"]
-    let def | "fun" `elem` args = (?>>) (\x -> if x `elem` deps then Just deps else Nothing)
-            | otherwise = (*>>) deps
+    -- Since ?>> and *>> are implemented separately we test everything in both modes
+    let deps ?*>> act | fun = (\x -> if x `elem` deps then Just deps else Nothing) ?>> act
+                      | otherwise = deps *>> act
 
-    def $ \[evens,odds] -> do
+    map obj ["even.txt","odd.txt"] ?*>> \[evens,odds] -> do
         src <- readFileLines $ obj "numbers.txt"
         let (es,os) = partition even $ map read src
         writeFileLines evens $ map show es
         writeFileLines odds  $ map show os
 
+    map obj ["dir1/out.txt","dir2/out.txt"] ?*>> \[a,b] -> do
+        writeFile' a "a"
+        writeFile' b "b"
 
+
 test build obj = do
-    forM_ [[],["fun"]] $ \args -> do
+    forM_ [[],["@"]] $ \args -> do
         let nums = unlines . map show
         writeFile (obj "numbers.txt") $ nums [1,2,4,5,2,3,1]
         build ("--sleep":args)
         assertContents (obj "even.txt") $ nums [2,4,2]
         assertContents (obj "odd.txt" ) $ nums [1,5,3,1]
+        build ["clean"]
+        build ["dir1/out.txt"]
diff --git a/Examples/Test/Lint.hs b/Examples/Test/Lint.hs
--- a/Examples/Test/Lint.hs
+++ b/Examples/Test/Lint.hs
@@ -46,6 +46,12 @@
         writeFile' (obj "createonce") "Y"
         writeFile' out ""
 
+    obj "listing" *> \out -> do
+        writeFile' (out <.> "ls1") ""
+        getDirectoryFiles (obj "") ["//*.ls*"]
+        writeFile' (out <.> "ls2") ""
+        writeFile' out ""
+
     obj "existance" *> \out -> do
         Development.Shake.doesFileExist $ obj "exists"
         writeFile' (obj "exists") ""
@@ -64,6 +70,8 @@
     crash ["changedir"] ["current directory has changed"]
     build ["cdir.1","cdir.2","-j1"]
     build ["--clean","cdir.1","pause.2","-j1"]
-    crash ["--clean","cdir.1","pause.2","-j2"] ["current directory has changed"]
-    crash ["existance"] ["changed since being built"]
-    crash ["createtwice"] ["changed since being built"]
+    crash ["--clean","cdir.1","pause.2","-j2"] ["before building output/lint/","current directory has changed"]
+    crash ["existance"] ["changed since being depended upon"]
+    crash ["createtwice"] ["changed since being depended upon"]
+    crash ["listing"] ["changed since being depended upon","output/lint"]
+    crash ["--clean","listing","existance"] ["changed since being depended upon"]
diff --git a/Examples/Test/Progress.hs b/Examples/Test/Progress.hs
--- a/Examples/Test/Progress.hs
+++ b/Examples/Test/Progress.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 
 module Examples.Test.Progress(main) where
 
 import Development.Shake.Progress
+import Development.Shake.Classes
 import Examples.Util
+import qualified Control.Exception as E
 import Data.IORef
 import Data.Monoid
 import Data.Char
@@ -14,6 +17,10 @@
 -- | Given a list of todo times, get out a list of how long is predicted
 prog = progEx 10000000000000000
 
+data MyException = MyException deriving (Show, Typeable)
+instance E.Exception MyException
+
+
 progEx :: Double -> [Double] -> IO [Double]
 progEx mxDone todo = do
     let resolution = 10000 -- Use resolution to get extra detail on the numbers
@@ -21,14 +28,15 @@
     pile <- newIORef $ tail $ zipWith (\t d -> mempty{timeBuilt=d*resolution,timeTodo=(t*resolution,0)}) todo done
     let get = do a <- readIORef pile
                  case a of
-                     [] -> return mempty{isRunning=False}
+                     [] -> E.throw MyException
                      x:xs -> do writeIORef pile xs; return x
 
     out <- newIORef []
     let put x = do let (mins,secs) = break (== 'm') $ takeWhile (/= '(') x
                    let f x = let y = filter isDigit x in if null y then 0/0 else read y
                    modifyIORef out (++ [(if null secs then f mins else f mins * 60 + f secs) / resolution])
-    progressDisplayTester resolution put get
+    -- we abort by killing the thread, but then catch the abort and resume normally
+    E.catch (progressDisplayTester resolution put get) $ \MyException -> return ()
     fmap (take $ length todo) $ readIORef out
 
 
diff --git a/Examples/Test/Throttle.hs b/Examples/Test/Throttle.hs
new file mode 100644
--- /dev/null
+++ b/Examples/Test/Throttle.hs
@@ -0,0 +1,34 @@
+
+module Examples.Test.Throttle(main) where
+
+import Development.Shake
+import Development.Shake.Util
+import Development.Shake.FilePath
+import Examples.Util
+import Control.Monad
+
+
+main = shaken test $ \args obj -> do
+    res <- newThrottle "test" 2 0.2
+    want $ map obj ["file1.1","file2.1","file3.2","file4.1","file5.2"]
+    obj "*.*" *> \out -> do
+        withResource res (read $ drop 1 $ takeExtension out) $ return ()
+        writeFile' out ""
+
+test build obj = do
+    forM_ [[],["-j8"]] $ \flags -> do
+        -- we are sometimes over the window if the machine is "a bit loaded" at some particular time
+        -- therefore we rerun the test three times, and only fail if it fails on all of them
+        flip loop 3 $ \i -> do
+            build ["clean"]
+            (s, _) <- duration $ build []
+            -- the 0.1s cap is a guess at an upper bound for how long everything else should take
+            -- and should be raised on slower machines
+            let good = s >= 0.6 && s < 0.7
+            if good then return $ Right ()
+             else if i > 1 then do
+                putStrLn $ "Throttle failed (took " ++ show s ++ "s), retrying"
+                return $ Left (i-1)
+             else do
+                assert False $ "Bad throttling, expected to take 0.6s + computation time (cap of 0.1s), took " ++ show s ++ "s (three times in a row)"
+                return $ Right ()
diff --git a/Examples/Test/Unicode.hs b/Examples/Test/Unicode.hs
new file mode 100644
--- /dev/null
+++ b/Examples/Test/Unicode.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Examples.Test.Unicode(main) where
+
+import Development.Shake
+import Development.Shake.FilePath
+import Examples.Util
+import Control.Monad
+import System.Directory(createDirectoryIfMissing)
+
+
+-- | Decode a dull ASCII string to certain unicode points, necessary because
+--   withArgs (even the UTF8 version) throws an encoding error on the > 256 code points
+decode :: String -> String
+decode ('e':'^':xs) = '\xEA' : decode xs -- Latin Small Letter E With Circumflex
+decode (':':')':xs) = '\x263A' : decode xs -- White Smiling Face
+decode (x:xs) = x : decode xs
+decode [] = []
+
+
+main = shaken test $ \xs obj -> do
+    let pre:args = map decode xs
+    want $ map obj args
+
+    obj (pre ++ "dir/*") *> \out -> do
+        let src = takeDirectory (takeDirectory out) </> takeFileName out
+        copyFile' src out
+
+    obj (pre ++ ".out") *> \out -> do
+        a <- readFile' $ obj $ pre ++ "dir" </> pre <.> "source"
+        b <- readFile' $ obj pre <.> "multi1"
+        writeFile' out $ a ++ b
+
+    map obj ["*.multi1","*.multi2"] *>> \[m1,m2] -> do
+        b <- doesFileExist $ m1 -<.> "exist"
+        writeFile' m1 $ show b
+        writeFile' m2 $ show b
+
+
+test build obj = {- handle (\e -> print (e :: SomeException) >> error "dead") $ -} do
+    build ["clean"]
+    -- IO.hSetEncoding IO.stdout IO.char8
+    -- IO.hSetEncoding IO.stderr IO.char8
+    forM_ ["normal","e^",":)","e^-:)"] $ \pre -> do
+        createDirectoryIfMissing True $ obj ""
+        let ext x = obj $ decode pre <.> x
+        writeFile (ext "source") "x"
+        build [pre,pre <.> "out","--sleep"]
+        assertContents (ext "out") $ "x" ++ "False"
+        writeFile (ext "source") "y"
+        build [pre,pre <.> "out","--sleep"]
+        assertContents (ext "out") $ "y" ++ "False"
+        writeFile (ext "exist") ""
+        build [pre,pre <.> "out"]
+        assertContents (ext "out") $ "y" ++ "True"
diff --git a/Examples/Util.hs b/Examples/Util.hs
--- a/Examples/Util.hs
+++ b/Examples/Util.hs
@@ -1,10 +1,10 @@
 
-module Examples.Util(module Examples.Util) where
+module Examples.Util(sleep, module Examples.Util) where
 
 import Development.Shake
+import Development.Shake.Util
 import Development.Shake.FilePath
 
-import Control.Concurrent
 import Control.Monad
 import Data.Char
 import Data.List
@@ -119,13 +119,24 @@
     build []
 
 
-sleep :: Double -> IO ()
-sleep x = threadDelay $ ceiling $ x * 1000000
-
-
 -- | Sleep long enough for the modification time resolution to catch up
 sleepFileTime :: IO ()
 sleepFileTime = sleep 1
+
+
+sleepFileTimeCalibrate :: IO (IO ())
+sleepFileTimeCalibrate = do
+    let file = "output/calibrate"
+    createDirectoryIfMissing True $ takeDirectory file
+    mtime <- fmap maximum $ forM [1..3] $ \i -> fmap fst $ duration $ do
+        writeFile file $ show i
+        t1 <- getModificationTime file
+        flip loop 0 $ \j -> do
+            writeFile file $ show (i,j)
+            t2 <- getModificationTime file
+            return $ if t1 == t2 then Left $ j+1 else Right ()
+    putStrLn $ "Longest file modification time lag was " ++ show mtime ++ "s"
+    return $ sleep $ min 1 $ mtime * 2
 
 
 removeFilesRandom :: FilePath -> IO Int
diff --git a/Test.hs b/Test.hs
--- a/Test.hs
+++ b/Test.hs
@@ -10,8 +10,9 @@
 import Development.Shake.Pool
 import Development.Shake.Timing
 import Development.Shake.FileTime
+import Development.Shake.Util
 import qualified Data.ByteString.Char8 as BS
-import Examples.Util(sleepFileTime)
+import Examples.Util(sleepFileTime, sleepFileTimeCalibrate)
 import Control.Concurrent
 
 import qualified Examples.Tar.Main as Tar
@@ -37,6 +38,8 @@
 import qualified Examples.Test.Progress as Progress
 import qualified Examples.Test.Random as Random
 import qualified Examples.Test.Resources as Resources
+import qualified Examples.Test.Throttle as Throttle
+import qualified Examples.Test.Unicode as Unicode
 
 import qualified Start as Start
 
@@ -51,7 +54,8 @@
         ,"journal" * Journal.main, "lint" * Lint.main, "makefile" * Makefile.main
         ,"pool" * Pool.main, "random" * Random.main, "ninja" * Ninja.main
         ,"resources" * Resources.main, "assume" * Assume.main, "benchmark" * Benchmark.main
-        ,"oracle" * Oracle.main, "progress" * Progress.main]
+        ,"oracle" * Oracle.main, "progress" * Progress.main, "unicode" * Unicode.main
+        ,"throttle" * Throttle.main]
     where (*) = (,)
 
 
@@ -100,7 +104,7 @@
     vars <- forM [a,b,c,d] $ \xs -> do
         mvar <- newEmptyMVar
         forkIO $ do
-            mapM_ getModTimeMaybe xs
+            mapM_ (getModTimeMaybe . packU_) xs
             putMVar mvar ()
         return $ takeMVar mvar
     sequence_ vars
@@ -116,8 +120,9 @@
     args <- getArgs
     let tests = filter ((/= "random") . fst) mains
     let (priority,normal) = partition (flip elem ["assume","journal"] . fst) tests
+    yield <- sleepFileTimeCalibrate
     flip onException (putStrLn "TESTS FAILED") $
-        execute sleepFileTime [\pause -> withArgs (name:"test":drop 1 args) $ test pause | (name,test) <- priority ++ normal]
+        execute yield [\pause -> withArgs (name:"test":drop 1 args) $ test pause | (name,test) <- priority ++ normal]
 
 
 -- | Execute each item in the list. They may yield (call the first parameter) in which case
diff --git a/shake.cabal b/shake.cabal
--- a/shake.cabal
+++ b/shake.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.8
 build-type:         Simple
 name:               shake
-version:            0.10.6
+version:            0.10.7
 license:            BSD3
 license-file:       LICENSE
 category:           Development
@@ -82,8 +82,9 @@
         binary,
         filepath,
         process >= 1.1,
-        unordered-containers (>= 0.1.4.3 && < 0.2) || (>= 0.2.1 && < 0.3),
+        unordered-containers >= 0.2.1 && < 0.3,
         bytestring,
+        utf8-string >= 0.3,
         time,
         random,
         transformers >= 0.2 && < 0.4,
@@ -93,7 +94,7 @@
         cpp-options: -DPORTABLE
     else
         if !os(windows)
-            build-depends: unix >= 2.5.1
+            build-depends: unix >= 2.6
 
     exposed-modules:
         Development.Shake
@@ -115,24 +116,25 @@
         Development.Shake.Files
         Development.Shake.FileTime
         Development.Shake.Intern
-        Development.Shake.Locks
         Development.Shake.Oracle
         Development.Shake.Pool
         Development.Shake.Progress
         Development.Shake.Report
         Development.Shake.Rerun
+        Development.Shake.Resource
         Development.Shake.Shake
         Development.Shake.Special
         Development.Shake.Storage
         Development.Shake.Timing
         Development.Shake.Types
+        Development.Shake.Util
         Development.Shake.Value
         Paths_shake
 
 
 executable shake
     main-is: Main.hs
-    ghc-options: -threaded
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -qg -qb"
     build-depends:
         base == 4.*,
         old-time,
@@ -140,9 +142,10 @@
         hashable >= 1.1.2.3 && < 1.3,
         binary,
         filepath,
-        process,
-        unordered-containers (>= 0.1.4.3 && < 0.2) || (>= 0.2.1 && < 0.3),
+        process >= 1.1,
+        unordered-containers >= 0.2.1 && < 0.3,
         bytestring,
+        utf8-string >= 0.3,
         time,
         random,
         transformers >= 0.2 && < 0.4,
@@ -152,7 +155,7 @@
         cpp-options: -DPORTABLE
     else
         if !os(windows)
-            build-depends: unix >= 2.5.1
+            build-depends: unix >= 2.6
 
     other-modules:
         Development.Make.All
@@ -173,7 +176,7 @@
         buildable: True
     else
         buildable: False
-    ghc-options: -threaded
+    ghc-options: -threaded -rtsopts
     build-depends:
         base == 4.*,
         old-time,
@@ -181,9 +184,10 @@
         hashable >= 1.1.2.3 && < 1.3,
         binary,
         filepath,
-        process,
-        unordered-containers (>= 0.1.4.3 && < 0.2) || (>= 0.2.1 && < 0.3),
+        process >= 1.1,
+        unordered-containers >= 0.2.1 && < 0.3,
         bytestring,
+        utf8-string >= 0.3,
         time,
         random,
         transformers >= 0.2 && < 0.4,
@@ -193,7 +197,7 @@
         cpp-options: -DPORTABLE
     else
         if !os(windows)
-            build-depends: unix >= 2.5.1
+            build-depends: unix >= 2.6
 
     other-modules:
         Development.Make.All
@@ -228,4 +232,6 @@
         Examples.Test.Progress
         Examples.Test.Random
         Examples.Test.Resources
+        Examples.Test.Throttle
+        Examples.Test.Unicode
         Start