src/Pure/pure_thy.ML
changeset 28861 f53abb0733ee
parent 28856 5e009a80fe6d
child 28864 d6fe93e3dcb9
--- a/src/Pure/pure_thy.ML	Thu Nov 20 14:51:40 2008 +0100
+++ b/src/Pure/pure_thy.ML	Thu Nov 20 14:55:25 2008 +0100
@@ -143,35 +143,36 @@
 fun enter_proofs (thy, thms) =
   (FactsData.map (apsnd (fold (cons o lazy_proof) thms)) thy, thms);
 
-fun enter_thms _ _ app_att ("", thms) thy = swap (enter_proofs (app_att (thy, thms)))
-  | enter_thms pre_name post_name app_att (bname, thms) thy =
-      let
-        val naming = Sign.naming_of thy;
-        val name = NameSpace.full naming bname;
-        val (thy', thms') =
-          enter_proofs (apsnd (post_name name) (app_att (thy, pre_name name thms)));
-        val thms'' = map (Thm.transfer thy') thms';
-        val thy'' = thy' |> FactsData.map (apfst (Facts.add_global naming (name, thms'')));
-      in (thms'', thy'') end;
+fun enter_thms pre_name post_name app_att (b, thms) thy =
+  if Name.is_nothing b
+  then swap (enter_proofs (app_att (thy, thms)))
+  else let
+    val naming = Sign.naming_of thy;
+    val name = NameSpace.full_binding naming b;
+    val (thy', thms') =
+      enter_proofs (apsnd (post_name name) (app_att (thy, pre_name name thms)));
+    val thms'' = map (Thm.transfer thy') thms';
+    val thy'' = thy' |> FactsData.map (apfst (Facts.add_global naming (name, thms'')));
+  in (thms'', thy'') end;
 
 
 (* store_thm(s) *)
 
-val store_thms =
-  enter_thms (name_thms true true Position.none) (name_thms false true Position.none) I;
+fun store_thms (bname, thms) = enter_thms (name_thms true true Position.none)
+  (name_thms false true Position.none) I (Name.binding bname, thms);
 
-fun store_thm (name, th) = store_thms (name, [th]) #>> the_single;
+fun store_thm (bname, th) = store_thms (bname, [th]) #>> the_single;
 
-fun store_thm_open (name, th) =
+fun store_thm_open (bname, th) =
   enter_thms (name_thms true false Position.none) (name_thms false false Position.none) I
-    (name, [th]) #>> the_single;
+    (Name.binding bname, [th]) #>> the_single;
 
 
 (* add_thms(s) *)
 
 fun add_thms_atts pre_name ((bname, thms), atts) =
   enter_thms pre_name (name_thms false true Position.none)
-    (foldl_map (Thm.theory_attributes atts)) (bname, thms);
+    (foldl_map (Thm.theory_attributes atts)) (Name.binding bname, thms);
 
 fun gen_add_thmss pre_name =
   fold_map (add_thms_atts pre_name);
@@ -195,17 +196,16 @@
 
 local
 
-fun gen_note_thmss tag = fold_map (fn ((binding, more_atts), ths_atts) => fn thy =>
+fun gen_note_thmss tag = fold_map (fn ((b, more_atts), ths_atts) => fn thy =>
   let
-    val bname = Name.name_of binding;
-    val pos = Name.pos_of binding;
-    val name = Sign.full_name thy bname;
+    val pos = Name.pos_of b;
+    val name = Sign.full_binding thy b;
     val _ = Position.report (Markup.fact_decl name) pos;
 
     fun app (x, (ths, atts)) = foldl_map (Thm.theory_attributes atts) (x, ths);
     val (thms, thy') = thy |> enter_thms
       (name_thmss true pos) (name_thms false true pos) (apsnd flat o foldl_map app)
-      (bname, map (fn (ths, atts) => (ths, surround tag (atts @ more_atts))) ths_atts);
+      (b, map (fn (ths, atts) => (ths, surround tag (atts @ more_atts))) ths_atts);
   in ((name, thms), thy') end);
 
 in