src/Pure/Concurrent/task_queue.ML

--- a/src/Pure/Concurrent/task_queue.ML	Wed Feb 02 15:04:09 2011 +0100
+++ b/src/Pure/Concurrent/task_queue.ML	Wed Feb 02 17:26:07 2011 +0100
@@ -262,8 +262,7 @@
       |> fold (fn gid => Inttab.cons_list (gid, task)) (group_ancestry group);
     val jobs' = jobs
       |> Task_Graph.new_node (task, Job [job])
-      |> fold (add_job task) deps
-      |> fold (fold (add_job task) o get_deps jobs) deps;
+      |> fold (add_job task) deps;
     val minimal = null (get_deps jobs' task);
   in ((task, minimal), make_queue groups' jobs') end;
 
@@ -302,18 +301,35 @@
 
 fun dequeue_deps thread (Deps deps) (queue as Queue {groups, jobs}) =
   let
-    fun ready task = ready_job task (Task_Graph.get_entry jobs task);
-    val tasks = filter (can (Task_Graph.get_node jobs)) deps;
-    fun result (res as (task, _)) =
+    fun ready [] rest = (NONE, rev rest)
+      | ready (task :: tasks) rest =
+          (case try (Task_Graph.get_entry jobs) task of
+            NONE => ready tasks rest
+          | SOME entry =>
+              (case ready_job task entry of
+                NONE => ready tasks (task :: rest)
+              | some => (some, List.revAppend (rest, tasks))));
+
+    fun ready_dep _ [] = NONE
+      | ready_dep seen (task :: tasks) =
+          if member eq_task seen task then ready_dep seen tasks
+          else
+            let val entry as (_, (ds, _)) = Task_Graph.get_entry jobs task in
+              (case ready_job task entry of
+                NONE => ready_dep (task :: seen) (ds @ tasks)
+              | some => some)
+            end;
+
+    fun result (res as (task, _)) deps' =
       let val jobs' = set_job task (Running thread) jobs
-      in ((SOME res, Deps tasks), make_queue groups jobs') end;
+      in ((SOME res, Deps deps'), make_queue groups jobs') end;
   in
-    (case get_first ready tasks of
-      SOME res => result res
-    | NONE =>
-        (case get_first (get_first ready o get_deps jobs) tasks of
-          SOME res => result res
-        | NONE => ((NONE, Deps tasks), queue)))
+    (case ready deps [] of
+      (SOME res, deps') => result res deps'
+    | (NONE, deps') =>
+        (case ready_dep [] deps' of
+          SOME res => result res deps'
+        | NONE => ((NONE, Deps deps'), queue)))
   end;
 
 end;