src/Pure/PIDE/document.ML
changeset 52569 18dde2cf7aa7
parent 52566 52a0eacf04d1
child 52570 26d84a0b9209
equal deleted inserted replaced
52568:92ae3f0ca060 52569:18dde2cf7aa7
    82 
    82 
    83 fun get_perspective (Node {perspective, ...}) = perspective;
    83 fun get_perspective (Node {perspective, ...}) = perspective;
    84 fun set_perspective ids =
    84 fun set_perspective ids =
    85   map_node (fn (header, _, entries, result) => (header, make_perspective ids, entries, result));
    85   map_node (fn (header, _, entries, result) => (header, make_perspective ids, entries, result));
    86 
    86 
    87 val visible_commands = #1 o get_perspective;
    87 val visible_command = Inttab.defined o #1 o get_perspective;
    88 val visible_last = #2 o get_perspective;
    88 val visible_last = #2 o get_perspective;
    89 val visible_node = is_some o visible_last
    89 val visible_node = is_some o visible_last
    90 
    90 
    91 fun map_entries f =
    91 fun map_entries f =
    92   map_node (fn (header, perspective, (entries, stable), result) =>
    92   map_node (fn (header, perspective, (entries, stable), result) =>
   277 fun the_command (State {commands, ...}) command_id =
   277 fun the_command (State {commands, ...}) command_id =
   278   (case Inttab.lookup commands command_id of
   278   (case Inttab.lookup commands command_id of
   279     NONE => err_undef "command" command_id
   279     NONE => err_undef "command" command_id
   280   | SOME command => command);
   280   | SOME command => command);
   281 
   281 
       
   282 val the_command_name = #1 oo the_command;
       
   283 
   282 end;
   284 end;
   283 
   285 
   284 
   286 
   285 (* remove_versions *)
   287 (* remove_versions *)
   286 
   288 
   394 
   396 
   395 fun check_theory full name node =
   397 fun check_theory full name node =
   396   is_some (Thy_Info.lookup_theory name) orelse
   398   is_some (Thy_Info.lookup_theory name) orelse
   397   can get_header node andalso (not full orelse is_some (get_result node));
   399   can get_header node andalso (not full orelse is_some (get_result node));
   398 
   400 
   399 fun last_common state last_visible node0 node =
   401 fun check_prints prints (prints': Command.print list) =
       
   402   if eq_list (op = o pairself #exec_id) (prints, prints') then NONE
       
   403   else SOME prints';
       
   404 
       
   405 fun update_prints command_visible command_name eval prints =
       
   406   if command_visible then
       
   407     let
       
   408       val new_prints = Command.print command_name eval;
       
   409       val prints' =
       
   410         new_prints |> map (fn new_print =>
       
   411           (case find_first (fn {name, ...} => name = #name new_print) prints of
       
   412             SOME print => if Command.stable_print print then print else new_print
       
   413           | NONE => new_print));
       
   414     in check_prints prints prints' end
       
   415   else check_prints prints (filter Command.stable_print prints);
       
   416 
       
   417 fun last_common state node0 node =
   400   let
   418   let
   401     fun update_flags prev (visible, initial) =
   419     fun update_flags prev (visible, initial) =
   402       let
   420       let
   403         val visible' = visible andalso prev <> last_visible;
   421         val visible' = visible andalso prev <> visible_last node;
   404         val initial' = initial andalso
   422         val initial' = initial andalso
   405           (case prev of
   423           (case prev of
   406             NONE => true
   424             NONE => true
   407           | SOME id => not (Keyword.is_theory_begin (#1 (the_command state id))));
   425           | SOME command_id => not (Keyword.is_theory_begin (the_command_name state command_id)));
   408       in (visible', initial') end;
   426       in (visible', initial') end;
   409     fun get_common ((prev, id), opt_exec) (same, (_, flags)) =
   427 
       
   428     fun get_common ((prev, command_id), opt_exec) (_, same, flags, assign_update) =
   410       if same then
   429       if same then
   411         let
   430         let
   412           val flags' = update_flags prev flags;
   431           val flags' = update_flags prev flags;
   413           val same' =
   432           val same' =
   414             (case opt_exec of
   433             (case opt_exec of
   415               NONE => false
   434               NONE => false
   416             | SOME (eval, _) =>
   435             | SOME (eval, _) =>
   417                 (case lookup_entry node0 id of
   436                 (case lookup_entry node0 command_id of
   418                   NONE => false
   437                   NONE => false
   419                 | SOME (eval0, _) =>
   438                 | SOME (eval0, _) =>
   420                     #exec_id eval = #exec_id eval0 andalso Command.stable_eval eval));
   439                     #exec_id eval = #exec_id eval0 andalso Command.stable_eval eval));
   421         in SOME (same', (prev, flags')) end
   440           val assign_update' = assign_update |>
       
   441             (case opt_exec of
       
   442               SOME (eval, prints) =>
       
   443                 let
       
   444                   val command_visible = visible_command node command_id;
       
   445                   val command_name = the_command_name state command_id;
       
   446                 in
       
   447                   (case update_prints command_visible command_name eval prints of
       
   448                     SOME prints' => assign_update_new (command_id, SOME (eval, prints'))
       
   449                   | NONE => I)
       
   450                 end
       
   451             | NONE => I);
       
   452         in SOME (prev, same', flags', assign_update') end
   422       else NONE;
   453       else NONE;
   423     val (same, (common, flags)) =
   454     val (common, same, flags, assign_update') =
   424       iterate_entries get_common node (true, (NONE, (true, true)));
   455       iterate_entries get_common node (NONE, true, (true, true), assign_update_empty);
   425   in
   456     val (common', flags') =
   426     if same then
   457       if same then
   427       let val last = Entries.get_after (get_entries node) common
   458         let val last = Entries.get_after (get_entries node) common
   428       in (last, update_flags last flags) end
   459         in (last, update_flags last flags) end
   429     else (common, flags)
   460       else (common, flags);
   430   end;
   461   in (assign_update', common', flags') end;
   431 
   462 
   432 fun illegal_init _ = error "Illegal theory header after end of theory";
   463 fun illegal_init _ = error "Illegal theory header after end of theory";
   433 
   464 
   434 fun new_exec state proper_init command_visible command_id' (assign_update, command_exec, init) =
   465 fun new_exec state proper_init command_visible command_id' (assign_update, command_exec, init) =
   435   if not proper_init andalso is_none init then NONE
   466   if not proper_init andalso is_none init then NONE
   437     let
   468     let
   438       val (_, (eval, _)) = command_exec;
   469       val (_, (eval, _)) = command_exec;
   439       val (command_name, span) = the_command state command_id' ||> Lazy.force;
   470       val (command_name, span) = the_command state command_id' ||> Lazy.force;
   440 
   471 
   441       val eval' = Command.eval (fn () => the_default illegal_init init span) span eval;
   472       val eval' = Command.eval (fn () => the_default illegal_init init span) span eval;
   442       val prints' = if command_visible then Command.print command_name eval' else [];
   473       val prints' = perhaps (update_prints command_visible command_name eval') [];
   443       val exec' = (eval', prints');
   474       val exec' = (eval', prints');
   444 
   475 
   445       val assign_update' = assign_update_new (command_id', SOME exec') assign_update;
   476       val assign_update' = assign_update_new (command_id', SOME exec') assign_update;
   446       val init' = if Keyword.is_theory_begin command_name then NONE else init;
   477       val init' = if Keyword.is_theory_begin command_name then NONE else init;
   447     in SOME (assign_update', (command_id', (eval', prints')), init') end;
   478     in SOME (assign_update', (command_id', (eval', prints')), init') end;
   448 
       
   449 fun update_prints state node command_id assign_update =
       
   450   (case the_entry node command_id of
       
   451     SOME (eval, prints) =>
       
   452       let
       
   453         val (command_name, _) = the_command state command_id;
       
   454         val new_prints = Command.print command_name eval;
       
   455         val prints' =
       
   456           new_prints |> map (fn new_print =>
       
   457             (case find_first (fn {name, ...} => name = #name new_print) prints of
       
   458               SOME print => if Command.stable_print print then print else new_print
       
   459             | NONE => new_print));
       
   460       in
       
   461         if eq_list (op = o pairself #exec_id) (prints, prints') then assign_update
       
   462         else assign_update_new (command_id, SOME (eval, prints')) assign_update
       
   463       end
       
   464   | NONE => assign_update);
       
   465 
   479 
   466 in
   480 in
   467 
   481 
   468 fun update old_version_id new_version_id edits state =
   482 fun update old_version_id new_version_id edits state =
   469   let
   483   let
   494                     val init = init_theory imports node;
   508                     val init = init_theory imports node;
   495                     val proper_init =
   509                     val proper_init =
   496                       check_theory false name node andalso
   510                       check_theory false name node andalso
   497                       forall (fn (name, (_, node)) => check_theory true name node) imports;
   511                       forall (fn (name, (_, node)) => check_theory true name node) imports;
   498 
   512 
   499                     val visible_commands = visible_commands node;
   513                     val (print_execs, common, (still_visible, initial)) =
   500                     val visible_command = Inttab.defined visible_commands;
   514                       if imports_changed then (assign_update_empty, NONE, (true, true))
   501                     val last_visible = visible_last node;
   515                       else last_common state node0 node;
   502 
       
   503                     val (common, (still_visible, initial)) =
       
   504                       if imports_changed then (NONE, (true, true))
       
   505                       else last_common state last_visible node0 node;
       
   506 
       
   507                     val common_command_exec = the_default_entry node common;
   516                     val common_command_exec = the_default_entry node common;
   508 
   517 
   509                     val (new_execs, (command_id', (eval', _)), _) =
   518                     val (updated_execs, (command_id', (eval', _)), _) =
   510                       (assign_update_empty, common_command_exec, if initial then SOME init else NONE)
   519                       (print_execs, common_command_exec, if initial then SOME init else NONE)
   511                       |> (still_visible orelse node_required) ?
   520                       |> (still_visible orelse node_required) ?
   512                         iterate_entries_after common
   521                         iterate_entries_after common
   513                           (fn ((prev, id), _) => fn res =>
   522                           (fn ((prev, id), _) => fn res =>
   514                             if not node_required andalso prev = last_visible then NONE
   523                             if not node_required andalso prev = visible_last node then NONE
   515                             else new_exec state proper_init (visible_command id) id res) node;
   524                             else new_exec state proper_init (visible_command node id) id res) node;
   516 
       
   517                     val updated_execs =
       
   518                       (visible_commands, new_execs) |-> Inttab.fold (fn (command_id, ()) =>
       
   519                         not (assign_update_defined new_execs command_id) ?
       
   520                           update_prints state node command_id);
       
   521 
   525 
   522                     val assigned_execs =
   526                     val assigned_execs =
   523                       (node0, updated_execs) |-> iterate_entries_after common
   527                       (node0, updated_execs) |-> iterate_entries_after common
   524                         (fn ((_, command_id0), exec0) => fn res =>
   528                         (fn ((_, command_id0), exec0) => fn res =>
   525                           if is_none exec0 then NONE
   529                           if is_none exec0 then NONE