clarified signature;
authorwenzelm
Fri, 16 Aug 2019 14:01:51 +0200
changeset 70550 8bc7e54bead9
parent 70546 2970fdc230cc
child 70551 9e87e978be5e
clarified signature;
src/Pure/facts.ML
src/Pure/global_theory.ML
--- a/src/Pure/facts.ML	Fri Aug 16 11:40:13 2019 +0200
+++ b/src/Pure/facts.ML	Fri Aug 16 14:01:51 2019 +0200
@@ -46,7 +46,8 @@
   val hide: bool -> string -> T -> T
   type thm_name = string * int
   val thm_name_ord: thm_name * thm_name -> order
-  val single_thm_name: string -> thm_name
+  val thm_name_flat: thm_name -> string
+  val thm_name_list: string -> thm list -> (thm_name * thm) list
   val get_thm: Context.generic -> T -> thm_name * Position.T -> thm
 end;
 
@@ -305,7 +306,12 @@
 type thm_name = string * int;
 val thm_name_ord = prod_ord string_ord int_ord;
 
-fun single_thm_name name : thm_name = (name, 0);
+fun thm_name_flat (name, i) =
+  if name = "" orelse i = 0 then name
+  else name ^ "_" ^ string_of_int i;
+
+fun thm_name_list name [thm: thm] = [((name, 0), thm)]
+  | thm_name_list name thms = map_index (fn (i, thm) => ((name, i + 1), thm)) thms;
 
 fun get_thm context facts ((name, i), pos) =
   let
--- a/src/Pure/global_theory.ML	Fri Aug 16 11:40:13 2019 +0200
+++ b/src/Pure/global_theory.ML	Fri Aug 16 14:01:51 2019 +0200
@@ -19,7 +19,7 @@
   val burrow_fact: ('a list -> 'b list) -> ('a list * 'c) list -> ('b list * 'c) list
   val burrow_facts: ('a list -> 'b list) ->
     ('c * ('a list * 'd) list) list -> ('c * ('b list * 'd) list) list
-  val name_multi: string * Position.T -> 'a list -> ((string * Position.T) * 'a) list
+  val name_multi: string * Position.T -> thm list -> ((string * Position.T) * thm) list
   type name_flags
   val unnamed: name_flags
   val official1: name_flags
@@ -134,15 +134,11 @@
 
 end;
 
-fun name_multi (name, pos: Position.T) xs =
-  (case xs of
-    [x] => [((name, pos), x)]
-  | _ =>
-      if name = "" then map (pair ("", pos)) xs
-      else map_index (fn (i, x) => ((name ^ "_" ^ string_of_int (i + 1), pos), x)) xs);
+fun name_multi (name, pos) =
+  Facts.thm_name_list name #> (map o apfst) (fn thm_name => (Facts.thm_name_flat thm_name, pos));
 
-fun name_thms name_flags name_pos thms =
-  map (uncurry (name_thm name_flags)) (name_multi name_pos thms);
+fun name_thms name_flags name_pos =
+  name_multi name_pos #> map (uncurry (name_thm name_flags));
 
 
 (* apply theorems and attributes *)