doc-src/IsarAdvanced/Codegen/Thy/Program.thy
author haftmann
Tue, 30 Sep 2008 14:30:44 +0200
changeset 28428 fd007794561f
parent 28419 f65e8b318581
child 28447 df77ed974a78
permissions -rw-r--r--
tuned
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     1
theory Program
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
     2
imports Introduction
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     3
begin
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     4
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
     5
section {* Turning Theories into Programs \label{sec:program} *}
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     6
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     7
subsection {* The @{text "Isabelle/HOL"} default setup *}
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     8
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
     9
subsection {* Selecting code equations *}
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
    10
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    11
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    12
  We have already seen how by default equations stemming from
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    13
  @{command definition}/@{command primrec}/@{command fun}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    14
  statements are used for code generation.  Deviating from this
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    15
  \emph{default} behaviour is always possible -- e.g.~we
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    16
  could provide an alternative @{text fun} for @{const dequeue} proving
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    17
  the following equations explicitly:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    18
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    19
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    20
lemma %quoteme [code func]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    21
  "dequeue (Queue xs []) = (if xs = [] then (None, Queue [] []) else dequeue (Queue [] (rev xs)))"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    22
  "dequeue (Queue xs (y # ys)) = (Some y, Queue xs ys)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    23
  by (cases xs, simp_all) (cases "rev xs", simp_all)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    24
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    25
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    26
  \noindent The annotation @{text "[code func]"} is an @{text Isar}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    27
  @{text attribute} which states that the given theorems should be
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    28
  considered as defining equations for a @{text fun} statement --
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    29
  the corresponding constant is determined syntactically.  The resulting code:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    30
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    31
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    32
text %quoteme {*@{code_stmts empty enqueue dequeue (Haskell)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    33
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    34
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    35
  \noindent You may note that the equality test @{term "xs = []"} has been
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    36
  replaced by the predicate @{term "null xs"}.  This is due to the default
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    37
  setup in the \qn{preprocessor} to be discussed further below (\secref{sec:preproc}).
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    38
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    39
  Changing the default constructor set of datatypes is also
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    40
  possible but rarely desired in practice.  See \secref{sec:datatypes} for an example.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    41
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    42
  As told in \secref{sec:concept}, code generation is based
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    43
  on a structured collection of code theorems.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    44
  For explorative purpose, this collection
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    45
  may be inspected using the @{command code_thms} command:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    46
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    47
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    48
code_thms %quoteme dequeue
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    49
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    50
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    51
  \noindent prints a table with \emph{all} defining equations
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    52
  for @{const dequeue}, including
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    53
  \emph{all} defining equations those equations depend
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    54
  on recursively.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    55
  
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    56
  Similarly, the @{command code_deps} command shows a graph
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    57
  visualising dependencies between defining equations.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    58
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    59
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    60
subsection {* @{text class} and @{text instantiation} *}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    61
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    62
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    63
  Concerning type classes and code generation, let us again examine an example
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    64
  from abstract algebra:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    65
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    66
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    67
class %quoteme semigroup = type +
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    68
  fixes mult :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<otimes>" 70)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    69
  assumes assoc: "(x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    70
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    71
class %quoteme monoid = semigroup +
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    72
  fixes neutral :: 'a ("\<one>")
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    73
  assumes neutl: "\<one> \<otimes> x = x"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    74
    and neutr: "x \<otimes> \<one> = x"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    75
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    76
instantiation %quoteme nat :: monoid
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    77
begin
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    78
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    79
primrec %quoteme mult_nat where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    80
    "0 \<otimes> n = (0\<Colon>nat)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    81
  | "Suc m \<otimes> n = n + m \<otimes> n"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    82
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    83
definition %quoteme neutral_nat where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    84
  "\<one> = Suc 0"
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
    85
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    86
lemma %quoteme add_mult_distrib:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    87
  fixes n m q :: nat
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    88
  shows "(n + m) \<otimes> q = n \<otimes> q + m \<otimes> q"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    89
  by (induct n) simp_all
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    90
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    91
instance %quoteme proof
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    92
  fix m n q :: nat
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    93
  show "m \<otimes> n \<otimes> q = m \<otimes> (n \<otimes> q)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    94
    by (induct m) (simp_all add: add_mult_distrib)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    95
  show "\<one> \<otimes> n = n"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    96
    by (simp add: neutral_nat_def)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    97
  show "m \<otimes> \<one> = m"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    98
    by (induct m) (simp_all add: neutral_nat_def)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
    99
qed
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   100
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   101
end %quoteme
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   102
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   103
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   104
  \noindent We define the natural operation of the natural numbers
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   105
  on monoids:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   106
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   107
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   108
primrec %quoteme pow :: "nat \<Rightarrow> 'a\<Colon>monoid \<Rightarrow> 'a\<Colon>monoid" where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   109
    "pow 0 a = \<one>"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   110
  | "pow (Suc n) a = a \<otimes> pow n a"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   111
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   112
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   113
  \noindent This we use to define the discrete exponentiation function:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   114
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   115
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   116
definition %quoteme bexp :: "nat \<Rightarrow> nat" where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   117
  "bexp n = pow n (Suc (Suc 0))"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   118
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   119
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   120
  \noindent The corresponding code:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   121
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   122
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   123
text %quoteme {*@{code_stmts bexp (Haskell)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   124
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   125
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   126
  \noindent An inspection reveals that the equations stemming from the
28428
haftmann
parents: 28419
diff changeset
   127
  @{command primrec} statement within instantiation of class
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   128
  @{class semigroup} with type @{typ nat} are mapped to a separate
28428
haftmann
parents: 28419
diff changeset
   129
  function declaration @{verbatim mult_nat} which in turn is used
haftmann
parents: 28419
diff changeset
   130
  to provide the right hand side for the @{verbatim "instance Semigroup Nat"}.
haftmann
parents: 28419
diff changeset
   131
  This perfectly
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   132
  agrees with the restriction that @{text inst} statements may
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   133
  only contain one single equation for each class class parameter
28428
haftmann
parents: 28419
diff changeset
   134
  The @{command instantiation} mechanism manages that for each
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   135
  overloaded constant @{text "f [\<kappa> \<^bvec>\<alpha>\<Colon>s\<^isub>k\<^evec>]"}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   136
  a \emph{shadow constant} @{text "f\<^isub>\<kappa> [\<^bvec>\<alpha>\<Colon>s\<^isub>k\<^evec>]"} is
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   137
  declared satisfying @{text "f [\<kappa> \<^bvec>\<alpha>\<Colon>s\<^isub>k\<^evec>] \<equiv> f\<^isub>\<kappa> [\<^bvec>\<alpha>\<Colon>s\<^isub>k\<^evec>]"}.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   138
  this equation is indeed the one used for the statement;
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   139
  using it as a rewrite rule, defining equations for 
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   140
  @{text "f [\<kappa> \<^bvec>\<alpha>\<Colon>s\<^isub>k\<^evec>]"} can be turned into
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   141
  defining equations for @{text "f\<^isub>\<kappa> [\<^bvec>\<alpha>\<Colon>s\<^isub>k\<^evec>]"}.  This
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   142
  happens transparently, providing the illusion that class parameters
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   143
  can be instantiated with more than one equation.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   144
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   145
  This is a convenient place to show how explicit dictionary construction
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   146
  manifests in generated code (here, the same example in @{text SML}):
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   147
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   148
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   149
text %quoteme {*@{code_stmts bexp (SML)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   150
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   151
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   152
subsection {* The preprocessor \label{sec:preproc} *}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   153
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   154
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   155
  Before selected function theorems are turned into abstract
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   156
  code, a chain of definitional transformation steps is carried
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   157
  out: \emph{preprocessing}.  In essence, the preprocessor
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   158
  consists of two components: a \emph{simpset} and \emph{function transformers}.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   159
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   160
  The \emph{simpset} allows to employ the full generality of the Isabelle
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   161
  simplifier.  Due to the interpretation of theorems
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   162
  as defining equations, rewrites are applied to the right
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   163
  hand side and the arguments of the left hand side of an
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   164
  equation, but never to the constant heading the left hand side.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   165
  An important special case are \emph{inline theorems} which may be
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   166
  declared and undeclared using the
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   167
  \emph{code inline} or \emph{code inline del} attribute respectively.
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   168
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   169
  Some common applications:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   170
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   171
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   172
text_raw {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   173
  \begin{itemize}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   174
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   175
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   176
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   177
     \item replacing non-executable constructs by executable ones:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   178
*}     
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   179
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   180
lemma %quoteme [code inline]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   181
  "x \<in> set xs \<longleftrightarrow> x mem xs" by (induct xs) simp_all
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   182
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   183
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   184
     \item eliminating superfluous constants:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   185
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   186
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   187
lemma %quoteme [code inline]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   188
  "1 = Suc 0" by simp
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   189
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   190
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   191
     \item replacing executable but inconvenient constructs:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   192
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   193
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   194
lemma %quoteme [code inline]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   195
  "xs = [] \<longleftrightarrow> List.null xs" by (induct xs) simp_all
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   196
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   197
text_raw {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   198
  \end{itemize}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   199
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   200
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   201
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   202
  \emph{Function transformers} provide a very general interface,
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   203
  transforming a list of function theorems to another
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   204
  list of function theorems, provided that neither the heading
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   205
  constant nor its type change.  The @{term "0\<Colon>nat"} / @{const Suc}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   206
  pattern elimination implemented in
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   207
  theory @{text Efficient_Nat} (see \secref{eff_nat}) uses this
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   208
  interface.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   209
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   210
  \noindent The current setup of the preprocessor may be inspected using
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   211
  the @{command print_codesetup} command.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   212
  @{command code_thms} provides a convenient
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   213
  mechanism to inspect the impact of a preprocessor setup
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   214
  on defining equations.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   215
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   216
  \begin{warn}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   217
    The attribute \emph{code unfold}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   218
    associated with the existing code generator also applies to
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   219
    the new one: \emph{code unfold} implies \emph{code inline}.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   220
  \end{warn}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   221
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   222
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   223
subsection {* Datatypes \label{sec:datatypes} *}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   224
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   225
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   226
  Conceptually, any datatype is spanned by a set of
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   227
  \emph{constructors} of type @{text "\<tau> = \<dots> \<Rightarrow> \<kappa> \<alpha>\<^isub>1 \<dots> \<alpha>\<^isub>n"}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   228
  where @{text "{\<alpha>\<^isub>1, \<dots>, \<alpha>\<^isub>n}"} is excactly the set of \emph{all}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   229
  type variables in @{text "\<tau>"}.  The HOL datatype package
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   230
  by default registers any new datatype in the table
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   231
  of datatypes, which may be inspected using
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   232
  the @{command print_codesetup} command.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   233
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   234
  In some cases, it may be convenient to alter or
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   235
  extend this table;  as an example, we will develop an alternative
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   236
  representation of natural numbers as binary digits, whose
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   237
  size does increase logarithmically with its value, not linear
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   238
  \footnote{Indeed, the @{theory Efficient_Nat} theory (see \ref{eff_nat})
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   239
    does something similar}.  First, the digit representation:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   240
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   241
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   242
definition %quoteme Dig0 :: "nat \<Rightarrow> nat" where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   243
  "Dig0 n = 2 * n"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   244
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   245
definition %quoteme  Dig1 :: "nat \<Rightarrow> nat" where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   246
  "Dig1 n = Suc (2 * n)"
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   247
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   248
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   249
  \noindent We will use these two ">digits"< to represent natural numbers
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   250
  in binary digits, e.g.:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   251
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   252
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   253
lemma %quoteme 42: "42 = Dig0 (Dig1 (Dig0 (Dig1 (Dig0 1))))"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   254
  by (simp add: Dig0_def Dig1_def)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   255
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   256
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   257
  \noindent Of course we also have to provide proper code equations for
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   258
  the operations, e.g. @{term "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"}:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   259
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   260
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   261
lemma %quoteme plus_Dig [code func]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   262
  "0 + n = n"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   263
  "m + 0 = m"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   264
  "1 + Dig0 n = Dig1 n"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   265
  "Dig0 m + 1 = Dig1 m"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   266
  "1 + Dig1 n = Dig0 (n + 1)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   267
  "Dig1 m + 1 = Dig0 (m + 1)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   268
  "Dig0 m + Dig0 n = Dig0 (m + n)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   269
  "Dig0 m + Dig1 n = Dig1 (m + n)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   270
  "Dig1 m + Dig0 n = Dig1 (m + n)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   271
  "Dig1 m + Dig1 n = Dig0 (m + n + 1)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   272
  by (simp_all add: Dig0_def Dig1_def)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   273
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   274
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   275
  \noindent We then instruct the code generator to view @{term "0\<Colon>nat"},
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   276
  @{term "1\<Colon>nat"}, @{term Dig0} and @{term Dig1} as
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   277
  datatype constructors:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   278
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   279
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   280
code_datatype %quoteme "0\<Colon>nat" "1\<Colon>nat" Dig0 Dig1
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   281
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   282
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   283
  \noindent For the former constructor @{term Suc}, we provide a code
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   284
  equation and remove some parts of the default code generator setup
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   285
  which are an obstacle here:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   286
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   287
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   288
lemma %quoteme Suc_Dig [code func]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   289
  "Suc n = n + 1"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   290
  by simp
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   291
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   292
declare %quoteme One_nat_def [code inline del]
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   293
declare %quoteme add_Suc_shift [code func del] 
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   294
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   295
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   296
  \noindent This yields the following code:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   297
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   298
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   299
text %quoteme {*@{code_stmts "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat" (SML)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   300
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   301
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   302
  \medskip
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   303
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   304
  From this example, it can be easily glimpsed that using own constructor sets
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   305
  is a little delicate since it changes the set of valid patterns for values
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   306
  of that type.  Without going into much detail, here some practical hints:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   307
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   308
  \begin{itemize}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   309
    \item When changing the constructor set for datatypes, take care to
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   310
      provide an alternative for the @{text case} combinator (e.g.~by replacing
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   311
      it using the preprocessor).
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   312
    \item Values in the target language need not to be normalised -- different
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   313
      values in the target language may represent the same value in the
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   314
      logic (e.g. @{term "Dig1 0 = 1"}).
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   315
    \item Usually, a good methodology to deal with the subtleties of pattern
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   316
      matching is to see the type as an abstract type: provide a set
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   317
      of operations which operate on the concrete representation of the type,
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   318
      and derive further operations by combinations of these primitive ones,
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   319
      without relying on a particular representation.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   320
  \end{itemize}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   321
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   322
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   323
code_datatype %invisible "0::nat" Suc
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   324
declare %invisible plus_Dig [code func del]
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   325
declare %invisible One_nat_def [code inline]
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   326
declare %invisible add_Suc_shift [code func] 
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   327
lemma %invisible [code func]: "0 + n = (n \<Colon> nat)" by simp
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   328
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   329
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   330
subsection {* Equality and wellsortedness *}
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   331
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   332
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   333
  Surely you have already noticed how equality is treated
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   334
  by the code generator:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   335
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   336
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   337
primrec %quoteme
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   338
  collect_duplicates :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   339
    "collect_duplicates xs ys [] = xs"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   340
  | "collect_duplicates xs ys (z#zs) = (if z \<in> set xs
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   341
      then if z \<in> set ys
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   342
        then collect_duplicates xs ys zs
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   343
        else collect_duplicates xs (z#ys) zs
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   344
      else collect_duplicates (z#xs) (z#ys) zs)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   345
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   346
text {*
28428
haftmann
parents: 28419
diff changeset
   347
  \noindent The membership test during preprocessing is rewritten,
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   348
  resulting in @{const List.member}, which itself
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   349
  performs an explicit equality check.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   350
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   351
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   352
text %quoteme {*@{code_stmts collect_duplicates (SML)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   353
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   354
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   355
  \noindent Obviously, polymorphic equality is implemented the Haskell
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   356
  way using a type class.  How is this achieved?  HOL introduces
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   357
  an explicit class @{class eq} with a corresponding operation
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   358
  @{const eq_class.eq} such that @{thm eq [no_vars]}.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   359
  The preprocessing framework does the rest.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   360
  For datatypes, instances of @{class eq} are implicitly derived
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   361
  when possible.  For other types, you may instantiate @{text eq}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   362
  manually like any other type class.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   363
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   364
  Though this @{text eq} class is designed to get rarely in
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   365
  the way, a subtlety
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   366
  enters the stage when definitions of overloaded constants
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   367
  are dependent on operational equality.  For example, let
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   368
  us define a lexicographic ordering on tuples:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   369
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   370
28428
haftmann
parents: 28419
diff changeset
   371
instantiation %quoteme * :: (ord, ord) ord
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   372
begin
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   373
28428
haftmann
parents: 28419
diff changeset
   374
definition %quoteme [code func del]:
haftmann
parents: 28419
diff changeset
   375
  "p1 < p2 \<longleftrightarrow> (let (x1, y1) = p1; (x2, y2) = p2 in x1 < x2 \<or> (x1 = x2 \<and> y1 < y2))"
haftmann
parents: 28419
diff changeset
   376
haftmann
parents: 28419
diff changeset
   377
definition %quoteme [code func del]:
haftmann
parents: 28419
diff changeset
   378
  "p1 \<le> p2 \<longleftrightarrow> (let (x1, y1) = p1; (x2, y2) = p2 in x1 < x2 \<or> (x1 = x2 \<and> y1 \<le> y2))"
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   379
28428
haftmann
parents: 28419
diff changeset
   380
instance %quoteme ..
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   381
28428
haftmann
parents: 28419
diff changeset
   382
end %quoteme
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   383
28428
haftmann
parents: 28419
diff changeset
   384
lemma %quoteme ord_prod [code func]:
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   385
  "(x1 \<Colon> 'a\<Colon>ord, y1 \<Colon> 'b\<Colon>ord) < (x2, y2) \<longleftrightarrow> x1 < x2 \<or> (x1 = x2 \<and> y1 < y2)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   386
  "(x1 \<Colon> 'a\<Colon>ord, y1 \<Colon> 'b\<Colon>ord) \<le> (x2, y2) \<longleftrightarrow> x1 < x2 \<or> (x1 = x2 \<and> y1 \<le> y2)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   387
  unfolding less_prod_def less_eq_prod_def by simp_all
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   388
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   389
text {*
28428
haftmann
parents: 28419
diff changeset
   390
  \noindent Then code generation will fail.  Why?  The definition
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   391
  of @{term "op \<le>"} depends on equality on both arguments,
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   392
  which are polymorphic and impose an additional @{class eq}
28428
haftmann
parents: 28419
diff changeset
   393
  class constraint, which the preprocessort does not propagate for technical
haftmann
parents: 28419
diff changeset
   394
  reasons.
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   395
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   396
  The solution is to add @{class eq} explicitly to the first sort arguments in the
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   397
  code theorems:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   398
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   399
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   400
lemma ord_prod_code [code func]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   401
  "(x1 \<Colon> 'a\<Colon>{ord, eq}, y1 \<Colon> 'b\<Colon>ord) < (x2, y2) \<longleftrightarrow>
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   402
    x1 < x2 \<or> (x1 = x2 \<and> y1 < y2)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   403
  "(x1 \<Colon> 'a\<Colon>{ord, eq}, y1 \<Colon> 'b\<Colon>ord) \<le> (x2, y2) \<longleftrightarrow>
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   404
    x1 < x2 \<or> (x1 = x2 \<and> y1 \<le> y2)"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   405
  unfolding ord_prod by rule+
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   406
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   407
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   408
  \noindent Then code generation succeeds:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   409
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   410
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   411
text %quoteme {*@{code_stmts "op \<le> \<Colon> 'a\<Colon>{eq, ord} \<times> 'b\<Colon>ord \<Rightarrow> 'a \<times> 'b \<Rightarrow> bool" (SML)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   412
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   413
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   414
  In some cases, the automatically derived defining equations
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   415
  for equality on a particular type may not be appropriate.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   416
  As example, watch the following datatype representing
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   417
  monomorphic parametric types (where type constructors
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   418
  are referred to by natural numbers):
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   419
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   420
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   421
datatype %quoteme monotype = Mono nat "monotype list"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   422
(*<*)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   423
lemma monotype_eq:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   424
  "Mono tyco1 typargs1 = Mono tyco2 typargs2 \<equiv> 
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   425
     tyco1 = tyco2 \<and> typargs1 = typargs2" by simp
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   426
(*>*)
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   427
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   428
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   429
  Then code generation for SML would fail with a message
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   430
  that the generated code contains illegal mutual dependencies:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   431
  the theorem @{thm monotype_eq [no_vars]} already requires the
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   432
  instance @{text "monotype \<Colon> eq"}, which itself requires
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   433
  @{thm monotype_eq [no_vars]};  Haskell has no problem with mutually
28428
haftmann
parents: 28419
diff changeset
   434
  recursive @{text inst} and @{text fun} definitions,
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   435
  but the SML serializer does not support this.
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   436
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   437
  In such cases, you have to provide you own equality equations
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   438
  involving auxiliary constants.  In our case,
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   439
  @{const [show_types] list_all2} can do the job:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   440
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   441
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   442
lemma %quoteme monotype_eq_list_all2 [code func]:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   443
  "eq_class.eq (Mono tyco1 typargs1) (Mono tyco2 typargs2) \<longleftrightarrow>
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   444
     tyco1 = tyco2 \<and> list_all2 eq_class.eq typargs1 typargs2"
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   445
  by (simp add: eq list_all2_eq [symmetric])
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   446
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   447
text {*
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   448
  \noindent does not depend on instance @{text "monotype \<Colon> eq"}:
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   449
*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   450
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   451
text %quoteme {*@{code_stmts "eq_class.eq :: monotype \<Rightarrow> monotype \<Rightarrow> bool" (SML)}*}
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   452
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   453
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   454
subsection {* Partiality *}
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   455
28419
f65e8b318581 re-canibalised manual
haftmann
parents: 28213
diff changeset
   456
text {* @{command "code_abort"}, examples: maps *}
28213
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   457
b52f9205a02d New outline for codegen tutorial -- draft
haftmann
parents:
diff changeset
   458
end