src/HOL/Tools/Ctr_Sugar/local_interpretation.ML
changeset 58178 695ba3101b37
parent 58177 166131276380
child 58182 82478e6c60cb
equal deleted inserted replaced
58177:166131276380 58178:695ba3101b37
    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;