src/HOL/ex/Records.thy
author wenzelm
Thu Oct 25 22:43:05 2001 +0200 (2001-10-25)
changeset 11939 c5e69470f03b
parent 11928 d0bae2c3abad
child 12266 fa0a3e95d395
permissions -rw-r--r--
updated records;
wenzelm@10052
     1
(*  Title:      HOL/ex/Records.thy
wenzelm@10052
     2
    ID:         $Id$
wenzelm@10052
     3
    Author:     Wolfgang Naraschewski and Markus Wenzel, TU Muenchen
wenzelm@10052
     4
    License:    GPL (GNU GENERAL PUBLIC LICENSE)
wenzelm@10052
     5
*)
wenzelm@10052
     6
wenzelm@10052
     7
header {* Using extensible records in HOL -- points and coloured points *}
wenzelm@10052
     8
wenzelm@10052
     9
theory Records = Main:
wenzelm@10052
    10
wenzelm@10052
    11
subsection {* Points *}
wenzelm@10052
    12
wenzelm@10052
    13
record point =
wenzelm@11939
    14
  xpos :: nat
wenzelm@11939
    15
  ypos :: nat
wenzelm@10052
    16
wenzelm@10052
    17
text {*
wenzelm@11939
    18
  Apart many other things, above record declaration produces the
wenzelm@11939
    19
  following theorems:
wenzelm@10052
    20
*}
wenzelm@10052
    21
wenzelm@10052
    22
thm "point.simps"
wenzelm@10052
    23
thm "point.iffs"
wenzelm@11939
    24
thm "point.derived_defs"
wenzelm@10052
    25
wenzelm@10052
    26
text {*
wenzelm@11939
    27
  The set of theorems @{thm [source] point.simps} is added
wenzelm@11939
    28
  automatically to the standard simpset, @{thm [source] point.iffs} is
wenzelm@11939
    29
  added to the Classical Reasoner and Simplifier context.
wenzelm@10052
    30
wenzelm@11939
    31
  \medskip Record declarations define new type abbreviations:
wenzelm@10357
    32
  @{text [display]
wenzelm@11939
    33
"    point = (| xpos :: nat, ypos :: nat |)
wenzelm@11939
    34
    'a point_scheme = (| xpos :: nat, ypos :: nat, ... :: 'a |)"}
wenzelm@10052
    35
*}
wenzelm@10052
    36
wenzelm@10052
    37
consts foo1 :: point
wenzelm@11939
    38
consts foo2 :: "(| xpos :: nat, ypos :: nat |)"
wenzelm@11939
    39
consts foo3 :: "'a => 'a point_scheme"
wenzelm@11939
    40
consts foo4 :: "'a => (| xpos :: nat, ypos :: nat, ... :: 'a |)"
wenzelm@10052
    41
wenzelm@10052
    42
wenzelm@10052
    43
subsubsection {* Introducing concrete records and record schemes *}
wenzelm@10052
    44
wenzelm@10052
    45
defs
wenzelm@11939
    46
  foo1_def: "foo1 == (| xpos = 1, ypos = 0 |)"
wenzelm@11939
    47
  foo3_def: "foo3 ext == (| xpos = 1, ypos = 0, ... = ext |)"
wenzelm@10052
    48
wenzelm@10052
    49
wenzelm@10052
    50
subsubsection {* Record selection and record update *}
wenzelm@10052
    51
wenzelm@10052
    52
constdefs
wenzelm@11939
    53
  getX :: "'a point_scheme => nat"
wenzelm@11939
    54
  "getX r == xpos r"
wenzelm@11939
    55
  setX :: "'a point_scheme => nat => 'a point_scheme"
wenzelm@11939
    56
  "setX r n == r (| xpos := n |)"
wenzelm@10052
    57
wenzelm@10052
    58
wenzelm@10052
    59
subsubsection {* Some lemmas about records *}
wenzelm@10052
    60
wenzelm@10357
    61
text {* Basic simplifications. *}
wenzelm@10052
    62
wenzelm@11939
    63
lemma "point.make n p = (| xpos = n, ypos = p |)"
wenzelm@11939
    64
  by (simp only: point.make_def)
wenzelm@10052
    65
wenzelm@11939
    66
lemma "xpos (| xpos = m, ypos = n, ... = p |) = m"
wenzelm@10052
    67
  by simp
wenzelm@10052
    68
wenzelm@11939
    69
lemma "(| xpos = m, ypos = n, ... = p |) (| xpos:= 0 |) = (| xpos = 0, ypos = n, ... = p |)"
wenzelm@10052
    70
  by simp
wenzelm@10052
    71
wenzelm@10052
    72
wenzelm@10357
    73
text {* \medskip Equality of records. *}
wenzelm@10052
    74
wenzelm@11939
    75
lemma "n = n' ==> p = p' ==> (| xpos = n, ypos = p |) = (| xpos = n', ypos = p' |)"
wenzelm@10052
    76
  -- "introduction of concrete record equality"
wenzelm@10052
    77
  by simp
wenzelm@10052
    78
wenzelm@11939
    79
lemma "(| xpos = n, ypos = p |) = (| xpos = n', ypos = p' |) ==> n = n'"
wenzelm@10052
    80
  -- "elimination of concrete record equality"
wenzelm@10052
    81
  by simp
wenzelm@10052
    82
wenzelm@11939
    83
lemma "r (| xpos := n |) (| ypos := m |) = r (| ypos := m |) (| xpos := n |)"
wenzelm@10052
    84
  -- "introduction of abstract record equality"
wenzelm@10052
    85
  by simp
wenzelm@10052
    86
wenzelm@11939
    87
lemma "r (| xpos := n |) = r (| xpos := n' |) ==> n = n'"
wenzelm@10052
    88
  -- "elimination of abstract record equality (manual proof)"
wenzelm@10052
    89
proof -
wenzelm@11939
    90
  assume "r (| xpos := n |) = r (| xpos := n' |)" (is "?lhs = ?rhs")
wenzelm@11939
    91
  hence "xpos ?lhs = xpos ?rhs" by simp
wenzelm@10052
    92
  thus ?thesis by simp
wenzelm@10052
    93
qed
wenzelm@10052
    94
wenzelm@10052
    95
wenzelm@10357
    96
text {* \medskip Surjective pairing *}
wenzelm@10052
    97
wenzelm@11939
    98
lemma "r = (| xpos = xpos r, ypos = ypos r |)"
wenzelm@10052
    99
  by simp
wenzelm@10052
   100
wenzelm@11939
   101
lemma "r = (| xpos = xpos r, ypos = ypos r, ... = more r |)"
wenzelm@10052
   102
  by simp
wenzelm@10052
   103
wenzelm@10052
   104
wenzelm@10357
   105
text {*
wenzelm@11939
   106
  \medskip Representation of records by cases or (degenerate)
wenzelm@11939
   107
  induction.
wenzelm@10357
   108
*}
wenzelm@10052
   109
wenzelm@11939
   110
lemma "r (| xpos := n |) (| ypos := m |) = r (| ypos := m |) (| xpos := n |)"
wenzelm@11939
   111
proof (cases r)
wenzelm@11939
   112
  fix xpos ypos more
wenzelm@11939
   113
  assume "r = (| xpos = xpos, ypos = ypos, ... = more |)"
wenzelm@11939
   114
  thus ?thesis by simp
wenzelm@11939
   115
qed
wenzelm@11939
   116
wenzelm@11939
   117
lemma "r (| xpos := n |) (| ypos := m |) = r (| ypos := m |) (| xpos := n |)"
wenzelm@11939
   118
proof (induct r)
wenzelm@11939
   119
  fix xpos ypos more
wenzelm@11939
   120
  show "(| xpos = xpos, ypos = ypos, ... = more |) (| xpos := n, ypos := m |) =
wenzelm@11939
   121
      (| xpos = xpos, ypos = ypos, ... = more |) (| ypos := m, xpos := n |)"
wenzelm@10052
   122
    by simp
wenzelm@10052
   123
qed
wenzelm@10052
   124
wenzelm@11939
   125
lemma "r (| xpos := n |) (| xpos := m |) = r (| xpos := m |)"
wenzelm@11939
   126
proof (cases r)
wenzelm@11939
   127
  fix xpos ypos more
wenzelm@11939
   128
  assume "r = \<lparr>xpos = xpos, ypos = ypos, \<dots> = more\<rparr>"
wenzelm@11939
   129
  thus ?thesis by simp
wenzelm@10052
   130
qed
wenzelm@10052
   131
wenzelm@11939
   132
lemma "r (| xpos := n |) (| xpos := m |) = r (| xpos := m |)"
wenzelm@11939
   133
proof (cases r)
wenzelm@11939
   134
  case fields
wenzelm@11939
   135
  thus ?thesis by simp
wenzelm@11939
   136
qed
wenzelm@11939
   137
wenzelm@11939
   138
lemma "r (| xpos := n |) (| xpos := m |) = r (| xpos := m |)"
wenzelm@11939
   139
  by (cases r) simp
wenzelm@11939
   140
wenzelm@10052
   141
wenzelm@10357
   142
text {*
wenzelm@10357
   143
 \medskip Concrete records are type instances of record schemes.
wenzelm@10357
   144
*}
wenzelm@10052
   145
wenzelm@10052
   146
constdefs
wenzelm@10052
   147
  foo5 :: nat
wenzelm@11939
   148
  "foo5 == getX (| xpos = 1, ypos = 0 |)"
wenzelm@10052
   149
wenzelm@10052
   150
wenzelm@11939
   151
text {* \medskip Manipulating the ``@{text "..."}'' (more) part. *}
wenzelm@10052
   152
wenzelm@10052
   153
constdefs
wenzelm@11939
   154
  incX :: "'a point_scheme => 'a point_scheme"
wenzelm@11939
   155
  "incX r == (| xpos = xpos r + 1, ypos = ypos r, ... = point.more r |)"
wenzelm@10052
   156
wenzelm@11939
   157
lemma "incX r = setX r (Suc (getX r))"
wenzelm@11939
   158
  by (simp add: getX_def setX_def incX_def)
wenzelm@11939
   159
wenzelm@10052
   160
wenzelm@10357
   161
text {* An alternative definition. *}
wenzelm@10052
   162
wenzelm@10052
   163
constdefs
wenzelm@11939
   164
  incX' :: "'a point_scheme => 'a point_scheme"
wenzelm@11939
   165
  "incX' r == r (| xpos := xpos r + 1 |)"
wenzelm@10052
   166
wenzelm@10052
   167
wenzelm@10052
   168
subsection {* Coloured points: record extension *}
wenzelm@10052
   169
wenzelm@10052
   170
datatype colour = Red | Green | Blue
wenzelm@10052
   171
wenzelm@10052
   172
record cpoint = point +
wenzelm@10052
   173
  colour :: colour
wenzelm@10052
   174
wenzelm@10052
   175
wenzelm@10052
   176
text {*
wenzelm@10052
   177
  The record declaration defines new type constructors:
wenzelm@10357
   178
  @{text [display]
wenzelm@11939
   179
"    cpoint = (| xpos :: nat, ypos :: nat, colour :: colour |)
wenzelm@11939
   180
    'a cpoint_scheme = (| xpos :: nat, ypos :: nat, colour :: colour, ... :: 'a |)"}
wenzelm@10052
   181
*}
wenzelm@10052
   182
wenzelm@10052
   183
consts foo6 :: cpoint
wenzelm@11939
   184
consts foo7 :: "(| xpos :: nat, ypos :: nat, colour :: colour |)"
wenzelm@11939
   185
consts foo8 :: "'a cpoint_scheme"
wenzelm@11939
   186
consts foo9 :: "(| xpos :: nat, ypos :: nat, colour :: colour, ... :: 'a |)"
wenzelm@10052
   187
wenzelm@10052
   188
wenzelm@10357
   189
text {*
wenzelm@10357
   190
 Functions on @{text point} schemes work for @{text cpoints} as well.
wenzelm@10357
   191
*}
wenzelm@10052
   192
wenzelm@10052
   193
constdefs
wenzelm@10052
   194
  foo10 :: nat
wenzelm@11939
   195
  "foo10 == getX (| xpos = 2, ypos = 0, colour = Blue |)"
wenzelm@10052
   196
wenzelm@10052
   197
wenzelm@10052
   198
subsubsection {* Non-coercive structural subtyping *}
wenzelm@10052
   199
wenzelm@10357
   200
text {*
wenzelm@10357
   201
 Term @{term foo11} has type @{typ cpoint}, not type @{typ point} ---
wenzelm@10357
   202
 Great!
wenzelm@10357
   203
*}
wenzelm@10052
   204
wenzelm@10052
   205
constdefs
wenzelm@10052
   206
  foo11 :: cpoint
wenzelm@11939
   207
  "foo11 == setX (| xpos = 2, ypos = 0, colour = Blue |) 0"
wenzelm@10052
   208
wenzelm@10052
   209
wenzelm@10052
   210
subsection {* Other features *}
wenzelm@10052
   211
wenzelm@10357
   212
text {* Field names contribute to record identity. *}
wenzelm@10052
   213
wenzelm@10052
   214
record point' =
wenzelm@11939
   215
  xpos' :: nat
wenzelm@11939
   216
  ypos' :: nat
wenzelm@10052
   217
wenzelm@10357
   218
text {*
wenzelm@11939
   219
  \noindent May not apply @{term getX} to @{term [source] "(| xpos' =
wenzelm@11939
   220
  2, ypos' = 0 |)"} -- type error.
wenzelm@10357
   221
*}
wenzelm@10052
   222
wenzelm@10357
   223
text {* \medskip Polymorphic records. *}
wenzelm@10052
   224
wenzelm@10052
   225
record 'a point'' = point +
wenzelm@10052
   226
  content :: 'a
wenzelm@10052
   227
wenzelm@10052
   228
types cpoint'' = "colour point''"
wenzelm@10052
   229
wenzelm@10052
   230
end