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) => |
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 |