src/Pure/PIDE/document.ML
changeset 47388 fe4b245af74c
parent 47347 af937661e4a1
child 47389 e8552cba702d
equal deleted inserted replaced
47387:a0f257197741 47388:fe4b245af74c
    27   val define_command: command_id -> string -> string -> state -> state
    27   val define_command: command_id -> string -> string -> state -> state
    28   val discontinue_execution: state -> unit
    28   val discontinue_execution: state -> unit
    29   val cancel_execution: state -> Future.task list
    29   val cancel_execution: state -> Future.task list
    30   val execute: version_id -> state -> state
    30   val execute: version_id -> state -> state
    31   val update: version_id -> version_id -> edit list -> state ->
    31   val update: version_id -> version_id -> edit list -> state ->
    32     ((command_id * exec_id option) list * (string * command_id option) list) * state
    32     (command_id * exec_id option) list * state
    33   val remove_versions: version_id list -> state -> state
    33   val remove_versions: version_id list -> state -> state
    34   val state: unit -> state
    34   val state: unit -> state
    35   val change_state: (state -> state) -> unit
    35   val change_state: (state -> state) -> unit
    36 end;
    36 end;
    37 
    37 
    68 abstype node = Node of
    68 abstype node = Node of
    69  {touched: bool,
    69  {touched: bool,
    70   header: node_header,
    70   header: node_header,
    71   perspective: perspective,
    71   perspective: perspective,
    72   entries: (exec_id * exec) option Entries.T,  (*command entries with excecutions*)
    72   entries: (exec_id * exec) option Entries.T,  (*command entries with excecutions*)
    73   last_exec: command_id option,  (*last command with exec state assignment*)
       
    74   result: exec}
    73   result: exec}
    75 and version = Version of node Graph.T  (*development graph wrt. static imports*)
    74 and version = Version of node Graph.T  (*development graph wrt. static imports*)
    76 with
    75 with
    77 
    76 
    78 fun make_node (touched, header, perspective, entries, last_exec, result) =
    77 fun make_node (touched, header, perspective, entries, result) =
    79   Node {touched = touched, header = header, perspective = perspective,
    78   Node {touched = touched, header = header, perspective = perspective,
    80     entries = entries, last_exec = last_exec, result = result};
    79     entries = entries, result = result};
    81 
    80 
    82 fun map_node f (Node {touched, header, perspective, entries, last_exec, result}) =
    81 fun map_node f (Node {touched, header, perspective, entries, result}) =
    83   make_node (f (touched, header, perspective, entries, last_exec, result));
    82   make_node (f (touched, header, perspective, entries, result));
    84 
    83 
    85 fun make_perspective command_ids : perspective =
    84 fun make_perspective command_ids : perspective =
    86   (Inttab.defined (Inttab.make (map (rpair ()) command_ids)), try List.last command_ids);
    85   (Inttab.defined (Inttab.make (map (rpair ()) command_ids)), try List.last command_ids);
    87 
    86 
    88 val no_header = Exn.Exn (ERROR "Bad theory header");
    87 val no_header = Exn.Exn (ERROR "Bad theory header");
    89 val no_perspective = make_perspective [];
    88 val no_perspective = make_perspective [];
    90 
    89 
    91 val empty_node = make_node (false, no_header, no_perspective, Entries.empty, NONE, no_exec);
    90 val empty_node = make_node (false, no_header, no_perspective, Entries.empty, no_exec);
    92 val clear_node = map_node (fn (_, header, _, _, _, _) =>
    91 val clear_node = map_node (fn (_, header, _, _, _) =>
    93   (false, header, no_perspective, Entries.empty, NONE, no_exec));
    92   (false, header, no_perspective, Entries.empty, no_exec));
    94 
    93 
    95 
    94 
    96 (* basic components *)
    95 (* basic components *)
    97 
    96 
    98 fun is_touched (Node {touched, ...}) = touched;
    97 fun is_touched (Node {touched, ...}) = touched;
    99 fun set_touched touched =
    98 fun set_touched touched =
   100   map_node (fn (_, header, perspective, entries, last_exec, result) =>
    99   map_node (fn (_, header, perspective, entries, result) =>
   101     (touched, header, perspective, entries, last_exec, result));
   100     (touched, header, perspective, entries, result));
   102 
   101 
   103 fun get_header (Node {header, ...}) = header;
   102 fun get_header (Node {header, ...}) = header;
   104 fun set_header header =
   103 fun set_header header =
   105   map_node (fn (touched, _, perspective, entries, last_exec, result) =>
   104   map_node (fn (touched, _, perspective, entries, result) =>
   106     (touched, header, perspective, entries, last_exec, result));
   105     (touched, header, perspective, entries, result));
   107 
   106 
   108 fun get_perspective (Node {perspective, ...}) = perspective;
   107 fun get_perspective (Node {perspective, ...}) = perspective;
   109 fun set_perspective ids =
   108 fun set_perspective ids =
   110   map_node (fn (touched, header, _, entries, last_exec, result) =>
   109   map_node (fn (touched, header, _, entries, result) =>
   111     (touched, header, make_perspective ids, entries, last_exec, result));
   110     (touched, header, make_perspective ids, entries, result));
   112 
   111 
   113 val visible_command = #1 o get_perspective;
   112 val visible_command = #1 o get_perspective;
   114 val visible_last = #2 o get_perspective;
   113 val visible_last = #2 o get_perspective;
   115 val visible_node = is_some o visible_last
   114 val visible_node = is_some o visible_last
   116 
   115 
   117 fun map_entries f =
   116 fun map_entries f =
   118   map_node (fn (touched, header, perspective, entries, last_exec, result) =>
   117   map_node (fn (touched, header, perspective, entries, result) =>
   119     (touched, header, perspective, f entries, last_exec, result));
   118     (touched, header, perspective, f entries, result));
   120 fun get_entries (Node {entries, ...}) = entries;
   119 fun get_entries (Node {entries, ...}) = entries;
   121 
   120 
   122 fun iterate_entries f = Entries.iterate NONE f o get_entries;
   121 fun iterate_entries f = Entries.iterate NONE f o get_entries;
   123 fun iterate_entries_after start f (Node {entries, ...}) =
   122 fun iterate_entries_after start f (Node {entries, ...}) =
   124   (case Entries.get_after entries start of
   123   (case Entries.get_after entries start of
   125     NONE => I
   124     NONE => I
   126   | SOME id => Entries.iterate (SOME id) f entries);
   125   | SOME id => Entries.iterate (SOME id) f entries);
   127 
   126 
   128 fun get_last_exec (Node {last_exec, ...}) = last_exec;
       
   129 fun set_last_exec last_exec =
       
   130   map_node (fn (touched, header, perspective, entries, _, result) =>
       
   131     (touched, header, perspective, entries, last_exec, result));
       
   132 
       
   133 fun get_result (Node {result, ...}) = result;
   127 fun get_result (Node {result, ...}) = result;
   134 fun set_result result =
   128 fun set_result result =
   135   map_node (fn (touched, header, perspective, entries, last_exec, _) =>
   129   map_node (fn (touched, header, perspective, entries, _) =>
   136     (touched, header, perspective, entries, last_exec, result));
   130     (touched, header, perspective, entries, result));
   137 
   131 
   138 fun get_node nodes name = Graph.get_node nodes name handle Graph.UNDEF _ => empty_node;
   132 fun get_node nodes name = Graph.get_node nodes name handle Graph.UNDEF _ => empty_node;
   139 fun default_node name = Graph.default_node (name, empty_node);
   133 fun default_node name = Graph.default_node (name, empty_node);
   140 fun update_node name f = default_node name #> Graph.map_node name f;
   134 fun update_node name f = default_node name #> Graph.map_node name f;
   141 
   135 
   497                       else exec;
   491                       else exec;
   498 
   492 
   499                     val node' = node
   493                     val node' = node
   500                       |> fold reset_entry no_execs
   494                       |> fold reset_entry no_execs
   501                       |> fold (fn (id, exec) => update_entry id (SOME exec)) execs
   495                       |> fold (fn (id, exec) => update_entry id (SOME exec)) execs
   502                       |> set_last_exec last_exec
       
   503                       |> set_result result
   496                       |> set_result result
   504                       |> set_touched false;
   497                       |> set_touched false;
   505                   in ((no_execs, execs, [(name, node')]), node') end)
   498                   in ((no_execs, execs, [(name, node')]), node') end)
   506             end
   499             end
   507           else Future.value (([], [], []), node))
   500           else Future.value (([], [], []), node))
   509 
   502 
   510     val command_execs =
   503     val command_execs =
   511       map (rpair NONE) (maps #1 updated) @
   504       map (rpair NONE) (maps #1 updated) @
   512       map (fn (command_id, (exec_id, _)) => (command_id, SOME exec_id)) (maps #2 updated);
   505       map (fn (command_id, (exec_id, _)) => (command_id, SOME exec_id)) (maps #2 updated);
   513     val updated_nodes = maps #3 updated;
   506     val updated_nodes = maps #3 updated;
   514     val last_execs = map (fn (name, node) => (name, get_last_exec node)) updated_nodes;
       
   515 
   507 
   516     val state' = state
   508     val state' = state
   517       |> define_version new_id (fold put_node updated_nodes new_version);
   509       |> define_version new_id (fold put_node updated_nodes new_version);
   518   in ((command_execs, last_execs), state') end;
   510   in (command_execs, state') end;
   519 
   511 
   520 end;
   512 end;
   521 
   513 
   522 
   514 
   523 (* remove versions *)
   515 (* remove versions *)