142 |
142 |
143 datatype theory = |
143 datatype theory = |
144 Theory of |
144 Theory of |
145 (*identity*) |
145 (*identity*) |
146 {self: theory ref option, (*dynamic self reference -- follows theory changes*) |
146 {self: theory ref option, (*dynamic self reference -- follows theory changes*) |
147 draft: bool, (*draft mode -- linear changes*) |
147 draft: bool, (*draft mode -- linear destructive changes*) |
148 id: serial, (*identifier*) |
148 id: serial, (*identifier*) |
149 ids: unit Inttab.table} * (*cumulative identifiers of non-drafts -- symbolic body content*) |
149 ids: unit Inttab.table} * (*cumulative identifiers of non-drafts -- symbolic body content*) |
150 (*data*) |
150 (*data*) |
151 Object.T Datatab.table * |
151 Object.T Datatab.table * (*body content*) |
152 (*ancestry*) |
152 (*ancestry*) |
153 {parents: theory list, (*immediate predecessors*) |
153 {parents: theory list, (*immediate predecessors*) |
154 ancestors: theory list} * (*all predecessors -- canonical reverse order*) |
154 ancestors: theory list} * (*all predecessors -- canonical reverse order*) |
155 (*history*) |
155 (*history*) |
156 {name: string, (*official theory name*) |
156 {name: string, (*official theory name*) |
157 stage: int}; (*checkpoint counter*) |
157 stage: int}; (*checkpoint counter*) |
158 |
158 |
159 exception THEORY of string * theory list; |
159 exception THEORY of string * theory list; |
160 |
160 |
203 |
203 |
204 (* names *) |
204 (* names *) |
205 |
205 |
206 val PureN = "Pure"; |
206 val PureN = "Pure"; |
207 val draftN = "#"; |
207 val draftN = "#"; |
|
208 val finished = ~1; |
208 |
209 |
209 fun display_names thy = |
210 fun display_names thy = |
210 let |
211 let |
211 val draft = if is_draft thy then [draftN] else []; |
212 val draft = if is_draft thy then [draftN] else []; |
|
213 val {stage, ...} = history_of thy; |
212 val name = |
214 val name = |
213 (case #stage (history_of thy) of |
215 if stage = finished then theory_name thy |
214 ~1 => theory_name thy |
216 else theory_name thy ^ ":" ^ string_of_int stage; |
215 | n => theory_name thy ^ ":" ^ string_of_int n); |
|
216 val ancestor_names = map theory_name (ancestors_of thy); |
217 val ancestor_names = map theory_name (ancestors_of thy); |
217 val stale = if is_stale thy then ["!"] else []; |
218 val stale = if is_stale thy then ["!"] else []; |
218 in rev (stale @ draft @ [name] @ ancestor_names) end; |
219 in rev (stale @ draft @ [name] @ ancestor_names) end; |
219 |
220 |
220 val pretty_thy = Pretty.str_list "{" "}" o display_names; |
221 val pretty_thy = Pretty.str_list "{" "}" o display_names; |
384 (* history stages *) |
385 (* history stages *) |
385 |
386 |
386 fun history_stage f thy = |
387 fun history_stage f thy = |
387 let |
388 let |
388 val {name, stage} = history_of thy; |
389 val {name, stage} = history_of thy; |
389 val _ = stage = ~1 andalso raise THEORY ("Theory already finished", [thy]); |
390 val _ = stage = finished andalso raise THEORY ("Theory already finished", [thy]); |
390 val history' = make_history name (f stage); |
391 val history' = make_history name (f stage); |
391 val thy' as Theory (identity', data', ancestry', _) = name_thy thy; |
392 val thy' as Theory (identity', data', ancestry', _) = name_thy thy; |
392 val thy'' = NAMED_CRITICAL "theory" (fn () => |
393 val thy'' = NAMED_CRITICAL "theory" (fn () => |
393 (check_thy thy'; vitalize (Theory (identity', data', ancestry', history')))); |
394 (check_thy thy'; vitalize (Theory (identity', data', ancestry', history')))); |
394 in thy'' end; |
395 in thy'' end; |
395 |
396 |
396 fun checkpoint_thy thy = |
397 fun checkpoint_thy thy = |
397 if is_draft thy then history_stage (fn stage => stage + 1) thy |
398 if is_draft thy then history_stage (fn stage => stage + 1) thy |
398 else thy; |
399 else thy; |
399 |
400 |
400 val finish_thy = history_stage (fn _ => ~1); |
401 val finish_thy = history_stage (fn _ => finished); |
401 |
402 |
402 |
403 |
403 (* theory data *) |
404 (* theory data *) |
404 |
405 |
405 structure TheoryData = |
406 structure TheoryData = |