# HG changeset patch # User wenzelm # Date 1139674672 -3600 # Node ID 5f06c37043e4c8e61542513b7a5ac894cadec49d # Parent f26377a4605ac0f353cf4ff3f37f71d814694865 added restore; consts: provide abbreviations; diff -r f26377a4605a -r 5f06c37043e4 src/Pure/Isar/local_theory.ML --- a/src/Pure/Isar/local_theory.ML Sat Feb 11 17:17:51 2006 +0100 +++ b/src/Pure/Isar/local_theory.ML Sat Feb 11 17:17:52 2006 +0100 @@ -19,6 +19,7 @@ val theory_result: (theory -> 'a * theory) -> local_theory -> 'a * local_theory val init: xstring option -> theory -> local_theory val init_i: string option -> theory -> local_theory + val restore: local_theory -> local_theory val exit: local_theory -> local_theory * theory val consts: ((bstring * typ) * mixfix) list -> local_theory -> term list * local_theory val consts_restricted: (string * typ -> bool) -> @@ -55,7 +56,6 @@ fun init thy = {locale = NONE, params = [], hyps = [], exit = I}; fun print _ _ = (); ); - val _ = Context.add_setup Data.init; fun map_locale f = Data.map (fn {locale, params, hyps, exit} => @@ -112,14 +112,18 @@ fun locale_result f ctxt = (case locale_of ctxt of NONE => error "Local theory: no locale context" - | SOME (loc, (view, loc_ctxt)) => + | SOME (_, view_ctxt) => let - val (res, loc_ctxt') = f loc_ctxt; + val (res, loc_ctxt') = f view_ctxt; val thy' = ProofContext.theory_of loc_ctxt'; in (res, ctxt |> map_locale (K loc_ctxt') |> transfer thy') end); +fun locale f ctxt = + if is_none (locale_of ctxt) then ctxt + else #2 (locale_result (f #> pair ()) ctxt); -(* init -- exit *) + +(* init -- restore -- exit *) fun init_i NONE thy = ProofContext.init thy | init_i (SOME loc) thy = @@ -135,6 +139,11 @@ fun init loc thy = init_i (Option.map (Locale.intern thy) loc) thy; +fun restore ctxt = + (case locale_of ctxt of + NONE => ctxt + | SOME (_, (_, loc_ctxt)) => loc_ctxt |> Data.put (Data.get ctxt)); + fun exit ctxt = (ctxt, #exit (Data.get ctxt) (ProofContext.theory_of ctxt)); @@ -149,11 +158,18 @@ val params = filter pred (params_of ctxt); val ps = map Free params; val Ps = map #2 params; + val abbrevs = decls |> map (fn ((c, T), mx) => + let val t = Term.list_comb (Const (Sign.full_name thy c, Ps ---> T), ps) + in (c, t, mx) end); in - ctxt - |> theory (Sign.add_consts_i (decls |> map (fn ((c, T), mx) => (c, Ps ---> T, mx)))) - |> pair (decls |> map (fn ((c, T), _) => - Term.list_comb (Const (Sign.full_name thy c, Ps ---> T), ps))) + ctxt |> + (case locale_of ctxt of + NONE => theory (Sign.add_consts_i (map (fn ((c, T), mx) => (c, T, mx)) decls)) + | SOME (loc, _) => + theory (Sign.add_consts_i (map (fn ((c, T), _) => (c, Ps ---> T, NoSyn)) decls)) #> + locale (Locale.add_abbrevs loc true abbrevs) #> + ProofContext.add_abbrevs_i true abbrevs) + |> pair (map #2 abbrevs) end; val consts = consts_restricted (K true); @@ -169,8 +185,8 @@ ctxt |> (case locale_of ctxt of NONE => theory_result (PureThy.note_thmss_i kind (Attrib.map_facts attrib facts')) - | SOME (loc, view_ctxt) => - locale_result (K (apfst #1 (Locale.add_thmss kind loc facts' view_ctxt)))) + | SOME (loc, _) => + locale_result (apfst #1 o Locale.add_thmss kind loc facts')) ||> (#2 o ProofContext.note_thmss_i (Attrib.map_facts attrib facts)) end;