comparison src/Subset.v @ 297:b441010125d4

Everything compiles in Coq 8.3pl1
author Adam Chlipala <adam@chlipala.net>
date Fri, 14 Jan 2011 14:39:12 -0500
parents 1b6c81e51799
children 7b38729be069
comparison
equal deleted inserted replaced
296:559ec7328410 297:b441010125d4
1 (* Copyright (c) 2008-2010, Adam Chlipala 1 (* Copyright (c) 2008-2011, Adam Chlipala
2 * 2 *
3 * This work is licensed under a 3 * This work is licensed under a
4 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 4 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0
5 * Unported License. 5 * Unported License.
6 * The license text is available at: 6 * The license text is available at:
224 | S n' -> n' 224 | S n' -> n'
225 </pre># 225 </pre>#
226 226
227 We have managed to reach a type that is, in a formal sense, the most expressive possible for [pred]. Any other implementation of the same type must have the same input-output behavior. However, there is still room for improvement in making this kind of code easier to write. Here is a version that takes advantage of tactic-based theorem proving. We switch back to passing a separate proof argument instead of using a subset type for the function's input, because this leads to cleaner code. *) 227 We have managed to reach a type that is, in a formal sense, the most expressive possible for [pred]. Any other implementation of the same type must have the same input-output behavior. However, there is still room for improvement in making this kind of code easier to write. Here is a version that takes advantage of tactic-based theorem proving. We switch back to passing a separate proof argument instead of using a subset type for the function's input, because this leads to cleaner code. *)
228 228
229 Definition pred_strong4 (n : nat) : n > 0 -> {m : nat | n = S m}. 229 Definition pred_strong4 : forall n : nat, n > 0 -> {m : nat | n = S m}.
230 refine (fun n => 230 refine (fun n =>
231 match n with 231 match n with
232 | O => fun _ => False_rec _ _ 232 | O => fun _ => False_rec _ _
233 | S n' => fun _ => exist _ n' _ 233 | S n' => fun _ => exist _ n' _
234 end). 234 end).
294 We are almost done with the ideal implementation of dependent predecessor. We can use Coq's syntax extension facility to arrive at code with almost no complexity beyond a Haskell or ML program with a complete specification in a comment. *) 294 We are almost done with the ideal implementation of dependent predecessor. We can use Coq's syntax extension facility to arrive at code with almost no complexity beyond a Haskell or ML program with a complete specification in a comment. *)
295 295
296 Notation "!" := (False_rec _ _). 296 Notation "!" := (False_rec _ _).
297 Notation "[ e ]" := (exist _ e _). 297 Notation "[ e ]" := (exist _ e _).
298 298
299 Definition pred_strong5 (n : nat) : n > 0 -> {m : nat | n = S m}. 299 Definition pred_strong5 : forall n : nat, n > 0 -> {m : nat | n = S m}.
300 refine (fun n => 300 refine (fun n =>
301 match n with 301 match n with
302 | O => fun _ => ! 302 | O => fun _ => !
303 | S n' => fun _ => [n'] 303 | S n' => fun _ => [n']
304 end); crush. 304 end); crush.
354 354
355 (** The [Reduce] notation is notable because it demonstrates how [if] is overloaded in Coq. The [if] form actually works when the test expression has any two-constructor inductive type. Moreover, in the [then] and [else] branches, the appropriate constructor arguments are bound. This is important when working with [sumbool]s, when we want to have the proof stored in the test expression available when proving the proof obligations generated in the appropriate branch. 355 (** The [Reduce] notation is notable because it demonstrates how [if] is overloaded in Coq. The [if] form actually works when the test expression has any two-constructor inductive type. Moreover, in the [then] and [else] branches, the appropriate constructor arguments are bound. This is important when working with [sumbool]s, when we want to have the proof stored in the test expression available when proving the proof obligations generated in the appropriate branch.
356 356
357 Now we can write [eq_nat_dec], which compares two natural numbers, returning either a proof of their equality or a proof of their inequality. *) 357 Now we can write [eq_nat_dec], which compares two natural numbers, returning either a proof of their equality or a proof of their inequality. *)
358 358
359 Definition eq_nat_dec (n m : nat) : {n = m} + {n <> m}. 359 Definition eq_nat_dec : forall n m : nat, {n = m} + {n <> m}.
360 refine (fix f (n m : nat) : {n = m} + {n <> m} := 360 refine (fix f (n m : nat) : {n = m} + {n <> m} :=
361 match n, m with 361 match n, m with
362 | O, O => Yes 362 | O, O => Yes
363 | S n', S m' => Reduce (f n' m') 363 | S n', S m' => Reduce (f n' m')
364 | _, _ => No 364 | _, _ => No
526 Notation "??" := (Unknown _). 526 Notation "??" := (Unknown _).
527 Notation "[[ x ]]" := (Found _ x _). 527 Notation "[[ x ]]" := (Found _ x _).
528 528
529 (** Now our next version of [pred] is trivial to write. *) 529 (** Now our next version of [pred] is trivial to write. *)
530 530
531 Definition pred_strong7 (n : nat) : {{m | n = S m}}. 531 Definition pred_strong7 : forall n : nat, {{m | n = S m}}.
532 refine (fun n => 532 refine (fun n =>
533 match n with 533 match n with
534 | O => ?? 534 | O => ??
535 | S n' => [[n']] 535 | S n' => [[n']]
536 end); trivial. 536 end); trivial.
565 Notation "!!" := (inright _ _). 565 Notation "!!" := (inright _ _).
566 Notation "[[[ x ]]]" := (inleft _ [x]). 566 Notation "[[[ x ]]]" := (inleft _ [x]).
567 567
568 (** Now we are ready to give the final version of possibly-failing predecessor. The [sumor]-based type that we use is maximally expressive; any implementation of the type has the same input-output behavior. *) 568 (** Now we are ready to give the final version of possibly-failing predecessor. The [sumor]-based type that we use is maximally expressive; any implementation of the type has the same input-output behavior. *)
569 569
570 Definition pred_strong8 (n : nat) : {m : nat | n = S m} + {n = 0}. 570 Definition pred_strong8 : forall n : nat, {m : nat | n = S m} + {n = 0}.
571 refine (fun n => 571 refine (fun n =>
572 match n with 572 match n with
573 | O => !! 573 | O => !!
574 | S n' => [[[n']]] 574 | S n' => [[[n']]]
575 end); trivial. 575 end); trivial.
602 602
603 (** The meaning of [x <- e1; e2] is: First run [e1]. If it fails to find an answer, then announce failure for our derived computation, too. If [e1] %\textit{%#<i>#does#</i>#%}% find an answer, pass that answer on to [e2] to find the final result. The variable [x] can be considered bound in [e2]. 603 (** The meaning of [x <- e1; e2] is: First run [e1]. If it fails to find an answer, then announce failure for our derived computation, too. If [e1] %\textit{%#<i>#does#</i>#%}% find an answer, pass that answer on to [e2] to find the final result. The variable [x] can be considered bound in [e2].
604 604
605 This notation is very helpful for composing richly-typed procedures. For instance, here is a very simple implementation of a function to take the predecessors of two naturals at once. *) 605 This notation is very helpful for composing richly-typed procedures. For instance, here is a very simple implementation of a function to take the predecessors of two naturals at once. *)
606 606
607 Definition doublePred (n1 n2 : nat) : {{p | n1 = S (fst p) /\ n2 = S (snd p)}}. 607 Definition doublePred : forall n1 n2 : nat, {{p | n1 = S (fst p) /\ n2 = S (snd p)}}.
608 refine (fun n1 n2 => 608 refine (fun n1 n2 =>
609 m1 <- pred_strong7 n1; 609 m1 <- pred_strong7 n1;
610 m2 <- pred_strong7 n2; 610 m2 <- pred_strong7 n2;
611 [[(m1, m2)]]); tauto. 611 [[(m1, m2)]]); tauto.
612 Defined. 612 Defined.
621 end) 621 end)
622 (right associativity, at level 60). 622 (right associativity, at level 60).
623 623
624 (** printing * $\times$ *) 624 (** printing * $\times$ *)
625 625
626 Definition doublePred' (n1 n2 : nat) 626 Definition doublePred' : forall n1 n2 : nat,
627 : {p : nat * nat | n1 = S (fst p) /\ n2 = S (snd p)} 627 {p : nat * nat | n1 = S (fst p) /\ n2 = S (snd p)}
628 + {n1 = 0 \/ n2 = 0}. 628 + {n1 = 0 \/ n2 = 0}.
629 refine (fun n1 n2 => 629 refine (fun n1 n2 =>
630 m1 <-- pred_strong8 n1; 630 m1 <-- pred_strong8 n1;
631 m2 <-- pred_strong8 n2; 631 m2 <-- pred_strong8 n2;
632 [[[(m1, m2)]]]); tauto. 632 [[[(m1, m2)]]]); tauto.
674 (right associativity, at level 60). 674 (right associativity, at level 60).
675 675
676 (** 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. *) 676 (** 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. *)
677 (* end thide *) 677 (* end thide *)
678 678
679 Definition typeCheck (e : exp) : {{t | hasType e t}}. 679 Definition typeCheck : forall e : exp, {{t | hasType e t}}.
680 (* begin thide *) 680 (* begin thide *)
681 Hint Constructors hasType. 681 Hint Constructors hasType.
682 682
683 refine (fix F (e : exp) : {{t | hasType e t}} := 683 refine (fix F (e : exp) : {{t | hasType e t}} :=
684 match e with 684 match e with
811 Qed. 811 Qed.
812 812
813 (** Now we can define the type-checker. Its type expresses that it only fails on untypable expressions. *) 813 (** Now we can define the type-checker. Its type expresses that it only fails on untypable expressions. *)
814 814
815 (* end thide *) 815 (* end thide *)
816 Definition typeCheck' (e : exp) : {t : type | hasType e t} + {forall t, ~ hasType e t}. 816 Definition typeCheck' : forall e : exp, {t : type | hasType e t} + {forall t, ~ hasType e t}.
817 (* begin thide *) 817 (* begin thide *)
818 Hint Constructors hasType. 818 Hint Constructors hasType.
819 (** We register all of the typing rules as hints. *) 819 (** We register all of the typing rules as hints. *)
820 820
821 Hint Resolve hasType_det. 821 Hint Resolve hasType_det.