# HG changeset patch
# User haftmann
# Date 1281532170 -7200
# Node ID dc67291d590b2a6b390607d2014c222b142d44f4
# Parent  43a765bc7ff0a071f2c9e142ff25ea3a9ee47da1
explicit accessed to structure Class_Target

diff -r 43a765bc7ff0 -r dc67291d590b src/Pure/Isar/class.ML
--- a/src/Pure/Isar/class.ML	Wed Aug 11 14:54:10 2010 +0200
+++ b/src/Pure/Isar/class.ML	Wed Aug 11 15:09:30 2010 +0200
@@ -19,7 +19,7 @@
   val subclass_cmd: xstring -> local_theory -> Proof.state
 end;
 
-structure Class : CLASS =
+structure Class: CLASS =
 struct
 
 open Class_Target;
@@ -55,7 +55,7 @@
     (* witness for canonical interpretation *)
     val prop = try the_single props;
     val wit = Option.map (fn prop => let
-        val sup_axioms = map_filter (fst o rules thy) sups;
+        val sup_axioms = map_filter (fst o Class_Target.rules thy) sups;
         val loc_intro_tac = case Locale.intros_of thy class
           of (_, NONE) => all_tac
            | (_, SOME intro) => ALLGOALS (Tactic.rtac intro);
@@ -66,9 +66,9 @@
 
     (* canonical interpretation *)
     val base_morph = inst_morph
-      $> Morphism.binding_morphism (Binding.prefix false (class_prefix class))
+      $> Morphism.binding_morphism (Binding.prefix false (Class_Target.class_prefix class))
       $> Element.satisfy_morphism (the_list wit);
-    val eq_morph = Element.eq_morphism thy (these_defs thy sups);
+    val eq_morph = Element.eq_morphism thy (Class_Target.these_defs thy sups);
 
     (* assm_intro *)
     fun prove_assm_intro thm =
@@ -88,7 +88,7 @@
     val of_class_prop = case prop of NONE => of_class_prop_concl
       | SOME prop => Logic.mk_implies (Morphism.term const_morph
           ((map_types o map_atyps) (K aT) prop), of_class_prop_concl);
-    val sup_of_classes = map (snd o rules thy) sups;
+    val sup_of_classes = map (snd o Class_Target.rules thy) sups;
     val loc_axiom_intros = map Drule.export_without_context_open (Locale.axioms_of thy class);
     val axclass_intro = #intro (AxClass.get_info thy class);
     val base_sort_trivs = Thm.of_sort (Thm.ctyp_of thy aT, base_sort);
@@ -110,10 +110,10 @@
     val algebra = Sign.classes_of thy;
     val inter_sort = curry (Sorts.inter_sort algebra);
     val proto_base_sort = if null sups then Sign.defaultS thy
-      else fold inter_sort (map (base_sort thy) sups) [];
+      else fold inter_sort (map (Class_Target.base_sort thy) sups) [];
     val base_constraints = (map o apsnd)
       (map_type_tfree (K (TVar ((Name.aT, 0), proto_base_sort))) o fst o snd)
-        (these_operations thy sups);
+        (Class_Target.these_operations thy sups);
     val reject_bcd_etc = (map o map_atyps) (fn T as TFree (v, sort) =>
           if v = Name.aT then T
           else error ("No type variable other than " ^ Name.aT ^ " allowed in class specification")
@@ -141,7 +141,7 @@
 
     (* preprocessing elements, retrieving base sort from type-checked elements *)
     val init_class_body = fold (ProofContext.add_const_constraint o apsnd SOME) base_constraints
-      #> redeclare_operations thy sups
+      #> Class_Target.redeclare_operations thy sups
       #> add_typ_check 10 "reject_bcd_etc" reject_bcd_etc
       #> add_typ_check ~10 "singleton_fixate" singleton_fixate;
     val raw_supexpr = (map (fn sup => (sup, (("", false),
@@ -181,10 +181,10 @@
     val inter_sort = curry (Sorts.inter_sort (Sign.classes_of thy));
     val sups = map (prep_class thy) raw_supclasses
       |> Sign.minimize_sort thy;
-    val _ = case filter_out (is_class thy) sups
+    val _ = case filter_out (Class_Target.is_class thy) sups
      of [] => ()
       | no_classes => error ("No (proper) classes: " ^ commas (map quote no_classes));
-    val raw_supparams = (map o apsnd) (snd o snd) (these_params thy sups);
+    val raw_supparams = (map o apsnd) (snd o snd) (Class_Target.these_params thy sups);
     val raw_supparam_names = map fst raw_supparams;
     val _ = if has_duplicates (op =) raw_supparam_names
       then error ("Duplicate parameter(s) in superclasses: "
@@ -197,7 +197,7 @@
     val sup_sort = inter_sort base_sort sups;
 
     (* process elements as class specification *)
-    val class_ctxt = begin sups base_sort (ProofContext.init_global thy);
+    val class_ctxt = Class_Target.begin sups base_sort (ProofContext.init_global thy);
     val ((_, _, syntax_elems), _) = class_ctxt
       |> Expression.cert_declaration supexpr I inferred_elems;
     fun check_vars e vs = if null vs
@@ -229,7 +229,7 @@
   let
     (*FIXME simplify*)
     val supconsts = supparam_names
-      |> AList.make (snd o the o AList.lookup (op =) (these_params thy sups))
+      |> AList.make (snd o the o AList.lookup (op =) (Class_Target.these_params thy sups))
       |> (map o apsnd o apsnd o map_atyps o K o TFree) (Name.aT, [class]);
     val all_params = Locale.params_of thy class;
     val raw_params = (snd o chop (length supparam_names)) all_params;
@@ -249,7 +249,7 @@
       end;
   in
     thy
-    |> Sign.add_path (class_prefix class)
+    |> Sign.add_path (Class_Target.class_prefix class)
     |> fold_map add_const raw_params
     ||> Sign.restore_naming thy
     |-> (fn params => pair (supconsts @ (map o apfst) fst params, params))
@@ -295,7 +295,7 @@
     #-> (fn (base_morph, eq_morph, export_morph, axiom, assm_intro, of_class) =>
        Context.theory_map (Locale.add_registration (class, base_morph)
          (Option.map (rpair true) eq_morph) export_morph)
-    #> register class sups params base_sort base_morph export_morph axiom assm_intro of_class))
+    #> Class_Target.register class sups params base_sort base_morph export_morph axiom assm_intro of_class))
     |> Named_Target.init (SOME class)
     |> pair class
   end;
@@ -327,7 +327,7 @@
     val some_prop = try the_single props;
     val some_dep_morph = try the_single (map snd deps);
     fun after_qed some_wit =
-      ProofContext.theory (register_subclass (sub, sup)
+      ProofContext.theory (Class_Target.register_subclass (sub, sup)
         some_dep_morph some_wit export)
       #> ProofContext.theory_of #> Named_Target.init (SOME sub);
   in do_proof after_qed some_prop goal_ctxt end;