merged
authorwenzelm
Fri, 31 Aug 2018 15:57:21 +0200
changeset 68863 a0769c7f51b4
parent 68860 f443ec10447d (current diff)
parent 68862 47e9912c53c3 (diff)
child 68864 1dacce27bc25
merged
--- a/src/Pure/Isar/expression.ML	Thu Aug 30 17:20:54 2018 +0200
+++ b/src/Pure/Isar/expression.ML	Fri Aug 31 15:57:21 2018 +0200
@@ -531,12 +531,8 @@
 local
 
 fun props_of thy (name, morph) =
-  let
-    val (asm, defs) = Locale.specification_of thy name;
-  in
-    (case asm of NONE => defs | SOME asm => asm :: defs)
-    |> map (Morphism.term morph)
-  end;
+  let val (asm, defs) = Locale.specification_of thy name
+  in map (Morphism.term morph) (the_list asm @ defs) end;
 
 fun prep_goal_expression prep expression ctxt =
   let
--- a/src/Pure/Isar/locale.ML	Thu Aug 30 17:20:54 2018 +0200
+++ b/src/Pure/Isar/locale.ML	Fri Aug 31 15:57:21 2018 +0200
@@ -42,6 +42,7 @@
     declaration list ->
     (string * Attrib.fact list) list ->
     (string * morphism) list -> theory -> theory
+  val locale_space: theory -> Name_Space.T
   val intern: theory -> xstring -> string
   val check: theory -> xstring * Position.T -> string
   val extern: theory -> string -> xstring
@@ -53,6 +54,14 @@
   val axioms_of: theory -> string -> thm list
   val instance_of: theory -> string -> morphism -> term list
   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
@@ -84,7 +93,6 @@
   val add_dependency: string -> registration -> theory -> theory
 
   (* Diagnostic *)
-  val hyp_spec_of: theory -> string -> Element.context_i 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
@@ -207,6 +215,20 @@
   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 **)
 
 fun params_of thy = snd o #parameters o the_locale thy;
@@ -220,8 +242,9 @@
 
 fun specification_of thy = #spec o the_locale thy;
 
-fun dependencies_of thy name = the_locale thy name |>
-  #dependencies;
+fun hyp_spec_of thy = #hyp_spec o the_locale thy;
+
+fun dependencies_of thy = #dependencies o the_locale thy;
 
 fun mixins_of thy name serial = the_locale thy name |>
   #mixins |> lookup_mixins serial;
@@ -693,8 +716,6 @@
 
 (*** diagnostic commands and interfaces ***)
 
-fun hyp_spec_of thy = #hyp_spec o the_locale thy;
-
 fun print_locales verbose thy =
   Pretty.block
     (Pretty.breaks
--- a/src/Pure/Thy/export_theory.ML	Thu Aug 30 17:20:54 2018 +0200
+++ b/src/Pure/Thy/export_theory.ML	Fri Aug 31 15:57:21 2018 +0200
@@ -87,7 +87,6 @@
                     XML.Elem (entity_markup space name, body))))
           |> sort (int_ord o apply2 #1) |> map #2
         end;
-
       in if null elems then () else export_body thy export_name elems end;
 
 
@@ -196,6 +195,21 @@
     val _ = if null classrel then () else export_body thy "classrel" (encode_classrel classrel);
     val _ = if null arities then () else export_body thy "arities" (encode_arities arities);
 
+
+    (* locales *)
+
+    fun encode_locale {type_params, params, asm, defs} =
+      (type_params, (map #1 params, (asm, defs))) |>
+        let open XML.Encode Term_XML.Encode in
+          pair (list (pair string sort))
+            (pair (list (pair string typ))
+              (pair (option term) (list term)))
+        end;
+
+    val _ =
+      export_entities "locales" (fn _ => SOME o encode_locale) Locale.locale_space
+        (Locale.dest_locales thy);
+
   in () end);
 
 end;
--- a/src/Pure/Thy/export_theory.scala	Thu Aug 30 17:20:54 2018 +0200
+++ b/src/Pure/Thy/export_theory.scala	Fri Aug 31 15:57:21 2018 +0200
@@ -30,9 +30,10 @@
     axioms: Boolean = true,
     facts: Boolean = true,
     classes: Boolean = true,
-    typedefs: Boolean = true,
+    locales: Boolean = true,
     classrel: Boolean = true,
     arities: Boolean = true,
+    typedefs: Boolean = true,
     cache: Term.Cache = Term.make_cache()): Session =
   {
     val thys =
@@ -42,7 +43,8 @@
           Export.read_theory_names(db, session_name).map((theory_name: String) =>
             read_theory(Export.Provider.database(db, session_name, theory_name),
               session_name, theory_name, types = types, consts = consts,
-              axioms = axioms, facts = facts, classes = classes, typedefs = typedefs,
+              axioms = axioms, facts = facts, classes = classes, locales = locales,
+              classrel = classrel, arities = arities, typedefs = typedefs,
               cache = Some(cache)))
         }
       })
@@ -69,9 +71,10 @@
     axioms: List[Fact_Single],
     facts: List[Fact_Multi],
     classes: List[Class],
-    typedefs: List[Typedef],
+    locales: List[Locale],
     classrel: List[Classrel],
-    arities: List[Arity])
+    arities: List[Arity],
+    typedefs: List[Typedef])
   {
     override def toString: String = name
 
@@ -81,7 +84,8 @@
         consts.iterator.map(_.entity.serial) ++
         axioms.iterator.map(_.entity.serial) ++
         facts.iterator.map(_.entity.serial) ++
-        classes.iterator.map(_.entity.serial)
+        classes.iterator.map(_.entity.serial) ++
+        locales.iterator.map(_.entity.serial)
 
     def cache(cache: Term.Cache): Theory =
       Theory(cache.string(name),
@@ -91,13 +95,14 @@
         axioms.map(_.cache(cache)),
         facts.map(_.cache(cache)),
         classes.map(_.cache(cache)),
-        typedefs.map(_.cache(cache)),
+        locales.map(_.cache(cache)),
         classrel.map(_.cache(cache)),
-        arities.map(_.cache(cache)))
+        arities.map(_.cache(cache)),
+        typedefs.map(_.cache(cache)))
   }
 
   def empty_theory(name: String): Theory =
-    Theory(name, Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil)
+    Theory(name, Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil)
 
   def read_theory(provider: Export.Provider, session_name: String, theory_name: String,
     types: Boolean = true,
@@ -105,9 +110,10 @@
     axioms: Boolean = true,
     facts: Boolean = true,
     classes: Boolean = true,
-    typedefs: Boolean = true,
+    locales: Boolean = true,
     classrel: Boolean = true,
     arities: Boolean = true,
+    typedefs: Boolean = true,
     cache: Option[Term.Cache] = None): Theory =
   {
     val parents =
@@ -124,9 +130,10 @@
         if (axioms) read_axioms(provider) else Nil,
         if (facts) read_facts(provider) else Nil,
         if (classes) read_classes(provider) else Nil,
-        if (typedefs) read_typedefs(provider) else Nil,
+        if (locales) read_locales(provider) else Nil,
         if (classrel) read_classrel(provider) else Nil,
-        if (arities) read_arities(provider) else Nil)
+        if (arities) read_arities(provider) else Nil,
+        if (typedefs) read_typedefs(provider) else Nil)
     if (cache.isDefined) theory.cache(cache.get) else theory
   }
 
@@ -154,6 +161,7 @@
     val AXIOM = Value("axiom")
     val FACT = Value("fact")
     val CLASS = Value("class")
+    val LOCALE = Value("locale")
   }
 
   sealed case class Entity(
@@ -316,6 +324,36 @@
       })
 
 
+  /* locales */
+
+  sealed case class Locale(
+    entity: Entity, type_params: List[(String, Term.Sort)], params: List[(String, Term.Typ)],
+      asm: Option[Term.Term], defs: List[Term.Term])
+  {
+    def cache(cache: Term.Cache): Locale =
+      Locale(entity.cache(cache),
+        type_params.map({ case (name, sort) => (cache.string(name), cache.sort(sort)) }),
+        params.map({ case (name, typ) => (cache.string(name), cache.typ(typ)) }),
+        asm.map(cache.term(_)),
+        defs.map(cache.term(_)))
+  }
+
+  def read_locales(provider: Export.Provider): List[Locale] =
+    provider.uncompressed_yxml(export_prefix + "locales").map((tree: XML.Tree) =>
+      {
+        val (entity, body) = decode_entity(Kind.LOCALE, tree)
+        val (type_params, (params, (asm, defs))) =
+        {
+          import XML.Decode._
+          import Term_XML.Decode._
+          pair(list(pair(string, sort)),
+            pair(list(pair(string, typ)),
+              pair(option(term), list(term))))(body)
+        }
+        Locale(entity, type_params, params, asm, defs)
+      })
+
+
   /* sort algebra */
 
   sealed case class Classrel(class_name: String, super_names: List[String])