# HG changeset patch # User wenzelm # Date 1468663837 -7200 # Node ID 6c46a1e786da35d32abedcef3fd9412a09109758 # Parent d4d3df24f5369ecc115d57d66a4c03d7c55b2dce re-use name space serial as unique (!) id; diff -r d4d3df24f536 -r 6c46a1e786da src/Pure/Isar/proof_context.ML --- a/src/Pure/Isar/proof_context.ML Sat Jul 16 11:32:48 2016 +0200 +++ b/src/Pure/Isar/proof_context.ML Sat Jul 16 12:10:37 2016 +0200 @@ -223,7 +223,7 @@ (** Isar proof context information **) -type cases = ((Rule_Cases.T * {legacy: bool}) * int) Name_Space.table; +type cases = (Rule_Cases.T * {legacy: bool}) Name_Space.table; val empty_cases: cases = Name_Space.empty_table Markup.caseN; datatype data = @@ -1275,14 +1275,20 @@ fun dest_cases prev_ctxt ctxt = let + val serial_of = #serial oo (Name_Space.the_entry o Name_Space.space_of_table); val ignored = (case prev_ctxt of NONE => Inttab.empty | SOME ctxt0 => - Name_Space.fold_table (Inttab.insert_set o #2 o #2) (cases_of ctxt0) Inttab.empty); + let val cases0 = cases_of ctxt0 in + Name_Space.fold_table (fn (a, _) => Inttab.insert_set (serial_of cases0 a)) + cases0 Inttab.empty + end); + val cases = cases_of ctxt; in - Name_Space.fold_table (fn (a, (c, i)) => - not (Inttab.defined ignored i) ? cons (i, (a, c))) (cases_of ctxt) [] + Name_Space.fold_table (fn (a, c) => + let val i = serial_of cases a + in not (Inttab.defined ignored i) ? cons (i, (a, c)) end) cases [] |> sort (int_ord o apply2 #1) |> map #2 end; @@ -1291,24 +1297,17 @@ fun drop_schematic (b as (xi, SOME t)) = if Term.exists_subterm is_Var t then (xi, NONE) else b | drop_schematic b = b; -fun update_case _ _ ("", _) res = res - | update_case _ _ (name, NONE) (cases, index) = - (Name_Space.del_table name cases, index) - | update_case context legacy (name, SOME c) (cases, index) = +fun update_case _ _ ("", _) cases = cases + | update_case _ _ (name, NONE) cases = Name_Space.del_table name cases + | update_case context legacy (name, SOME c) cases = let val binding = Binding.name name |> legacy ? Binding.concealed; - val (_, cases') = cases - |> Name_Space.define context false (binding, ((c, {legacy = legacy}), index)); - val index' = index + 1; - in (cases', index') end; + val (_, cases') = Name_Space.define context false (binding, (c, {legacy = legacy})) cases; + in cases' end; fun update_cases' legacy args ctxt = - let - val context = Context.Proof ctxt |> Name_Space.map_naming (K Name_Space.global_naming); - val cases = cases_of ctxt; - val index = Name_Space.fold_table (fn _ => Integer.add 1) cases 0; - val (cases', _) = fold (update_case context legacy) args (cases, index); - in map_cases (K cases') ctxt end; + let val context = Context.Proof ctxt |> Name_Space.map_naming (K Name_Space.global_naming); + in map_cases (fold (update_case context legacy) args) ctxt end; fun fix (b, T) ctxt = let val ([x], ctxt') = add_fixes [(b, SOME T, NoSyn)] ctxt @@ -1335,7 +1334,7 @@ fun check_case ctxt internal (name, pos) param_specs = let - val (_, ((Rule_Cases.Case {fixes, assumes, binds, cases}, {legacy}), _)) = + val (_, (Rule_Cases.Case {fixes, assumes, binds, cases}, {legacy})) = Name_Space.check (Context.Proof ctxt) (cases_of ctxt) (name, pos); val _ = if legacy then