src/Pure/PIDE/document.ML
changeset 52566 52a0eacf04d1
parent 52536 3a35ce87a55c
child 52569 18dde2cf7aa7
equal deleted inserted replaced
52565:b04cbc49bdcf 52566:52a0eacf04d1
   106 
   106 
   107 fun get_result (Node {result, ...}) = result;
   107 fun get_result (Node {result, ...}) = result;
   108 fun set_result result =
   108 fun set_result result =
   109   map_node (fn (header, perspective, entries, _) => (header, perspective, entries, result));
   109   map_node (fn (header, perspective, entries, _) => (header, perspective, entries, result));
   110 
   110 
       
   111 fun changed_result node node' =
       
   112   (case (get_result node, get_result node') of
       
   113     (SOME eval, SOME eval') => #exec_id eval <> #exec_id eval'
       
   114   | (NONE, NONE) => false
       
   115   | _ => true);
       
   116 
   111 fun finished_theory node =
   117 fun finished_theory node =
   112   (case Exn.capture (Command.eval_result_state o the) (get_result node) of
   118   (case Exn.capture (Command.eval_result_state o the) (get_result node) of
   113     Exn.Res st => can (Toplevel.end_theory Position.none) st
   119     Exn.Res st => can (Toplevel.end_theory Position.none) st
   114   | _ => false);
   120   | _ => false);
   115 
   121 
   142   | SOME (exec, _) => exec);
   148   | SOME (exec, _) => exec);
   143 
   149 
   144 fun the_default_entry node (SOME id) = (id, the_default Command.no_exec (the_entry node id))
   150 fun the_default_entry node (SOME id) = (id, the_default Command.no_exec (the_entry node id))
   145   | the_default_entry _ NONE = (Document_ID.none, Command.no_exec);
   151   | the_default_entry _ NONE = (Document_ID.none, Command.no_exec);
   146 
   152 
   147 fun update_entry id exec =
   153 fun assign_entry (command_id, exec) node =
   148   map_entries (Entries.update (id, exec));
   154   if is_none (Entries.lookup (get_entries node) command_id) then node
   149 
   155   else map_entries (Entries.update (command_id, exec)) node;
   150 fun reset_entry id node =
       
   151   if is_some (lookup_entry node id) then update_entry id NONE node else node;
       
   152 
   156 
   153 fun reset_after id entries =
   157 fun reset_after id entries =
   154   (case Entries.get_after entries id of
   158   (case Entries.get_after entries id of
   155     NONE => entries
   159     NONE => entries
   156   | SOME next => Entries.update (next, NONE) entries);
   160   | SOME next => Entries.update (next, NONE) entries);
   275     NONE => err_undef "command" command_id
   279     NONE => err_undef "command" command_id
   276   | SOME command => command);
   280   | SOME command => command);
   277 
   281 
   278 end;
   282 end;
   279 
   283 
       
   284 
       
   285 (* remove_versions *)
       
   286 
   280 fun remove_versions version_ids state = state |> map_state (fn (versions, _, execution) =>
   287 fun remove_versions version_ids state = state |> map_state (fn (versions, _, execution) =>
   281   let
   288   let
   282     val _ =
   289     val _ =
   283       member (op =) version_ids (#version_id execution) andalso
   290       member (op =) version_ids (#version_id execution) andalso
   284         error ("Attempt to remove execution version " ^ Document_ID.print (#version_id execution));
   291         error ("Attempt to remove execution version " ^ Document_ID.print (#version_id execution));
   324   in () end;
   331   in () end;
   325 
   332 
   326 
   333 
   327 
   334 
   328 (** document update **)
   335 (** document update **)
       
   336 
       
   337 (* exec state assignment *)
       
   338 
       
   339 type assign_update = Command.exec option Inttab.table;  (*command id -> exec*)
       
   340 
       
   341 val assign_update_empty: assign_update = Inttab.empty;
       
   342 fun assign_update_null (tab: assign_update) = Inttab.is_empty tab;
       
   343 fun assign_update_defined (tab: assign_update) command_id = Inttab.defined tab command_id;
       
   344 fun assign_update_apply (tab: assign_update) node = Inttab.fold assign_entry tab node;
       
   345 
       
   346 fun assign_update_new upd (tab: assign_update) =
       
   347   Inttab.update_new upd tab
       
   348     handle Inttab.DUP dup => err_dup "exec state assignment" dup;
       
   349 
       
   350 fun assign_update_result (tab: assign_update) =
       
   351   Inttab.fold (fn (command_id, exec) => cons (command_id, Command.exec_ids exec)) tab [];
       
   352 
       
   353 
       
   354 (* update *)
   329 
   355 
   330 val timing = Unsynchronized.ref false;
   356 val timing = Unsynchronized.ref false;
   331 fun timeit msg e = cond_timeit (! timing) msg e;
   357 fun timeit msg e = cond_timeit (! timing) msg e;
   332 
   358 
   333 local
   359 local
   403     else (common, flags)
   429     else (common, flags)
   404   end;
   430   end;
   405 
   431 
   406 fun illegal_init _ = error "Illegal theory header after end of theory";
   432 fun illegal_init _ = error "Illegal theory header after end of theory";
   407 
   433 
   408 fun new_exec state proper_init command_visible command_id' (execs, command_exec, init) =
   434 fun new_exec state proper_init command_visible command_id' (assign_update, command_exec, init) =
   409   if not proper_init andalso is_none init then NONE
   435   if not proper_init andalso is_none init then NONE
   410   else
   436   else
   411     let
   437     let
   412       val (_, (eval, _)) = command_exec;
   438       val (_, (eval, _)) = command_exec;
   413       val (command_name, span) = the_command state command_id' ||> Lazy.force;
   439       val (command_name, span) = the_command state command_id' ||> Lazy.force;
   414       val init' = if Keyword.is_theory_begin command_name then NONE else init;
   440 
   415       val eval' = Command.eval (fn () => the_default illegal_init init span) span eval;
   441       val eval' = Command.eval (fn () => the_default illegal_init init span) span eval;
   416       val prints' = if command_visible then Command.print command_name eval' else [];
   442       val prints' = if command_visible then Command.print command_name eval' else [];
   417       val command_exec' = (command_id', (eval', prints'));
   443       val exec' = (eval', prints');
   418     in SOME (command_exec' :: execs, command_exec', init') end;
   444 
   419 
   445       val assign_update' = assign_update_new (command_id', SOME exec') assign_update;
   420 fun update_prints state node command_id =
   446       val init' = if Keyword.is_theory_begin command_name then NONE else init;
       
   447     in SOME (assign_update', (command_id', (eval', prints')), init') end;
       
   448 
       
   449 fun update_prints state node command_id assign_update =
   421   (case the_entry node command_id of
   450   (case the_entry node command_id of
   422     SOME (eval, prints) =>
   451     SOME (eval, prints) =>
   423       let
   452       let
   424         val (command_name, _) = the_command state command_id;
   453         val (command_name, _) = the_command state command_id;
   425         val new_prints = Command.print command_name eval;
   454         val new_prints = Command.print command_name eval;
   427           new_prints |> map (fn new_print =>
   456           new_prints |> map (fn new_print =>
   428             (case find_first (fn {name, ...} => name = #name new_print) prints of
   457             (case find_first (fn {name, ...} => name = #name new_print) prints of
   429               SOME print => if Command.stable_print print then print else new_print
   458               SOME print => if Command.stable_print print then print else new_print
   430             | NONE => new_print));
   459             | NONE => new_print));
   431       in
   460       in
   432         if eq_list (op = o pairself #exec_id) (prints, prints') then NONE
   461         if eq_list (op = o pairself #exec_id) (prints, prints') then assign_update
   433         else SOME (command_id, (eval, prints'))
   462         else assign_update_new (command_id, SOME (eval, prints')) assign_update
   434       end
   463       end
   435   | NONE => NONE);
   464   | NONE => assign_update);
   436 
   465 
   437 in
   466 in
   438 
   467 
   439 fun update old_version_id new_version_id edits state =
   468 fun update old_version_id new_version_id edits state =
   440   let
   469   let
   452             {name = "Document.update", group = NONE,
   481             {name = "Document.update", group = NONE,
   453               deps = map (Future.task_of o #2) deps, pri = 0, interrupts = false}
   482               deps = map (Future.task_of o #2) deps, pri = 0, interrupts = false}
   454             (fn () =>
   483             (fn () =>
   455               let
   484               let
   456                 val imports = map (apsnd Future.join) deps;
   485                 val imports = map (apsnd Future.join) deps;
   457                 val changed_imports = exists (#4 o #1 o #2) imports;
   486                 val imports_changed = exists (#3 o #1 o #2) imports;
   458                 val node_required = is_required name;
   487                 val node_required = is_required name;
   459               in
   488               in
   460                 if changed_imports orelse AList.defined (op =) edits name orelse
   489                 if imports_changed orelse AList.defined (op =) edits name orelse
   461                   not (stable_entries node) orelse not (finished_theory node)
   490                   not (stable_entries node) orelse not (finished_theory node)
   462                 then
   491                 then
   463                   let
   492                   let
   464                     val node0 = node_of old_version name;
   493                     val node0 = node_of old_version name;
   465                     val init = init_theory imports node;
   494                     val init = init_theory imports node;
   470                     val visible_commands = visible_commands node;
   499                     val visible_commands = visible_commands node;
   471                     val visible_command = Inttab.defined visible_commands;
   500                     val visible_command = Inttab.defined visible_commands;
   472                     val last_visible = visible_last node;
   501                     val last_visible = visible_last node;
   473 
   502 
   474                     val (common, (still_visible, initial)) =
   503                     val (common, (still_visible, initial)) =
   475                       if changed_imports then (NONE, (true, true))
   504                       if imports_changed then (NONE, (true, true))
   476                       else last_common state last_visible node0 node;
   505                       else last_common state last_visible node0 node;
       
   506 
   477                     val common_command_exec = the_default_entry node common;
   507                     val common_command_exec = the_default_entry node common;
   478 
   508 
   479                     val (new_execs, (command_id', (eval', _)), _) =
   509                     val (new_execs, (command_id', (eval', _)), _) =
   480                       ([], common_command_exec, if initial then SOME init else NONE) |>
   510                       (assign_update_empty, common_command_exec, if initial then SOME init else NONE)
   481                       (still_visible orelse node_required) ?
   511                       |> (still_visible orelse node_required) ?
   482                         iterate_entries_after common
   512                         iterate_entries_after common
   483                           (fn ((prev, id), _) => fn res =>
   513                           (fn ((prev, id), _) => fn res =>
   484                             if not node_required andalso prev = last_visible then NONE
   514                             if not node_required andalso prev = last_visible then NONE
   485                             else new_exec state proper_init (visible_command id) id res) node;
   515                             else new_exec state proper_init (visible_command id) id res) node;
   486 
   516 
   487                     val updated_execs =
   517                     val updated_execs =
   488                       (visible_commands, new_execs) |-> Inttab.fold (fn (id, ()) =>
   518                       (visible_commands, new_execs) |-> Inttab.fold (fn (command_id, ()) =>
   489                         if exists (fn (_, ({exec_id = id', ...}, _)) => id = id') new_execs then I
   519                         not (assign_update_defined new_execs command_id) ?
   490                         else append (the_list (update_prints state node id)));
   520                           update_prints state node command_id);
   491 
   521 
   492                     val no_execs =
   522                     val assigned_execs =
   493                       iterate_entries_after common
   523                       (node0, updated_execs) |-> iterate_entries_after common
   494                         (fn ((_, id0), exec0) => fn res =>
   524                         (fn ((_, command_id0), exec0) => fn res =>
   495                           if is_none exec0 then NONE
   525                           if is_none exec0 then NONE
   496                           else if exists (fn (_, ({exec_id = id, ...}, _)) => id0 = id) updated_execs
   526                           else if assign_update_defined updated_execs command_id0 then SOME res
   497                           then SOME res
   527                           else SOME (assign_update_new (command_id0, NONE) res));
   498                           else SOME (id0 :: res)) node0 [];
       
   499 
   528 
   500                     val last_exec =
   529                     val last_exec =
   501                       if command_id' = Document_ID.none then NONE else SOME command_id';
   530                       if command_id' = Document_ID.none then NONE else SOME command_id';
   502                     val result =
   531                     val result =
   503                       if is_some (after_entry node last_exec) then NONE
   532                       if is_none last_exec orelse is_some (after_entry node last_exec) then NONE
   504                       else SOME eval';
   533                       else SOME eval';
   505 
   534 
   506                     val node' = node
   535                     val node' = node
   507                       |> fold reset_entry no_execs
   536                       |> assign_update_apply assigned_execs
   508                       |> fold (fn (id, exec) => update_entry id (SOME exec)) updated_execs
   537                       |> entries_stable (assign_update_null updated_execs)
   509                       |> entries_stable (null updated_execs)
       
   510                       |> set_result result;
   538                       |> set_result result;
   511                     val updated_node =
   539                     val assigned_node =
   512                       if null no_execs andalso null updated_execs then NONE
   540                       if assign_update_null assigned_execs then NONE else SOME (name, node');
   513                       else SOME (name, node');
   541                     val result_changed = changed_result node0 node';
   514                     val changed_result = not (null no_execs) orelse not (null new_execs);
   542                   in
   515                   in ((no_execs, updated_execs, updated_node, changed_result), node') end
   543                     ((assign_update_result assigned_execs, assigned_node, result_changed), node')
   516                 else (([], [], NONE, false), node)
   544                   end
       
   545                 else (([], NONE, false), node)
   517               end))
   546               end))
   518       |> Future.joins |> map #1);
   547       |> Future.joins |> map #1);
   519 
   548 
   520     val command_execs =
       
   521       map (rpair []) (maps #1 updated) @
       
   522       map (fn (command_id, exec) => (command_id, Command.exec_ids exec)) (maps #2 updated);
       
   523     val updated_nodes = map_filter #3 updated;
       
   524 
       
   525     val state' = state
   549     val state' = state
   526       |> define_version new_version_id (fold put_node updated_nodes new_version);
   550       |> define_version new_version_id (fold put_node (map_filter #2 updated) new_version);
   527   in (command_execs, state') end;
   551   in (maps #1 updated, state') end;
   528 
   552 
   529 end;
   553 end;
   530 
   554 
   531 
   555 
   532 
   556