# HG changeset patch
# User wenzelm
# Date 1537561570 -7200
# Node ID aec64b88e708d5948e3cc4c9ca713cea7b7eba84
# Parent  f440bedb8e4595efbb5b5ccab8dde469d972e4bc
clarified locale content: proper args with types for interpretation/axioms and typargs derived from the result;

diff -r f440bedb8e45 -r aec64b88e708 src/Pure/Isar/locale.ML
--- a/src/Pure/Isar/locale.ML	Fri Sep 21 21:06:23 2018 +0200
+++ b/src/Pure/Isar/locale.ML	Fri Sep 21 22:26:10 2018 +0200
@@ -56,13 +56,6 @@
   val specification_of: theory -> string -> term option * term list
   val hyp_spec_of: theory -> string -> Element.context_i list
 
-  type content =
-   {type_params: (string * sort) list,
-    params: ((string * typ) * mixfix) list,
-    asm: term option,
-    defs: term list}
-  val dest_locales: theory -> (string * content) list
-
   (* Storing results *)
   val add_facts: string -> string -> Attrib.fact list -> Proof.context -> Proof.context
   val add_declaration: string -> bool -> declaration -> Proof.context -> Proof.context
@@ -93,6 +86,7 @@
   val add_dependency: string -> registration -> theory -> theory
 
   (* Diagnostic *)
+  val get_locales: theory -> string list
   val print_locales: bool -> theory -> unit
   val print_locale: theory -> bool -> xstring * Position.T -> unit
   val print_registrations: Proof.context -> xstring * Position.T -> unit
@@ -215,19 +209,6 @@
   Locales.map o Name_Space.map_table_entry name o map_locale o apsnd;
 
 
-(* content *)
-
-type content =
- {type_params: (string * sort) list,
-  params: ((string * typ) * mixfix) list,
-  asm: term option,
-  defs: term list};
-
-fun dest_locales thy =
-  (Locales.get thy, []) |-> Name_Space.fold_table
-    (fn (name, Loc {parameters = (type_params, params), spec = (asm, defs), ...}) =>
-      cons (name, {type_params = type_params, params = params, asm = asm, defs = defs}));
-
 
 (** Primitive operations **)
 
@@ -715,6 +696,8 @@
 
 (*** diagnostic commands and interfaces ***)
 
+fun get_locales thy = map #1 (Name_Space.dest_table (Locales.get thy));
+
 fun print_locales verbose thy =
   Pretty.block
     (Pretty.breaks
diff -r f440bedb8e45 -r aec64b88e708 src/Pure/Thy/export_theory.ML
--- a/src/Pure/Thy/export_theory.ML	Fri Sep 21 21:06:23 2018 +0200
+++ b/src/Pure/Thy/export_theory.ML	Fri Sep 21 22:26:10 2018 +0200
@@ -70,23 +70,39 @@
   (fold_types o fold_atyps) (fn TFree (a, S) => is_free used a ? insert (op =) (a, S) | _ => I);
 
 
-(* locale support *)
+(* locale content *)
 
-fun locale_axioms thy loc =
+fun locale_content ctxt loc =
   let
-    val (intro1, intro2) = Locale.intros_of thy loc;
-    fun intros_tac ctxt = Method.try_intros_tac ctxt (the_list intro1 @ the_list intro2);
-    val res =
-      Proof_Context.init_global thy
-      |> Interpretation.interpretation ([(loc, (("", false), (Expression.Named [], [])))], [])
-      |> Proof.refine (Method.Basic (METHOD o intros_tac))
-      |> Seq.filter_results
-      |> try Seq.hd;
-  in
-    (case res of
-      SOME st => Thm.prems_of (#goal (Proof.goal st))
-    | NONE => raise Fail ("Cannot unfold locale " ^ quote loc))
-  end;
+    val thy = Proof_Context.theory_of ctxt;
+
+    val args = map #1 (Locale.params_of thy loc);
+    val axioms =
+      let
+        val (intro1, intro2) = Locale.intros_of thy loc;
+        fun intros_tac ctxt = Method.try_intros_tac ctxt (the_list intro1 @ the_list intro2);
+        val inst = Expression.Named (args |> map (fn (x, T) => (x, Free (x, T))));
+        val res =
+          Proof_Context.init_global thy
+          |> Interpretation.interpretation ([(loc, (("", false), (inst, [])))], [])
+          |> Proof.refine (Method.Basic (METHOD o intros_tac))
+          |> Seq.filter_results
+          |> try Seq.hd;
+      in
+        (case res of
+          SOME st => Thm.prems_of (#goal (Proof.goal st))
+        | NONE => raise Fail ("Cannot unfold locale " ^ quote loc))
+      end;
+
+    val typargs = rev (fold Term.add_tfrees (map Free args @ axioms) []);
+    val typargs_dups =
+      AList.group (op =) typargs |> filter (fn (_, [_]) => false | _ => true)
+        |> maps (fn (x, ys) => map (pair x) ys);
+    val typargs_print = Syntax.string_of_typ (Config.put show_sorts true ctxt) o TFree;
+    val _ =
+      if null typargs_dups then ()
+      else error ("Duplicate type parameters " ^ commas (map typargs_print typargs_dups));
+  in {typargs = typargs, args = args, axioms = axioms} end;
 
 
 (* general setup *)
@@ -272,20 +288,9 @@
       let open XML.Encode Term_XML.Encode
       in triple (list (pair string sort)) (list (pair string typ)) (list (encode_axiom used)) end;
 
-    fun export_locale loc ({type_params, params, ...}: Locale.content) =
+    fun export_locale loc =
       let
-        val axioms = locale_axioms thy loc;
-        val args = map #1 params;
-
-        val typargs = rev (fold Term.add_tfrees (map Free args @ axioms) (rev type_params));
-        val typargs_dups =
-          AList.group (op =) typargs |> filter (fn (_, [_]) => false | _ => true)
-            |> maps (fn (x, ys) => map (pair x) ys);
-        val typargs_print = Syntax.string_of_typ (Config.put show_sorts true thy_ctxt) o TFree;
-        val _ =
-          if null typargs_dups then ()
-          else error ("Duplicate type parameters " ^ commas (map typargs_print typargs_dups));
-
+        val {typargs, args, axioms} = locale_content thy_ctxt loc;
         val used = fold Name.declare (map #1 typargs @ map #1 args) Name.context;
       in encode_locale used (typargs, args, axioms) end
       handle ERROR msg =>
@@ -293,8 +298,9 @@
           quote (Locale.markup_name thy_ctxt loc));
 
     val _ =
-      export_entities "locales" (SOME oo export_locale) Locale.locale_space
-        (Locale.dest_locales thy);
+      export_entities "locales" (fn loc => fn () => SOME (export_locale loc))
+        Locale.locale_space
+        (map (rpair ()) (Locale.get_locales thy));
 
 
     (* parents *)