# HG changeset patch
# User wenzelm
# Date 1010675082 -3600
# Node ID 721b622d896737b4cca79fc6449f5ad11a30320a
# Parent  77ac6d8451eae46d292fa9e248cc99f66c78d672
add_thmss_hybrid;

diff -r 77ac6d8451ea -r 721b622d8967 src/Pure/Isar/locale.ML
--- a/src/Pure/Isar/locale.ML	Thu Jan 10 16:04:28 2002 +0100
+++ b/src/Pure/Isar/locale.ML	Thu Jan 10 16:04:42 2002 +0100
@@ -47,12 +47,17 @@
   val print_locales: theory -> unit
   val print_locale: theory -> expr -> unit
   val add_thmss: string -> ((string * thm list) * context attribute list) list -> theory -> theory
+  val add_thmss_hybrid: string ->
+    ((bstring * theory attribute list) * (thm list * theory attribute list) list) list ->
+    (string * context attribute list list) option -> thm list list ->
+    theory -> theory * (string * thm list) list
   val setup: (theory -> theory) list
 end;
 
 structure Locale: LOCALE =
 struct
 
+
 (** locale elements and expressions **)
 
 type context = ProofContext.context;
@@ -694,17 +699,34 @@
 
 (** store results **)
 
-fun add_thmss name args thy =
+fun add_thmss loc args thy =
   let
-    val {import, params, elems, text} = the_locale thy name;
+    val {import, params, elems, text} = the_locale thy loc;
     val note = Notes (map (fn ((a, ths), atts) =>
       ((a, atts), [(map (curry Thm.name_thm a) ths, [])])) args);
   in
     thy |> ProofContext.init
-    |> cert_context_statement (Some name) [Elem note] [];    (*test attributes!*)
-    thy |> put_locale name (make_locale import (elems @ [(note, stamp ())]) params text)
+    |> cert_context_statement (Some loc) [Elem note] [];    (*test attributes!*)
+    thy |> put_locale loc (make_locale import (elems @ [(note, stamp ())]) params text)
   end;
 
+fun hide_bound_names names thy =
+  thy |> PureThy.hide_thms false
+    (map (Sign.full_name (Theory.sign_of thy)) (filter_out (equal "") names));
+
+fun add_thmss_hybrid kind args None _ thy = PureThy.have_thmss [Drule.kind kind] args thy
+  | add_thmss_hybrid kind args (Some (loc, loc_atts)) loc_ths thy =
+      let val names = map (#1 o #1) args in
+        conditional (length names <> length loc_atts) (fn () =>
+          raise THEORY ("Bad number of locale attributes", [thy]));
+        thy
+        |> add_thmss loc ((names ~~ loc_ths) ~~ loc_atts)
+        |> Theory.add_path (Sign.base_name loc)
+        |> PureThy.have_thmss [Drule.kind kind] args
+        |>> hide_bound_names names
+        |>> Theory.parent_path
+      end;
+
 
 
 (** locale theory setup **)