doc-src/TutorialI/CodeGen/CodeGen.thy
author haftmann
Fri, 17 Jun 2005 16:12:49 +0200
changeset 16417 9bc16273c2d4
parent 11458 09a6c44a48ea
child 17212 6859484b5b2b
permissions -rw-r--r--
migrated theory headers to new format
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
     1
(*<*)
16417
9bc16273c2d4 migrated theory headers to new format
haftmann
parents: 11458
diff changeset
     2
theory CodeGen imports Main begin
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
     3
(*>*)
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
     4
10885
90695f46440b lcp's pass over the book, chapters 1-8
paulson
parents: 10795
diff changeset
     5
section{*Case Study: Compiling Expressions*}
9844
8016321c7de1 *** empty log message ***
nipkow
parents: 9792
diff changeset
     6
8016321c7de1 *** empty log message ***
nipkow
parents: 9792
diff changeset
     7
text{*\label{sec:ExprCompiler}
11458
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
     8
\index{compiling expressions example|(}%
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
     9
The task is to develop a compiler from a generic type of expressions (built
10795
9e888d60d3e5 minor edits to Chapters 1-3
paulson
parents: 10171
diff changeset
    10
from variables, constants and binary operations) to a stack machine.  This
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    11
generic type of expressions is a generalization of the boolean expressions in
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    12
\S\ref{sec:boolex}.  This time we do not commit ourselves to a particular
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    13
type of variables or values but make them type parameters.  Neither is there
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    14
a fixed set of binary operations: instead the expression contains the
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    15
appropriate function itself.
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    16
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    17
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    18
types 'v binop = "'v \<Rightarrow> 'v \<Rightarrow> 'v";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    19
datatype ('a,'v)expr = Cex 'v
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    20
                     | Vex 'a
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    21
                     | Bex "'v binop"  "('a,'v)expr"  "('a,'v)expr";
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    22
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    23
text{*\noindent
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    24
The three constructors represent constants, variables and the application of
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    25
a binary operation to two subexpressions.
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    26
10795
9e888d60d3e5 minor edits to Chapters 1-3
paulson
parents: 10171
diff changeset
    27
The value of an expression with respect to an environment that maps variables to
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    28
values is easily defined:
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    29
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    30
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    31
consts value :: "('a,'v)expr \<Rightarrow> ('a \<Rightarrow> 'v) \<Rightarrow> 'v";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    32
primrec
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    33
"value (Cex v) env = v"
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    34
"value (Vex a) env = env a"
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    35
"value (Bex f e1 e2) env = f (value e1 env) (value e2 env)";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    36
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    37
text{*
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    38
The stack machine has three instructions: load a constant value onto the
10795
9e888d60d3e5 minor edits to Chapters 1-3
paulson
parents: 10171
diff changeset
    39
stack, load the contents of an address onto the stack, and apply a
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    40
binary operation to the two topmost elements of the stack, replacing them by
9792
bbefb6ce5cb2 *** empty log message ***
nipkow
parents: 9458
diff changeset
    41
the result. As for @{text"expr"}, addresses and values are type parameters:
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    42
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    43
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    44
datatype ('a,'v) instr = Const 'v
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    45
                       | Load 'a
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    46
                       | Apply "'v binop";
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    47
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    48
text{*
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    49
The execution of the stack machine is modelled by a function
9792
bbefb6ce5cb2 *** empty log message ***
nipkow
parents: 9458
diff changeset
    50
@{text"exec"} that takes a list of instructions, a store (modelled as a
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    51
function from addresses to values, just like the environment for
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    52
evaluating expressions), and a stack (modelled as a list) of values,
10971
6852682eaf16 *** empty log message ***
nipkow
parents: 10885
diff changeset
    53
and returns the stack at the end of the execution --- the store remains
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    54
unchanged:
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    55
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    56
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    57
consts exec :: "('a,'v)instr list \<Rightarrow> ('a\<Rightarrow>'v) \<Rightarrow> 'v list \<Rightarrow> 'v list";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    58
primrec
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    59
"exec [] s vs = vs"
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    60
"exec (i#is) s vs = (case i of
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    61
    Const v  \<Rightarrow> exec is s (v#vs)
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    62
  | Load a   \<Rightarrow> exec is s ((s a)#vs)
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    63
  | Apply f  \<Rightarrow> exec is s ((f (hd vs) (hd(tl vs)))#(tl(tl vs))))";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    64
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    65
text{*\noindent
9792
bbefb6ce5cb2 *** empty log message ***
nipkow
parents: 9458
diff changeset
    66
Recall that @{term"hd"} and @{term"tl"}
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    67
return the first element and the remainder of a list.
11458
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
    68
Because all functions are total, \cdx{hd} is defined even for the empty
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    69
list, although we do not know what the result is. Thus our model of the
10795
9e888d60d3e5 minor edits to Chapters 1-3
paulson
parents: 10171
diff changeset
    70
machine always terminates properly, although the definition above does not
9792
bbefb6ce5cb2 *** empty log message ***
nipkow
parents: 9458
diff changeset
    71
tell us much about the result in situations where @{term"Apply"} was executed
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    72
with fewer than two elements on the stack.
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    73
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    74
The compiler is a function from expressions to a list of instructions. Its
10795
9e888d60d3e5 minor edits to Chapters 1-3
paulson
parents: 10171
diff changeset
    75
definition is obvious:
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    76
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    77
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    78
consts comp :: "('a,'v)expr \<Rightarrow> ('a,'v)instr list";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    79
primrec
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    80
"comp (Cex v)       = [Const v]"
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    81
"comp (Vex a)       = [Load a]"
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    82
"comp (Bex f e1 e2) = (comp e2) @ (comp e1) @ [Apply f]";
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    83
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    84
text{*
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    85
Now we have to prove the correctness of the compiler, i.e.\ that the
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    86
execution of a compiled expression results in the value of the expression:
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    87
*}
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
    88
theorem "exec (comp e) s [] = [value e s]";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    89
(*<*)oops;(*>*)
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    90
text{*\noindent
11458
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
    91
This theorem needs to be generalized:
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    92
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    93
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
    94
theorem "\<forall>vs. exec (comp e) s vs = (value e s) # vs";
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    95
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    96
txt{*\noindent
11458
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
    97
It will be proved by induction on @{term"e"} followed by simplification.  
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
    98
First, we must prove a lemma about executing the concatenation of two
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
    99
instruction sequences:
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   100
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   101
(*<*)oops;(*>*)
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   102
lemma exec_app[simp]:
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
   103
  "\<forall>vs. exec (xs@ys) s vs = exec ys s (exec xs s vs)"; 
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   104
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   105
txt{*\noindent
9792
bbefb6ce5cb2 *** empty log message ***
nipkow
parents: 9458
diff changeset
   106
This requires induction on @{term"xs"} and ordinary simplification for the
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   107
base cases. In the induction step, simplification leaves us with a formula
9792
bbefb6ce5cb2 *** empty log message ***
nipkow
parents: 9458
diff changeset
   108
that contains two @{text"case"}-expressions over instructions. Thus we add
11458
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
   109
automatic case splitting, which finishes the proof:
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   110
*}
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
   111
apply(induct_tac xs, simp, simp split: instr.split);
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
   112
(*<*)done(*>*)
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   113
text{*\noindent
11428
332347b9b942 tidying the index
paulson
parents: 10971
diff changeset
   114
Note that because both \methdx{simp_all} and \methdx{auto} perform simplification, they can
332347b9b942 tidying the index
paulson
parents: 10971
diff changeset
   115
be modified in the same way as @{text simp}.  Thus the proof can be
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   116
rewritten as
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   117
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   118
(*<*)
9933
9feb1e0c4cb3 *** empty log message ***
nipkow
parents: 9844
diff changeset
   119
declare exec_app[simp del];
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
   120
lemma [simp]: "\<forall>vs. exec (xs@ys) s vs = exec ys s (exec xs s vs)"; 
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   121
(*>*)
10971
6852682eaf16 *** empty log message ***
nipkow
parents: 10885
diff changeset
   122
apply(induct_tac xs, simp_all split: instr.split);
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
   123
(*<*)done(*>*)
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   124
text{*\noindent
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   125
Although this is more compact, it is less clear for the reader of the proof.
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   126
8771
026f37a86ea7 *** empty log message ***
nipkow
parents: 8744
diff changeset
   127
We could now go back and prove \isa{exec (comp e) s [] = [value e s]}
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   128
merely by simplification with the generalized version we just proved.
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   129
However, this is unnecessary because the generalized version fully subsumes
11458
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
   130
its instance.%
09a6c44a48ea numerous stylistic changes and indexing
paulson
parents: 11428
diff changeset
   131
\index{compiling expressions example|)}
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   132
*}
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   133
(*<*)
10171
59d6633835fa *** empty log message ***
nipkow
parents: 9933
diff changeset
   134
theorem "\<forall>vs. exec (comp e) s vs = (value e s) # vs";
9458
c613cd06d5cf apply. -> by
nipkow
parents: 8771
diff changeset
   135
by(induct_tac e, auto);
8744
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   136
end
22fa8b16c3ae *** empty log message ***
nipkow
parents:
diff changeset
   137
(*>*)