parellel scheduling of node edits and execution;
authorwenzelm
Mon, 15 Aug 2011 21:05:30 +0200
changeset 450726429ab1b6883
parent 45071 ce0112e26b3b
child 45073 44c4ae5c5ce2
parellel scheduling of node edits and execution;
src/Pure/PIDE/document.ML
     1.1 --- a/src/Pure/PIDE/document.ML	Mon Aug 15 20:38:16 2011 +0200
     1.2 +++ b/src/Pure/PIDE/document.ML	Mon Aug 15 21:05:30 2011 +0200
     1.3 @@ -123,7 +123,6 @@
     1.4  
     1.5  fun nodes_of (Version nodes) = nodes;
     1.6  val node_of = get_node o nodes_of;
     1.7 -val node_names_of = Graph.keys o nodes_of;
     1.8  
     1.9  fun cycle_msg names = "Cyclic dependency of " ^ space_implode " via " (map quote names);
    1.10  
    1.11 @@ -324,19 +323,13 @@
    1.12      val _ = Time.now ();  (* FIXME odd workaround for polyml-5.4.0/x86_64 *)
    1.13      val new_version = fold edit_nodes edits old_version;
    1.14  
    1.15 -    (* FIXME futures *)
    1.16      val updates =
    1.17        nodes_of new_version |> Graph.schedule
    1.18          (fn deps => fn (name, node) =>
    1.19            (case first_entry NONE (is_changed (node_of old_version name)) node of
    1.20 -            NONE => (([], [], []), node)
    1.21 +            NONE => Future.value (([], [], []), node)
    1.22            | SOME ((prev, id), _) =>
    1.23                let
    1.24 -                val prev_exec =
    1.25 -                  (case prev of
    1.26 -                    NONE => no_id
    1.27 -                  | SOME prev_id => the_default no_id (the_entry node prev_id));
    1.28 -
    1.29                  fun init () =
    1.30                    let
    1.31                      val (thy_name, imports, uses) = Exn.release (get_header node);
    1.32 @@ -347,21 +340,32 @@
    1.33                      val parents =
    1.34                        imports |> map (fn import =>
    1.35                          (case AList.lookup (op =) deps import of
    1.36 -                          SOME (_, parent_node) =>
    1.37 -                            get_theory (Position.file_only (import ^ ".thy")) parent_node
    1.38 +                          SOME parent_future =>
    1.39 +                            get_theory (Position.file_only (import ^ ".thy"))
    1.40 +                              (#2 (Future.join parent_future))
    1.41                          | NONE => Thy_Info.get_theory (Thy_Info.base_name import)));
    1.42                    in Thy_Load.begin_theory dir thy_name imports files parents end
    1.43                  fun get_command id =
    1.44                    (id, the_command state id |> Future.map (Toplevel.modify_init init));
    1.45 -
    1.46 -                val (assigns, execs, result) =
    1.47 -                  fold_entries (SOME id) (new_exec o get_command o #2 o #1)
    1.48 -                    node ([], [], the_exec state prev_exec);
    1.49 -                val node' = node
    1.50 -                  |> fold update_entry assigns
    1.51 -                  |> set_result result;
    1.52 -              in ((assigns, execs, [(name, node')]), node') end))
    1.53 -      |> map #1;
    1.54 +              in
    1.55 +                singleton
    1.56 +                  (Future.forks {name = "Document.edit", group = NONE,
    1.57 +                    deps = map (Future.task_of o #2) deps, pri = 2, interrupts = false})
    1.58 +                  (fn () =>
    1.59 +                    let
    1.60 +                      val prev_exec =
    1.61 +                        (case prev of
    1.62 +                          NONE => no_id
    1.63 +                        | SOME prev_id => the_default no_id (the_entry node prev_id));
    1.64 +                      val (assigns, execs, result) =
    1.65 +                        fold_entries (SOME id) (new_exec o get_command o #2 o #1)
    1.66 +                          node ([], [], the_exec state prev_exec);
    1.67 +                      val node' = node
    1.68 +                        |> fold update_entry assigns
    1.69 +                        |> set_result result;
    1.70 +                    in ((assigns, execs, [(name, node')]), node') end)
    1.71 +              end))
    1.72 +      |> Future.join_results |> Exn.release_all |> map #1;
    1.73  
    1.74      val state' = state
    1.75        |> fold (fold define_exec o #2) updates
    1.76 @@ -382,13 +386,15 @@
    1.77        fun force_exec NONE = ()
    1.78          | force_exec (SOME exec_id) = ignore (Lazy.force (the_exec state exec_id));
    1.79  
    1.80 -      val execution' = (* FIXME Graph.schedule *)
    1.81 -        Future.forks
    1.82 -          {name = "Document.execute", group = NONE, deps = [], pri = 1, interrupts = true}
    1.83 -          [fn () =>
    1.84 -            node_names_of version |> List.app (fn name =>
    1.85 -              fold_entries NONE (fn (_, exec) => fn () => force_exec exec)
    1.86 -                  (node_of version name) ())];
    1.87 +      val execution' =
    1.88 +        nodes_of version |> Graph.schedule
    1.89 +          (fn deps => fn (name, node) =>
    1.90 +            singleton
    1.91 +              (Future.forks
    1.92 +                {name = "theory:" ^ name, group = NONE,
    1.93 +                  deps = map (Future.task_of o #2) deps,
    1.94 +                  pri = 1, interrupts = true})
    1.95 +              (fold_entries NONE (fn (_, exec) => fn () => force_exec exec) node));
    1.96  
    1.97      in (versions, commands, execs, execution') end);
    1.98