more formal type assign_update: avoid duplicate results and redundant update of global State.execs;
authorwenzelm
Tue Jul 09 17:58:38 2013 +0200 (2013-07-09 ago)
changeset 5256652a0eacf04d1
parent 52565 b04cbc49bdcf
child 52567 b6912471b8f5
more formal type assign_update: avoid duplicate results and redundant update of global State.execs;
src/Pure/PIDE/command.ML
src/Pure/PIDE/document.ML
src/Pure/PIDE/document.scala
     1.1 --- a/src/Pure/PIDE/command.ML	Tue Jul 09 16:32:51 2013 +0200
     1.2 +++ b/src/Pure/PIDE/command.ML	Tue Jul 09 17:58:38 2013 +0200
     1.3 @@ -13,7 +13,7 @@
     1.4    type print = {name: string, pri: int, exec_id: Document_ID.exec, print_process: print_process}
     1.5    type exec = eval * print list
     1.6    val no_exec: exec
     1.7 -  val exec_ids: exec -> Document_ID.exec list
     1.8 +  val exec_ids: exec option -> Document_ID.exec list
     1.9    val read: (unit -> theory) -> Token.T list -> Toplevel.transition
    1.10    val eval: (unit -> theory) -> Token.T list -> eval -> eval
    1.11    val print: string -> eval -> print list
    1.12 @@ -90,7 +90,8 @@
    1.13  type exec = eval * print list;
    1.14  val no_exec: exec = ({exec_id = Document_ID.none, eval_process = memo_value init_eval_state}, []);
    1.15  
    1.16 -fun exec_ids (({exec_id, ...}, prints): exec) = exec_id :: map #exec_id prints;
    1.17 +fun exec_ids (NONE: exec option) = []
    1.18 +  | exec_ids (SOME ({exec_id, ...}, prints)) = exec_id :: map #exec_id prints;
    1.19  
    1.20  
    1.21  (* read *)
     2.1 --- a/src/Pure/PIDE/document.ML	Tue Jul 09 16:32:51 2013 +0200
     2.2 +++ b/src/Pure/PIDE/document.ML	Tue Jul 09 17:58:38 2013 +0200
     2.3 @@ -108,6 +108,12 @@
     2.4  fun set_result result =
     2.5    map_node (fn (header, perspective, entries, _) => (header, perspective, entries, result));
     2.6  
     2.7 +fun changed_result node node' =
     2.8 +  (case (get_result node, get_result node') of
     2.9 +    (SOME eval, SOME eval') => #exec_id eval <> #exec_id eval'
    2.10 +  | (NONE, NONE) => false
    2.11 +  | _ => true);
    2.12 +
    2.13  fun finished_theory node =
    2.14    (case Exn.capture (Command.eval_result_state o the) (get_result node) of
    2.15      Exn.Res st => can (Toplevel.end_theory Position.none) st
    2.16 @@ -144,11 +150,9 @@
    2.17  fun the_default_entry node (SOME id) = (id, the_default Command.no_exec (the_entry node id))
    2.18    | the_default_entry _ NONE = (Document_ID.none, Command.no_exec);
    2.19  
    2.20 -fun update_entry id exec =
    2.21 -  map_entries (Entries.update (id, exec));
    2.22 -
    2.23 -fun reset_entry id node =
    2.24 -  if is_some (lookup_entry node id) then update_entry id NONE node else node;
    2.25 +fun assign_entry (command_id, exec) node =
    2.26 +  if is_none (Entries.lookup (get_entries node) command_id) then node
    2.27 +  else map_entries (Entries.update (command_id, exec)) node;
    2.28  
    2.29  fun reset_after id entries =
    2.30    (case Entries.get_after entries id of
    2.31 @@ -277,6 +281,9 @@
    2.32  
    2.33  end;
    2.34  
    2.35 +
    2.36 +(* remove_versions *)
    2.37 +
    2.38  fun remove_versions version_ids state = state |> map_state (fn (versions, _, execution) =>
    2.39    let
    2.40      val _ =
    2.41 @@ -327,6 +334,25 @@
    2.42  
    2.43  (** document update **)
    2.44  
    2.45 +(* exec state assignment *)
    2.46 +
    2.47 +type assign_update = Command.exec option Inttab.table;  (*command id -> exec*)
    2.48 +
    2.49 +val assign_update_empty: assign_update = Inttab.empty;
    2.50 +fun assign_update_null (tab: assign_update) = Inttab.is_empty tab;
    2.51 +fun assign_update_defined (tab: assign_update) command_id = Inttab.defined tab command_id;
    2.52 +fun assign_update_apply (tab: assign_update) node = Inttab.fold assign_entry tab node;
    2.53 +
    2.54 +fun assign_update_new upd (tab: assign_update) =
    2.55 +  Inttab.update_new upd tab
    2.56 +    handle Inttab.DUP dup => err_dup "exec state assignment" dup;
    2.57 +
    2.58 +fun assign_update_result (tab: assign_update) =
    2.59 +  Inttab.fold (fn (command_id, exec) => cons (command_id, Command.exec_ids exec)) tab [];
    2.60 +
    2.61 +
    2.62 +(* update *)
    2.63 +
    2.64  val timing = Unsynchronized.ref false;
    2.65  fun timeit msg e = cond_timeit (! timing) msg e;
    2.66  
    2.67 @@ -405,19 +431,22 @@
    2.68  
    2.69  fun illegal_init _ = error "Illegal theory header after end of theory";
    2.70  
    2.71 -fun new_exec state proper_init command_visible command_id' (execs, command_exec, init) =
    2.72 +fun new_exec state proper_init command_visible command_id' (assign_update, command_exec, init) =
    2.73    if not proper_init andalso is_none init then NONE
    2.74    else
    2.75      let
    2.76        val (_, (eval, _)) = command_exec;
    2.77        val (command_name, span) = the_command state command_id' ||> Lazy.force;
    2.78 -      val init' = if Keyword.is_theory_begin command_name then NONE else init;
    2.79 +
    2.80        val eval' = Command.eval (fn () => the_default illegal_init init span) span eval;
    2.81        val prints' = if command_visible then Command.print command_name eval' else [];
    2.82 -      val command_exec' = (command_id', (eval', prints'));
    2.83 -    in SOME (command_exec' :: execs, command_exec', init') end;
    2.84 +      val exec' = (eval', prints');
    2.85  
    2.86 -fun update_prints state node command_id =
    2.87 +      val assign_update' = assign_update_new (command_id', SOME exec') assign_update;
    2.88 +      val init' = if Keyword.is_theory_begin command_name then NONE else init;
    2.89 +    in SOME (assign_update', (command_id', (eval', prints')), init') end;
    2.90 +
    2.91 +fun update_prints state node command_id assign_update =
    2.92    (case the_entry node command_id of
    2.93      SOME (eval, prints) =>
    2.94        let
    2.95 @@ -429,10 +458,10 @@
    2.96                SOME print => if Command.stable_print print then print else new_print
    2.97              | NONE => new_print));
    2.98        in
    2.99 -        if eq_list (op = o pairself #exec_id) (prints, prints') then NONE
   2.100 -        else SOME (command_id, (eval, prints'))
   2.101 +        if eq_list (op = o pairself #exec_id) (prints, prints') then assign_update
   2.102 +        else assign_update_new (command_id, SOME (eval, prints')) assign_update
   2.103        end
   2.104 -  | NONE => NONE);
   2.105 +  | NONE => assign_update);
   2.106  
   2.107  in
   2.108  
   2.109 @@ -454,10 +483,10 @@
   2.110              (fn () =>
   2.111                let
   2.112                  val imports = map (apsnd Future.join) deps;
   2.113 -                val changed_imports = exists (#4 o #1 o #2) imports;
   2.114 +                val imports_changed = exists (#3 o #1 o #2) imports;
   2.115                  val node_required = is_required name;
   2.116                in
   2.117 -                if changed_imports orelse AList.defined (op =) edits name orelse
   2.118 +                if imports_changed orelse AList.defined (op =) edits name orelse
   2.119                    not (stable_entries node) orelse not (finished_theory node)
   2.120                  then
   2.121                    let
   2.122 @@ -472,59 +501,54 @@
   2.123                      val last_visible = visible_last node;
   2.124  
   2.125                      val (common, (still_visible, initial)) =
   2.126 -                      if changed_imports then (NONE, (true, true))
   2.127 +                      if imports_changed then (NONE, (true, true))
   2.128                        else last_common state last_visible node0 node;
   2.129 +
   2.130                      val common_command_exec = the_default_entry node common;
   2.131  
   2.132                      val (new_execs, (command_id', (eval', _)), _) =
   2.133 -                      ([], common_command_exec, if initial then SOME init else NONE) |>
   2.134 -                      (still_visible orelse node_required) ?
   2.135 +                      (assign_update_empty, common_command_exec, if initial then SOME init else NONE)
   2.136 +                      |> (still_visible orelse node_required) ?
   2.137                          iterate_entries_after common
   2.138                            (fn ((prev, id), _) => fn res =>
   2.139                              if not node_required andalso prev = last_visible then NONE
   2.140                              else new_exec state proper_init (visible_command id) id res) node;
   2.141  
   2.142                      val updated_execs =
   2.143 -                      (visible_commands, new_execs) |-> Inttab.fold (fn (id, ()) =>
   2.144 -                        if exists (fn (_, ({exec_id = id', ...}, _)) => id = id') new_execs then I
   2.145 -                        else append (the_list (update_prints state node id)));
   2.146 +                      (visible_commands, new_execs) |-> Inttab.fold (fn (command_id, ()) =>
   2.147 +                        not (assign_update_defined new_execs command_id) ?
   2.148 +                          update_prints state node command_id);
   2.149  
   2.150 -                    val no_execs =
   2.151 -                      iterate_entries_after common
   2.152 -                        (fn ((_, id0), exec0) => fn res =>
   2.153 +                    val assigned_execs =
   2.154 +                      (node0, updated_execs) |-> iterate_entries_after common
   2.155 +                        (fn ((_, command_id0), exec0) => fn res =>
   2.156                            if is_none exec0 then NONE
   2.157 -                          else if exists (fn (_, ({exec_id = id, ...}, _)) => id0 = id) updated_execs
   2.158 -                          then SOME res
   2.159 -                          else SOME (id0 :: res)) node0 [];
   2.160 +                          else if assign_update_defined updated_execs command_id0 then SOME res
   2.161 +                          else SOME (assign_update_new (command_id0, NONE) res));
   2.162  
   2.163                      val last_exec =
   2.164                        if command_id' = Document_ID.none then NONE else SOME command_id';
   2.165                      val result =
   2.166 -                      if is_some (after_entry node last_exec) then NONE
   2.167 +                      if is_none last_exec orelse is_some (after_entry node last_exec) then NONE
   2.168                        else SOME eval';
   2.169  
   2.170                      val node' = node
   2.171 -                      |> fold reset_entry no_execs
   2.172 -                      |> fold (fn (id, exec) => update_entry id (SOME exec)) updated_execs
   2.173 -                      |> entries_stable (null updated_execs)
   2.174 +                      |> assign_update_apply assigned_execs
   2.175 +                      |> entries_stable (assign_update_null updated_execs)
   2.176                        |> set_result result;
   2.177 -                    val updated_node =
   2.178 -                      if null no_execs andalso null updated_execs then NONE
   2.179 -                      else SOME (name, node');
   2.180 -                    val changed_result = not (null no_execs) orelse not (null new_execs);
   2.181 -                  in ((no_execs, updated_execs, updated_node, changed_result), node') end
   2.182 -                else (([], [], NONE, false), node)
   2.183 +                    val assigned_node =
   2.184 +                      if assign_update_null assigned_execs then NONE else SOME (name, node');
   2.185 +                    val result_changed = changed_result node0 node';
   2.186 +                  in
   2.187 +                    ((assign_update_result assigned_execs, assigned_node, result_changed), node')
   2.188 +                  end
   2.189 +                else (([], NONE, false), node)
   2.190                end))
   2.191        |> Future.joins |> map #1);
   2.192  
   2.193 -    val command_execs =
   2.194 -      map (rpair []) (maps #1 updated) @
   2.195 -      map (fn (command_id, exec) => (command_id, Command.exec_ids exec)) (maps #2 updated);
   2.196 -    val updated_nodes = map_filter #3 updated;
   2.197 -
   2.198      val state' = state
   2.199 -      |> define_version new_version_id (fold put_node updated_nodes new_version);
   2.200 -  in (command_execs, state') end;
   2.201 +      |> define_version new_version_id (fold put_node (map_filter #2 updated) new_version);
   2.202 +  in (maps #1 updated, state') end;
   2.203  
   2.204  end;
   2.205  
     3.1 --- a/src/Pure/PIDE/document.scala	Tue Jul 09 16:32:51 2013 +0200
     3.2 +++ b/src/Pure/PIDE/document.scala	Tue Jul 09 17:58:38 2013 +0200
     3.3 @@ -367,20 +367,22 @@
     3.4      {
     3.5        val version = the_version(id)
     3.6  
     3.7 +      def upd(exec_id: Document_ID.Exec, st: Command.State)
     3.8 +          : Option[(Document_ID.Exec, Command.State)] =
     3.9 +        if (execs.isDefinedAt(exec_id)) None else Some(exec_id -> st)
    3.10 +
    3.11        val (changed_commands, new_execs) =
    3.12          ((Nil: List[Command], execs) /: update) {
    3.13 -          case ((commands1, execs1), (cmd_id, exec)) =>
    3.14 -            val st1 = the_static_state(cmd_id)
    3.15 -            val command = st1.command
    3.16 -            val st0 = command.empty_state
    3.17 -
    3.18 +          case ((commands1, execs1), (command_id, exec)) =>
    3.19 +            val st = the_static_state(command_id)
    3.20 +            val command = st.command
    3.21              val commands2 = command :: commands1
    3.22              val execs2 =
    3.23                exec match {
    3.24                  case Nil => execs1
    3.25                  case eval_id :: print_ids =>
    3.26 -                  execs1 + (eval_id -> execs.getOrElse(eval_id, st1)) ++
    3.27 -                    print_ids.iterator.map(id => id -> execs.getOrElse(id, st0))
    3.28 +                  execs1 ++ upd(eval_id, st) ++
    3.29 +                    (for (id <- print_ids; up <- upd(id, command.empty_state)) yield up)
    3.30                }
    3.31              (commands2, execs2)
    3.32          }