140 nodes |
140 nodes |
141 |> update_node name (edit_node edits) |
141 |> update_node name (edit_node edits) |
142 | Header header => |
142 | Header header => |
143 let |
143 let |
144 val node = get_node nodes name; |
144 val node = get_node nodes name; |
145 val nodes' = Graph.new_node (name, node) (remove_node name nodes); |
145 val nodes1 = Graph.new_node (name, node) (remove_node name nodes); |
146 val parents = |
146 val parents = (case header of Exn.Res (_, parents, _) => parents | _ => []); |
147 (case header of Exn.Res (_, parents, _) => parents | _ => []) |
147 val nodes2 = fold default_node parents nodes1; |
148 |> filter (can (Graph.get_node nodes')); |
148 val (header', nodes3) = |
149 val (header', nodes'') = |
149 (header, Graph.add_deps_acyclic (name, parents) nodes2) |
150 (header, Graph.add_deps_acyclic (name, parents) nodes') |
150 handle Graph.CYCLES cs => (Exn.Exn (ERROR (cat_lines (map cycle_msg cs))), nodes2); |
151 handle Graph.CYCLES cs => (Exn.Exn (ERROR (cat_lines (map cycle_msg cs))), nodes') |
151 in Graph.map_node name (set_header header') nodes3 end)); |
152 | Graph.UNDEF d => (Exn.Exn (ERROR ("Undefined theory entry: " ^ quote d)), nodes') |
152 |
153 in |
153 fun put_node (name, node) (Version nodes) = |
154 nodes'' |
154 Version (update_node name (K node) nodes); |
155 |> Graph.map_node name (set_header header') |
|
156 end)); |
|
157 |
|
158 fun def_node name (Version nodes) = Version (default_node name nodes); |
|
159 fun put_node (name, node) (Version nodes) = Version (update_node name (K node) nodes); |
|
160 |
155 |
161 end; |
156 end; |
162 |
157 |
163 |
158 |
164 |
159 |
329 |
324 |
330 fun edit (old_id: version_id) (new_id: version_id) edits state = |
325 fun edit (old_id: version_id) (new_id: version_id) edits state = |
331 let |
326 let |
332 val old_version = the_version state old_id; |
327 val old_version = the_version state old_id; |
333 val _ = Time.now (); (* FIXME odd workaround for polyml-5.4.0/x86_64 *) |
328 val _ = Time.now (); (* FIXME odd workaround for polyml-5.4.0/x86_64 *) |
334 val new_version = |
329 val new_version = fold edit_nodes edits old_version; |
335 old_version |
|
336 |> fold (def_node o #1) edits |
|
337 |> fold edit_nodes edits; |
|
338 |
330 |
339 val updates = |
331 val updates = |
340 nodes_of new_version |> Graph.schedule |
332 nodes_of new_version |> Graph.schedule |
341 (fn deps => fn (name, node) => |
333 (fn deps => fn (name, node) => |
342 (case first_entry NONE (is_changed (node_of old_version name)) node of |
334 (case first_entry NONE (is_changed (node_of old_version name)) node of |
350 val dir = Path.dir (Path.explode name); |
342 val dir = Path.dir (Path.explode name); |
351 val files = map (apfst Path.explode) uses; |
343 val files = map (apfst Path.explode) uses; |
352 |
344 |
353 val parents = |
345 val parents = |
354 imports |> map (fn import => |
346 imports |> map (fn import => |
355 (case AList.lookup (op =) deps import of |
347 (case Thy_Info.lookup_theory import of |
356 SOME parent_future => |
348 SOME thy => thy |
357 get_theory (Position.file_only (import ^ ".thy")) |
349 | NONE => |
358 (#2 (Future.join parent_future)) |
350 get_theory (Position.file_only import) |
359 | NONE => Thy_Info.get_theory (Thy_Info.base_name import))); |
351 (#2 (Future.join (the (AList.lookup (op =) deps import)))))); |
360 in Thy_Load.begin_theory dir thy_name imports files parents end |
352 in Thy_Load.begin_theory dir thy_name imports files parents end |
361 fun get_command id = |
353 fun get_command id = |
362 (id, the_command state id |> Future.map (Toplevel.modify_init init)); |
354 (id, the_command state id |> Future.map (Toplevel.modify_init init)); |
363 in |
355 in |
364 singleton |
356 singleton |