src/Pure/Isar/isar_document.ML
changeset 29520 7402322256b0
parent 29519 4dff3b11f64d
child 31443 c23663825e23
equal deleted inserted replaced
29519:4dff3b11f64d 29520:7402322256b0
    22 
    22 
    23 type state_id = string;
    23 type state_id = string;
    24 type command_id = string;
    24 type command_id = string;
    25 type document_id = string;
    25 type document_id = string;
    26 
    26 
    27 fun new_id () = "isabelle:" ^ serial_string ();
    27 fun make_id () = "isabelle:" ^ serial_string ();
    28 
    28 
    29 fun err_dup kind id = error ("Duplicate " ^ kind ^ ": " ^ quote id);
    29 fun err_dup kind id = error ("Duplicate " ^ kind ^ ": " ^ quote id);
    30 fun err_undef kind id = error ("Unknown " ^ kind ^ ": " ^ quote id);
    30 fun err_undef kind id = error ("Unknown " ^ kind ^ ": " ^ quote id);
    31 
    31 
    32 
    32 
    49   let val {next, ...} = the_entry entries id
    49   let val {next, ...} = the_entry entries id
    50   in put_entry (id, make_entry next state) entries end;
    50   in put_entry (id, make_entry next state) entries end;
    51 
    51 
    52 fun reset_entry_state id = put_entry_state id NONE;
    52 fun reset_entry_state id = put_entry_state id NONE;
    53 fun set_entry_state (id, state_id) = put_entry_state id (SOME state_id);
    53 fun set_entry_state (id, state_id) = put_entry_state id (SOME state_id);
    54 
       
    55 
    54 
    56 
    55 
    57 (* document *)
    56 (* document *)
    58 
    57 
    59 datatype document = Document of
    58 datatype document = Document of
   133   global_documents := Symtab.empty));
   132   global_documents := Symtab.empty));
   134 
   133 
   135 end;
   134 end;
   136 
   135 
   137 
   136 
   138 fun define_state (id: state_id) state =
   137 (* state *)
   139   change_states (Symtab.update_new (id, state))
   138 
       
   139 val empty_state = Future.value (SOME Toplevel.toplevel);
       
   140 
       
   141 fun define_state (id: state_id) =
       
   142   change_states (Symtab.update_new (id, empty_state))
   140     handle Symtab.DUP dup => err_dup "state" dup;
   143     handle Symtab.DUP dup => err_dup "state" dup;
       
   144 
       
   145 fun put_state (id: state_id) state = change_states (Symtab.update (id, state));
   141 
   146 
   142 fun the_state (id: state_id) =
   147 fun the_state (id: state_id) =
   143   (case Symtab.lookup (get_states ()) id of
   148   (case Symtab.lookup (get_states ()) id of
   144     NONE => err_undef "state" id
   149     NONE => err_undef "state" id
   145   | SOME state => state);
   150   | SOME state => state);
   146 
   151 
   147 
   152 
       
   153 (* command *)
       
   154 
   148 fun define_command id tr =
   155 fun define_command id tr =
   149   change_commands (Symtab.update_new (id, Toplevel.put_id id tr))
   156   change_commands (Symtab.update_new (id, Toplevel.put_id id tr))
   150     handle Symtab.DUP dup => err_dup "command" dup;
   157     handle Symtab.DUP dup => err_dup "command" dup;
   151 
   158 
   152 fun the_command (id: command_id) =
   159 fun the_command (id: command_id) =
   153   (case Symtab.lookup (get_commands ()) id of
   160   (case Symtab.lookup (get_commands ()) id of
   154     NONE => err_undef "command" id
   161     NONE => err_undef "command" id
   155   | SOME tr => tr);
   162   | SOME tr => tr);
   156 
   163 
   157 
   164 
       
   165 (* document *)
       
   166 
   158 fun define_document (id: document_id) document =
   167 fun define_document (id: document_id) document =
   159   change_documents (Symtab.update_new (id, document))
   168   change_documents (Symtab.update_new (id, document))
   160     handle Symtab.DUP dup => err_dup "document" dup;
   169     handle Symtab.DUP dup => err_dup "document" dup;
   161 
   170 
   162 fun the_document (id: document_id) =
   171 fun the_document (id: document_id) =
   163   (case Symtab.lookup (get_documents ()) id of
   172   (case Symtab.lookup (get_documents ()) id of
   164     NONE => err_undef "document" id
   173     NONE => err_undef "document" id
   165   | SOME document => document);
   174   | SOME document => document);
   166 
   175 
   167 
   176 
       
   177 
       
   178 (** main operations **)
       
   179 
   168 (* begin/end document *)
   180 (* begin/end document *)
   169 
   181 
   170 fun begin_document (id: document_id) path =
   182 fun begin_document (id: document_id) path =
   171   let
   183   let
   172     val (dir, name) = ThyLoad.split_thy_path path;
   184     val (dir, name) = ThyLoad.split_thy_path path;
   173     val _ = define_command id Toplevel.empty;
   185     val _ = define_command id Toplevel.empty;
   174     val _ = define_state id (Future.value (SOME Toplevel.toplevel));
   186     val _ = define_state id;
   175     val entries = Symtab.make [(id, make_entry NONE (SOME id))];
   187     val entries = Symtab.make [(id, make_entry NONE (SOME id))];
   176     val _ = define_document id (make_document dir name id entries);
   188     val _ = define_document id (make_document dir name id entries);
   177   in () end;
   189   in () end;
   178 
   190 
   179 fun end_document (id: document_id) =
   191 fun end_document (id: document_id) =
   187         (case Future.join end_state of
   199         (case Future.join end_state of
   188           SOME st =>
   200           SOME st =>
   189            (Toplevel.run_command name (Toplevel.put_id id (Toplevel.commit_exit Position.none)) st;
   201            (Toplevel.run_command name (Toplevel.put_id id (Toplevel.commit_exit Position.none)) st;
   190             ThyInfo.touch_child_thys name;
   202             ThyInfo.touch_child_thys name;
   191             ThyInfo.register_thy name)
   203             ThyInfo.register_thy name)
   192         | NONE => error ("Failed to finish theory " ^ quote name)))
   204         | NONE => error ("Failed to finish theory " ^ quote name)));
   193   in () end;
   205   in () end;
   194 
   206 
   195 
   207 
   196 (* document editing *)
   208 (* document editing *)
   197 
   209 
   202     NONE => true
   214     NONE => true
   203   | SOME {next = _, state = state'} => state' <> state);
   215   | SOME {next = _, state = state'} => state' <> state);
   204 
   216 
   205 fun new_state name (id, _) (state_id, updates) =
   217 fun new_state name (id, _) (state_id, updates) =
   206   let
   218   let
   207     val state_id' = new_id ();
   219     val state_id' = make_id ();
       
   220     val _ = define_state state_id';
   208     val tr = Toplevel.put_id state_id' (the_command id);
   221     val tr = Toplevel.put_id state_id' (the_command id);
   209     val state = the_state state_id;
   222     fun make_state' () =
   210     val state' =
   223       let
   211       Future.fork_deps [state] (fn () =>
   224         val state = the_state state_id;
   212         (case Future.join state of
   225         val state' =
   213           NONE => NONE
   226           Future.fork_deps [state] (fn () =>
   214         | SOME st => Toplevel.run_command name tr st));
   227             (case Future.join state of
   215     val _ = define_state state_id' state';
   228               NONE => NONE
   216   in (state_id', (id, state_id') :: updates) end;
   229             | SOME st => Toplevel.run_command name tr st));
   217 
   230       in put_state state_id' state' end;
   218 fun update_states old_document new_document =
   231   in (state_id', ((id, state_id'), make_state') :: updates) end;
   219   let
       
   220     fun cancel_old id = fold_entries id
       
   221       (fn (_, {state = SOME state_id, ...}) => K (Future.cancel (the_state state_id)) | _ => K ())
       
   222       old_document ();
       
   223 
       
   224     val Document {entries = old_entries, ...} = old_document;
       
   225     val Document {name, entries = new_entries, ...} = new_document;
       
   226   in
       
   227     (case first_entry (is_changed old_entries) new_document of
       
   228       NONE =>
       
   229         (case first_entry (is_changed new_entries) old_document of
       
   230           NONE => ([], new_document)
       
   231         | SOME (_, id, _) => (cancel_old id; ([], new_document)))
       
   232     | SOME (prev, id, _) =>
       
   233         let
       
   234           val _ = cancel_old id;
       
   235           val prev_state_id = the (#state (the_entry new_entries (the prev)));
       
   236           val (_, updates) = fold_entries id (new_state name) new_document (prev_state_id, []);
       
   237           val new_document' = new_document |> map_entries (fold set_entry_state updates);
       
   238         in (rev updates, new_document') end)
       
   239   end;
       
   240 
   232 
   241 fun report_updates _ [] = ()
   233 fun report_updates _ [] = ()
   242   | report_updates (document_id: document_id) updates =
   234   | report_updates (document_id: document_id) updates =
   243       implode (map (fn (id, state_id) => Markup.markup (Markup.edit id state_id) "") updates)
   235       implode (map (fn (id, state_id) => Markup.markup (Markup.edit id state_id) "") updates)
   244       |> Markup.markup (Markup.edits document_id)
   236       |> Markup.markup (Markup.edits document_id)
   245       |> Output.status;
   237       |> Output.status;
   246 
   238 
   247 in
   239 in
   248 
   240 
   249 fun edit_document (id: document_id) (id': document_id) edits =
   241 fun edit_document (old_id: document_id) (new_id: document_id) edits =
   250   let
   242   let
   251     val document = the_document id;
   243     val old_document as Document {name, entries = old_entries, ...} = the_document old_id;
   252     val (updates, document') =
   244     val new_document as Document {entries = new_entries, ...} = old_document
   253       document
   245       |> fold (fn (id, SOME id2) => insert_after id id2 | (id, NONE) => delete_after id) edits;
   254       |> fold (fn (id, SOME id2) => insert_after id id2 | (id, NONE) => delete_after id) edits
   246 
   255       |> update_states document;
   247     fun cancel_old id = fold_entries id
   256     val _ = define_document id' document';
   248       (fn (_, {state = SOME state_id, ...}) => K (Future.cancel (the_state state_id)) | _ => K ())
   257     val _ = report_updates id' updates;
   249       old_document ();
       
   250 
       
   251     val (updates, new_document') =
       
   252       (case first_entry (is_changed old_entries) new_document of
       
   253         NONE =>
       
   254           (case first_entry (is_changed new_entries) old_document of
       
   255             NONE => ([], new_document)
       
   256           | SOME (_, id, _) => (cancel_old id; ([], new_document)))
       
   257       | SOME (prev, id, _) =>
       
   258           let
       
   259             val _ = cancel_old id;
       
   260             val prev_state_id = the (#state (the_entry new_entries (the prev)));
       
   261             val (_, updates) = fold_entries id (new_state name) new_document (prev_state_id, []);
       
   262             val new_document' = new_document |> map_entries (fold (set_entry_state o #1) updates);
       
   263           in (rev updates, new_document') end);
       
   264 
       
   265     val _ = define_document new_id new_document';
       
   266     val _ = report_updates new_id (map #1 updates);
       
   267     val _ = List.app (fn (_, run) => run ()) updates;
   258   in () end;
   268   in () end;
   259 
   269 
   260 end;
   270 end;
   261 
   271 
   262 
   272