35 AList.join (eq_snd (op =)) (K (Library.merge eq)) (interps1, interps2)); |
35 AList.join (eq_snd (op =)) (K (Library.merge eq)) (interps1, interps2)); |
36 ); |
36 ); |
37 |
37 |
38 val result = #1 o Interp.get; |
38 val result = #1 o Interp.get; |
39 |
39 |
40 fun consolidate lthy = |
40 fun consolidate_common g_or_f lift_lthy thy thy_or_lthy = |
41 let |
41 let |
42 val thy = Proof_Context.theory_of lthy; |
|
43 val (data, interps) = Interp.get thy; |
42 val (data, interps) = Interp.get thy; |
44 val unfinished = interps |> map (fn (((_, f), _), xs) => |
43 val unfinished = interps |> map (fn ((gf, _), xs) => |
45 (f, if eq_list eq (xs, data) then [] else subtract eq xs data)); |
44 (g_or_f gf, if eq_list eq (xs, data) then [] else subtract eq xs data)); |
46 val finished = interps |> map (fn (interp, _) => (interp, data)); |
45 val finished = interps |> map (fn (interp, _) => (interp, data)); |
47 in |
46 in |
48 if forall (null o #2) unfinished then NONE |
47 if forall (null o #2) unfinished then NONE |
49 else SOME (lthy |> fold_rev (uncurry fold_rev) unfinished |
48 else SOME (thy_or_lthy |> fold_rev (uncurry fold_rev) unfinished |
50 |> Local_Theory.background_theory (Interp.put (data, finished))) |
49 |> lift_lthy (Interp.put (data, finished))) |
51 end; |
50 end; |
52 |
51 |
53 fun consolidate_global thy = |
52 fun consolidate lthy = |
54 let |
53 consolidate_common snd Local_Theory.background_theory (Proof_Context.theory_of lthy) lthy; |
55 val (data, interps) = Interp.get thy; |
54 fun consolidate_global thy = consolidate_common fst I thy thy; |
56 val unfinished = interps |> map (fn (((g, _), _), xs) => |
|
57 (g, if eq_list eq (xs, data) then [] else subtract eq xs data)); |
|
58 val finished = interps |> map (fn (interp, _) => (interp, data)); |
|
59 in |
|
60 if forall (null o #2) unfinished then NONE |
|
61 else SOME (thy |> fold_rev (uncurry fold_rev) unfinished |> Interp.put (data, finished)) |
|
62 end; |
|
63 |
55 |
64 fun interpretation g f = |
56 fun interpretation g f = |
65 Interp.map (apsnd (cons (((g, f), stamp ()), []))) #> perhaps consolidate_global; |
57 Interp.map (apsnd (cons (((g, f), stamp ()), []))) #> perhaps consolidate_global; |
66 |
58 |
67 fun data x = Local_Theory.background_theory (Interp.map (apfst (cons x))) #> perhaps consolidate; |
59 fun data x = Local_Theory.background_theory (Interp.map (apfst (cons x))) #> perhaps consolidate; |