src/Pure/thm_name.ML
author wenzelm
Wed, 27 Dec 2023 15:57:42 +0100
changeset 79372 d02c8adce4e6
parent 79371 a2fbac74fba7
child 79376 b275e3379024
permissions -rw-r--r--
clarified modules;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/thm_name.ML
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     3
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     4
Systematic naming of individual theorems, as selections from multi-facts.
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     5
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     6
  (NAME, 0): the single entry of a singleton fact NAME
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     7
  (NAME, i): entry i of a non-singleton fact (1 <= i <= length)
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     8
*)
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
     9
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    10
signature THM_NAME =
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    11
sig
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    12
  type T = string * int
70586
57df8a85317a clarified signature;
wenzelm
parents: 70575
diff changeset
    13
  val ord: T ord
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    14
  val print: T -> string
79358
b191339a014c clarified signature;
wenzelm
parents: 79329
diff changeset
    15
  val flatten: T * Position.T -> string * Position.T
79371
a2fbac74fba7 clarified signature;
wenzelm
parents: 79358
diff changeset
    16
  val list: string * Position.T -> 'a list -> ((T * Position.T) * 'a) list
79372
d02c8adce4e6 clarified modules;
wenzelm
parents: 79371
diff changeset
    17
  val expr: string * Position.T -> ('a list * 'b) list -> (((T * Position.T) * 'a) list * 'b) list
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    18
end;
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    19
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    20
structure Thm_Name: THM_NAME =
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    21
struct
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    22
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    23
type T = string * int;
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    24
val ord = prod_ord string_ord int_ord;
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    25
70575
wenzelm
parents: 70574
diff changeset
    26
fun print (name, index) =
wenzelm
parents: 70574
diff changeset
    27
  if name = "" orelse index = 0 then name
wenzelm
parents: 70574
diff changeset
    28
  else name ^ enclose "(" ")" (string_of_int index);
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    29
79358
b191339a014c clarified signature;
wenzelm
parents: 79329
diff changeset
    30
fun flatten ((name, index), pos) =
b191339a014c clarified signature;
wenzelm
parents: 79329
diff changeset
    31
  if name = "" orelse index = 0 then (name, pos)
b191339a014c clarified signature;
wenzelm
parents: 79329
diff changeset
    32
  else (name ^ "_" ^ string_of_int index, pos);
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    33
79371
a2fbac74fba7 clarified signature;
wenzelm
parents: 79358
diff changeset
    34
fun list (name, pos: Position.T) [thm] = [(((name, 0): T, pos), thm)]
a2fbac74fba7 clarified signature;
wenzelm
parents: 79358
diff changeset
    35
  | list (name, pos) thms = map_index (fn (i, thm) => (((name, i + 1), pos), thm)) thms;
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    36
79372
d02c8adce4e6 clarified modules;
wenzelm
parents: 79371
diff changeset
    37
fun expr name = split_list #>> burrow (list name) #> op ~~;
d02c8adce4e6 clarified modules;
wenzelm
parents: 79371
diff changeset
    38
70574
503ca64329cc clarified modules;
wenzelm
parents:
diff changeset
    39
end;