# Theory HOL-Examples.Records

```(*  Title:      HOL/Examples/Records.thy
Author:     Wolfgang Naraschewski, TU Muenchen
Author:     Norbert Schirmer, TU Muenchen
Author:     Norbert Schirmer, Apple, 2022
Author:     Markus Wenzel, TU Muenchen
*)

section ‹Using extensible records in HOL -- points and coloured points›

theory Records
imports Main
begin

subsection ‹Points›

record point =
xpos :: nat
ypos :: nat

text ‹
Apart many other things, above record declaration produces the
following theorems:
›

thm point.simps
thm point.iffs
thm point.defs

text ‹
The set of theorems @{thm [source] point.simps} is added
automatically to the standard simpset, @{thm [source] point.iffs} is
added to the Classical Reasoner and Simplifier context.

┉ Record declarations define new types and type abbreviations:
@{text [display]
‹point = ⦇xpos :: nat, ypos :: nat⦈ = () point_ext_type
'a point_scheme = ⦇xpos :: nat, ypos :: nat, ... :: 'a⦈  = 'a point_ext_type›}
›

consts foo2 :: "⦇xpos :: nat, ypos :: nat⦈"
consts foo4 :: "'a ⇒ ⦇xpos :: nat, ypos :: nat, … :: 'a⦈"

subsubsection ‹Introducing concrete records and record schemes›

definition foo1 :: point
where "foo1 = ⦇xpos = 1, ypos = 0⦈"

definition foo3 :: "'a ⇒ 'a point_scheme"
where "foo3 ext = ⦇xpos = 1, ypos = 0, … = ext⦈"

subsubsection ‹Record selection and record update›

definition getX :: "'a point_scheme ⇒ nat"
where "getX r = xpos r"

definition setX :: "'a point_scheme ⇒ nat ⇒ 'a point_scheme"
where "setX r n = r ⦇xpos := n⦈"

text ‹Basic simplifications.›

lemma "point.make n p = ⦇xpos = n, ypos = p⦈"
by (simp only: point.make_def)

lemma "xpos ⦇xpos = m, ypos = n, … = p⦈ = m"
by simp

lemma "⦇xpos = m, ypos = n, … = p⦈⦇xpos:= 0⦈ = ⦇xpos = 0, ypos = n, … = p⦈"
by simp

text ‹┉ Equality of records.›

lemma "n = n' ⟹ p = p' ⟹ ⦇xpos = n, ypos = p⦈ = ⦇xpos = n', ypos = p'⦈"
― ‹introduction of concrete record equality›
by simp

lemma "⦇xpos = n, ypos = p⦈ = ⦇xpos = n', ypos = p'⦈ ⟹ n = n'"
― ‹elimination of concrete record equality›
by simp

lemma "r⦇xpos := n⦈⦇ypos := m⦈ = r⦇ypos := m⦈⦇xpos := n⦈"
― ‹introduction of abstract record equality›
by simp

lemma "r⦇xpos := n⦈ = r⦇xpos := n'⦈" if "n = n'"
― ‹elimination of abstract record equality (manual proof)›
proof -
let "?lhs = ?rhs" = ?thesis
from that have "xpos ?lhs = xpos ?rhs" by simp
then show ?thesis by simp
qed

text ‹┉ Surjective pairing›

lemma "r = ⦇xpos = xpos r, ypos = ypos r⦈"
by simp

lemma "r = ⦇xpos = xpos r, ypos = ypos r, … = point.more r⦈"
by simp

text ‹┉ Representation of records by cases or (degenerate) induction.›

lemma "r⦇xpos := n⦈⦇ypos := m⦈ = r⦇ypos := m⦈⦇xpos := n⦈"
proof (cases r)
fix xpos ypos more
assume "r = ⦇xpos = xpos, ypos = ypos, … = more⦈"
then show ?thesis by simp
qed

lemma "r⦇xpos := n⦈⦇ypos := m⦈ = r⦇ypos := m⦈⦇xpos := n⦈"
proof (induct r)
fix xpos ypos more
show "⦇xpos = xpos, ypos = ypos, … = more⦈⦇xpos := n, ypos := m⦈ =
⦇xpos = xpos, ypos = ypos, … = more⦈⦇ypos := m, xpos := n⦈"
by simp
qed

lemma "r⦇xpos := n⦈⦇xpos := m⦈ = r⦇xpos := m⦈"
proof (cases r)
fix xpos ypos more
assume "r = ⦇xpos = xpos, ypos = ypos, … = more⦈"
then show ?thesis by simp
qed

lemma "r⦇xpos := n⦈⦇xpos := m⦈ = r⦇xpos := m⦈"
proof (cases r)
case fields
then show ?thesis by simp
qed

lemma "r⦇xpos := n⦈⦇xpos := m⦈ = r⦇xpos := m⦈"
by (cases r) simp

text ‹┉ Concrete records are type instances of record schemes.›

definition foo5 :: nat
where "foo5 = getX ⦇xpos = 1, ypos = 0⦈"

text ‹┉ Manipulating the ``‹...›'' (more) part.›

definition incX :: "'a point_scheme ⇒ 'a point_scheme"
where "incX r = ⦇xpos = xpos r + 1, ypos = ypos r, … = point.more r⦈"

lemma "incX r = setX r (Suc (getX r))"
by (simp add: getX_def setX_def incX_def)

text ‹┉ An alternative definition.›

definition incX' :: "'a point_scheme ⇒ 'a point_scheme"
where "incX' r = r⦇xpos := xpos r + 1⦈"

subsection ‹Coloured points: record extension›

datatype colour = Red | Green | Blue

record cpoint = point +
colour :: colour

text ‹
The record declaration defines a new type constructor and abbreviations:
@{text [display]
‹cpoint = ⦇xpos :: nat, ypos :: nat, colour :: colour⦈ =
() cpoint_ext_type point_ext_type
'a cpoint_scheme = ⦇xpos :: nat, ypos :: nat, colour :: colour, … :: 'a⦈ =
'a cpoint_ext_type point_ext_type›}
›

consts foo6 :: cpoint
consts foo7 :: "⦇xpos :: nat, ypos :: nat, colour :: colour⦈"
consts foo8 :: "'a cpoint_scheme"
consts foo9 :: "⦇xpos :: nat, ypos :: nat, colour :: colour, … :: 'a⦈"

text ‹Functions on ‹point› schemes work for ‹cpoints› as well.›

definition foo10 :: nat
where "foo10 = getX ⦇xpos = 2, ypos = 0, colour = Blue⦈"

subsubsection ‹Non-coercive structural subtyping›

text ‹Term \<^term>‹foo11› has type \<^typ>‹cpoint›, not type \<^typ>‹point› --- Great!›

definition foo11 :: cpoint
where "foo11 = setX ⦇xpos = 2, ypos = 0, colour = Blue⦈ 0"

subsection ‹Other features›

text ‹Field names contribute to record identity.›

record point' =
xpos' :: nat
ypos' :: nat

text ‹
⇤ May not apply \<^term>‹getX› to @{term [source] "⦇xpos' = 2, ypos' = 0⦈"}
--- type error.
›

text ‹┉ Polymorphic records.›

record 'a point'' = point +
content :: 'a

type_synonym cpoint'' = "colour point''"

text ‹Updating a record field with an identical value is simplified.›
lemma "r⦇xpos := xpos r⦈ = r"
by simp

text ‹Only the most recent update to a component survives simplification.›
lemma "r⦇xpos := x, ypos := y, xpos := x'⦈ = r⦇ypos := y, xpos := x'⦈"
by simp

text ‹
In some cases its convenient to automatically split (quantified) records.
For this purpose there is the simproc @{ML [source] "Record.split_simproc"}
and the tactic @{ML [source] "Record.split_simp_tac"}. The simplification
procedure only splits the records, whereas the tactic also simplifies the
resulting goal with the standard record simplification rules. A
(generalized) predicate on the record is passed as parameter that decides
whether or how `deep' to split the record. It can peek on the subterm
starting at the quantified occurrence of the record (including the
quantifier). The value \<^ML>‹0› indicates no split, a value greater
\<^ML>‹0› splits up to the given bound of record extension and finally the
value \<^ML>‹~1› completely splits the record. @{ML [source]
"Record.split_simp_tac"} additionally takes a list of equations for
simplification and can also split fixed record variables.
›

lemma "(∀r. P (xpos r)) ⟶ (∀x. P x)"
apply (tactic ‹simp_tac (put_simpset HOL_basic_ss \<^context>
apply simp
done

lemma "(∀r. P (xpos r)) ⟶ (∀x. P x)"
apply (tactic ‹Record.split_simp_tac \<^context> [] (K ~1) 1›)
apply simp
done

lemma "(∃r. P (xpos r)) ⟶ (∃x. P x)"
apply (tactic ‹simp_tac (put_simpset HOL_basic_ss \<^context>
apply simp
done

lemma "(∃r. P (xpos r)) ⟶ (∃x. P x)"
apply (tactic ‹Record.split_simp_tac \<^context> [] (K ~1) 1›)
apply simp
done

lemma "⋀r. P (xpos r) ⟹ (∃x. P x)"
apply (tactic ‹simp_tac (put_simpset HOL_basic_ss \<^context>
apply auto
done

lemma "⋀r. P (xpos r) ⟹ (∃x. P x)"
apply (tactic ‹Record.split_simp_tac \<^context> [] (K ~1) 1›)
apply auto
done

lemma "P (xpos r) ⟹ (∃x. P x)"
apply (tactic ‹Record.split_simp_tac \<^context> [] (K ~1) 1›)
apply auto
done

begin
have "∃x. P x"
if "P (xpos r)" for P r
apply (insert that)
apply (tactic ‹Record.split_simp_tac \<^context> [] (K ~1) 1›)
apply auto
done
end

text ‹
The effect of simproc @{ML [source] Record.ex_sel_eq_simproc} is illustrated
by the following lemma.›

lemma "∃r. xpos r = x"
apply (simp)
done

subsection ‹Simprocs for update and equality›

record alph1 =
a :: nat
b :: nat

record alph2 = alph1 +
c :: nat
d :: nat

record alph3 = alph2 +
e :: nat
f :: nat

text ‹
The simprocs that are activated by default are:
▪ @{ML [source] Record.simproc}: field selection of (nested) record updates.
▪ @{ML [source] Record.upd_simproc}: nested record updates.
▪ @{ML [source] Record.eq_simproc}: (componentwise) equality of records.
›

text ‹By default record updates are not ordered by simplification.›
schematic_goal "r⦇b := x, a:= y⦈ = ?X"
by simp

text ‹Normalisation towards an update ordering (string ordering of update function names) can
be configured as follows.›
schematic_goal "r⦇b := y, a := x⦈ = ?X"
by simp

text ‹Note the interplay between update ordering and record equality. Without update ordering
the following equality is handled by @{ML [source] Record.eq_simproc}. Record equality is thus
solved by componentwise comparison of all the fields of the records which can be expensive
in the presence of many fields.›

lemma "r⦇f := x1, a:= x2⦈ = r⦇a := x2, f:= x1⦈"
by simp

lemma "r⦇f := x1, a:= x2⦈ = r⦇a := x2, f:= x1⦈"
supply [[simproc del: Record.eq]]
apply (simp?)
oops

text ‹With update ordering the equality is already established after update normalisation. There
is no need for componentwise comparison.›

lemma "r⦇f := x1, a:= x2⦈ = r⦇a := x2, f:= x1⦈"
apply simp
done

schematic_goal "r⦇f := x1, e := x2, d:= x3, c:= x4, b:=x5, a:= x6⦈ = ?X"
by simp

schematic_goal "r⦇f := x1, e := x2, d:= x3, c:= x4, e:=x5, a:= x6⦈ = ?X"
by simp

schematic_goal "r⦇f := x1, e := x2, d:= x3, c:= x4, e:=x5, a:= x6⦈ = ?X"
by simp

subsection ‹A more complex record expression›

record ('a, 'b, 'c) bar = bar1 :: 'a
bar2 :: 'b
bar3 :: 'c
bar21 :: "'b × 'a"
bar32 :: "'c × 'b"
bar31 :: "'c × 'a"

print_record "('a,'b,'c) bar"

subsection ‹Some code generation›

export_code foo1 foo3 foo5 foo10 checking SML

text ‹
Code generation can also be switched off, for instance for very large
records:›

declare [[record_codegen = false]]

record not_so_large_record =
bar520 :: nat
bar521 :: "nat × nat"

setup ‹
let
val N = 300
in
(map (fn i => (Binding.make ("fld_" ^ string_of_int i, ⌂), @{typ nat}, Mixfix.NoSyn))
(1 upto N))
end
›

declare [[record_codegen]]

schematic_goal ‹fld_1 (r⦇fld_300 := x300, fld_20 := x20, fld_200 := x200⦈) = ?X›
by simp

schematic_goal ‹r⦇fld_300 := x300, fld_20 := x20, fld_200 := x200⦈ = ?X›