src/Pure/context.ML
changeset 29095 a75f3ed534a0
parent 29093 1cc36c0ec9eb
child 29367 741373421318
equal deleted inserted replaced
29094:2a527750cf90 29095:a75f3ed534a0
   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 =