doc-src/Codegen/Thy/Refinement.thy
author wenzelm
Wed, 18 Aug 2010 23:44:50 +0200
changeset 38479 e628da370072
parent 38459 cfe74b0eecb1
child 38502 c4b7ae8ea82e
permissions -rw-r--r--
more efficient Markup_Tree, based on branches sorted by quasi-order; renamed markup_node.scala to markup_tree.scala and classes/objects accordingly; Position.Range: produce actual Text.Range; Symbol.Index.decode: convert 1-based Isabelle offsets here; added static Command.range; simplified Command.markup; Document_Model.token_marker: flatten markup at most once; tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
38405
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
     1
theory Refinement
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
     2
imports Setup
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
     3
begin
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
     4
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
     5
section {* Program and datatype refinement \label{sec:refinement} *}
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
     6
38451
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
     7
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
     8
  Code generation by shallow embedding (cf.~\secref{sec:principle})
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
     9
  allows to choose code equations and datatype constructors freely,
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    10
  given that some very basic syntactic properties are met; this
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    11
  flexibility opens up mechanisms for refinement which allow to extend
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    12
  the scope and quality of generated code dramatically.
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    13
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    14
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    15
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    16
subsection {* Program refinement *}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    17
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    18
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    19
  Program refinement works by choosing appropriate code equations
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    20
  explicitly (cf.~\label{sec:equations}); as example, we use Fibonacci
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    21
  numbers:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    22
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    23
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    24
fun %quote fib :: "nat \<Rightarrow> nat" where
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    25
    "fib 0 = 0"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    26
  | "fib (Suc 0) = Suc 0"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    27
  | "fib (Suc (Suc n)) = fib n + fib (Suc n)"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    28
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    29
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    30
  \noindent The runtime of the corresponding code grows exponential due
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    31
  to two recursive calls:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    32
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    33
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    34
text %quote {*@{code_stmts fib (consts) fib (Haskell)}*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    35
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    36
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    37
  \noindent A more efficient implementation would use dynamic
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    38
  programming, e.g.~sharing of common intermediate results between
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    39
  recursive calls.  This idea is expressed by an auxiliary operation
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    40
  which computes a Fibonacci number and its successor simultaneously:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    41
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    42
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    43
definition %quote fib_step :: "nat \<Rightarrow> nat \<times> nat" where
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    44
  "fib_step n = (fib (Suc n), fib n)"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    45
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    46
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    47
  \noindent This operation can be implemented by recursion using
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    48
  dynamic programming:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    49
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    50
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    51
lemma %quote [code]:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    52
  "fib_step 0 = (Suc 0, 0)"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    53
  "fib_step (Suc n) = (let (m, q) = fib_step n in (m + q, m))"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    54
  by (simp_all add: fib_step_def)
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    55
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    56
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    57
  \noindent What remains is to implement @{const fib} by @{const
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    58
  fib_step} as follows:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    59
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    60
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    61
lemma %quote [code]:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    62
  "fib 0 = 0"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    63
  "fib (Suc n) = fst (fib_step n)"
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    64
  by (simp_all add: fib_step_def)
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    65
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    66
text {*
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    67
  \noindent The resulting code shows only linear growth of runtime:
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    68
*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    69
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    70
text %quote {*@{code_stmts fib (consts) fib fib_step (Haskell)}*}
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    71
4c065e97ecee added section on program refinement
haftmann
parents: 38437
diff changeset
    72
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    73
subsection {* Datatype refinement *}
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    74
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    75
text {*
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    76
  Selecting specific code equations \emph{and} datatype constructors
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    77
  leads to datatype refinement.  As an example, we will develop an
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    78
  alternative representation of the queue example given in
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    79
  \secref{sec:queue_example}.  The amortised representation is
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    80
  convenient for generating code but exposes its \qt{implementation}
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    81
  details, which may be cumbersome when proving theorems about it.
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    82
  Therefore, here is a simple, straightforward representation of
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
    83
  queues:
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    84
*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    85
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    86
datatype %quote 'a queue = Queue "'a list"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    87
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    88
definition %quote empty :: "'a queue" where
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    89
  "empty = Queue []"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    90
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    91
primrec %quote enqueue :: "'a \<Rightarrow> 'a queue \<Rightarrow> 'a queue" where
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    92
  "enqueue x (Queue xs) = Queue (xs @ [x])"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    93
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    94
fun %quote dequeue :: "'a queue \<Rightarrow> 'a option \<times> 'a queue" where
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    95
    "dequeue (Queue []) = (None, Queue [])"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    96
  | "dequeue (Queue (x # xs)) = (Some x, Queue xs)"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    97
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    98
text {*
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
    99
  \noindent This we can use directly for proving;  for executing,
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   100
  we provide an alternative characterisation:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   101
*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   102
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   103
definition %quote AQueue :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a queue" where
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   104
  "AQueue xs ys = Queue (ys @ rev xs)"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   105
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   106
code_datatype %quote AQueue
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   107
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   108
text {*
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   109
  \noindent Here we define a \qt{constructor} @{const "AQueue"} which
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   110
  is defined in terms of @{text "Queue"} and interprets its arguments
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   111
  according to what the \emph{content} of an amortised queue is supposed
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   112
  to be.
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   113
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   114
  The prerequisite for datatype constructors is only syntactical: a
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   115
  constructor must be of type @{text "\<tau> = \<dots> \<Rightarrow> \<kappa> \<alpha>\<^isub>1 \<dots> \<alpha>\<^isub>n"} where @{text
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   116
  "{\<alpha>\<^isub>1, \<dots>, \<alpha>\<^isub>n}"} is exactly the set of \emph{all} type variables in
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   117
  @{text "\<tau>"}; then @{text "\<kappa>"} is its corresponding datatype.  The
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   118
  HOL datatype package by default registers any new datatype with its
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   119
  constructors, but this may be changed using @{command
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   120
  code_datatype}; the currently chosen constructors can be inspected
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   121
  using the @{command print_codesetup} command.
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   122
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   123
  Equipped with this, we are able to prove the following equations
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   124
  for our primitive queue operations which \qt{implement} the simple
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   125
  queues in an amortised fashion:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   126
*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   127
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   128
lemma %quote empty_AQueue [code]:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   129
  "empty = AQueue [] []"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   130
  unfolding AQueue_def empty_def by simp
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   131
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   132
lemma %quote enqueue_AQueue [code]:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   133
  "enqueue x (AQueue xs ys) = AQueue (x # xs) ys"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   134
  unfolding AQueue_def by simp
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   135
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   136
lemma %quote dequeue_AQueue [code]:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   137
  "dequeue (AQueue xs []) =
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   138
    (if xs = [] then (None, AQueue [] [])
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   139
    else dequeue (AQueue [] (rev xs)))"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   140
  "dequeue (AQueue xs (y # ys)) = (Some y, AQueue xs ys)"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   141
  unfolding AQueue_def by simp_all
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   142
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   143
text {*
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   144
  \noindent For completeness, we provide a substitute for the
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   145
  @{text case} combinator on queues:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   146
*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   147
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   148
lemma %quote queue_case_AQueue [code]:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   149
  "queue_case f (AQueue xs ys) = f (ys @ rev xs)"
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   150
  unfolding AQueue_def by simp
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   151
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   152
text {*
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   153
  \noindent The resulting code looks as expected:
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   154
*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   155
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   156
text %quote {*@{code_stmts empty enqueue dequeue (SML)}*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   157
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   158
text {*
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   159
  The same techniques can also be applied to types which are not
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   160
  specified as datatypes, e.g.~type @{typ int} is originally specified
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   161
  as quotient type by means of @{command typedef}, but for code
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   162
  generation constants allowing construction of binary numeral values
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   163
  are used as constructors for @{typ int}.
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   164
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   165
  This approach however fails if the representation of a type demands
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   166
  invariants; this issue is discussed in the next section.
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   167
*}
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   168
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   169
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   170
subsection {* Datatype refinement involving invariants *}
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   171
38459
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   172
text {*
cfe74b0eecb1 reworked section on simple datatype refinement
haftmann
parents: 38451
diff changeset
   173
  FIXME
38437
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   174
*}
ffb1c5bf0425 adaptation to new outline
haftmann
parents: 38405
diff changeset
   175
38405
7935b334893e sketch of new outline
haftmann
parents:
diff changeset
   176
end