comparison src/Coinductive.v @ 67:55199444e5e7

Finish Coinductive chapter
author Adam Chlipala <adamc@hcoop.net>
date Wed, 01 Oct 2008 09:56:32 -0400
parents 21bb59c56b98
children 943478e5a32d
comparison
equal deleted inserted replaced
66:b52204928c7d 67:55199444e5e7
307 (** The standard [auto] machinery sees that our goal matches an assumption and so applies that assumption, even though this violates guardedness. One usually starts a proof like this by [destruct]ing some parameter and running a custom tactic to figure out the first proof rule to apply for each case. Alternatively, there are tricks that can be played with "hiding" the co-inductive hypothesis. We will see examples of effective co-inductive proving in later chapters. *) 307 (** The standard [auto] machinery sees that our goal matches an assumption and so applies that assumption, even though this violates guardedness. One usually starts a proof like this by [destruct]ing some parameter and running a custom tactic to figure out the first proof rule to apply for each case. Alternatively, there are tricks that can be played with "hiding" the co-inductive hypothesis. We will see examples of effective co-inductive proving in later chapters. *)
308 308
309 309
310 (** * Simple Modeling of Non-Terminating Programs *) 310 (** * Simple Modeling of Non-Terminating Programs *)
311 311
312 (** We close the chapter with a quick motivating example for more complex uses of co-inductive types. We will define a co-inductive semantics for a simple assembly language and use that semantics to prove that an optimization function is sound. We start by defining a type of instructions. *) 312 (** We close the chapter with a quick motivating example for more complex uses of co-inductive types. We will define a co-inductive semantics for a simple assembly language and use that semantics to prove that an optimization function is sound. We start by defining types of registers, program labels, and instructions. *)
313 313
314 Inductive reg : Set := R1 | R2. 314 Inductive reg : Set := R1 | R2.
315 Definition label := nat. 315 Definition label := nat.
316 316
317 Inductive instrs : Set := 317 Inductive instrs : Set :=
318 | Const : reg -> nat -> instrs -> instrs 318 | Const : reg -> nat -> instrs -> instrs
319 | Add : reg -> reg -> reg -> instrs -> instrs 319 | Add : reg -> reg -> reg -> instrs -> instrs
320 | Halt : reg -> instrs 320 | Halt : reg -> instrs
321 | Jeq : reg -> reg -> label -> instrs -> instrs. 321 | Jeq : reg -> reg -> label -> instrs -> instrs.
322 322
323 (** [Const] stores a constant in a register; [Add] stores in the first register the sum of the values in the second two; [Halt] ends the program, returning the value of its register argument; and [Jeq] jumps to a label if the values in two registers are equal. Each instruction but [Halt] takes an [instrs], which can be read as "list of instructions," as the normal continuation of control flow.
324
325 We can define a program as a list of lists of instructions, where labels will be interpreted as indexing into such a list. *)
326
323 Definition program := list instrs. 327 Definition program := list instrs.
324 328
329 (** We define a polymorphic map type for register keys, with its associated operations. *)
325 Section regmap. 330 Section regmap.
326 Variable A : Set. 331 Variable A : Set.
327 332
328 Record regmap : Set := Regmap { 333 Record regmap : Set := Regmap {
329 VR1 : A; 334 VR1 : A;
330 VR2 : A 335 VR2 : A
331 }. 336 }.
332 337
333 Definition empty v : regmap := Regmap v v. 338 Definition empty (v : A) : regmap := Regmap v v.
334 Definition get (rm : regmap) (r : reg) : A := 339 Definition get (rm : regmap) (r : reg) : A :=
335 match r with 340 match r with
336 | R1 => VR1 rm 341 | R1 => VR1 rm
337 | R2 => VR2 rm 342 | R2 => VR2 rm
338 end. 343 end.
340 match r with 345 match r with
341 | R1 => Regmap v (VR2 rm) 346 | R1 => Regmap v (VR2 rm)
342 | R2 => Regmap (VR1 rm) v 347 | R2 => Regmap (VR1 rm) v
343 end. 348 end.
344 End regmap. 349 End regmap.
350
351 (** Now comes the interesting part. We define a co-inductive semantics for programs. The definition itself is not surprising. We could change [CoInductive] to [Inductive] and arrive at a valid semantics that only covers terminating program executions. Using [CoInductive] admits infinite derivations for infinite executions. *)
345 352
346 Section run. 353 Section run.
347 Variable prog : program. 354 Variable prog : program.
348 355
349 CoInductive run : regmap nat -> instrs -> nat -> Prop := 356 CoInductive run : regmap nat -> instrs -> nat -> Prop :=
364 get rm r1 <> get rm r2 371 get rm r1 <> get rm r2
365 -> run rm is v 372 -> run rm is v
366 -> run rm (Jeq r1 r2 l is) v. 373 -> run rm (Jeq r1 r2 l is) v.
367 End run. 374 End run.
368 375
376 (** We can write a function which tracks known register values to attempt to constant fold a sequence of instructions. We track register values with a [regmap (option nat)], where a mapping to [None] indicates no information, and a mapping to [Some n] indicates that the corresponding register is known to have value [n]. *)
377
369 Fixpoint constFold (rm : regmap (option nat)) (is : instrs) {struct is} : instrs := 378 Fixpoint constFold (rm : regmap (option nat)) (is : instrs) {struct is} : instrs :=
370 match is with 379 match is with
371 | Const r n is => Const r n (constFold (set rm r (Some n)) is) 380 | Const r n is => Const r n (constFold (set rm r (Some n)) is)
372 | Add r r1 r2 is => 381 | Add r r1 r2 is =>
373 match get rm r1, get rm r2 with 382 match get rm r1, get rm r2 with
374 | Some n1, Some n2 => Const r (n1 + n2) (constFold (set rm r (Some (n1 + n2))) is) 383 | Some n1, Some n2 =>
384 Const r (n1 + n2) (constFold (set rm r (Some (n1 + n2))) is)
375 | _, _ => Add r r1 r2 (constFold (set rm r None) is) 385 | _, _ => Add r r1 r2 (constFold (set rm r None) is)
376 end 386 end
377 | Halt _ => is 387 | Halt _ => is
378 | Jeq r1 r2 l is => Jeq r1 r2 l (constFold rm is) 388 | Jeq r1 r2 l is => Jeq r1 r2 l (constFold rm is)
379 end. 389 end.
380 390
391 (** We characterize when the two types of register maps we are using agree with each other. *)
392
381 Definition regmapCompat (rm : regmap nat) (rm' : regmap (option nat)) := 393 Definition regmapCompat (rm : regmap nat) (rm' : regmap (option nat)) :=
382 forall r, match get rm' r with 394 forall r, match get rm' r with
383 | None => True 395 | None => True
384 | Some v => get rm r = v 396 | Some v => get rm r = v
385 end. 397 end.
386 398
399 (** We prove two lemmas about how register map modifications affect compatibility. A tactic [compat] abstracts the common structure of the two proofs. *)
400
401 (** remove printing * *)
387 Ltac compat := unfold regmapCompat in *; crush; 402 Ltac compat := unfold regmapCompat in *; crush;
388 match goal with 403 match goal with
389 | [ |- match get _ ?R with Some _ => _ | None => _ end ] => destruct R; crush 404 | [ |- match get _ ?R with Some _ => _ | None => _ end ] => destruct R; crush
390 end. 405 end.
391 406
399 regmapCompat rm rm' 414 regmapCompat rm rm'
400 -> regmapCompat (set rm r n) (set rm' r (Some n)). 415 -> regmapCompat (set rm r n) (set rm' r (Some n)).
401 destruct r; compat. 416 destruct r; compat.
402 Qed. 417 Qed.
403 418
404 Require Import Arith. 419 (** Finally, we can prove the main theorem. *)
405 420
406 Section constFold_ok. 421 Section constFold_ok.
407 Variable prog : program. 422 Variable prog : program.
408 423
409 Theorem constFold_ok : forall rm is v, 424 Theorem constFold_ok : forall rm is v,
414 Hint Constructors run. 429 Hint Constructors run.
415 430
416 cofix; 431 cofix;
417 destruct 1; crush; eauto; 432 destruct 1; crush; eauto;
418 repeat match goal with 433 repeat match goal with
419 | [ H : regmapCompat _ _ |- run _ _ (match get ?RM ?R with Some _ => _ | None => _ end) _ ] => 434 | [ H : regmapCompat _ _
435 |- run _ _ (match get ?RM ?R with
436 | Some _ => _
437 | None => _
438 end) _ ] =>
420 generalize (H R); destruct (get RM R); crush 439 generalize (H R); destruct (get RM R); crush
421 end. 440 end.
422 Qed. 441 Qed.
423 End constFold_ok. 442 End constFold_ok.
424 443
444 (** If we print the proof term that was generated, we can verify that the proof is structured as a [cofix], with each co-recursive call properly guarded. *)
445
425 Print constFold_ok. 446 Print constFold_ok.