diff -r dfa14d921fd2 -r bbb95a494e5d src/Pure/Isar/code.ML --- a/src/Pure/Isar/code.ML Thu Oct 02 11:02:15 2025 +0000 +++ b/src/Pure/Isar/code.ML Fri Oct 03 17:26:12 2025 +0200 @@ -287,49 +287,82 @@ structure History = struct +datatype state = + Fresh (*entry is active and unhistorized*) + | Historized (*entry is active and historized*) + | Suppressed (*incompatible entries are merely suppressed after theory merge but sustain*) + +fun is_unhistorized Fresh = true + | is_unhistorized _ = false; + type 'a T = { entry: 'a, - suppressed: bool, (*incompatible entries are merely suppressed after theory merge but sustain*) - history: serial list (*explicit trace of declaration history supports non-monotonic declarations*) + state: state, + history: Context.id list (*explicit trace of declaration history supports non-monotonic declarations*) } Symtab.table; -fun some_entry (SOME {suppressed = false, entry, ...}) = SOME entry +fun some_entry (SOME {state = Suppressed, ...}) = NONE + | some_entry (SOME {entry, ...}) = SOME entry | some_entry _ = NONE; +fun the_history (SOME {history = history, ...}) = history + | the_history _ = []; + fun lookup table = Symtab.lookup table #> some_entry; +fun history_of table = + Symtab.lookup table #> the_history; + fun register key entry table = - if is_some (Symtab.lookup table key) - then Symtab.map_entry key - (fn {history, ...} => {entry = entry, suppressed = false, history = serial () :: history}) table - else Symtab.update (key, {entry = entry, suppressed = false, history = [serial ()]}) table; + table + |> Symtab.update + (key, {entry = entry, state = Fresh, history = history_of table key}); + +fun modify_entry key f = + Symtab.map_entry key (fn {entry, state, history} => + {entry = f entry, state = state, history = history}); -fun modify_entry key f = Symtab.map_entry key - (fn {entry, suppressed, history} => {entry = f entry, suppressed = suppressed, history = history}); +fun all table = + Symtab.dest table + |> map_filter (fn (key, record) => case some_entry (SOME record) of SOME entry => SOME (key, entry) | _ => NONE); + +fun has_unhistorized table = + Symtab.exists (fn (_, {state, ...}) => is_unhistorized state) table; -fun all table = Symtab.dest table - |> map_filter (fn (key, {entry, suppressed = false, ...}) => SOME (key, entry) | _ => NONE); +fun historize_record thy (record as {entry, state, history}) = + if is_unhistorized state + then {entry = entry, state = Historized, history = Context.theory_identifier thy :: history} + else record; + +fun historize thy table = + Symtab.map (K (historize_record thy)) table; local -fun merge_history join_same - ({entry = entry1, history = history1, ...}, {entry = entry2, history = history2, ...}) = - let - val history = merge (op =) (history1, history2); - val entry = if hd history1 = hd history2 then join_same (entry1, entry2) - else if hd history = hd history1 then entry1 else entry2; - in {entry = entry, suppressed = false, history = history} end; +fun merge_history _ ({history = [], ...}, record) = record (*degenerate case: unfinished theory*) + | merge_history _ (record, {history = [], ...}) = record (*degenerate case: unfinished theory*) + | merge_history join_same + ({entry = entry1, history = history1, ...}, {entry = entry2, history = history2, ...}) = + let + val history = merge (op =) (history1, history2); + val entry = if hd history1 = hd history2 then join_same (entry1, entry2) + else if hd history = hd history1 then entry1 else entry2; + in {entry = entry, state = Historized, history = history} end; + +fun suppressed_if _ Suppressed = Suppressed + | suppressed_if true _ = Suppressed + | suppressed_if _ state = state; in fun join join_same tables = Symtab.join (K (merge_history join_same)) tables; fun suppress key = Symtab.map_entry key - (fn {entry, history, ...} => {entry = entry, suppressed = true, history = history}); + (fn {entry, history, ...} => {entry = entry, state = Suppressed, history = history}); -fun suppress_except f = Symtab.map (fn key => fn {entry, suppressed, history} => - {entry = entry, suppressed = suppressed orelse (not o f) (key, entry), history = history}); +fun suppress_except f = Symtab.map (fn key => fn {entry, state, history} => + {entry = entry, state = suppressed_if ((not o f) (key, entry)) state, history = history}); end; @@ -394,6 +427,16 @@ val map_functions = map_specs o apsnd o apfst o apsnd; val map_cases = map_specs o apsnd o apsnd; +fun has_unhistorized specs = + History.has_unhistorized (types_of specs) + orelse History.has_unhistorized (functions_of specs) + orelse History.has_unhistorized (cases_of specs); + +fun historize thy = + map_types (History.historize thy) + #> map_functions (History.historize thy) + #> map_cases (History.historize thy); + (* data slots dependent on executable code *) @@ -516,6 +559,9 @@ |> map (fn c => (c, the_fun_spec specs c)) |> filter_out (is_unimplemented o snd); + +(* historization *) + fun historize_pending_fun_specs thy = let val pending_eqns = (pending_eqns_of o specs_of) thy; @@ -530,7 +576,12 @@ |> SOME end; -val _ = Theory.setup (Theory.at_end (historize_pending_fun_specs)); +fun historize_specs thy = + if (has_unhistorized o specs_of) thy + then thy |> modify_specs (historize thy) |> SOME + else NONE; + +val _ = Theory.setup (Theory.at_end (perhaps_apply [historize_pending_fun_specs, historize_specs])); (** foundation **)