diff --git a/Development/Shake.hs b/Development/Shake.hs
--- a/Development/Shake.hs
+++ b/Development/Shake.hs
@@ -9,7 +9,7 @@
 --
 --main = 'shake' 'shakeOptions' $ do
 --    'want' [\"result.tar\"]
---    \"*.tar\" *> \\out -> do
+--    \"*.tar\" '*>' \\out -> do
 --        contents <- 'readFileLines' $ replaceExtension out \"txt\"
 --        'need' contents
 --        'system'' \"tar\" $ [\"-cf\",out] ++ contents
@@ -23,8 +23,7 @@
     ShakeOptions(..), shakeOptions,
     Rule(..), Rules, defaultRule, rule, action,
     Action, apply, apply1, traced,
-    putLoud, putNormal, putQuiet,
-    Observed(..),
+    Verbosity(..), getVerbosity, putLoud, putNormal, putQuiet,
     liftIO,
     -- * Utility functions
     module Development.Shake.Derived,
@@ -33,29 +32,34 @@
     module Development.Shake.Files,
     FilePattern, (?==),
     -- * Directory rules
-    doesFileExist, getDirectoryContents, getDirectoryFiles, getDirectoryDirs
+    doesFileExist, getDirectoryContents, getDirectoryFiles, getDirectoryDirs,
+    -- * Additional rules
+    addOracle, askOracle,
+    alwaysRerun
     ) where
 
 -- I would love to use module export in the above export list, but alas Haddock
 -- then shows all the things that are hidden in the docs, which is terrible.
 
 import Control.Monad.IO.Class
-import Development.Shake.Core hiding (run)
+import Development.Shake.Core
 import Development.Shake.Derived
-import Development.Shake.File hiding (defaultRuleFile)
-import Development.Shake.FilePattern(FilePattern, (?==))
+
+import Development.Shake.Directory
+import Development.Shake.File
+import Development.Shake.FilePattern
 import Development.Shake.Files
-import Development.Shake.Directory hiding (defaultRuleDirectory)
+import Development.Shake.Oracle
+import Development.Shake.Rerun
 
-import qualified Development.Shake.Core as X
-import qualified Development.Shake.File as X
-import qualified Development.Shake.Directory as X
 
--- | Main entry point for running Shake build systems. For an example see "Development.Shake".
+-- | Main entry point for running Shake build systems. For an example see the top of the module "Development.Shake".
+--   Use 'ShakeOptions' to specify how the system runs, and 'Rules' to specify what to build.
 shake :: ShakeOptions -> Rules () -> IO ()
 shake opts r = do
-    X.run opts $ do
+    run opts $ do
         r
-        X.defaultRuleFile
-        X.defaultRuleDirectory
+        defaultRuleFile
+        defaultRuleDirectory
+        defaultRuleRerun
     return ()
diff --git a/Development/Shake/Core.hs b/Development/Shake/Core.hs
--- a/Development/Shake/Core.hs
+++ b/Development/Shake/Core.hs
@@ -5,13 +5,11 @@
     ShakeOptions(..), shakeOptions, run,
     Rule(..), Rules, defaultRule, rule, action,
     Action, apply, apply1, traced,
-    putLoud, putNormal, putQuiet,
-    Observed(..)
+    Verbosity(..), getVerbosity, putLoud, putNormal, putQuiet
     ) where
 
 import Prelude hiding (catch)
-import Control.Arrow
-import Control.Concurrent.ParallelIO.Local
+import Development.Shake.Pool
 import Control.DeepSeq
 import Control.Exception
 import Control.Monad
@@ -20,14 +18,11 @@
 import Data.Binary(Binary)
 import Data.Hashable
 import Data.Function
-import Data.IORef
 import Data.List
 import qualified Data.HashMap.Strict as Map
 import Data.Maybe
 import Data.Monoid
-import Data.Time.Clock
 import Data.Typeable
-import System.IO.Unsafe
 
 import Development.Shake.Database
 import Development.Shake.Locks
@@ -37,35 +32,52 @@
 ---------------------------------------------------------------------
 -- OPTIONS
 
--- | Options to control 'shake'.
+-- | Options to control the execution of Shake, usually specified by overriding fields in
+--   'shakeOptions':
+--
+--   @'shakeOptions'{'shakeThreads'=4, 'shakeDump'=True}@
 data ShakeOptions = ShakeOptions
     {shakeFiles :: FilePath -- ^ Where shall I store the database and journal files (defaults to @.shake@).
-    ,shakeParallel :: Int -- ^ What is the maximum number of rules I should run in parallel (defaults to @1@).
-    ,shakeVersion :: Int -- ^ What is the version of your build system, increment to force a complete rebuild.
-    ,shakeVerbosity :: Int -- ^ 1 = normal, 0 = quiet, 2 = loud.
-    ,shakeLint :: Bool -- ^ Run under lint mode, when set implies 'shakeParallel' is @1@ (defaults to 'False').
-                       --   /This feature has not yet been completed, and should not be used./
-    ,shakeDump :: Bool -- ^ Dump all profiling information to @'shakeFiles'.json@ (defaults to 'False').
+    ,shakeThreads :: Int -- ^ What is the maximum number of rules I should run in parallel (defaults to @1@).
+    ,shakeVersion :: Int -- ^ What is the version of your build system, increment to force a complete rebuild (defaults to @1@).
+    ,shakeVerbosity :: Verbosity -- ^ What messages to print out (defaults to 'Normal').
+    ,shakeStaunch :: Bool -- ^ Operate in staunch mode, where building continues even after errors (defaults to 'False').
+    ,shakeDump :: Bool -- ^ Dump all profiling information to 'shakeFiles' plus the extension @.js@ (defaults to 'False').
     }
-    deriving (Show, Eq, Ord, Read)
+    deriving (Show, Eq, Ord)
 
 -- | The default set of 'ShakeOptions'.
 shakeOptions :: ShakeOptions
-shakeOptions = ShakeOptions ".shake" 1 1 1 False False
+shakeOptions = ShakeOptions ".shake" 1 1 Normal False False
 
 
-data ShakeException = ShakeException [Key] SomeException
-     deriving Typeable
+-- | All forseen exception conditions thrown by Shake, such problems with the rules or errors when executing
+--   rules, will be raised using this exception type.
+data ShakeException = ShakeException
+        [String] -- Entries on the stack, starting at the top of the stack.
+        SomeException -- Inner exception that was raised.
+        -- If I make these Haddock comments, then Haddock dies
+    deriving Typeable
 
 instance Exception ShakeException
 
 instance Show ShakeException where
     show (ShakeException stack inner) = unlines $
         "Error when running Shake build system:" :
-        map (("* " ++) . show) stack ++
+        map ("* " ++) stack ++
         [show inner]
 
 
+-- | The verbosity data type, specified in 'shakeVerbosity'.
+data Verbosity
+    = Silent -- ^ Don't print any messages.
+    | Quiet  -- ^ Only print essential messages (typically errors).
+    | Normal -- ^ Print normal messages (typically errors and warnings).
+    | Loud   -- ^ Print lots of messages (typically errors, warnings and status updates).
+    | Diagnostic -- ^ Print messages for virtually everything (for debugging a build system).
+      deriving (Eq,Ord,Bounded,Enum,Show,Read,Typeable)
+
+
 ---------------------------------------------------------------------
 -- RULES
 
@@ -83,13 +95,14 @@
     validStored :: key -> value -> IO Bool
     validStored _ _ = return True
 
+{-
     -- | Return 'True' if the value should not be changed by the build system. Defaults to returning
-    --   'False'. Only used when running under lint mode.
+    --   'False'. Only used when running with 'shakeLint'.
     invariant :: key -> Bool
     invariant _ = False
 
     -- | Given an action, return what has changed, along with what you think should
-    --   have stayed the same. Only used when running under lint mode.
+    --   have stayed the same. Only used when running with 'shakeLint'.
     observed :: IO a -> IO (Observed key, a)
     observed = fmap ((,) mempty)
 
@@ -112,6 +125,7 @@
         where
             f Nothing Nothing = Nothing
             f a b = Just $ fromMaybe [] a ++ fromMaybe [] b
+-}
 
 
 data ARule = forall key value . Rule key value => ARule (key -> Maybe (Action value))
@@ -125,15 +139,9 @@
 ruleStored :: Rule key value => (key -> Maybe (Action value)) -> (key -> value -> IO Bool)
 ruleStored _ = validStored
 
-ruleInvariant :: Rule key value => (key -> Maybe (Action value)) -> (key -> Bool)
-ruleInvariant _ = invariant
 
-ruleObserved :: Rule key value => (key -> Maybe (Action value)) -> (IO a -> IO (Observed key, a))
-ruleObserved _ = observed
-
-
 -- | Define a set of rules. Rules can be created with calls to 'rule', 'defaultRule' or 'action'. Rules are combined
---   with either the 'Monoid' instance, or more commonly using the 'Monad' instance and @do@ notation.
+--   with either the 'Monoid' instance, or (more commonly) the 'Monad' instance and @do@ notation.
 data Rules a = Rules
     {value :: a -- not really used, other than for the Monad instance
     ,actions :: [Action ()]
@@ -186,18 +194,17 @@
     -- global constants
     {database :: Database
     ,pool :: Pool
-    ,started :: UTCTime
+    ,started :: IO Time
     ,stored :: Key -> Value -> IO Bool
     ,execute :: Key -> Action Value
-    ,outputLock :: Var ()
-    ,verbosity :: Int
-    ,observer :: Key -> IO () -> IO ()
+    ,output :: String -> IO ()
+    ,verbosity :: Verbosity
     -- stack variables
     ,stack :: [Key] -- in reverse
     -- local variables
     ,depends :: [[Key]] -- built up in reverse
-    ,discount :: Double
-    ,traces :: [(String, Double, Double)] -- in reverse
+    ,discount :: Duration
+    ,traces :: [(String, Time, Time)] -- in reverse
     }
 
 -- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'need' to execute files.
@@ -209,44 +216,40 @@
 -- | This function is not actually exported, but Haddock is buggy. Please ignore.
 run :: ShakeOptions -> Rules () -> IO ()
 run opts@ShakeOptions{..} rs = do
-    start <- getCurrentTime
+    start <- startTime
     registerWitnesses rs
-    outputLock <- newVar ()
-    withDatabase shakeFiles shakeVersion $ \database -> do
-        withObserver database $ \observer ->
-            withPool (if shakeLint then 1 else shakeParallel) $ \pool -> do
-                let s0 = S database pool start stored execute outputLock shakeVerbosity observer [] [] 0 []
-                if shakeLint
-                    then mapM_ (wrapStack [] . runAction s0 . applyKeyValue . return . fst) =<< allEntries database
-                    else parallel_ pool $ map (wrapStack [] . runAction s0) (actions rs)
+
+    output <- do
+        lock <- newLock
+        return $ withLock lock . putStrLn
+
+    let logger = if shakeVerbosity >= Diagnostic then output . ("% "++) else const $ return ()
+
+    except <- newVar (Nothing :: Maybe SomeException)
+    let staunch act | not shakeStaunch = act >> return ()
+                    | otherwise = do
+            res <- try act
+            case res of
+                Left err -> do
+                    modifyVar_ except $ \v -> return $ Just $ fromMaybe err v
+                    let msg = show err ++ "Continuing due to staunch mode, this error will be repeated later"
+                    when (shakeVerbosity >= Quiet) $ output msg
+                Right _ -> return ()
+
+    withDatabase logger shakeFiles shakeVersion $ \database -> do
+        runPool shakeThreads $ \pool -> do
+            let s0 = S database pool start (createStored rs) (createExecute rs) output shakeVerbosity [] [] 0 []
+            mapM_ (addPool pool . staunch . wrapStack [] . runAction s0) (actions rs)
         when shakeDump $ do
             json <- showJSON database
             writeFile (shakeFiles ++ ".js") $ "var shake =\n" ++ json
-    where
-        stored = createStored rs
-        execute = createExecute rs
-
-        withObserver database act
-            | not shakeLint = act $ \key val -> val
-            | otherwise = do
-            ents <- allEntries database
-            let invariants = [(k,v) | (k,v) <- ents, Just (_,_,(_,ARule r):_) <- [Map.lookup (typeKey k) $ rules rs], ruleInvariant r (fromKey k)]
-                observe = createObserver rs
-            badStart <- filterM (fmap not . uncurry stored) invariants
-            seen <- newIORef ([] :: [(Key,[Observed Key])])
-            act $ \key val -> do
-                obs <- observe val
-                atomicModifyIORef seen $ \xs -> ((key,obs):xs, ())
-            badEnd <- filterM (fmap not . uncurry stored) invariants
-            when (not $ null $ badStart ++ badEnd) $
-                error "There were invariants that were broken" -- FIXME: Better error message
-            -- FIXME: Check the seen pile against the database
+    maybe (return ()) throwIO =<< readVar except
 
 
 wrapStack :: [Key] -> IO a -> IO a
 wrapStack stk act = catch act $ \(SomeException e) -> case cast e of
     Just s@ShakeException{} -> throw s
-    Nothing -> throw $ ShakeException stk $ SomeException e
+    Nothing -> throw $ ShakeException (map show stk) $ SomeException e
 
 
 registerWitnesses :: Rules () -> IO ()
@@ -256,16 +259,6 @@
         registerWitness $ ruleValue r
 
 
-createObserver :: Rules () -> (IO () -> IO [Observed Key])
-createObserver Rules{..} = f os
-    where
-        os = [obs | (k,v,(_,ARule r):_) <- Map.elems rules, let obs = fmap (first $ fmap newKey) . ruleObserved r]
-        f [] act = act >> return []
-        f (o:os) act = do
-            (x,xs) <- o $ f os act
-            return $ [x | x /= mempty] ++ xs
-
-
 createStored :: Rules () -> (Key -> Value -> IO Bool)
 createStored Rules{..} = \k v ->
     let (tk,tv) = (typeKey k, typeValue v) in
@@ -305,10 +298,6 @@
 runAction s (Action x) = runStateT x s
 
 
-duration :: UTCTime -> UTCTime -> Double
-duration start end = fromRational $ toRational $ end `diffUTCTime` start
-
-
 -- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.
 --   This function requires that appropriate rules have been added with 'rule' or 'defaultRule'.
 apply :: Rule key value => [key] -> Action [value]
@@ -317,83 +306,65 @@
 applyKeyValue :: [Key] -> Action [Value]
 applyKeyValue ks = Action $ do
     modify $ \s -> s{depends=ks:depends s}
-    loop
-    where
-        loop = do
-            s <- get
-            let unsafeStored k v = unsafePerformIO $ stored s k v -- safe because of the invariants on validStored
-            res <- liftIO $ request (database s) unsafeStored ks
-            case res of
-                Block (seen,act) -> do
-                    let bad = intersect (stack s) seen
-                    if not $ null bad
-                        then error $ "Invalid rules, recursion detected when trying to build: " ++ show (head bad)
-                        else discounted (liftIO $ extraWorkerWhileBlocked (pool s) act) >> loop
-                Response vs -> return vs
-                Execute todo -> do
-                    discounted $ liftIO $ parallel_ (pool s) $ flip map todo $ \t ->
-                        wrapStack (reverse $ t:stack s) $ observer s t $ do
-                            start <- getCurrentTime
-                            let s2 = s{depends=[], stack=t:stack s, discount=0, traces=[]}
-                            (res,s2) <- runAction s2 $ do
-                                putNormal $ "# " ++ show t
-                                execute s t
-                            evaluate $ rnf res
-                            end <- getCurrentTime
-                            let x = duration start end - discount s2
-                            finished (database s) t res (reverse $ depends s2) x (reverse $ traces s2)
-                    loop
-
-        discounted x = do
-            start <- liftIO getCurrentTime
-            res <- x
-            end <- liftIO getCurrentTime
-            modify $ \s -> s{discount=discount s + duration start end}
+    s <- get
+    let bad = stack s `intersect` ks
+    unless (null bad) $ 
+        error $ "Invalid rules, recursion detected when trying to build: " ++ show (head bad)
+    let exec more_stack k = let stack2 = k : more_stack ++ stack s in try $ wrapStack (reverse stack2) $ do
+            evaluate $ rnf k
+            let s2 = s{depends=[], stack=stack2, discount=0, traces=[]}
+            (dur,(res,s2)) <- duration $ runAction s2 $ do
+                putNormal $ "# " ++ show k
+                execute s k
+            let ans = (res, reverse $ depends s2, dur - discount s2, reverse $ traces s2)
+            evaluate $ rnf ans
+            return ans
+    res <- liftIO $ eval (pool s) (database s) (Ops (stored s) exec) ks
+    case res of
+        Left err -> throw err
+        Right (d, vs) -> do
+            modify $ \s -> s{discount=discount s + d}
+            return vs
 
 
 -- | Apply a single rule, equivalent to calling 'apply' with a singleton list. Where possible,
---   use 'apply' to allow the potential for parallelism.
+--   use 'apply' to allow parallelism.
 apply1 :: Rule key value => key -> Action value
 apply1 = fmap head . apply . return
 
 
 -- | Write an action to the trace list, along with the start/end time of running the IO action.
---   The 'system'' command automatically calls 'traced'.
+--   The 'system'' command automatically calls 'traced'. The trace list is used for profile reports
+--   (see 'shakeDump').
 traced :: String -> IO a -> Action a
 traced msg act = Action $ do
-    start <- liftIO getCurrentTime
+    s <- get
+    start <- liftIO $ started s
     res <- liftIO act
-    stop <- liftIO getCurrentTime
-    modify $ \s -> s{traces = (msg,duration (started s) start, duration (started s) stop):traces s}
+    stop <- liftIO $ started s
+    modify $ \s -> s{traces = (msg,start,stop):traces s}
     return res
 
-{-
--- Do not provide currentStack/currentRule, since they return [Key], and Key isn't an exported type.
 
--- | Get the stack of 'Key's for the current rule - usually used to improve error messages.
---   Returns @[]@ if being run by 'action', otherwise returns the stack with the oldest rule
---   first.
-currentStack :: Action [Key]
-currentStack = Action $ fmap reverse $ gets stack
-
-
--- | Get the 'Key' for the currently executing rule - usally used to improve error messages.
---   Returns 'Nothing' if being run by 'action'.
-currentRule = Action $ fmap listToMaybe $ gets stack
--}
-
-putWhen :: (Int -> Bool) -> String -> Action ()
+putWhen :: (Verbosity -> Bool) -> String -> Action ()
 putWhen f msg = Action $ do
     s <- get
     when (f $ verbosity s) $
-        liftIO $ modifyVar_ (outputLock s) $ const $
-            putStrLn msg
+        liftIO $ output s msg
 
 
 -- | Write a message to the output when the verbosity is appropriate.
 --   The output will not be interleaved with any other Shake messages
 --   (other than those generated by system commands).
 putLoud, putNormal, putQuiet :: String -> Action ()
-putLoud = putWhen (>= 2)
-putNormal = putWhen (>= 1)
-putQuiet = putWhen (>= 0)
+putLoud = putWhen (>= Loud)
+putNormal = putWhen (>= Normal)
+putQuiet = putWhen (>= Quiet)
+
+
+-- | Get the current verbosity level, as set by 'shakeVerbosity'. If you
+--   want to output information to the console, you are recommended to use
+--   'putLoud' \/ 'putNormal' \/ 'putQuiet', which ensures multiple messages are
+--   not interleaved.
+getVerbosity :: Action Verbosity
+getVerbosity = Action $ gets verbosity
diff --git a/Development/Shake/Database.hs b/Development/Shake/Database.hs
--- a/Development/Shake/Database.hs
+++ b/Development/Shake/Database.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}
 {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
-{-# OPTIONS -fno-warn-unused-binds #-} -- for fields used just for docs
 {-
 Files stores the meta-data so its very important its always accurate
 We can't rely on getting a Ctrl+C at the end, so we'd better write out a journal
@@ -9,27 +8,29 @@
 -}
 
 module Development.Shake.Database(
+    Time, startTime, Duration, duration, Trace,
     Database, withDatabase,
-    request, Response(..), finished,
+    Ops(..), eval,
     allEntries, showJSON,
     ) where
 
 import Development.Shake.Binary
-import Development.Shake.Locks
+import Development.Shake.Pool
 import Development.Shake.Value
+import Development.Shake.Locks
 
 import Prelude hiding (catch)
 import Control.Arrow
 import Control.Exception
 import Control.Monad
-import Control.Monad.IO.Class
-import qualified Control.Monad.Trans.State as S
 import Data.Binary.Get
 import Data.Binary.Put
 import Data.Char
 import qualified Data.HashMap.Strict as Map
+import Data.IORef
 import Data.Maybe
 import Data.List
+import Data.Time.Clock
 import System.Directory
 import System.FilePath
 import System.IO
@@ -48,130 +49,267 @@
 removeFile_ :: FilePath -> IO ()
 removeFile_ x = catch (removeFile x) (\(e :: SomeException) -> return ())
 
-
 type Map = Map.HashMap
 
-newtype Time = Time Int
-    deriving (Eq,Ord,Show)
 
-incTime (Time i) = Time $ i + 1
+---------------------------------------------------------------------
+-- UTILITY TYPES
 
+newtype Step = Step Int deriving (Eq,Ord,Show)
 
+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
+
+
+---------------------------------------------------------------------
+-- CENTRAL TYPES
+
+type Trace = (String, Time, Time)
+
+
 -- | Invariant: The database does not have any cycles when a Key depends on itself
 data Database = Database
-    {status :: Var (Map Key Status)
-    ,timestamp :: Time
+    {lock :: Lock
+    ,status :: IORef (Map Key Status)
+    ,step :: Step
     ,journal :: Journal
     ,filename :: FilePath
     ,version :: Int -- user supplied version
+    ,logger :: String -> IO () -- logging function
     }
 
-data Info = Info
+data Status
+    = Ready Result -- I have a value
+    | Error SomeException -- I have been run and raised an error
+    | Loaded Result -- Loaded from the database
+    | Dirty (Maybe Result) -- One of my dependents is in Error or Dirty
+    | Checking Pending Result -- Currently checking if I am valid
+    | Building Pending (Maybe Result) -- Currently building
+      deriving Show
+
+data Result = Result
     {value :: Value -- the value associated with the Key
-    ,built :: Time -- the timestamp for deciding if it's valid
-    ,changed :: Time -- when it was actually run
+    ,built :: Step -- when it was actually run
+    ,changed :: Step -- the step for deciding if it's valid
     ,depends :: [[Key]] -- dependencies
-    ,execution :: Double -- how long it took when it was last run (seconds)
-    ,traces :: [(String, Double, Double)] -- a trace of the expensive operations (start/end in seconds since beginning of run)
-    }
-    deriving Show
+    ,execution :: Duration -- how long it took when it was last run (seconds)
+    ,traces :: [Trace] -- a trace of the expensive operations (start/end in seconds since beginning of run)
+    } deriving Show
 
+newtype Pending = Pending (IORef (IO ()))
+    -- you must run this action when you finish, while holding DB lock
+    -- after you have set the result to Error, Ready or Dirty (checking only)
 
-data Status
-    = Building Barrier (Maybe Info)
-    | Built  Info
-    | Loaded Info
-      deriving Show
+addPending :: Pending -> IO () -> IO ()
+addPending (Pending p) act = modifyIORef p (>> act)
 
-getInfo :: Status -> Maybe Info
-getInfo (Built i) = Just i
-getInfo (Loaded i) = Just i
-getInfo (Building _ i) = i
+instance Show Pending where show _ = "Pending"
 
 
+getResult :: Status -> Maybe Result
+getResult (Ready r) = Just r
+getResult (Loaded r) = Just r
+getResult (Checking _ r) = Just r
+getResult (Dirty r) = r
+getResult (Building _ r) = r
+getResult _ = Nothing
+
+getPending :: Status -> Maybe Pending
+getPending (Checking p _) = Just p
+getPending (Building p _) = Just p
+getPending _ = Nothing
+
+
 ---------------------------------------------------------------------
 -- OPERATIONS
 
-data Response
-    = Execute [Key] -- you need to execute these keys and call finished at least once before calling request again
-    | Block ([Key], IO ()) -- you need to block on at least one of these barriers before calling request again
-    | Response [Value] -- actual result values, do not call request again
-
-data Response_ = Response_
-    {execute :: [Key]
-    ,barriers :: [(Key,Barrier)]
-    ,values :: [(Time,Value)]
+data Ops = Ops
+    {valid :: Key -> Value -> IO Bool
+        -- ^ Given a Key and a Value from the database, check it still matches the value stored on disk
+    ,exec :: [Key] -> Key -> IO (Either SomeException (Value, [[Key]], Duration, [Trace]))
+        -- ^ Given a chunk of stack (bottom element first), and a key, either raise an exception or successfully build it
     }
 
-concatResponse :: [Response_] -> Response_
-concatResponse xs = Response_ (concatMap execute xs) (concatMap barriers xs) (concatMap values xs)
 
-toResponse :: Response_ -> Response
-toResponse Response_{..}
-    | not $ null execute = Execute execute
-    | not $ null barriers = Block $ second waitAnyBarrier $ unzip barriers
-    | otherwise = Response $ map snd values
+-- | Return either an exception (crash), or (how much time you spent waiting, the value)
+eval :: Pool -> Database -> Ops -> [Key] -> IO (Either SomeException (Duration,[Value]))
+eval pool Database{..} Ops{..} ks =
+    join $ withLock lock $ do
+        vs <- mapM (evalRECB []) ks
+        let errs = [e | Error e <- vs]
+        if all isReady vs then
+            return $ return $ Right (0, [value r | Ready r <- vs])
+         else if not $ null errs then
+            return $ return $ Left $ head errs
+         else do
+            let cb = filter (isCheckingBuilding . snd) $ zip ks vs
+            wait <- newBarrier
+            todo <- newIORef $ Just $ length cb
+            forM_ cb $ \(k,v) -> do
+                let act = do
+                        t <- readIORef todo
+                        when (isJust t) $ do
+                            s <- readIORef status
+                            case Map.lookup k s of
+                                Just (Error e) -> do
+                                    writeIORef todo Nothing
+                                    signalBarrier wait $ Left e
+                                Just (Dirty r) -> do
+                                    Building p _ <- evalB [] k r
+                                    addPending p act -- try again
+                                Just (Building p _) ->
+                                    -- can only happen if two people are waiting on the same Dirty
+                                    -- the first gets kicked, and sets it to Building, meaning the second sees Building
+                                    -- very subtle!
+                                    addPending p act
+                                Just Ready{} | fromJust t == 1 -> do
+                                    writeIORef todo Nothing
+                                    signalBarrier wait $ Right [value r | k <- ks, let Ready r = fromJust $ Map.lookup k s]
+                                Just Ready{} ->
+                                    writeIORef todo $ fmap (subtract 1) t
+                addPending (fromJust $ getPending v) act
+            return $ do
+                (dur,res) <- duration $ blockPool pool $ waitBarrier wait
+                return $ case res of
+                    Left e -> Left e
+                    Right v -> Right (dur,v)
+    where
+        k #= v = do
+            s <- readIORef status
+            writeIORef status $ Map.insert k v s
+            let shw = head . words . show
+            logger $ maybe "Missing" shw (Map.lookup k s) ++ " -> " ++ shw v ++ ", " ++ show k
+            return v
 
+        isErrorDirty Error{} = True
+        isErrorDirty Dirty{} = True
+        isErrorDirty _ = False
 
--- The idea behind request is that we do as much as we can with a single lock, which reduces a clean
--- rebuild to an absolute minimum traversal in single-threaded fast-path code. We may pay more repeatedly
--- calling 'request', but the depth of the call graph is low so it shouldn't be an issue, and with additional
--- complexity it could be avoided.
-request :: Database -> (Key -> Value -> Bool) -> [Key] -> IO Response
-request Database{..} validStored ks =
-     modifyVar status $ \v -> do
-        (res, mp) <- S.runStateT (fmap concatResponse $ mapM f ks) v
-        return (mp, toResponse res)
-    where
-        f :: Key -> S.StateT (Map Key Status) IO Response_
-        f k = do
-            s <- S.get
-            case Map.lookup k s of
-                Nothing -> build k
-                Just (Building bar _) -> return $ Response_ [] [(k,bar)] []
-                Just (Built i) -> return $ Response_ [] [] [(changed i, value i)]
-                Just (Loaded i) ->
-                    if not $ validStored k (value i)
-                    then build k
-                    else validHistory k i (depends i)
+        isCheckingBuilding Checking{} = True
+        isCheckingBuilding Building{} = True
+        isCheckingBuilding _ = False
 
-        validHistory :: Key -> Info -> [[Key]] -> S.StateT (Map Key Status) IO Response_
-        validHistory k i [] = do
-            S.modify $ Map.insert k $ Built i
-            return $ Response_ [] [] [(changed i, value i)]
-        validHistory k i (x:xs) = do
-            r@Response_{..} <- fmap concatResponse $ mapM f x
-            if not $ null execute && null barriers then return r
-             else if all ((<= built i) . fst) values then validHistory k i xs
-             else build k
+        isReady Ready{} = True
+        isReady _ = False
 
-        build :: Key -> S.StateT (Map Key Status) IO Response_
-        build k = do
-            bar <- liftIO newBarrier
-            S.modify $ \mp ->
-                let info = case Map.lookup k mp of Nothing -> Nothing; Just (Loaded i) -> Just i
-                in Map.insert k (Building bar info) mp
-            return $ Response_ [k] [] []
+        -- Rules for each eval* function
+        -- * Must NOT lock
+        -- * Must have an equal return to what is stored in the db at that point
+        -- * Must return only one of the items in its suffix
 
 
-finished :: Database -> Key -> Value -> [[Key]] -> Double -> [(String,Double,Double)] -> IO ()
-finished Database{..} k v depends duration traces = do
-    let info = Info v timestamp timestamp depends duration traces
-    (info2, barrier) <- modifyVar status $ \mp -> return $
-        let Just (Building bar old) = Map.lookup k mp
-            info2 = if isJust old && value (fromJust old) == value info then info{changed=changed $ fromJust old} else info
-        in (Map.insert k (Built info2) mp, (info2, bar))
-    appendJournal journal k info2
-    releaseBarrier barrier
+        evalRECB :: [Key] -> Key -> IO Status
+        evalRECB stack k = do
+            res <- evalREDCB stack k
+            case res of
+                Dirty r -> evalB stack k r
+                res -> return res
 
 
+        evalB :: [Key] -> Key -> Maybe Result -> IO Status
+        evalB stack k r = do
+            pend <- newIORef (return ())
+            addPool pool $ do
+                res <- exec stack k
+                ans <- withLock lock $ do
+                    ans <- k #= case res of
+                        Left err -> Error err
+                        Right (v,depends,execution,traces) ->
+                            let c | Just r <- r, value r == v = changed r
+                                  | otherwise = step
+                            in Ready Result{value=v,changed=c,built=step,..}
+                    join $ readIORef pend
+                    return ans
+                case ans of
+                    Ready r -> appendJournal journal k r -- leave the DB lock before appending
+                    _ -> return ()
+            k #= Building (Pending pend) r
+
+
+        evalREDCB :: [Key] -> Key -> IO Status
+        evalREDCB stack k = do
+            s <- readIORef status
+            case Map.lookup k s of
+                Nothing -> evalB stack k Nothing
+                Just (Loaded r) -> do
+                    b <- valid k (value r)
+                    if not b then evalB stack k $ Just r else checkREDCB stack k r (depends r)
+                Just res -> return res
+
+
+        checkREDCB :: [Key] -> Key -> Result -> [[Key]] -> IO Status
+        checkREDCB stack k r [] =
+            k #= Ready r
+        checkREDCB stack k r (ds:rest) = do
+            vs <- mapM (evalREDCB (k:stack)) ds
+            let cb = filter (isCheckingBuilding . snd) $ zip ds vs
+            if any isErrorDirty vs then
+                k #= Dirty (Just r)
+             else if any (> built r) [changed | Ready Result{..} <- vs] then
+                evalB stack k $ Just r
+             else if null cb then
+                checkREDCB stack k r rest
+             else do
+                todo <- newIORef $ Just $ length cb -- how many to do
+                pend <- newIORef $ return ()
+                forM_ cb $ \(d,i) ->
+                    addPending (fromJust $ getPending i) $ do
+                        t <- readIORef todo
+                        when (isJust t) $ do
+                            s <- readIORef status
+                            case Map.lookup d s of
+                                Just v | isErrorDirty v -> do
+                                    writeIORef todo Nothing
+                                    k #= Dirty (Just r)
+                                    join $ readIORef pend
+                                Just (Ready r2)
+                                    | changed r2 > built r -> do
+                                        writeIORef todo Nothing
+                                        Building p _ <- evalB stack k $ Just r
+                                        addPending p $ join $ readIORef pend
+                                    | fromJust t == 1 -> do
+                                        writeIORef todo Nothing
+                                        res <- checkREDCB stack k r rest
+                                        case getPending res of
+                                            Nothing -> join $ readIORef pend
+                                            Just p -> addPending p $ join $ readIORef pend
+                                    | otherwise ->
+                                        writeIORef todo $ fmap (subtract 1) t
+                                Just (Building p _) -> do
+                                    writeIORef todo Nothing
+                                    addPending p $ join $ readIORef pend
+                k #= Checking (Pending pend) r
+
+
+---------------------------------------------------------------------
+-- QUERY DATABASE
+
 -- | Return a list of keys in an order which would build them bottom up. Relies on the invariant
 --   that the database is not cyclic.
 allEntries :: Database -> IO [(Key,Value)]
 allEntries Database{..} = do
-    status <- readVar status
-    return $ ordering [((k, value i), concat $ depends i) | (k,v) <- Map.toList status, Just i <- [getInfo v]]
+    status <- readIORef status
+    return $ ordering [((k, value i), concat $ depends i) | (k,v) <- Map.toList status, Just i <- [getResult v]]
     where
         ordering :: Eq a => [((a,b), [a])] -> [(a,b)]
         ordering xs = f [(a, nub b `intersect` as) | let as = map (fst . fst) xs, (a,b) <- xs]
@@ -184,16 +322,16 @@
 
 showJSON :: Database -> IO String
 showJSON Database{..} = do
-    status <- readVar status
+    status <- readIORef status
     let ids = Map.fromList $ zip (Map.keys status) [0..]
-        f (k, v) | Just Info{..} <- getInfo v =
+        f (k, v) | Just Result{..} <- getResult v =
             let xs = ["name:" ++ show (show k)
-                     ,"built:" ++ showTime built
-                     ,"changed:" ++ showTime changed
+                     ,"built:" ++ showStep built
+                     ,"changed:" ++ showStep changed
                      ,"depends:" ++ show (mapMaybe (`Map.lookup` ids) (concat depends))
                      ,"execution:" ++ show execution] ++
                      ["traces:[" ++ intercalate "," (map showTrace traces) ++ "]" | traces /= []]
-                showTime (Time i) = show i
+                showStep (Step i) = show i
                 showTrace (a,b,c) = "{start:" ++ show b ++ ",stop:" ++ show c ++ ",command:" ++ show a ++ "}"
             in  ["{" ++ intercalate ", " xs ++ "}"]
         f _ = []
@@ -203,51 +341,52 @@
 ---------------------------------------------------------------------
 -- DATABASE
 
-withDatabase :: FilePath -> Int -> (Database -> IO a) -> IO a
-withDatabase filename version = bracket (openDatabase filename version) closeDatabase
+withDatabase :: (String -> IO ()) -> FilePath -> Int -> (Database -> IO a) -> IO a
+withDatabase logger filename version = bracket (openDatabase logger filename version) closeDatabase
 
 
 -- Files are named based on the FilePath, but with different extensions,
 -- such as .database, .journal, .trace
-openDatabase :: FilePath -> Int -> IO Database
-openDatabase filename version = do
+openDatabase :: (String -> IO ()) -> FilePath -> Int -> IO Database
+openDatabase logger filename version = do
     let dbfile = filename <.> "database"
         jfile = filename <.> "journal"
 
-    (timestamp, status) <- readDatabase dbfile version
-    timestamp <- return $ incTime timestamp
+    lock <- newLock
+    (step, status) <- readDatabase dbfile version
+    step <- return $ incStep step
     
     b <- doesFileExist jfile
-    (status,timestamp) <- if not b then return (status,timestamp) else do
+    (status,step) <- if not b then return (status,step) else do
         status <- replayJournal jfile version status
         removeFile_ jfile
-        -- the journal potentially things at the current timestamp, so increment my timestamp
-        writeDatabase dbfile version timestamp status
-        return (status, incTime timestamp)
+        -- the journal potentially things at the current step, so increment my step
+        writeDatabase dbfile version step status
+        return (status, incStep step)
 
-    status <- newVar status
+    status <- newIORef status
     journal <- openJournal jfile version
     return Database{..}
 
 
 closeDatabase :: Database -> IO ()
 closeDatabase Database{..} = do
-    status <- readVar status
-    writeDatabase (filename <.> "database") version timestamp status
+    status <- readIORef status
+    writeDatabase (filename <.> "database") version step status
     closeJournal journal
 
 
-writeDatabase :: FilePath -> Int -> Time -> Map Key Status -> IO ()
-writeDatabase file version timestamp status = do
+writeDatabase :: FilePath -> Int -> Step -> Map Key Status -> IO ()
+writeDatabase file version step status = do
     ws <- currentWitness
     LBS.writeFile file $
-        (LBS.pack $ databaseVersion version) `LBS.append`
-        encode (timestamp, Witnessed ws $ Statuses status)
+        LBS.pack (databaseVersion version) `LBS.append`
+        encode (step, Witnessed ws $ Statuses status)
 
 
-readDatabase :: FilePath -> Int -> IO (Time, Map Key Status)
+readDatabase :: FilePath -> Int -> IO (Step, Map Key Status)
 readDatabase file version = do
-    let zero = (Time 1, Map.fromList [])
+    let zero = (Step 1, Map.fromList [])
     b <- doesFileExist file
     if not b
         then return zero
@@ -302,7 +441,7 @@
         return mp
 
 
-appendJournal :: Journal -> Key -> Info -> IO ()
+appendJournal :: Journal -> Key -> Result -> IO ()
 appendJournal Journal{..} k i = modifyVar_ handle $ \v -> case v of
     Nothing -> return Nothing
     Just h -> do
@@ -323,9 +462,9 @@
 ---------------------------------------------------------------------
 -- SERIALISATION
 
-instance Binary Time where
-    put (Time i) = put i
-    get = fmap Time get
+instance Binary Step where
+    put (Step i) = put i
+    get = fmap Step get
 
 
 data Witnessed a = Witnessed Witness a
@@ -339,18 +478,14 @@
 newtype Statuses = Statuses {fromStatuses :: Map Key Status}
 
 instance BinaryWith Witness Statuses where
-    putWith ws (Statuses x) = putWith ws [(k,i) | (k,v) <- Map.toList x, Just i <- [f v]]
-        where
-            f (Building _ i) = i
-            f (Built i) = Just i
-            f (Loaded i) = Just i
+    putWith ws (Statuses x) = putWith ws [(k,i) | (k,v) <- Map.toList x, Just i <- [getResult v]]
     getWith ws = do
         x <- getWith ws
         return $ Statuses $ Map.fromList $ map (second Loaded) x
 
-instance BinaryWith Witness Info where
-    putWith ws (Info x1 x2 x3 x4 x5 x6) = putWith ws x1 >> put x2 >> put x3 >> putWith ws x4 >> put x5 >> put x6
-    getWith ws = do x1 <- getWith ws; x2 <- get; x3 <- get; x4 <- getWith ws; x5 <- get; x6 <- get; return $ Info x1 x2 x3 x4 x5 x6
+instance BinaryWith Witness Result where
+    putWith ws (Result x1 x2 x3 x4 x5 x6) = putWith ws x1 >> put x2 >> put x3 >> putWith ws x4 >> put x5 >> put x6
+    getWith ws = do x1 <- getWith ws; x2 <- get; x3 <- get; x4 <- getWith ws; x5 <- get; x6 <- get; return $ Result x1 x2 x3 x4 x5 x6
 
 
 readFileVer :: FilePath -> String -> IO LBS.ByteString
diff --git a/Development/Shake/Derived.hs b/Development/Shake/Derived.hs
--- a/Development/Shake/Derived.hs
+++ b/Development/Shake/Derived.hs
@@ -3,9 +3,10 @@
 
 import Control.Monad
 import Control.Monad.IO.Class
-import System.Cmd
+import System.Process
 import System.Directory
 import System.Exit
+import qualified Data.ByteString.Char8 as BS
 
 import Development.Shake.Core
 import Development.Shake.File
@@ -19,11 +20,24 @@
     let path2 = toNative path
     let cmd = unwords $ path2 : args
     putLoud cmd
-    res <- traced ("system' " ++ cmd) $ rawSystem path2 args
+    res <- traced ("system " ++ cmd) $ rawSystem path2 args
     when (res /= ExitSuccess) $
         error $ "System command failed:\n" ++ cmd
 
+-- | Execute a system command, returning @(stdout,stderr)@.
+--   This function will raise an error if the exit code is non-zero.
+--   Before running 'systemOutput'' make sure you 'need' any required files.
+systemOutput :: FilePath -> [String] -> Action (String, String)
+systemOutput path args = do
+    let path2 = toNative path
+    let cmd = unwords $ path2 : args
+    putLoud cmd
+    (res,stdout,stderr) <- traced ("system' " ++ cmd) $ readProcessWithExitCode path2 args ""
+    when (res /= ExitSuccess) $
+        error $ "System command failed:\n" ++ cmd
+    return (stdout, stderr)
 
+
 -- | @copyFile old new@ copies the existing file from @old@ to @new@. The @old@ file is has 'need' called on it
 --   before copying the file.
 copyFile' :: FilePath -> FilePath -> Action ()
@@ -46,3 +60,13 @@
 -- | A version of 'writeFile'' which writes out a list of lines.
 writeFileLines :: FilePath -> [String] -> Action ()
 writeFileLines name = writeFile' name . unlines
+
+
+-- | Write a file, but only if the contents would change.
+writeFileChanged :: FilePath -> String -> Action ()
+writeFileChanged name x = liftIO $ do
+    b <- doesFileExist name
+    if not b then writeFile name x else do
+        orig <- BS.readFile name
+        let new = BS.pack x
+        when (orig /= new) $ BS.writeFile name new
diff --git a/Development/Shake/Directory.hs b/Development/Shake/Directory.hs
--- a/Development/Shake/Directory.hs
+++ b/Development/Shake/Directory.hs
@@ -66,11 +66,11 @@
 
 instance Rule Exist Bool where
     validStored (Exist x) b = fmap (== b) $ IO.doesFileExist x
-    invariant _ = True
+    -- invariant _ = True
 
 instance Rule GetDir GetDir_ where
     validStored x y = fmap (== y) $ getDir x
-    invariant _ = True
+    -- invariant _ = True
 
 
 -- | This function is not actually exported, but Haddock is buggy. Please ignore.
@@ -111,6 +111,6 @@
         validName = not . all (== '.')
 
         f GetDir{} xs = return xs
-        f GetDirFiles{} xs = flip filterM xs $ \s -> do
+        f GetDirFiles{} xs = flip filterM xs $ \s ->
             if not $ pat x ?== s then return False else IO.doesFileExist $ dir x </> s
         f GetDirDirs{} xs = flip filterM xs $ \s -> IO.doesDirectoryExist $ dir x </> s
diff --git a/Development/Shake/File.hs b/Development/Shake/File.hs
--- a/Development/Shake/File.hs
+++ b/Development/Shake/File.hs
@@ -7,14 +7,9 @@
     ) where
 
 import Control.DeepSeq
-import Control.Exception
-import Control.Monad
 import Control.Monad.IO.Class
 import Data.Binary
 import Data.Hashable
-import Data.List
-import Data.Maybe
-import Data.Monoid
 import Data.Typeable
 import System.Directory
 
@@ -23,7 +18,9 @@
 import Development.Shake.FilePattern
 import Development.Shake.FileTime
 
+infix 1 *>, ?>, **>
 
+
 newtype File = File FilePath
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
@@ -33,6 +30,7 @@
 instance Rule File FileTime where
     validStored (File x) t = fmap (== Just t) $ getModTimeMaybe x
 
+{-
     observed act = do
         src <- getCurrentDirectory
         old <- listDir src
@@ -84,7 +82,7 @@
             | x1 <  y1  = (x1,Just x2,Nothing):zips xs ((y1,y2):ys)
             | otherwise = (y1,Nothing,Just y2):zips ((x1,x2):xs) ys
         zips xs ys = [(a,Just b,Nothing) | (a,b) <- xs] ++ [(a,Nothing,Just b) | (a,b) <- ys]
-
+-}
 
 
 -- | This function is not actually exported, but Haddock is buggy. Please ignore.
diff --git a/Development/Shake/FilePath.hs b/Development/Shake/FilePath.hs
--- a/Development/Shake/FilePath.hs
+++ b/Development/Shake/FilePath.hs
@@ -13,8 +13,9 @@
     toNative, (</>), combine,
     ) where
 
-import System.FilePath.Posix hiding (isPathSeparator, normalise, (</>), combine)
+import System.FilePath.Posix hiding (normalise, (</>), combine)
 import qualified System.FilePath as Native
+import Data.List
 
 
 -- | Drop the first directory from a 'FilePath'. Should only be used on
@@ -38,11 +39,22 @@
 takeDirectory1 = takeWhile (not . Native.isPathSeparator)
 
 
--- | Normalise a 'FilePath', translating any path separators to @\/@.
+-- | Normalise a 'FilePath', applying the standard 'FilePath' normalisation, plus
+--   translating any path separators to @\/@ and removing @foo\/..@ components where possible.
 normalise :: FilePath -> FilePath
-normalise = map (\x -> if Native.isPathSeparator x then '/' else x)
+normalise = intercalate "/" . dropDots . split . Native.normalise
+    where
+        dropDots = reverse . f 0 . reverse
+            where
+                f i ("..":xs) = f (i+1) xs
+                f 0 (x:xs) = x : f 0 xs
+                f i (x:xs) = f (i-1) xs
+                f i [] = replicate i ".."
 
+        split xs = a : if null b then [] else split $ tail b
+            where (a,b) = break Native.isPathSeparator xs
 
+
 -- | Convert to native path separators, namely @\\@ on Windows. 
 toNative :: FilePath -> FilePath
 toNative = map (\x -> if Native.isPathSeparator x then Native.pathSeparator else x)
@@ -60,6 +72,7 @@
 -- > combine "aaa/bbb" "./ccc" == "aaa/bbb/ccc"
 -- > combine "aaa/bbb" "../ccc" == "aaa/ccc"
 combine :: FilePath -> FilePath -> FilePath
+combine "." y = y
 combine x ('.':'.':'/':y) = combine (takeDirectory x) y
 combine x ('.':'/':y) = combine x y
 combine x y = normalise $ Native.combine (toNative x) (toNative y)
diff --git a/Development/Shake/FilePattern.hs b/Development/Shake/FilePattern.hs
--- a/Development/Shake/FilePattern.hs
+++ b/Development/Shake/FilePattern.hs
@@ -62,7 +62,7 @@
         f [] [] = [[]]
         f _ _ = []
 
-        rest p xs = [(skip:res) | (skip,keep) <- xs, res <- f p keep]
+        rest p xs = [skip:res | (skip,keep) <- xs, res <- f p keep]
 
 
 -- | Given the result of 'extract', substitute it back in to a 'compatible' pattern.
diff --git a/Development/Shake/FileTime.hs b/Development/Shake/FileTime.hs
--- a/Development/Shake/FileTime.hs
+++ b/Development/Shake/FileTime.hs
@@ -1,18 +1,17 @@
 {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
 
 module Development.Shake.FileTime(
-    FileTime, sleepFileTime,
-    getModTime, getModTimeError, getModTimeMaybe,
-    getAccTime
+    FileTime,
+    getModTimeError, getModTimeMaybe
     ) where
 
-import Control.Concurrent(threadDelay)
 import Control.DeepSeq
 import Data.Binary
 import Data.Hashable
 import Data.Typeable
 import System.Directory
-import System.Directory.AccessTime
+import System.IO.Error
+import Control.Exception
 import System.Time
 
 
@@ -21,16 +20,16 @@
 
 
 getModTimeMaybe :: FilePath -> IO (Maybe FileTime)
-getModTimeMaybe x = do
-    b <- doesFileExist x
-    if b then fmap Just $ getModTime x else return Nothing
+getModTimeMaybe x =
+    fmap Just (getModTime x) `Control.Exception.catch` \e ->
+        if isDoesNotExistError e then return Nothing else ioError e
 
 
 getModTimeError :: String -> FilePath -> IO FileTime
 getModTimeError msg x = do
     res <- getModTimeMaybe x
     case res of
-        -- Important to raise an error in IO, not return a value which will error later
+        -- Make sure you raise an error in IO, not return a value which will error later
         Nothing -> error $ msg ++ "\n" ++ x
         Just x -> return x
 
@@ -39,14 +38,3 @@
 getModTime x = do
     TOD t _ <- getModificationTime x
     return $ FileTime $ fromIntegral t
-
-
-getAccTime :: FilePath -> IO FileTime
-getAccTime x = do
-    TOD t _ <- getAccessTime x
-    return $ FileTime $ fromIntegral t
-
-
--- | Sleep long enough for the modification time resolution to catch up
-sleepFileTime :: IO ()
-sleepFileTime = threadDelay 1000000 -- 1 second
diff --git a/Development/Shake/Files.hs b/Development/Shake/Files.hs
--- a/Development/Shake/Files.hs
+++ b/Development/Shake/Files.hs
@@ -16,7 +16,9 @@
 import Development.Shake.FilePattern
 import Development.Shake.FileTime
 
+infix 1 *>>
 
+
 newtype Files = Files [FilePath]
     deriving (Typeable,Eq,Hashable,Binary,NFData)
 
@@ -47,7 +49,7 @@
         "All patterns to *>> must have the same number and position of // and * wildcards\n" ++
         unwords ps
     | otherwise = do
-        forM ps $ \p ->
+        forM_ ps $ \p ->
             p *> \file -> do
                 apply1 $ Files $ map (substitute $ extract p file) ps :: Action FileTimes
                 return ()
diff --git a/Development/Shake/Locks.hs b/Development/Shake/Locks.hs
--- a/Development/Shake/Locks.hs
+++ b/Development/Shake/Locks.hs
@@ -1,15 +1,28 @@
 
 module Development.Shake.Locks(
+    Lock, newLock, withLock,
     Var, newVar, readVar, modifyVar, modifyVar_,
-    Barrier, newBarrier, releaseBarrier, waitBarrier, waitAnyBarrier
+    Barrier, newBarrier, signalBarrier, waitBarrier,
     ) where
 
 import Control.Concurrent
-import Control.Monad
-import Data.IORef
 
 
 ---------------------------------------------------------------------
+-- 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
@@ -32,39 +45,15 @@
 ---------------------------------------------------------------------
 -- BARRIER
 
--- Either Nothing to indicate it has been released already,
--- or Just the list of actions to run when released
-newtype Barrier = Barrier (IORef (Maybe [IO ()]))
-instance Show Barrier where show _ = "Barrier"
-
-newBarrier :: IO Barrier
-newBarrier = fmap Barrier $ newIORef $ Just []
-
-
-releaseBarrier :: Barrier -> IO ()
-releaseBarrier (Barrier v) = do
-    xs <- atomicModifyIORef v $ \v -> (Nothing, v)
-    sequence_ $ maybe [] reverse xs
-
+-- | Starts out empty, then is filled exactly once
+newtype Barrier a = Barrier (MVar a)
+instance Show (Barrier a) where show _ = "Barrier"
 
-waitBarrier :: Barrier -> IO ()
-waitBarrier (Barrier v) = do
-    i <- newEmptyMVar
-    b <- atomicModifyIORef v $ \v -> case v of
-        Nothing -> (Nothing, False)
-        Just xs -> (Just $ putMVar i ():xs, True)
-    when b $ takeMVar i
+newBarrier :: IO (Barrier a)
+newBarrier = fmap Barrier newEmptyMVar
 
+signalBarrier :: Barrier a -> a -> IO ()
+signalBarrier (Barrier x) = putMVar x
 
-waitAnyBarrier :: [Barrier] -> IO ()
-waitAnyBarrier bs = do
-    i <- newEmptyMVar 
-    ref <- newIORef True
-    let f = do
-            b <- atomicModifyIORef ref $ \x -> (False,x)
-            when b $ putMVar i ()
-    b <- fmap and $ forM bs $ \(Barrier v) ->
-        atomicModifyIORef v $ \v -> case v of
-            Nothing -> (Nothing, False)
-            Just xs -> (Just $ f:xs, True)
-    when b $ takeMVar i
+waitBarrier :: Barrier a -> IO a
+waitBarrier (Barrier x) = readMVar x
diff --git a/Development/Shake/Oracle.hs b/Development/Shake/Oracle.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Oracle.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}
+
+module Development.Shake.Oracle(
+    addOracle, askOracle
+    ) where
+
+import Control.DeepSeq
+import Data.Binary
+import Data.Hashable
+import Data.Typeable
+
+import Development.Shake.Core
+
+
+newtype Question = Question [String]
+    deriving (Typeable,Eq,Hashable,Binary,NFData)
+newtype Answer = Answer [String]
+    deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
+
+instance Show Question where
+    show (Question xs) = "Oracle " ++ unwords xs
+
+instance Rule Question Answer where
+    validStored _ _ = return False
+
+
+-- | Add extra information which your build should depend on. For example:
+--
+-- > addOracle ["ghc"] $ return ["7.2.1"]
+-- > addOracle ["ghc-pkg","shake"] $ return ["1.0"]
+--
+--   If a rule depends on the GHC version, it can then use @'getOracle' ["ghc"]@, and
+--   if the GHC version changes, the rule will rebuild. It is common for the value returned
+--   by 'askOracle' to be ignored.
+--
+--   The Oracle maps questions of @[String]@ and answers of @[String]@. This type is a
+--   compromise. Questions will often be the singleton list, but allowing a list of strings
+--   there is more flexibility for heirarchical schemes and grouping - i.e. to have
+--   @ghc-pkg shake@, @ghc-pkg base@ etc. The answers are often singleton lists, but
+--   sometimes are used as sets - for example the list of packages returned by @ghc-pkg@.
+--
+--   Actions passed to 'addOracle' will be run in every Shake execution they are required,
+--   there value will not be kept between runs. To get a similar behaviour using files, see
+--   'alwaysRerun'.
+addOracle :: [String] -> Action [String] -> Rules ()
+addOracle question act = rule $ \(Question q) ->
+    if q == question then Just $ fmap Answer act else Nothing
+
+
+-- | Get information previously added with 'addOracle'.
+askOracle :: [String] -> Action [String]
+askOracle question = do Answer answer <- apply1 $ Question question; return answer
diff --git a/Development/Shake/Pool.hs b/Development/Shake/Pool.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Pool.hs
@@ -0,0 +1,113 @@
+
+-- | Thread pool implementation.
+module Development.Shake.Pool(Pool, addPool, blockPool, runPool) where
+
+import Control.Concurrent
+import Control.Exception hiding (blocked)
+import Development.Shake.Locks
+import qualified Data.HashSet as Set
+
+
+---------------------------------------------------------------------
+-- SUPER QUEUE
+
+-- FIXME: The super queue should use randomness for the normal priority pile
+
+data SuperQueue a = SuperQueue [a] [a]
+
+newSuperQueue :: SuperQueue a
+newSuperQueue = SuperQueue [] []
+
+enqueuePriority :: a -> SuperQueue a -> SuperQueue a
+enqueuePriority x (SuperQueue p n) = SuperQueue (x:p) n
+
+enqueue :: a -> SuperQueue a -> SuperQueue a
+enqueue x (SuperQueue p n) = SuperQueue p (x:n)
+
+dequeue :: SuperQueue a -> Maybe (a, SuperQueue a)
+dequeue (SuperQueue (p:ps) ns) = Just (p, SuperQueue ps ns)
+dequeue (SuperQueue [] (n:ns)) = Just (n, SuperQueue [] ns)
+dequeue (SuperQueue [] []) = Nothing
+
+
+---------------------------------------------------------------------
+-- THREAD POOL
+
+{-
+Must keep a list of active threads, so can raise exceptions in a timely manner
+Must spawn a fresh thread to do blockPool
+If any worker throws an exception, must signal to all the other workers
+-}
+
+data Pool = Pool Int (Var (Maybe S)) (Barrier (Maybe SomeException))
+
+data S = S
+    {threads :: Set.HashSet ThreadId
+    ,working :: Int -- threads which are actively working
+    ,blocked :: Int -- threads which are blocked
+    ,todo :: SuperQueue (IO ())
+    }
+
+
+emptyS :: S
+emptyS = S Set.empty 0 0 newSuperQueue
+
+
+-- | Given a pool, and a function that breaks the S invariants, restore them
+--   They are only allowed to touch working or todo
+step :: Pool -> (S -> S) -> IO ()
+step pool@(Pool n var done) op = do
+    let onVar act = modifyVar_ var $ maybe (return Nothing) act
+    onVar $ \s -> do
+        s <- return $ op s
+        case dequeue (todo s) of
+            Just (now, todo2) | working s < n -> do
+                -- spawn a new worker
+                t <- forkIO $ do
+                    t <- myThreadId
+                    res <- try now
+                    case res of
+                        Left e -> onVar $ \s -> do
+                            mapM_ killThread $ Set.toList $ Set.delete t $ threads s
+                            signalBarrier done $ Just e
+                            return Nothing
+                        Right _ -> step pool $ \s -> 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}
+            Nothing | working s == 0 && blocked s == 0 -> do
+                signalBarrier done Nothing
+                return Nothing
+            _ -> return $ Just s
+
+
+-- | Add a new task to the pool
+addPool :: Pool -> IO a -> IO ()
+addPool pool act = step pool $ \s -> s{todo = enqueue (act >> return ()) (todo s)}
+
+
+-- | A blocking action is being run while on the pool, yeild your thread.
+--   Should only be called by an action under addPool.
+blockPool :: Pool -> IO a -> IO a
+blockPool pool act = do
+    step pool $ \s -> s{working = working s - 1, blocked = blocked s + 1}
+    res <- act
+    var <- newBarrier
+    let act = do
+            step pool $ \s -> s{working = working s + 1, blocked = blocked s - 1}
+            signalBarrier var ()
+    step pool $ \s -> s{todo = enqueuePriority act $ todo s}
+    waitBarrier var
+    return res
+
+
+-- | Run all the tasks in the pool on the given number of works.
+--   If any thread throws an exception, the exception will be reraised.
+runPool :: Int -> (Pool -> IO ()) -> IO () -- run all tasks in the pool
+runPool n act = do
+    s <- newVar $ Just emptyS
+    res <- newBarrier
+    let pool = Pool n s res
+    addPool pool $ act pool
+    res <- waitBarrier res
+    case res of
+        Nothing -> return ()
+        Just e -> throw e
diff --git a/Development/Shake/Rerun.hs b/Development/Shake/Rerun.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Rerun.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}
+
+module Development.Shake.Rerun(
+    defaultRuleRerun, alwaysRerun
+    ) where
+
+import Control.DeepSeq
+import Data.Binary
+import Data.Hashable
+import Data.Typeable
+
+import Development.Shake.Core
+
+
+newtype AlwaysRerun = AlwaysRerun ()
+    deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
+
+newtype Dirty = Dirty ()
+    deriving (Show,Typeable,Hashable,Binary,NFData)
+instance Eq Dirty where a == b = False
+
+instance Rule AlwaysRerun Dirty where
+    validStored _ _ = return False
+
+
+-- | Always rerun the associated action. Useful for defining rules that query
+--   the environment. For example:
+--
+-- > "ghcVersion.txt" *> \out -> do
+-- >     alwaysRerun
+-- >     (stdout,_) <- systemOutput' "ghc" ["--version"]
+-- >     writeFile' out stdout
+alwaysRerun :: Action ()
+alwaysRerun = do Dirty _ <- apply1 $ AlwaysRerun (); return ()
+
+defaultRuleRerun :: Rules ()
+defaultRuleRerun = defaultRule $ \AlwaysRerun{} -> Just $ return $ Dirty ()
diff --git a/Examples/Self/Main.hs b/Examples/Self/Main.hs
--- a/Examples/Self/Main.hs
+++ b/Examples/Self/Main.hs
@@ -12,17 +12,20 @@
 
 main :: IO ()
 main = shaken noTest $ \args obj -> do
-    let pkgs = "transformers binary unordered-containers parallel-io filepath directory process access-time deepseq"
-        flags = map ("-package=" ++) $ words pkgs
-
     let moduleToFile ext xs = map (\x -> if x == '.' then '/' else x) xs <.> ext
     want $ if null args then [obj "Main.exe"] else args
 
+    let ghc args = do
+            -- since ghc-pkg includes the ghc package, it changes if the version does
+            askOracle ["ghc-pkg"]
+            flags <- askOracle ["ghc-flags"]
+            system' "ghc" $ args ++ flags
+
     obj "/*.exe" *> \out -> do
         src <- readFileLines $ replaceExtension out "deps"
         let os = map (obj . moduleToFile "o") $ "Main":src
         need os
-        system' "ghc" $ ["-o",out] ++ os ++ flags
+        ghc $ ["-o",out] ++ os
 
     obj "/*.deps" *> \out -> do
         dep <- readFileLines $ replaceExtension out "dep"
@@ -44,9 +47,31 @@
         dep <- readFileLines $ replaceExtension out "dep"
         let hs = unobj $ replaceExtension out "hs"
         need $ hs : map (obj . moduleToFile "hi") dep
-        system' "ghc" $ ["-c",hs,"-odir=output/self","-hidir=output/self","-i=output/self"] ++ flags
+        ghc ["-c",hs,"-hide-all-packages","-odir=output/self","-hidir=output/self","-i=output/self"]
 
+    obj ".pkgs" *> \out -> do
+        src <- readFile' "shake.cabal"
+        writeFileLines out $ sort $ cabalBuildDepends src
 
+    addOracle ["ghc-pkg"] $ do
+        (out,_) <- systemOutput "ghc-pkg" ["list","--simple-output"]
+        return $ words out
+
+    addOracle ["ghc-flags"] $ do
+        pkgs <- readFileLines $ obj ".pkgs"
+        return $ map ("-package=" ++) pkgs
+
+
+---------------------------------------------------------------------
+-- GRAB INFORMATION FROM FILES
+
 hsImports :: String -> [String]
 hsImports xs = [ takeWhile (\x -> isAlphaNum x || x `elem` "._") $ dropWhile (not . isUpper) x
                | x <- lines xs, "import " `isPrefixOf` x]
+
+
+-- FIXME: Should actually parse the list from the contents of the .cabal file
+cabalBuildDepends :: String -> [String]
+cabalBuildDepends _ = words $
+    "base transformers binary unordered-containers hashable time old-time bytestring " ++
+    "filepath directory process deepseq"
diff --git a/Examples/Test/Basic1.hs b/Examples/Test/Basic1.hs
--- a/Examples/Test/Basic1.hs
+++ b/Examples/Test/Basic1.hs
@@ -3,7 +3,9 @@
 
 import Development.Shake
 import Examples.Util
+import System.Directory
 
+
 main = shaken test $ \args obj -> do
     want $ map obj args
     obj "AB.txt" *> \out -> do
@@ -53,3 +55,7 @@
     build ["once.txt","twice.txt"]
     assertContents (obj "twice.txt") "zzz"
     assertContents (obj "once.txt") "zzz"
+
+    removeFile $ obj "twice.txt"
+    build ["twice.txt"]
+    assertContents (obj "twice.txt") "zzz"
diff --git a/Examples/Test/Errors.hs b/Examples/Test/Errors.hs
--- a/Examples/Test/Errors.hs
+++ b/Examples/Test/Errors.hs
@@ -7,6 +7,7 @@
 import Control.Exception hiding (assert)
 import Control.Monad
 import Data.List
+import System.Directory as IO
 
 
 main = shaken test $ \args obj -> do
@@ -28,7 +29,12 @@
     obj "stack2" *> \_ -> need [obj "stack3"]
     obj "stack3" *> \_ -> error "crash"
 
+    obj "staunch1" *> \out -> do
+        liftIO $ sleep 0.1
+        writeFile' out "test"
+    obj "staunch2" *> \_ -> error "crash"
 
+
 test build obj = do
     let crash args parts = do
             res <- try $ build args
@@ -42,3 +48,12 @@
     crash ["recursive"] ["recursive"]
     crash ["systemcmd"] ["systemcmd","random_missing_command"]
     crash ["stack1"] ["stack1","stack2","stack3","crash"]
+
+    b <- IO.doesFileExist $ obj "staunch1"
+    when b $ removeFile $ obj "staunch1"
+    crash ["staunch1","staunch2","--threads2"] ["crash"]
+    b <- IO.doesFileExist $ obj "staunch1"
+    assert (not b) "File should not exist, should have crashed first"
+    crash ["staunch1","staunch2","--threads2","--staunch"] ["crash"]
+    b <- IO.doesFileExist $ obj "staunch1"
+    assert b "File should exist, staunch should have let it be created"
diff --git a/Examples/Test/FilePath.hs b/Examples/Test/FilePath.hs
new file mode 100644
--- /dev/null
+++ b/Examples/Test/FilePath.hs
@@ -0,0 +1,17 @@
+
+module Examples.Test.FilePath(main) where
+
+import Development.Shake.FilePath
+import Examples.Util
+
+
+main = shaken test $ \args obj -> return ()
+
+
+test build obj = do
+    normalise "neil//./test/moo/../bar/bob/../foo" === "neil/test/bar/foo"
+    normalise "bar/foo" === "bar/foo"
+    normalise "bar/foo/" === "bar/foo/"
+    normalise "../../foo" === "../../foo"
+    normalise "foo/bar/../../neil" === "neil"
+    normalise "foo/../bar/../neil" === "neil"
diff --git a/Examples/Test/Pool.hs b/Examples/Test/Pool.hs
new file mode 100644
--- /dev/null
+++ b/Examples/Test/Pool.hs
@@ -0,0 +1,64 @@
+
+module Examples.Test.Pool(main) where
+
+import Examples.Util
+import Development.Shake.Pool
+
+import Control.Concurrent
+import Control.Exception hiding (assert)
+import Control.Monad
+
+
+main = shaken test $ \args obj -> return ()
+
+
+test build obj = do
+    let wait = sleep 0.01
+
+    -- check that it aims for exactly the limit
+    forM_ [1..6] $ \n -> do
+        var <- newMVar (0,0) -- (maximum, current)
+        runPool n $ \pool ->
+            forM_ [1..5] $ \i ->
+                addPool pool $ do
+                    modifyMVar_ var $ \(mx,now) -> return (max (now+1) mx, now+1)
+                    wait
+                    modifyMVar_ var $ \(mx,now) -> return (mx,now-1)
+        res <- takeMVar var
+        res === (min n 5, 0)
+
+    -- check that exceptions are immediate
+    self <- myThreadId
+    handle (\(ErrorCall msg) -> msg === "pass") $
+        runPool 3 $ \pool -> do
+            addPool pool $ do
+                wait
+                error "pass"
+            addPool pool $ do
+                wait >> wait
+                throwTo self $ ErrorCall "fail" 
+    wait >> wait -- give chance for a delayed exception
+
+    -- check blocking works
+    done <- newMVar False
+    runPool 1 $ \pool -> do
+        var <- newEmptyMVar
+        addPool pool $ do
+            addPool pool $ do
+                wait
+                putMVar var ()
+            blockPool pool $ takeMVar var
+            modifyMVar_ done $ const $ return True
+    done <- readMVar done
+    assert done "Blocking works"
+
+    -- check someone spawned when at zero todo still gets run
+    done <- newMVar False
+    runPool 1 $ \pool ->
+        addPool pool $ do
+            wait
+            addPool pool $ do
+                wait
+                modifyMVar_ done $ const $ return True
+    done <- readMVar done
+    assert done "Waiting on someone works"
diff --git a/Examples/Util.hs b/Examples/Util.hs
--- a/Examples/Util.hs
+++ b/Examples/Util.hs
@@ -1,11 +1,12 @@
 
-module Examples.Util(module Examples.Util, sleepFileTime) where
+module Examples.Util(module Examples.Util) where
 
 import Development.Shake
 import Development.Shake.FilePath
-import Development.Shake.FileTime
 
+import Control.Concurrent
 import Control.Monad
+import Data.List
 import System.Directory as IO
 import System.Environment
 
@@ -23,7 +24,9 @@
         "test":_ -> do
             putStrLn $ "## TESTING " ++ name
             test (\args -> withArgs (name:args) $ shaken test rules) (out++)
+            putStrLn $ "## FINISHED TESTING " ++ name
         "clean":_ -> removeDirectoryRecursive out
+{-
         "lint":args -> do
             let dbfile = out ++ ".database"
                 tempfile = "output/" ++ name ++ ".database"
@@ -33,9 +36,33 @@
             createDirectoryIfMissing True out
             when b $ renameFile tempfile dbfile
             shake shakeOptions{shakeFiles=out, shakeLint=True} $ rules args (out++)
-        _ -> shake shakeOptions{shakeFiles=out, shakeDump=True} $ rules args (out++)
+-}
+        args -> do
+            (flags,args) <- return $ partition ("-" `isPrefixOf`) args
+            let f o x = let x2 = dropWhile (== '-') x in case lookup x2 flagList of
+                    Just op -> op o
+                    Nothing | "threads" `isPrefixOf` x2 -> o{shakeThreads=read $ drop 7 x2}
+                            | otherwise -> error $ "Don't know how to deal with flag: " ++ x
+            let opts = foldl' f shakeOptions{shakeFiles=out, shakeDump=True} flags
+            shake opts $ rules args (out++)
 
 
+flags :: [String]
+flags = "threads#" : map fst flagList
+
+
+flagList :: [(String, ShakeOptions -> ShakeOptions)]
+flagList = let (*) = (,) in
+    ["no-dump" * \o -> o{shakeDump=False}
+    ,"silent" * \o -> o{shakeVerbosity=Silent}
+    ,"quiet" * \o -> o{shakeVerbosity=Quiet}
+    ,"normal" * \o -> o{shakeVerbosity=Normal}
+    ,"loud" * \o -> o{shakeVerbosity=Loud}
+    ,"diagnostic" * \o -> o{shakeVerbosity=Diagnostic}
+    ,"staunch" * \o -> o{shakeStaunch=True}
+    ]
+
+
 unobj :: FilePath -> FilePath
 unobj = dropDirectory1 . dropDirectory1
 
@@ -57,3 +84,13 @@
 noTest build obj = do
     build []
     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
+
diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -4,19 +4,23 @@
 import Data.Maybe
 import System.Environment
 
+import Examples.Util(flags)
 import qualified Examples.Tar.Main as Tar
 import qualified Examples.Self.Main as Self
 import qualified Examples.Test.Basic1 as Basic1
 import qualified Examples.Test.Directory as Directory
 import qualified Examples.Test.Errors as Errors
 import qualified Examples.Test.Files as Files
+import qualified Examples.Test.FilePath as FilePath
+import qualified Examples.Test.Pool as Pool
 
 
 fakes = ["clean" * clean, "test" * test]
     where (*) = (,)
 
 mains = ["tar" * Tar.main, "self" * Self.main
-        ,"basic1" * Basic1.main, "directory" * Directory.main, "errors" * Errors.main, "files" * Files.main]
+        ,"basic1" * Basic1.main, "directory" * Directory.main, "errors" * Errors.main
+        ,"filepath" * FilePath.main, "files" * Files.main, "pool" * Pool.main]
     where (*) = (,)
 
 
@@ -24,7 +28,18 @@
 main = do
     xs <- getArgs
     case flip lookup (fakes ++ mains) =<< listToMaybe xs of
-        Nothing -> error $ "Enter one of the examples: " ++ unwords (map fst $ fakes ++ mains)
+        Nothing -> putStrLn $ unlines
+            ["Welcome to the Shake demo"
+            ,""
+            ,unwords $ "Modes:" : map fst fakes
+            ,unwords $ "Demos:" : map fst mains
+            ,unwords $ "Flags:" : flags
+            ,""
+            ,"As an example, try:"
+            ,""
+            ,"  main self --threads2 --loud"
+            ,""
+            ,"Which will build Shake, using Shake, on 2 threads."]
         Just main -> main
 
 
diff --git a/shake.cabal b/shake.cabal
--- a/shake.cabal
+++ b/shake.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.6
 build-type:         Simple
 name:               shake
-version:            0.1.5
+version:            0.2
 license:            BSD3
 license-file:       LICENSE
 category:           Development
@@ -61,9 +61,7 @@
         unordered-containers,
         bytestring,
         time,
-        parallel-io,
         transformers == 0.2.*,
-        access-time == 0.1.*,
         deepseq >= 1.1 && < 1.3
 
     exposed-modules:
@@ -81,7 +79,10 @@
         Development.Shake.Files
         Development.Shake.FileTime
         Development.Shake.Locks
+        Development.Shake.Oracle
+        Development.Shake.Pool
         Development.Shake.TypeHash
+        Development.Shake.Rerun
         Development.Shake.Value
 
 executable shake
@@ -97,5 +98,7 @@
         Examples.Test.Basic1
         Examples.Test.Directory
         Examples.Test.Errors
+        Examples.Test.FilePath
         Examples.Test.Files
+        Examples.Test.Pool
         Examples.Tar.Main