Mercurial > cpdt > repo

annotate src/StackMachine.v @ 17:2c5a2a221b85

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Target language source examples
author Adam Chlipala <adamc@hcoop.net>
date Wed, 03 Sep 2008 15:08:28 -0400
parents 4d8ca6845e67
children 82618ad75252
rev   line source
adamc@2 1 (* Copyright (c) 2008, Adam Chlipala
adamc@2 2 *
adamc@2 3 * This work is licensed under a
adamc@2 4 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0
adamc@2 5 * Unported License.
adamc@2 6 * The license text is available at:
adamc@2 7 * http://creativecommons.org/licenses/by-nc-nd/3.0/
adamc@2 8 *)
adamc@2 9
adamc@3 10 (* begin hide *)
adamc@2 11 Require Import List.
adamc@2 12
adamc@2 13 Require Import Tactics.
adamc@14 14
adamc@14 15 Set Implicit Arguments.
adamc@3 16 (* end hide *)
adamc@2 17
adamc@2 18
adamc@9 19 (** I will start off by jumping right in to a fully-worked set of examples, building certified compilers from increasingly complicated source languages to stack machines. We will meet a few useful tactics and see how they can be used in manual proofs, and we will also see how easily these proofs can be automated instead. I assume that you have installed Coq and Proof General.
adamc@9 20
adamc@11 21 As always, you can step through the source file %\texttt{%#<tt>#StackMachine.v#</tt>#%}% for this chapter interactively in Proof General. Alternatively, to get a feel for the whole lifecycle of creating a Coq development, you can enter the pieces of source code in this chapter in a new %\texttt{%#<tt>#.v#</tt>#%}% file in an Emacs buffer. If you do the latter, include a line [Require Import List Tactics] at the start of the file, to match some code hidden from the chapter source, and be sure to run the Coq binary %\texttt{%#<tt>#coqtop#</tt>#%}% with the command-line argument %\texttt{%#<tt>#-I SRC#</tt>#%}%, where %\texttt{%#<tt>#SRC#</tt>#%}% is the path to a directory containing the source for this book. In either case, if you have installed Proof General properly, it should start automatically when you visit a %\texttt{%#<tt>#.v#</tt>#%}% buffer in Emacs.
adamc@11 22
adamc@11 23 With Proof General, the portion of a buffer that Coq has processed is highlighted in some way, like being given a blue background. You step through Coq source files by positioning the point at the position you want Coq to run to and pressing C-C C-RET. This can be used both for normal step-by-step coding, by placing the point inside some command past the end of the highlighted region; and for undoing, by placing the point inside the highlighted region. *)
adamc@9 24
adamc@9 25
adamc@2 26 (** * Arithmetic expressions over natural numbers *)
adamc@2 27
adamc@9 28 (** We will begin with that staple of compiler textbooks, arithemtic expressions over a single type of numbers. *)
adamc@9 29
adamc@9 30 (** ** Source language *)
adamc@9 31
adamc@9 32 (** We begin with the syntax of the source language. *)
adamc@2 33
adamc@4 34 Inductive binop : Set := Plus | Times.
adamc@2 35
adamc@9 36 (** Our first line of Coq code should be unsurprising to ML and Haskell programmers. We define an algebraic datatype [binop] to stand for the binary operators of our source language. There are just two wrinkles compared to ML and Haskell. First, we use the keyword [Inductive], in place of %\texttt{%#<tt>#data#</tt>#%}%, %\texttt{%#<tt>#datatype#</tt>#%}%, or %\texttt{%#<tt>#type#</tt>#%}%. This is not just a trivial surface syntax difference; inductive types in Coq are much more expressive than garden variety algebraic datatypes, essentially enabling us to encode all of mathematics, though we begin humbly in this chapter. Second, there is the [: Set] fragment, which declares that we are defining a datatype that should be thought of as a constituent of programs. Later, we will see other options for defining datatypes in the universe of proofs or in an infinite hierarchy of universes, encompassing both programs and proofs, that is useful in higher-order constructions. *)
adamc@9 37
adamc@4 38 Inductive exp : Set :=
adamc@4 39 | Const : nat -> exp
adamc@4 40 | Binop : binop -> exp -> exp -> exp.
adamc@2 41
adamc@9 42 (** Now we define the type of arithmetic expressions. We write that a constant may be built from one argument, a natural number; and a binary operation may be built from a choice of operator and two operand expressions.
adamc@9 43
adamc@9 44 A note for readers following along in the PDF version: coqdoc supports pretty-printing of tokens in LaTeX or HTML. Where you see a right arrow character, the source contains the ASCII text %\texttt{%#<tt>#->#</tt>#%}%. Other examples of this substitution appearing in this chapter are a double right arrow for %\texttt{%#<tt>#=>#</tt>#%}% and the inverted 'A' symbol for %\texttt{%#<tt>#forall#</tt>#%}%. When in doubt about the ASCII version of a symbol, you can consult the chapter source code.
adamc@9 45
adamc@9 46 %\medskip%
adamc@9 47
adamc@9 48 Now we are ready to say what these programs mean. We will do this by writing an interpreter that can be thought of as a trivial operational or denotational semantics. (If you are not familiar with these semantic techniques, no need to worry; we will stick to "common sense" constructions.) *)
adamc@9 49
adamc@4 50 Definition binopDenote (b : binop) : nat -> nat -> nat :=
adamc@4 51 match b with
adamc@4 52 | Plus => plus
adamc@4 53 | Times => mult
adamc@4 54 end.
adamc@2 55
adamc@9 56 (** The meaning of a binary operator is a binary function over naturals, defined with pattern-matching notation analogous to the %\texttt{%#<tt>#case#</tt>#%}% and %\texttt{%#<tt>#match#</tt>#%}% of ML and Haskell, and referring to the functions [plus] and [mult] from the Coq standard library. The keyword [Definition] is Coq's all-purpose notation for binding a term of the programming language to a name, with some associated syntactic sugar, like the notation we see here for defining a function. That sugar could be expanded to yield this definition:
adamc@9 57
adamc@9 58 [[
adamc@9 59 Definition binopDenote : binop -> nat -> nat -> nat := fun (b : binop) =>
adamc@9 60 match b with
adamc@9 61 | Plus => plus
adamc@9 62 | Times => mult
adamc@9 63 end.
adamc@9 64
adamc@9 65 In this example, we could also omit all of the type annotations, arriving at:
adamc@9 66
adamc@9 67 [[
adamc@9 68 Definition binopDenote := fun b =>
adamc@9 69 match b with
adamc@9 70 | Plus => plus
adamc@9 71 | Times => mult
adamc@9 72 end.
adamc@9 73
adamc@9 74 Languages like Haskell and ML have a convenient %\textit{%#<i>#principal typing#</i>#%}% property, which gives us strong guarantees about how effective type inference will be. Unfortunately, Coq's type system is so expressive that any kind of "complete" type inference is impossible, and the task even seems to be hard heuristically in practice. Nonetheless, Coq includes some very helpful heuristics, many of them copying the workings of Haskell and ML type-checkers for programs that fall in simple fragments of Coq's language.
adamc@9 75
adamc@9 76 This is as good a time as any to mention the preponderance of different languages associated with Coq. The theoretical foundation of Coq is a formal system called the %\textit{%#<i>#Calculus of Inductive Constructions (CIC)#</i>#%}%, which is an extension of the older %\textit{%#<i>#Calculus of Constructions (CoC)#</i>#%}%. CIC is quite a spartan foundation, which is helpful for proving metatheory but not so helpful for real development. Still, it is nice to know that it has been proved that CIC enjoys properties like %\textit{%#<i>#strong normalization#</i>#%}%, meaning that every program (and, more importantly, every proof term) terminates; and %\textit{%#<i>#relative consistency#</i>#%}% with systems like versions of Zermelo Fraenkel set theory, which roughly means that you can believe that Coq proofs mean that the corresponding propositions are "really true," if you believe in set theory.
adamc@9 77
adamc@9 78 Coq is actually based on an extension of CIC called %\textit{%#<i>#Gallina#</i>#%}%. The text after the [:=] and before the period in the last code example is a term of Gallina. Gallina adds many useful features that are not compiled internalluy to more primitive CIC features. The important metatheorems about CIC have not been extended to the full breadth of these features, but most Coq users do not seem to lose much sleep over this omission.
adamc@9 79
adamc@9 80 Commands like [Inductive] and [Definition] are part of %\textit{%#<i>#the vernacular#</i>#%}%, which includes all sorts of useful queries and requests to the Coq system.
adamc@9 81
adamc@9 82 Finally, there is %\textit{%#<i>#Ltac#</i>#%}%, Coq's domain-specific language for writing proofs and decision procedures. We will see some basic examples of Ltac later in this chapter, and much of this book is devoted to more involved Ltac examples.
adamc@9 83
adamc@9 84 %\medskip%
adamc@9 85
adamc@9 86 We can give a simple definition of the meaning of an expression: *)
adamc@9 87
adamc@4 88 Fixpoint expDenote (e : exp) : nat :=
adamc@4 89 match e with
adamc@4 90 | Const n => n
adamc@4 91 | Binop b e1 e2 => (binopDenote b) (expDenote e1) (expDenote e2)
adamc@4 92 end.
adamc@2 93
adamc@9 94 (** We declare explicitly that this is a recursive definition, using the keyword [Fixpoint]. The rest should be old hat for functional programmers. *)
adamc@2 95
adamc@16 96 (** It is convenient to be able to test definitions before starting to prove things about them. We can verify that our semantics is sensible by evaluating some sample uses. *)
adamc@16 97
adamc@16 98 Eval simpl in expDenote (Const 42).
adamc@16 99 Eval simpl in expDenote (Binop Plus (Const 2) (Const 2)).
adamc@16 100 Eval simpl in expDenote (Binop Times (Binop Plus (Const 2) (Const 2)) (Const 7)).
adamc@16 101
adamc@9 102
adamc@9 103 (** ** Target language *)
adamc@4 104
adamc@10 105 (** We will compile our source programs onto a simple stack machine, whose syntax is: *)
adamc@2 106
adamc@4 107 Inductive instr : Set :=
adamc@4 108 | IConst : nat -> instr
adamc@4 109 | IBinop : binop -> instr.
adamc@2 110
adamc@4 111 Definition prog := list instr.
adamc@4 112 Definition stack := list nat.
adamc@2 113
adamc@10 114 (** An instruction either pushes a constant onto the stack or pops two arguments, applies a binary operator to them, and pushes the result onto the stack. A program is a list of instructions, and a stack is a list of natural numbers.
adamc@10 115
adamc@10 116 We can give instructions meanings as functions from stacks to optional stacks, where running an instruction results in [None] in case of a stack underflow and results in [Some s'] when the result of execution is the new stack [s']. [::] is the "list cons" operator from the Coq standard library. *)
adamc@10 117
adamc@4 118 Definition instrDenote (i : instr) (s : stack) : option stack :=
adamc@4 119 match i with
adamc@4 120 | IConst n => Some (n :: s)
adamc@4 121 | IBinop b =>
adamc@4 122 match s with
adamc@4 123 | arg1 :: arg2 :: s' => Some ((binopDenote b) arg1 arg2 :: s')
adamc@4 124 | _ => None
adamc@4 125 end
adamc@4 126 end.
adamc@2 127
adamc@10 128 (** With [instrDenote] defined, it is easy to define a function [progDenote], which iterates application of [instrDenote] through a whole program. *)
adamc@10 129
adamc@4 130 Fixpoint progDenote (p : prog) (s : stack) {struct p} : option stack :=
adamc@4 131 match p with
adamc@4 132 | nil => Some s
adamc@4 133 | i :: p' =>
adamc@4 134 match instrDenote i s with
adamc@4 135 | None => None
adamc@4 136 | Some s' => progDenote p' s'
adamc@4 137 end
adamc@4 138 end.
adamc@2 139
adamc@10 140 (** There is one interesting difference compared to our previous example of a [Fixpoint]. This recursive function takes two arguments, [p] and [s]. It is critical for the soundness of Coq that every program terminate, so a shallow syntactic termination check is imposed on every recursive function definition. One of the function parameters must be designated to decrease monotonically across recursive calls. That is, every recursive call must use a version of that argument that has been pulled out of the current argument by some number of [match] expressions. [expDenote] has only one argument, so we did not need to specify which of its arguments decreases. For [progDenote], we resolve the ambiguity by writing [{struct p}] to indicate that argument [p] decreases structurally. *)
adamc@2 141
adamc@4 142
adamc@9 143 (** ** Translation *)
adamc@4 144
adamc@10 145 (** Our compiler itself is now unsurprising. [++] is the list concatenation operator from the Coq standard library. *)
adamc@2 146
adamc@4 147 Fixpoint compile (e : exp) : prog :=
adamc@4 148 match e with
adamc@4 149 | Const n => IConst n :: nil
adamc@4 150 | Binop b e1 e2 => compile e2 ++ compile e1 ++ IBinop b :: nil
adamc@4 151 end.
adamc@2 152
adamc@2 153
adamc@16 154 (** Before we set about proving that this compiler is correct, we can try a few test runs, using our sample programs from earlier. *)
adamc@16 155
adamc@16 156 Eval simpl in compile (Const 42).
adamc@16 157 Eval simpl in compile (Binop Plus (Const 2) (Const 2)).
adamc@16 158 Eval simpl in compile (Binop Times (Binop Plus (Const 2) (Const 2)) (Const 7)).
adamc@16 159
adamc@16 160 (** We can also run our compiled programs and chedk that they give the right results. *)
adamc@16 161
adamc@16 162 Eval simpl in progDenote (compile (Const 42)) nil.
adamc@16 163 Eval simpl in progDenote (compile (Binop Plus (Const 2) (Const 2))) nil.
adamc@16 164 Eval simpl in progDenote (compile (Binop Times (Binop Plus (Const 2) (Const 2)) (Const 7))) nil.
adamc@16 165
adamc@16 166
adamc@9 167 (** ** Translation correctness *)
adamc@4 168
adamc@11 169 (** We are ready to prove that our compiler is implemented correctly. We can use a new vernacular command [Theorem] to start a correctness proof, in terms of the semantics we defined earlier: *)
adamc@11 170
adamc@11 171 Theorem compileCorrect : forall e, progDenote (compile e) nil = Some (expDenote e :: nil).
adamc@11 172 (* begin hide *)
adamc@11 173 Abort.
adamc@11 174 (* end hide *)
adamc@11 175
adamc@11 176 (** Though a pencil-and-paper proof might clock out at this point, writing "by a routine induction on [e]," it turns out not to make sense to attack this proof directly. We need to use the standard trick of %\textit{%#<i>#strengthening the induction hypothesis#</i>#%}%. We do that by proving an auxiliary lemma:
adamc@11 177 *)
adamc@2 178
adamc@15 179 Lemma compileCorrect' : forall e p s, progDenote (compile e ++ p) s = progDenote p (expDenote e :: s).
adamc@11 180
adamc@11 181 (** After the period in the [Lemma] command, we are in %\textit{%#<i>#the interactive proof-editing mode#</i>#%}%. We find ourselves staring at this ominous screen of text:
adamc@11 182
adamc@11 183 [[
adamc@11 184 1 subgoal
adamc@11 185
adamc@11 186 ============================
adamc@15 187 forall (e : exp) (p : list instr) (s : stack),
adamc@15 188 progDenote (compile e ++ p) s = progDenote p (expDenote e :: s)
adamc@11 189 ]]
adamc@11 190
adamc@11 191 Coq seems to be restating the lemma for us. What we are seeing is a limited case of a more general protocol for describing where we are in a proof. We are told that we have a single subgoal. In general, during a proof, we can have many pending subgoals, each of which is a logical proposition to prove. Subgoals can be proved in any order, but it usually works best to prove them in the order that Coq chooses.
adamc@11 192
adamc@11 193 Next in the output, we see our single subgoal described in full detail. There is a double-dashed line, above which would be our free variables and hypotheses, if we had any. Below the line is the conclusion, which, in general, is to be proved from the hypotheses.
adamc@11 194
adamc@11 195 We manipulate the proof state by running commands called %\textit{%#<i>#tactics#</i>#%}%. Let us start out by running one of the most important tactics:
adamc@11 196 *)
adamc@11 197
adamc@4 198 induction e.
adamc@2 199
adamc@11 200 (** We declare that this proof will proceed by induction on the structure of the expression [e]. This swaps out our initial subgoal for two new subgoals, one for each case of the inductive proof:
adamc@11 201
adamc@11 202 [[
adamc@11 203 2 subgoals
adamc@11 204
adamc@11 205 n : nat
adamc@11 206 ============================
adamc@11 207 forall (s : stack) (p : list instr),
adamc@11 208 progDenote (compile (Const n) ++ p) s =
adamc@11 209 progDenote p (expDenote (Const n) :: s)
adamc@11 210 ]]
adamc@11 211 [[
adamc@11 212 subgoal 2 is:
adamc@11 213 forall (s : stack) (p : list instr),
adamc@11 214 progDenote (compile (Binop b e1 e2) ++ p) s =
adamc@11 215 progDenote p (expDenote (Binop b e1 e2) :: s)
adamc@11 216 ]]
adamc@11 217
adamc@11 218 The first and current subgoal is displayed with the double-dashed line below free variables and hypotheses, while later subgoals are only summarized with their conclusions. We see an example of a free variable in the first subgoal; [n] is a free variable of type [nat]. The conclusion is the original theorem statement where [e] has been replaced by [Const n]. In a similar manner, the second case has [e] replaced by a generalized invocation of the [Binop] expression constructor. We can see that proving both cases corresponds to a standard proof by structural induction.
adamc@11 219
adamc@11 220 We begin the first case with another very common tactic.
adamc@11 221 *)
adamc@11 222
adamc@4 223 intros.
adamc@11 224
adamc@11 225 (** The current subgoal changes to:
adamc@11 226 [[
adamc@11 227
adamc@11 228 n : nat
adamc@11 229 s : stack
adamc@11 230 p : list instr
adamc@11 231 ============================
adamc@11 232 progDenote (compile (Const n) ++ p) s =
adamc@11 233 progDenote p (expDenote (Const n) :: s)
adamc@11 234 ]]
adamc@11 235
adamc@11 236 We see that [intros] changes [forall]-bound variables at the beginning of a goal into free variables.
adamc@11 237
adamc@11 238 To progress further, we need to use the definitions of some of the functions appearing in the goal. The [unfold] tactic replaces an identifier with its definition.
adamc@11 239 *)
adamc@11 240
adamc@4 241 unfold compile.
adamc@11 242
adamc@11 243 (** [[
adamc@11 244
adamc@11 245 n : nat
adamc@11 246 s : stack
adamc@11 247 p : list instr
adamc@11 248 ============================
adamc@11 249 progDenote ((IConst n :: nil) ++ p) s =
adamc@11 250 progDenote p (expDenote (Const n) :: s)
adamc@11 251 ]] *)
adamc@11 252
adamc@4 253 unfold expDenote.
adamc@11 254
adamc@11 255 (** [[
adamc@11 256
adamc@11 257 n : nat
adamc@11 258 s : stack
adamc@11 259 p : list instr
adamc@11 260 ============================
adamc@11 261 progDenote ((IConst n :: nil) ++ p) s = progDenote p (n :: s)
adamc@11 262 ]]
adamc@11 263
adamc@11 264 We only need to unfold the first occurrence of [progDenote] to prove the goal: *)
adamc@11 265
adamc@11 266 unfold progDenote at 1.
adamc@11 267
adamc@11 268 (** [[
adamc@11 269
adamc@11 270 n : nat
adamc@11 271 s : stack
adamc@11 272 p : list instr
adamc@11 273 ============================
adamc@11 274 (fix progDenote (p0 : prog) (s0 : stack) {struct p0} :
adamc@11 275 option stack :=
adamc@11 276 match p0 with
adamc@11 277 | nil => Some s0
adamc@11 278 | i :: p' =>
adamc@11 279 match instrDenote i s0 with
adamc@11 280 | Some s' => progDenote p' s'
adamc@11 281 | None => None (A:=stack)
adamc@11 282 end
adamc@11 283 end) ((IConst n :: nil) ++ p) s =
adamc@11 284 progDenote p (n :: s)
adamc@11 285 ]]
adamc@11 286
adamc@11 287 This last [unfold] has left us with an anonymous fixpoint version of [progDenote], which will generally happen when unfolding recursive definitions. Fortunately, in this case, we can eliminate such complications right away, since the structure of the argument [(IConst n :: nil) ++ p] is known, allowing us to simplify the internal pattern match with the [simpl] tactic:
adamc@11 288 *)
adamc@11 289
adamc@4 290 simpl.
adamc@11 291
adamc@11 292 (** [[
adamc@11 293
adamc@11 294 n : nat
adamc@11 295 s : stack
adamc@11 296 p : list instr
adamc@11 297 ============================
adamc@11 298 (fix progDenote (p0 : prog) (s0 : stack) {struct p0} :
adamc@11 299 option stack :=
adamc@11 300 match p0 with
adamc@11 301 | nil => Some s0
adamc@11 302 | i :: p' =>
adamc@11 303 match instrDenote i s0 with
adamc@11 304 | Some s' => progDenote p' s'
adamc@11 305 | None => None (A:=stack)
adamc@11 306 end
adamc@11 307 end) p (n :: s) = progDenote p (n :: s)
adamc@11 308 ]]
adamc@11 309
adamc@11 310 Now we can unexpand the definition of [progDenote]:
adamc@11 311 *)
adamc@11 312
adamc@11 313 fold progDenote.
adamc@11 314
adamc@11 315 (** [[
adamc@11 316
adamc@11 317 n : nat
adamc@11 318 s : stack
adamc@11 319 p : list instr
adamc@11 320 ============================
adamc@11 321 progDenote p (n :: s) = progDenote p (n :: s)
adamc@11 322 ]]
adamc@11 323
adamc@11 324 It looks like we are at the end of this case, since we have a trivial equality. Indeed, a single tactic finishes us off:
adamc@11 325 *)
adamc@11 326
adamc@4 327 reflexivity.
adamc@2 328
adamc@11 329 (** On to the second inductive case:
adamc@11 330
adamc@11 331 [[
adamc@11 332
adamc@11 333 b : binop
adamc@11 334 e1 : exp
adamc@11 335 IHe1 : forall (s : stack) (p : list instr),
adamc@11 336 progDenote (compile e1 ++ p) s = progDenote p (expDenote e1 :: s)
adamc@11 337 e2 : exp
adamc@11 338 IHe2 : forall (s : stack) (p : list instr),
adamc@11 339 progDenote (compile e2 ++ p) s = progDenote p (expDenote e2 :: s)
adamc@11 340 ============================
adamc@11 341 forall (s : stack) (p : list instr),
adamc@11 342 progDenote (compile (Binop b e1 e2) ++ p) s =
adamc@11 343 progDenote p (expDenote (Binop b e1 e2) :: s)
adamc@11 344 ]]
adamc@11 345
adamc@11 346 We see our first example of hypotheses above the double-dashed line. They are the inductive hypotheses [IHe1] and [IHe2] corresponding to the subterms [e1] and [e2], respectively.
adamc@11 347
adamc@11 348 We start out the same way as before, introducing new free variables and unfolding and folding the appropriate definitions. The seemingly frivolous [unfold]/[fold] pairs are actually accomplishing useful work, because [unfold] will sometimes perform easy simplifications. *)
adamc@11 349
adamc@4 350 intros.
adamc@4 351 unfold compile.
adamc@4 352 fold compile.
adamc@4 353 unfold expDenote.
adamc@4 354 fold expDenote.
adamc@11 355
adamc@11 356 (** Now we arrive at a point where the tactics we have seen so far are insufficient:
adamc@11 357
adamc@11 358 [[
adamc@11 359
adamc@11 360 b : binop
adamc@11 361 e1 : exp
adamc@11 362 IHe1 : forall (s : stack) (p : list instr),
adamc@11 363 progDenote (compile e1 ++ p) s = progDenote p (expDenote e1 :: s)
adamc@11 364 e2 : exp
adamc@11 365 IHe2 : forall (s : stack) (p : list instr),
adamc@11 366 progDenote (compile e2 ++ p) s = progDenote p (expDenote e2 :: s)
adamc@11 367 s : stack
adamc@11 368 p : list instr
adamc@11 369 ============================
adamc@11 370 progDenote ((compile e2 ++ compile e1 ++ IBinop b :: nil) ++ p) s =
adamc@11 371 progDenote p (binopDenote b (expDenote e1) (expDenote e2) :: s)
adamc@11 372 ]]
adamc@11 373
adamc@11 374 What we need is the associative law of list concatenation, available as a theorem [app_ass] in the standard library. *)
adamc@11 375
adamc@11 376 Check app_ass.
adamc@11 377
adamc@11 378 (** [[
adamc@11 379
adamc@11 380 app_ass
adamc@11 381 : forall (A : Type) (l m n : list A), (l ++ m) ++ n = l ++ m ++ n
adamc@11 382 ]]
adamc@11 383
adamc@11 384 We use it to perform a rewrite: *)
adamc@11 385
adamc@4 386 rewrite app_ass.
adamc@11 387
adamc@11 388 (** changing the conclusion to: [[
adamc@11 389
adamc@11 390 progDenote (compile e2 ++ (compile e1 ++ IBinop b :: nil) ++ p) s =
adamc@11 391 progDenote p (binopDenote b (expDenote e1) (expDenote e2) :: s)
adamc@11 392 ]]
adamc@11 393
adamc@11 394 Now we can notice that the lefthand side of the equality matches the lefthand side of the second inductive hypothesis, so we can rewrite with that hypothesis, too: *)
adamc@11 395
adamc@4 396 rewrite IHe2.
adamc@11 397
adamc@11 398 (** [[
adamc@11 399
adamc@11 400 progDenote ((compile e1 ++ IBinop b :: nil) ++ p) (expDenote e2 :: s) =
adamc@11 401 progDenote p (binopDenote b (expDenote e1) (expDenote e2) :: s)
adamc@11 402 ]]
adamc@11 403
adamc@11 404 The same process lets us apply the remaining hypothesis. *)
adamc@11 405
adamc@4 406 rewrite app_ass.
adamc@4 407 rewrite IHe1.
adamc@11 408
adamc@11 409 (** [[
adamc@11 410
adamc@11 411 progDenote ((IBinop b :: nil) ++ p) (expDenote e1 :: expDenote e2 :: s) =
adamc@11 412 progDenote p (binopDenote b (expDenote e1) (expDenote e2) :: s)
adamc@11 413 ]]
adamc@11 414
adamc@11 415 Now we can apply a similar sequence of tactics to that that ended the proof of the first case.
adamc@11 416 *)
adamc@11 417
adamc@11 418 unfold progDenote at 1.
adamc@4 419 simpl.
adamc@11 420 fold progDenote.
adamc@4 421 reflexivity.
adamc@11 422
adamc@11 423 (** And the proof is completed, as indicated by the message:
adamc@11 424
adamc@11 425 [[
adamc@11 426 Proof completed.
adamc@11 427
adamc@11 428 And there lies our first proof. Already, even for simple theorems like this, the final proof script is unstructured and not very enlightening to readers. If we extend this approach to more serious theorems, we arrive at the unreadable proof scripts that are the favorite complaints of opponents of tactic-based proving. Fortunately, Coq has rich support for scripted automation, and we can take advantage of such a scripted tactic (defined elsewhere) to make short work of this lemma. We abort the old proof attempt and start again.
adamc@11 429 *)
adamc@11 430
adamc@4 431 Abort.
adamc@2 432
adamc@4 433 Lemma compileCorrect' : forall e s p, progDenote (compile e ++ p) s =
adamc@4 434 progDenote p (expDenote e :: s).
adamc@4 435 induction e; crush.
adamc@4 436 Qed.
adamc@2 437
adamc@11 438 (** We need only to state the basic inductive proof scheme and call a tactic that automates the tedious reasoning in between. In contrast to the period tactic terminator from our last proof, the semicolon tactic separator supports structured, compositional proofs. The tactic [t1; t2] has the effect of running [t1] and then running [t2] on each remaining subgoal. The semicolon is one of the most fundamental building blocks of effective proof automation. The period terminator is very useful for exploratory proving, where you need to see intermediate proof states, but final proofs of any serious complexity should have just one period, terminating a single compound tactic that probably uses semicolons.
adamc@11 439
adamc@11 440 The proof of our main theorem is now easy. We prove it with four period-terminated tactics, though separating them with semicolons would work as well; the version here is easier to step through. *)
adamc@11 441
adamc@4 442 Theorem compileCorrect : forall e, progDenote (compile e) nil = Some (expDenote e :: nil).
adamc@11 443 intros.
adamc@11 444
adamc@11 445 (** [[
adamc@11 446
adamc@11 447 e : exp
adamc@11 448 ============================
adamc@11 449 progDenote (compile e) nil = Some (expDenote e :: nil)
adamc@11 450 ]]
adamc@11 451
adamc@11 452 At this point, we want to massage the lefthand side to match the statement of [compileCorrect']. A theorem from the standard library is useful: *)
adamc@11 453
adamc@11 454 Check app_nil_end.
adamc@11 455
adamc@11 456 (** [[
adamc@11 457
adamc@11 458 app_nil_end
adamc@11 459 : forall (A : Type) (l : list A), l = l ++ nil
adamc@11 460 ]] *)
adamc@11 461
adamc@4 462 rewrite (app_nil_end (compile e)).
adamc@11 463
adamc@11 464 (** This time, we explicitly specify the value of the variable [l] from the theorem statement, since multiple expressions of list type appear in the conclusion. [rewrite] might choose the wrong place to rewrite if we did not specify which we want.
adamc@11 465
adamc@11 466 [[
adamc@11 467
adamc@11 468 e : exp
adamc@11 469 ============================
adamc@11 470 progDenote (compile e ++ nil) nil = Some (expDenote e :: nil)
adamc@11 471 ]]
adamc@11 472
adamc@11 473 Now we can apply the lemma. *)
adamc@11 474
adamc@4 475 rewrite compileCorrect'.
adamc@11 476
adamc@11 477 (** [[
adamc@11 478
adamc@11 479 e : exp
adamc@11 480 ============================
adamc@11 481 progDenote nil (expDenote e :: nil) = Some (expDenote e :: nil)
adamc@11 482 ]]
adamc@11 483
adamc@11 484 We are almost done. The lefthand and righthand sides can be seen to match by simple symbolic evaluation. That means we are in luck, because Coq identifies any pair of terms as equal whenever they normalize to the same result by symbolic evaluation. By the definition of [progDenote], that is the case here, but we do not need to worry about such details. A simple invocation of [reflexivity] does the normalization and checks that the two results are syntactically equal. *)
adamc@11 485
adamc@4 486 reflexivity.
adamc@4 487 Qed.
adamc@14 488
adamc@14 489
adamc@14 490 (** * Typed expressions *)
adamc@14 491
adamc@14 492 (** In this section, we will build on the initial example by adding additional expression forms that depend on static typing of terms for safety. *)
adamc@14 493
adamc@14 494 (** ** Source language *)
adamc@14 495
adamc@15 496 (** We define a trivial language of types to classify our expressions: *)
adamc@15 497
adamc@14 498 Inductive type : Set := Nat | Bool.
adamc@14 499
adamc@15 500 (** Now we define an expanded set of binary operators. *)
adamc@15 501
adamc@14 502 Inductive tbinop : type -> type -> type -> Set :=
adamc@14 503 | TPlus : tbinop Nat Nat Nat
adamc@14 504 | TTimes : tbinop Nat Nat Nat
adamc@14 505 | TEq : forall t, tbinop t t Bool
adamc@14 506 | TLt : tbinop Nat Nat Bool.
adamc@14 507
adamc@15 508 (** The definition of [tbinop] is different from [binop] in an important way. Where we declared that [binop] has type [Set], here we declare that [tbinop] has type [type -> type -> type -> Set]. We define [tbinop] as an %\textit{%#<i>#indexed type family#</i>#%}%. Indexed inductive types are at the heart of Coq's expressive power; almost everything else of interest is defined in terms of them.
adamc@15 509
adamc@15 510 ML and Haskell have indexed algebraic datatypes. For instance, their list types are indexed by the type of data that the list carries. However, compared to Coq, ML and Haskell 98 place two important restrictions on datatype definitions.
adamc@15 511
adamc@15 512 First, the indices of the range of each data constructor must be type variables bound at the top level of the datatype definition. There is no way to do what we did here, where we, for instance, say that [TPlus] is a constructor building a [tbinop] whose indices are all fixed at [Nat]. %\textit{%#<i>#Generalized algebraic datatypes (GADTs)#</i>#%}% are a popular feature in GHC Haskell and other languages that removes this first restriction.
adamc@15 513
adamc@15 514 The second restriction is not lifted by GADTs. In ML and Haskell, indices of types must be types and may not be %\textit{%#<i>#expressions#</i>#%}%. In Coq, types may be indiced by arbitrary Gallina terms. Type indices can live in the same universe as programs, and we can compute with them just like regular programs. Haskell supports a hobbled form of computation in type indices based on multi-parameter type classes, and recent extensions like type functions bring Haskell programming even closer to "real" functional programming with types, but, without dependent typing, there must always be a gap between how one programs with types and how one programs normally.
adamc@15 515 *)
adamc@15 516
adamc@15 517 (** We can define a similar type family for typed expressions. *)
adamc@15 518
adamc@14 519 Inductive texp : type -> Set :=
adamc@14 520 | TNConst : nat -> texp Nat
adamc@14 521 | TBConst : bool -> texp Bool
adamc@14 522 | TBinop : forall arg1 arg2 res, tbinop arg1 arg2 res -> texp arg1 -> texp arg2 -> texp res.
adamc@14 523
adamc@15 524 (** Thanks to our use of dependent types, every well-typed [texp] represents a well-typed source expression, by construction. This turns out to be very convenient for many things we might want to do with expressions. For instance, it is easy to adapt our interpreter approach to defining semantics. We start by defining a function mapping the types of our languages into Coq types: *)
adamc@15 525
adamc@14 526 Definition typeDenote (t : type) : Set :=
adamc@14 527 match t with
adamc@14 528 | Nat => nat
adamc@14 529 | Bool => bool
adamc@14 530 end.
adamc@14 531
adamc@15 532 (** It can take a few moments to come to terms with the fact that [Set], the type of types of programs, is itself a first-class type, and that we can write functions that return [Set]s. Past that wrinkle, the definition of [typeDenote] is trivial, relying on the [nat] and [bool] types from the Coq standard library.
adamc@15 533
adamc@15 534 We need to define a few auxiliary functions, implementing our boolean binary operators that do not appear with the right types in the standard library. They are entirely standard and ML-like, with the one caveat being that the Coq [nat] type uses a unary representation, where [O] is zero and [S n] is the successor of [n].
adamc@15 535 *)
adamc@15 536
adamc@14 537 Definition eq_bool (b1 b2 : bool) : bool :=
adamc@14 538 match b1, b2 with
adamc@14 539 | true, true => true
adamc@14 540 | false, false => true
adamc@14 541 | _, _ => false
adamc@14 542 end.
adamc@14 543
adamc@14 544 Fixpoint eq_nat (n1 n2 : nat) {struct n1} : bool :=
adamc@14 545 match n1, n2 with
adamc@14 546 | O, O => true
adamc@14 547 | S n1', S n2' => eq_nat n1' n2'
adamc@14 548 | _, _ => false
adamc@14 549 end.
adamc@14 550
adamc@14 551 Fixpoint lt (n1 n2 : nat) {struct n1} : bool :=
adamc@14 552 match n1, n2 with
adamc@14 553 | O, S _ => true
adamc@14 554 | S n1', S n2' => lt n1' n2'
adamc@14 555 | _, _ => false
adamc@14 556 end.
adamc@14 557
adamc@15 558 (** Now we can interpret binary operators: *)
adamc@15 559
adamc@14 560 Definition tbinopDenote arg1 arg2 res (b : tbinop arg1 arg2 res)
adamc@14 561 : typeDenote arg1 -> typeDenote arg2 -> typeDenote res :=
adamc@14 562 match b in (tbinop arg1 arg2 res) return (typeDenote arg1 -> typeDenote arg2 -> typeDenote res) with
adamc@14 563 | TPlus => plus
adamc@14 564 | TTimes => mult
adamc@14 565 | TEq Nat => eq_nat
adamc@14 566 | TEq Bool => eq_bool
adamc@14 567 | TLt => lt
adamc@14 568 end.
adamc@14 569
adamc@15 570 (** This function has just a few differences from the denotation functions we saw earlier. First, [tbinop] is an indexed type, so its indices become additional arguments to [tbinopDenote]. Second, we need to perform a genuine %\textit{%#<i>#dependent pattern match#</i>#%}% to come up with a definition of this function that type-checks. In each branch of the [match], we need to use branch-specific information about the indices to [tbinop]. General type inference that takes such information into account is undecidable, and Coq avoids pursuing special heuristics for the problem, instead asking users to write annotations, like we see above on the line with [match].
adamc@15 571
adamc@15 572 The [in] annotation restates the type of the term being case-analyzed. Though we use the same names for the indices as we use in the type of the original argument binder, these are actually fresh variables, and they are %\textit{%#<i>#binding occcurrences#</i>#%}%. Their scope is the [return] clause. That is, [arg1], [arg2], and [arg3] are new bound variables bound only within the return clause [typeDenote arg1 -> typeDenote arg2 -> typeDenote res]. By being explicit about the functional relationship between the type indices and the match result, we regain decidable type inference.
adamc@15 573
adamc@15 574 The same tricks suffice to define an expression denotation function in an unsurprising way:
adamc@15 575 *)
adamc@15 576
adamc@14 577 Fixpoint texpDenote t (e : texp t) {struct e} : typeDenote t :=
adamc@14 578 match e in (texp t) return (typeDenote t) with
adamc@14 579 | TNConst n => n
adamc@14 580 | TBConst b => b
adamc@14 581 | TBinop _ _ _ b e1 e2 => (tbinopDenote b) (texpDenote e1) (texpDenote e2)
adamc@14 582 end.
adamc@14 583
adamc@17 584 (** We can evaluate a few example programs to convince ourselves that this semantics is correct. *)
adamc@17 585
adamc@17 586 Eval simpl in texpDenote (TNConst 42).
adamc@17 587 Eval simpl in texpDenote (TBConst true).
adamc@17 588 Eval simpl in texpDenote (TBinop TTimes (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7)).
adamc@17 589 Eval simpl in texpDenote (TBinop (TEq Nat) (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7)).
adamc@17 590 Eval simpl in texpDenote (TBinop TLt (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7)).
adamc@17 591
adamc@14 592
adamc@14 593 (** ** Target language *)
adamc@14 594
adamc@14 595 Definition tstack := list type.
adamc@14 596
adamc@14 597 Inductive tinstr : tstack -> tstack -> Set :=
adamc@14 598 | TINConst : forall s, nat -> tinstr s (Nat :: s)
adamc@14 599 | TIBConst : forall s, bool -> tinstr s (Bool :: s)
adamc@14 600 | TIBinop : forall arg1 arg2 res s,
adamc@14 601 tbinop arg1 arg2 res
adamc@14 602 -> tinstr (arg1 :: arg2 :: s) (res :: s).
adamc@14 603
adamc@14 604 Inductive tprog : tstack -> tstack -> Set :=
adamc@14 605 | TNil : forall s, tprog s s
adamc@14 606 | TCons : forall s1 s2 s3,
adamc@14 607 tinstr s1 s2
adamc@14 608 -> tprog s2 s3
adamc@14 609 -> tprog s1 s3.
adamc@14 610
adamc@14 611 Fixpoint vstack (ts : tstack) : Set :=
adamc@14 612 match ts with
adamc@14 613 | nil => unit
adamc@14 614 | t :: ts' => typeDenote t * vstack ts'
adamc@14 615 end%type.
adamc@14 616
adamc@14 617 Definition tinstrDenote ts ts' (i : tinstr ts ts') : vstack ts -> vstack ts' :=
adamc@14 618 match i in (tinstr ts ts') return (vstack ts -> vstack ts') with
adamc@14 619 | TINConst _ n => fun s => (n, s)
adamc@14 620 | TIBConst _ b => fun s => (b, s)
adamc@14 621 | TIBinop _ _ _ _ b => fun s =>
adamc@14 622 match s with
adamc@14 623 (arg1, (arg2, s')) => ((tbinopDenote b) arg1 arg2, s')
adamc@14 624 end
adamc@14 625 end.
adamc@14 626
adamc@14 627 Fixpoint tprogDenote ts ts' (p : tprog ts ts') {struct p} : vstack ts -> vstack ts' :=
adamc@14 628 match p in (tprog ts ts') return (vstack ts -> vstack ts') with
adamc@14 629 | TNil _ => fun s => s
adamc@14 630 | TCons _ _ _ i p' => fun s => tprogDenote p' (tinstrDenote i s)
adamc@14 631 end.
adamc@14 632
adamc@14 633
adamc@14 634 (** ** Translation *)
adamc@14 635
adamc@14 636 Fixpoint tconcat ts ts' ts'' (p : tprog ts ts') {struct p} : tprog ts' ts'' -> tprog ts ts'' :=
adamc@14 637 match p in (tprog ts ts') return (tprog ts' ts'' -> tprog ts ts'') with
adamc@14 638 | TNil _ => fun p' => p'
adamc@14 639 | TCons _ _ _ i p1 => fun p' => TCons i (tconcat p1 p')
adamc@14 640 end.
adamc@14 641
adamc@14 642 Fixpoint tcompile t (e : texp t) (ts : tstack) {struct e} : tprog ts (t :: ts) :=
adamc@14 643 match e in (texp t) return (tprog ts (t :: ts)) with
adamc@14 644 | TNConst n => TCons (TINConst _ n) (TNil _)
adamc@14 645 | TBConst b => TCons (TIBConst _ b) (TNil _)
adamc@14 646 | TBinop _ _ _ b e1 e2 => tconcat (tcompile e2 _)
adamc@14 647 (tconcat (tcompile e1 _) (TCons (TIBinop _ b) (TNil _)))
adamc@14 648 end.
adamc@14 649
adamc@14 650 Print tcompile.
adamc@14 651
adamc@14 652
adamc@14 653 (** ** Translation correctness *)
adamc@14 654
adamc@14 655 Lemma tcompileCorrect' : forall t (e : texp t)
adamc@14 656 ts (s : vstack ts),
adamc@14 657 tprogDenote (tcompile e ts) s
adamc@14 658 = (texpDenote e, s).
adamc@14 659 induction e; crush.
adamc@14 660 Abort.
adamc@14 661
adamc@14 662 Lemma tconcatCorrect : forall ts ts' ts'' (p : tprog ts ts') (p' : tprog ts' ts'')
adamc@14 663 (s : vstack ts),
adamc@14 664 tprogDenote (tconcat p p') s
adamc@14 665 = tprogDenote p' (tprogDenote p s).
adamc@14 666 induction p; crush.
adamc@14 667 Qed.
adamc@14 668
adamc@14 669 Hint Rewrite tconcatCorrect : cpdt.
adamc@14 670
adamc@14 671 Lemma tcompileCorrect' : forall t (e : texp t)
adamc@14 672 ts (s : vstack ts),
adamc@14 673 tprogDenote (tcompile e ts) s
adamc@14 674 = (texpDenote e, s).
adamc@14 675 induction e; crush.
adamc@14 676 Qed.
adamc@14 677
adamc@14 678 Hint Rewrite tcompileCorrect' : cpdt.
adamc@14 679
adamc@14 680 Theorem tcompileCorrect : forall t (e : texp t), tprogDenote (tcompile e nil) tt = (texpDenote e, tt).
adamc@14 681 crush.
adamc@14 682 Qed.