comparison src/Subset.v @ 77:d07c77659c20

Templatizing Subset
author Adam Chlipala <adamc@hcoop.net>
date Fri, 03 Oct 2008 15:27:39 -0400
parents 82a2189fa283
children 15e2b3485dc4
comparison
equal deleted inserted replaced
76:82a2189fa283 77:d07c77659c20
202 refine (fun n => 202 refine (fun n =>
203 match n return (n > 0 -> {m : nat | n = S m}) with 203 match n return (n > 0 -> {m : nat | n = S m}) with
204 | O => fun _ => False_rec _ _ 204 | O => fun _ => False_rec _ _
205 | S n' => fun _ => exist _ n' _ 205 | S n' => fun _ => exist _ n' _
206 end). 206 end).
207 207 (* begin thide *)
208 (** We build [pred_strong4] using tactic-based proving, beginning with a [Definition] command that ends in a period before a definition is given. Such a command enters the interactive proving mode, with the type given for the new identifier as our proof goal. We do most of the work with the [refine] tactic, to which we pass a partial "proof" of the type we are trying to prove. There may be some pieces left to fill in, indicated by underscores. Any underscore that Coq cannot reconstruct with type inference is added as a proof subgoal. In this case, we have two subgoals: 208 (** We build [pred_strong4] using tactic-based proving, beginning with a [Definition] command that ends in a period before a definition is given. Such a command enters the interactive proving mode, with the type given for the new identifier as our proof goal. We do most of the work with the [refine] tactic, to which we pass a partial "proof" of the type we are trying to prove. There may be some pieces left to fill in, indicated by underscores. Any underscore that Coq cannot reconstruct with type inference is added as a proof subgoal. In this case, we have two subgoals:
209 209
210 [[ 210 [[
211 211
212 2 subgoals 212 2 subgoals
229 refine (fun n => 229 refine (fun n =>
230 match n return (n > 0 -> {m : nat | n = S m}) with 230 match n return (n > 0 -> {m : nat | n = S m}) with
231 | O => fun _ => False_rec _ _ 231 | O => fun _ => False_rec _ _
232 | S n' => fun _ => exist _ n' _ 232 | S n' => fun _ => exist _ n' _
233 end); crush. 233 end); crush.
234 (* end thide *)
234 Defined. 235 Defined.
235 236
236 (** We end the "proof" with [Defined] instead of [Qed], so that the definition we constructed remains visible. This contrasts to the case of ending a proof with [Qed], where the details of the proof are hidden afterward. Let us see what our proof script constructed. *) 237 (** We end the "proof" with [Defined] instead of [Qed], so that the definition we constructed remains visible. This contrasts to the case of ending a proof with [Qed], where the details of the proof are hidden afterward. Let us see what our proof script constructed. *)
237 238
238 Print pred_strong4. 239 Print pred_strong4.
372 373
373 (** %\smallskip% 374 (** %\smallskip%
374 375
375 We can build "smart" versions of the usual boolean operators and put them to good use in certified programming. For instance, here is a [sumbool] version of boolean "or." *) 376 We can build "smart" versions of the usual boolean operators and put them to good use in certified programming. For instance, here is a [sumbool] version of boolean "or." *)
376 377
378 (* begin thide *)
377 Notation "x || y" := (if x then Yes else Reduce y) (at level 50). 379 Notation "x || y" := (if x then Yes else Reduce y) (at level 50).
378 380
379 (** Let us use it for building a function that decides list membership. We need to assume the existence of an equality decision procedure for the type of list elements. *) 381 (** Let us use it for building a function that decides list membership. We need to assume the existence of an equality decision procedure for the type of list elements. *)
380 382
381 Section In_dec. 383 Section In_dec.
395 End In_dec. 397 End In_dec.
396 398
397 (** [In_dec] has a reasonable extraction to OCaml. *) 399 (** [In_dec] has a reasonable extraction to OCaml. *)
398 400
399 Extraction In_dec. 401 Extraction In_dec.
402 (* end thide *)
400 403
401 (** %\begin{verbatim} 404 (** %\begin{verbatim}
402 (** val in_dec : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 list -> bool **) 405 (** val in_dec : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 list -> bool **)
403 406
404 let rec in_dec a_eq_dec x = function 407 let rec in_dec a_eq_dec x = function
542 -> hasType e2 TBool 545 -> hasType e2 TBool
543 -> hasType (And e1 e2) TBool. 546 -> hasType (And e1 e2) TBool.
544 547
545 (** It will be helpful to have a function for comparing two types. We build one using [decide equality]. *) 548 (** It will be helpful to have a function for comparing two types. We build one using [decide equality]. *)
546 549
550 (* begin thide *)
547 Definition eq_type_dec : forall t1 t2 : type, {t1 = t2} + {t1 <> t2}. 551 Definition eq_type_dec : forall t1 t2 : type, {t1 = t2} + {t1 <> t2}.
548 decide equality. 552 decide equality.
549 Defined. 553 Defined.
550 554
551 (** Another notation complements the monadic notation for [maybe] that we defined earlier. Sometimes we want to be to include "assertions" in our procedures. That is, we want to run a decision procedure and fail if it fails; otherwise, we want to continue, with the proof that it produced made available to us. This infix notation captures that, for a procedure that returns an arbitrary two-constructor type. *) 555 (** Another notation complements the monadic notation for [maybe] that we defined earlier. Sometimes we want to be to include "assertions" in our procedures. That is, we want to run a decision procedure and fail if it fails; otherwise, we want to continue, with the proof that it produced made available to us. This infix notation captures that, for a procedure that returns an arbitrary two-constructor type. *)
552 556
553 Notation "e1 ;; e2" := (if e1 then e2 else ??) 557 Notation "e1 ;; e2" := (if e1 then e2 else ??)
554 (right associativity, at level 60). 558 (right associativity, at level 60).
555 559
556 (** With that notation defined, we can implement a [typeCheck] function, whose code is only more complex than what we would write in ML because it needs to include some extra type annotations. Every [[[e]]] expression adds a [hasType] proof obligation, and [crush] makes short work of them when we add [hasType]'s constructors as hints. *) 560 (** With that notation defined, we can implement a [typeCheck] function, whose code is only more complex than what we would write in ML because it needs to include some extra type annotations. Every [[[e]]] expression adds a [hasType] proof obligation, and [crush] makes short work of them when we add [hasType]'s constructors as hints. *)
561 (* end thide *)
557 562
558 Definition typeCheck (e : exp) : {{t | hasType e t}}. 563 Definition typeCheck (e : exp) : {{t | hasType e t}}.
564 (* begin thide *)
559 Hint Constructors hasType. 565 Hint Constructors hasType.
560 566
561 refine (fix F (e : exp) : {{t | hasType e t}} := 567 refine (fix F (e : exp) : {{t | hasType e t}} :=
562 match e return {{t | hasType e t}} with 568 match e return {{t | hasType e t}} with
563 | Nat _ => [[TNat]] 569 | Nat _ => [[TNat]]
573 t2 <- F e2; 579 t2 <- F e2;
574 eq_type_dec t1 TBool;; 580 eq_type_dec t1 TBool;;
575 eq_type_dec t2 TBool;; 581 eq_type_dec t2 TBool;;
576 [[TBool]] 582 [[TBool]]
577 end); crush. 583 end); crush.
584 (* end thide *)
578 Defined. 585 Defined.
579 586
580 (** Despite manipulating proofs, our type checker is easy to run. *) 587 (** Despite manipulating proofs, our type checker is easy to run. *)
581 588
582 Eval simpl in typeCheck (Nat 0). 589 Eval simpl in typeCheck (Nat 0).
674 681
675 (** %\smallskip% 682 (** %\smallskip%
676 683
677 We can adapt this implementation to use [sumor], so that we know our type-checker only fails on ill-typed inputs. First, we define an analogue to the "assertion" notation. *) 684 We can adapt this implementation to use [sumor], so that we know our type-checker only fails on ill-typed inputs. First, we define an analogue to the "assertion" notation. *)
678 685
686 (* begin thide *)
679 Notation "e1 ;;; e2" := (if e1 then e2 else !!) 687 Notation "e1 ;;; e2" := (if e1 then e2 else !!)
680 (right associativity, at level 60). 688 (right associativity, at level 60).
681 689
682 (** Next, we prove a helpful lemma, which states that a given expression can have at most one type. *) 690 (** Next, we prove a helpful lemma, which states that a given expression can have at most one type. *)
683 691
689 induction 1; inversion 1; crush. 697 induction 1; inversion 1; crush.
690 Qed. 698 Qed.
691 699
692 (** Now we can define the type-checker. Its type expresses that it only fails on untypable expressions. *) 700 (** Now we can define the type-checker. Its type expresses that it only fails on untypable expressions. *)
693 701
702 (* end thide *)
694 Definition typeCheck' (e : exp) : {t : type | hasType e t} + {forall t, ~hasType e t}. 703 Definition typeCheck' (e : exp) : {t : type | hasType e t} + {forall t, ~hasType e t}.
704 (* begin thide *)
695 Hint Constructors hasType. 705 Hint Constructors hasType.
696 (** We register all of the typing rules as hints. *) 706 (** We register all of the typing rules as hints. *)
697 707
698 Hint Resolve hasType_det. 708 Hint Resolve hasType_det.
699 (** [hasType_det] will also be useful for proving proof obligations with contradictory contexts. Since its statement includes [forall]-bound variables that do not appear in its conclusion, only [eauto] will apply this hint. *) 709 (** [hasType_det] will also be useful for proving proof obligations with contradictory contexts. Since its statement includes [forall]-bound variables that do not appear in its conclusion, only [eauto] will apply this hint. *)
716 eq_type_dec t2 TBool;;; 726 eq_type_dec t2 TBool;;;
717 [[[TBool]]] 727 [[[TBool]]]
718 end); clear F; crush' tt hasType; eauto. 728 end); clear F; crush' tt hasType; eauto.
719 729
720 (** We clear [F], the local name for the recursive function, to avoid strange proofs that refer to recursive calls that we never make. The [crush] variant [crush'] helps us by performing automatic inversion on instances of the predicates specified in its second argument. Once we throw in [eauto] to apply [hasType_det] for us, we have discharged all the subgoals. *) 730 (** We clear [F], the local name for the recursive function, to avoid strange proofs that refer to recursive calls that we never make. The [crush] variant [crush'] helps us by performing automatic inversion on instances of the predicates specified in its second argument. Once we throw in [eauto] to apply [hasType_det] for us, we have discharged all the subgoals. *)
731 (* end thide *)
721 Defined. 732 Defined.
722 733
723 (** The short implementation here hides just how time-saving automation is. Every use of one of the notations adds a proof obligation, giving us 12 in total. Most of these obligations require multiple inversions and either uses of [hasType_det] or applications of [hasType] rules. 734 (** The short implementation here hides just how time-saving automation is. Every use of one of the notations adds a proof obligation, giving us 12 in total. Most of these obligations require multiple inversions and either uses of [hasType_det] or applications of [hasType] rules.
724 735
725 The results of simplifying calls to [typeCheck'] look deceptively similar to the results for [typeCheck], but now the types of the results provide more information. *) 736 The results of simplifying calls to [typeCheck'] look deceptively similar to the results for [typeCheck], but now the types of the results provide more information. *)