--- 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.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])