src/HOL/ex/Records.thy
author wenzelm
Sat May 17 21:46:22 2008 +0200 (2008-05-17)
changeset 26932 c398a3866082
parent 25707 0a599404f5a1
child 31248 d1c65a593daf
permissions -rw-r--r--
avoid undeclared variables within proofs;
wenzelm@10052
     1
(*  Title:      HOL/ex/Records.thy
wenzelm@10052
     2
    ID:         $Id$
schirmer@14700
     3
    Author:     Wolfgang Naraschewski, Norbert Schirmer and Markus Wenzel, 
schirmer@14700
     4
                TU Muenchen
wenzelm@10052
     5
*)
wenzelm@10052
     6
wenzelm@10052
     7
header {* Using extensible records in HOL -- points and coloured points *}
wenzelm@10052
     8
haftmann@16417
     9
theory Records imports Main begin
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
schirmer@14700
    22
wenzelm@10052
    23
thm "point.simps"
wenzelm@10052
    24
thm "point.iffs"
wenzelm@12266
    25
thm "point.defs"
wenzelm@10052
    26
wenzelm@10052
    27
text {*
wenzelm@11939
    28
  The set of theorems @{thm [source] point.simps} is added
wenzelm@11939
    29
  automatically to the standard simpset, @{thm [source] point.iffs} is
wenzelm@11939
    30
  added to the Classical Reasoner and Simplifier context.
wenzelm@10052
    31
schirmer@14700
    32
  \medskip Record declarations define new types and type abbreviations:
wenzelm@10357
    33
  @{text [display]
schirmer@14700
    34
"  point = \<lparr>xpos :: nat, ypos :: nat\<rparr> = () point_ext_type
schirmer@14700
    35
  'a point_scheme = \<lparr>xpos :: nat, ypos :: nat, ... :: 'a\<rparr>  = 'a point_ext_type"}
wenzelm@10052
    36
*}
wenzelm@10052
    37
wenzelm@11939
    38
consts foo2 :: "(| xpos :: nat, ypos :: nat |)"
wenzelm@11939
    39
consts foo4 :: "'a => (| xpos :: nat, ypos :: nat, ... :: 'a |)"
wenzelm@10052
    40
wenzelm@10052
    41
wenzelm@10052
    42
subsubsection {* Introducing concrete records and record schemes *}
wenzelm@10052
    43
haftmann@22737
    44
definition
haftmann@22737
    45
  foo1 :: point
haftmann@22737
    46
where
haftmann@22737
    47
  foo1_def: "foo1 = (| xpos = 1, ypos = 0 |)"
haftmann@22737
    48
haftmann@22737
    49
definition
haftmann@22737
    50
  foo3 :: "'a => 'a point_scheme"
haftmann@22737
    51
where
haftmann@22737
    52
  foo3_def: "foo3 ext = (| xpos = 1, ypos = 0, ... = ext |)"
wenzelm@10052
    53
wenzelm@10052
    54
wenzelm@10052
    55
subsubsection {* Record selection and record update *}
wenzelm@10052
    56
wenzelm@19736
    57
definition
wenzelm@21404
    58
  getX :: "'a point_scheme => nat" where
wenzelm@19736
    59
  "getX r = xpos r"
wenzelm@21404
    60
wenzelm@21404
    61
definition
wenzelm@21404
    62
  setX :: "'a point_scheme => nat => 'a point_scheme" where
wenzelm@19736
    63
  "setX r n = r (| xpos := n |)"
wenzelm@10052
    64
wenzelm@10052
    65
wenzelm@10052
    66
subsubsection {* Some lemmas about records *}
wenzelm@10052
    67
wenzelm@10357
    68
text {* Basic simplifications. *}
wenzelm@10052
    69
wenzelm@11939
    70
lemma "point.make n p = (| xpos = n, ypos = p |)"
wenzelm@11939
    71
  by (simp only: point.make_def)
wenzelm@10052
    72
wenzelm@11939
    73
lemma "xpos (| xpos = m, ypos = n, ... = p |) = m"
wenzelm@10052
    74
  by simp
wenzelm@10052
    75
wenzelm@11939
    76
lemma "(| xpos = m, ypos = n, ... = p |) (| xpos:= 0 |) = (| xpos = 0, ypos = n, ... = p |)"
wenzelm@10052
    77
  by simp
wenzelm@10052
    78
wenzelm@10052
    79
wenzelm@10357
    80
text {* \medskip Equality of records. *}
wenzelm@10052
    81
wenzelm@11939
    82
lemma "n = n' ==> p = p' ==> (| xpos = n, ypos = p |) = (| xpos = n', ypos = p' |)"
wenzelm@10052
    83
  -- "introduction of concrete record equality"
wenzelm@10052
    84
  by simp
wenzelm@10052
    85
wenzelm@11939
    86
lemma "(| xpos = n, ypos = p |) = (| xpos = n', ypos = p' |) ==> n = n'"
wenzelm@10052
    87
  -- "elimination of concrete record equality"
wenzelm@10052
    88
  by simp
wenzelm@10052
    89
wenzelm@11939
    90
lemma "r (| xpos := n |) (| ypos := m |) = r (| ypos := m |) (| xpos := n |)"
wenzelm@10052
    91
  -- "introduction of abstract record equality"
wenzelm@10052
    92
  by simp
wenzelm@10052
    93
wenzelm@11939
    94
lemma "r (| xpos := n |) = r (| xpos := n' |) ==> n = n'"
wenzelm@10052
    95
  -- "elimination of abstract record equality (manual proof)"
wenzelm@10052
    96
proof -
wenzelm@11939
    97
  assume "r (| xpos := n |) = r (| xpos := n' |)" (is "?lhs = ?rhs")
wenzelm@11939
    98
  hence "xpos ?lhs = xpos ?rhs" by simp
wenzelm@10052
    99
  thus ?thesis by simp
wenzelm@10052
   100
qed
wenzelm@10052
   101
wenzelm@10052
   102
wenzelm@10357
   103
text {* \medskip Surjective pairing *}
wenzelm@10052
   104
wenzelm@11939
   105
lemma "r = (| xpos = xpos r, ypos = ypos r |)"
wenzelm@10052
   106
  by simp
wenzelm@10052
   107
wenzelm@12591
   108
lemma "r = (| xpos = xpos r, ypos = ypos r, ... = point.more r |)"
wenzelm@10052
   109
  by simp
wenzelm@10052
   110
wenzelm@10052
   111
wenzelm@10357
   112
text {*
wenzelm@11939
   113
  \medskip Representation of records by cases or (degenerate)
wenzelm@11939
   114
  induction.
wenzelm@10357
   115
*}
wenzelm@10052
   116
schirmer@14700
   117
lemma "r(| xpos := n |) (| ypos := m |) = r (| ypos := m |) (| xpos := n |)"
wenzelm@11939
   118
proof (cases r)
wenzelm@11939
   119
  fix xpos ypos more
wenzelm@11939
   120
  assume "r = (| xpos = xpos, ypos = ypos, ... = more |)"
wenzelm@11939
   121
  thus ?thesis by simp
wenzelm@11939
   122
qed
wenzelm@11939
   123
wenzelm@11939
   124
lemma "r (| xpos := n |) (| ypos := m |) = r (| ypos := m |) (| xpos := n |)"
wenzelm@11939
   125
proof (induct r)
wenzelm@11939
   126
  fix xpos ypos more
wenzelm@11939
   127
  show "(| xpos = xpos, ypos = ypos, ... = more |) (| xpos := n, ypos := m |) =
wenzelm@11939
   128
      (| xpos = xpos, ypos = ypos, ... = more |) (| ypos := m, xpos := n |)"
wenzelm@10052
   129
    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
  fix xpos ypos more
wenzelm@11939
   135
  assume "r = \<lparr>xpos = xpos, ypos = ypos, \<dots> = more\<rparr>"
wenzelm@11939
   136
  thus ?thesis by simp
wenzelm@10052
   137
qed
wenzelm@10052
   138
wenzelm@11939
   139
lemma "r (| xpos := n |) (| xpos := m |) = r (| xpos := m |)"
wenzelm@11939
   140
proof (cases r)
wenzelm@11939
   141
  case fields
wenzelm@11939
   142
  thus ?thesis by simp
wenzelm@11939
   143
qed
wenzelm@11939
   144
wenzelm@11939
   145
lemma "r (| xpos := n |) (| xpos := m |) = r (| xpos := m |)"
wenzelm@11939
   146
  by (cases r) simp
wenzelm@11939
   147
wenzelm@10052
   148
wenzelm@10357
   149
text {*
wenzelm@10357
   150
 \medskip Concrete records are type instances of record schemes.
wenzelm@10357
   151
*}
wenzelm@10052
   152
wenzelm@19736
   153
definition
wenzelm@21404
   154
  foo5 :: nat where
wenzelm@19736
   155
  "foo5 = getX (| xpos = 1, ypos = 0 |)"
wenzelm@10052
   156
wenzelm@10052
   157
wenzelm@11939
   158
text {* \medskip Manipulating the ``@{text "..."}'' (more) part. *}
wenzelm@10052
   159
wenzelm@19736
   160
definition
wenzelm@21404
   161
  incX :: "'a point_scheme => 'a point_scheme" where
wenzelm@19736
   162
  "incX r = (| xpos = xpos r + 1, ypos = ypos r, ... = point.more r |)"
wenzelm@10052
   163
wenzelm@11939
   164
lemma "incX r = setX r (Suc (getX r))"
wenzelm@11939
   165
  by (simp add: getX_def setX_def incX_def)
wenzelm@11939
   166
wenzelm@10052
   167
wenzelm@10357
   168
text {* An alternative definition. *}
wenzelm@10052
   169
wenzelm@19736
   170
definition
wenzelm@21404
   171
  incX' :: "'a point_scheme => 'a point_scheme" where
wenzelm@19736
   172
  "incX' r = r (| xpos := xpos r + 1 |)"
wenzelm@10052
   173
wenzelm@10052
   174
wenzelm@10052
   175
subsection {* Coloured points: record extension *}
wenzelm@10052
   176
wenzelm@10052
   177
datatype colour = Red | Green | Blue
wenzelm@10052
   178
wenzelm@10052
   179
record cpoint = point +
wenzelm@10052
   180
  colour :: colour
wenzelm@10052
   181
wenzelm@10052
   182
wenzelm@10052
   183
text {*
schirmer@14700
   184
  The record declaration defines a new type constructure and abbreviations:
wenzelm@10357
   185
  @{text [display]
schirmer@14700
   186
"  cpoint = (| xpos :: nat, ypos :: nat, colour :: colour |) = 
schirmer@14700
   187
     () cpoint_ext_type point_ext_type
schirmer@14700
   188
   'a cpoint_scheme = (| xpos :: nat, ypos :: nat, colour :: colour, ... :: 'a |) = 
schirmer@14700
   189
     'a cpoint_ext_type point_ext_type"}
wenzelm@10052
   190
*}
wenzelm@10052
   191
wenzelm@10052
   192
consts foo6 :: cpoint
wenzelm@11939
   193
consts foo7 :: "(| xpos :: nat, ypos :: nat, colour :: colour |)"
wenzelm@11939
   194
consts foo8 :: "'a cpoint_scheme"
wenzelm@11939
   195
consts foo9 :: "(| xpos :: nat, ypos :: nat, colour :: colour, ... :: 'a |)"
wenzelm@10052
   196
wenzelm@10052
   197
wenzelm@10357
   198
text {*
wenzelm@10357
   199
 Functions on @{text point} schemes work for @{text cpoints} as well.
wenzelm@10357
   200
*}
wenzelm@10052
   201
wenzelm@19736
   202
definition
wenzelm@21404
   203
  foo10 :: nat where
wenzelm@19736
   204
  "foo10 = getX (| xpos = 2, ypos = 0, colour = Blue |)"
wenzelm@10052
   205
wenzelm@10052
   206
wenzelm@10052
   207
subsubsection {* Non-coercive structural subtyping *}
wenzelm@10052
   208
wenzelm@10357
   209
text {*
wenzelm@10357
   210
 Term @{term foo11} has type @{typ cpoint}, not type @{typ point} ---
wenzelm@10357
   211
 Great!
wenzelm@10357
   212
*}
wenzelm@10052
   213
wenzelm@19736
   214
definition
wenzelm@21404
   215
  foo11 :: cpoint where
wenzelm@19736
   216
  "foo11 = setX (| xpos = 2, ypos = 0, colour = Blue |) 0"
wenzelm@10052
   217
wenzelm@10052
   218
wenzelm@10052
   219
subsection {* Other features *}
wenzelm@10052
   220
wenzelm@10357
   221
text {* Field names contribute to record identity. *}
wenzelm@10052
   222
wenzelm@10052
   223
record point' =
wenzelm@11939
   224
  xpos' :: nat
wenzelm@11939
   225
  ypos' :: nat
wenzelm@10052
   226
wenzelm@10357
   227
text {*
wenzelm@11939
   228
  \noindent May not apply @{term getX} to @{term [source] "(| xpos' =
wenzelm@11939
   229
  2, ypos' = 0 |)"} -- type error.
wenzelm@10357
   230
*}
wenzelm@10052
   231
wenzelm@10357
   232
text {* \medskip Polymorphic records. *}
wenzelm@10052
   233
wenzelm@10052
   234
record 'a point'' = point +
wenzelm@10052
   235
  content :: 'a
wenzelm@10052
   236
wenzelm@10052
   237
types cpoint'' = "colour point''"
wenzelm@10052
   238
schirmer@25707
   239
schirmer@25707
   240
schirmer@25707
   241
text {* Updating a record field with an identical value is simplified.*}
schirmer@25707
   242
lemma "r (| xpos := xpos r |) = r"
schirmer@25707
   243
  by simp
schirmer@25707
   244
schirmer@25707
   245
text {* Only the most recent update to a component survives simplification. *}
schirmer@25707
   246
lemma "r (| xpos := x, ypos := y, xpos := x' |) = r (| ypos := y, xpos := x' |)"
schirmer@25707
   247
  by simp
schirmer@25707
   248
schirmer@25707
   249
text {* In some cases its convenient to automatically split
schirmer@25707
   250
(quantified) records. For this purpose there is the simproc @{ML [source]
schirmer@25707
   251
"RecordPackage.record_split_simproc"} and the tactic @{ML [source]
schirmer@25707
   252
"RecordPackage.record_split_simp_tac"}.  The simplification procedure
schirmer@25707
   253
only splits the records, whereas the tactic also simplifies the
schirmer@25707
   254
resulting goal with the standard record simplification rules. A
schirmer@25707
   255
(generalized) predicate on the record is passed as parameter that
schirmer@25707
   256
decides whether or how `deep' to split the record. It can peek on the
schirmer@25707
   257
subterm starting at the quantified occurrence of the record (including
schirmer@25707
   258
the quantifier). The value @{ML "0"} indicates no split, a value
schirmer@25707
   259
greater @{ML "0"} splits up to the given bound of record extension and
schirmer@25707
   260
finally the value @{ML "~1"} completely splits the record.
schirmer@25707
   261
@{ML [source] "RecordPackage.record_split_simp_tac"} additionally takes a list of
schirmer@25707
   262
equations for simplification and can also split fixed record variables.
schirmer@25707
   263
schirmer@25707
   264
*}
schirmer@25707
   265
schirmer@25707
   266
lemma "(\<forall>r. P (xpos r)) \<longrightarrow> (\<forall>x. P x)"
schirmer@25707
   267
  apply (tactic {* simp_tac
schirmer@25707
   268
          (HOL_basic_ss addsimprocs [RecordPackage.record_split_simproc (K ~1)]) 1*})
schirmer@25707
   269
  apply simp
schirmer@25707
   270
  done
schirmer@25707
   271
schirmer@25707
   272
lemma "(\<forall>r. P (xpos r)) \<longrightarrow> (\<forall>x. P x)"
schirmer@25707
   273
  apply (tactic {* RecordPackage.record_split_simp_tac [] (K ~1) 1*})
schirmer@25707
   274
  apply simp
schirmer@25707
   275
  done
schirmer@25707
   276
schirmer@25707
   277
lemma "(\<exists>r. P (xpos r)) \<longrightarrow> (\<exists>x. P x)"
schirmer@25707
   278
  apply (tactic {* simp_tac
schirmer@25707
   279
          (HOL_basic_ss addsimprocs [RecordPackage.record_split_simproc (K ~1)]) 1*})
schirmer@25707
   280
  apply simp
schirmer@25707
   281
  done
schirmer@25707
   282
schirmer@25707
   283
lemma "(\<exists>r. P (xpos r)) \<longrightarrow> (\<exists>x. P x)"
schirmer@25707
   284
  apply (tactic {* RecordPackage.record_split_simp_tac [] (K ~1) 1*})
schirmer@25707
   285
  apply simp
schirmer@25707
   286
  done
schirmer@25707
   287
schirmer@25707
   288
lemma "\<And>r. P (xpos r) \<Longrightarrow> (\<exists>x. P x)"
schirmer@25707
   289
  apply (tactic {* simp_tac
schirmer@25707
   290
          (HOL_basic_ss addsimprocs [RecordPackage.record_split_simproc (K ~1)]) 1*})
schirmer@25707
   291
  apply auto
schirmer@25707
   292
  done
schirmer@25707
   293
schirmer@25707
   294
lemma "\<And>r. P (xpos r) \<Longrightarrow> (\<exists>x. P x)"
schirmer@25707
   295
  apply (tactic {* RecordPackage.record_split_simp_tac [] (K ~1) 1*})
schirmer@25707
   296
  apply auto
schirmer@25707
   297
  done
schirmer@25707
   298
schirmer@25707
   299
lemma "P (xpos r) \<Longrightarrow> (\<exists>x. P x)"
schirmer@25707
   300
  apply (tactic {* RecordPackage.record_split_simp_tac [] (K ~1) 1*})
schirmer@25707
   301
  apply auto
schirmer@25707
   302
  done
schirmer@25707
   303
schirmer@25707
   304
lemma fixes r shows "P (xpos r) \<Longrightarrow> (\<exists>x. P x)"
schirmer@25707
   305
  apply (tactic {* RecordPackage.record_split_simp_tac [] (K ~1) 1*})
schirmer@25707
   306
  apply auto
schirmer@25707
   307
  done
schirmer@25707
   308
schirmer@25707
   309
schirmer@25707
   310
lemma True
schirmer@25707
   311
proof -
schirmer@25707
   312
  {
wenzelm@26932
   313
    fix P r
schirmer@25707
   314
    assume pre: "P (xpos r)"
schirmer@25707
   315
    have "\<exists>x. P x"
schirmer@25707
   316
      using pre
schirmer@25707
   317
      apply -
schirmer@25707
   318
      apply (tactic {* RecordPackage.record_split_simp_tac [] (K ~1) 1*})
schirmer@25707
   319
      apply auto 
schirmer@25707
   320
      done
schirmer@25707
   321
  }
schirmer@25707
   322
  show ?thesis ..
schirmer@25707
   323
qed
schirmer@25707
   324
schirmer@25707
   325
text {* The effect of simproc @{ML [source]
schirmer@25707
   326
"RecordPackage.record_ex_sel_eq_simproc"} is illustrated by the
schirmer@25707
   327
following lemma.  
schirmer@25707
   328
*}
schirmer@25707
   329
schirmer@25707
   330
lemma "\<exists>r. xpos r = x"
schirmer@25707
   331
  apply (tactic {*simp_tac 
schirmer@25707
   332
           (HOL_basic_ss addsimprocs [RecordPackage.record_ex_sel_eq_simproc]) 1*})
schirmer@25707
   333
  done
schirmer@25707
   334
schirmer@25707
   335
wenzelm@10052
   336
end