
These fixes are merged because properly testing the latter requires having the former, while properly implementing the former is made simpler by having the latter. Fixed handling of names/substitution === * Added capture-avoiding substitution. Closes #7 * Added equivalence during typing checking, including α-equivalence and limited β-equivalence. Closes #8 * Exposed better typing-check reflection features to allow typing checking modulo equivalence. * Tweaked QED macro to use new type-checking reflection feature. Fixed inductive families === The implementation of inductive families is now based on the theoretical models of inductive families, rather than an ad-hoc non-dependent pattern matcher. * Removed case and fix from Cur and Curnel. They are replaced by elim, the generic eliminator for inductive families. Closes #5. Since fix is no more, also closes #2. * Elimination of false works! Closes #4. * Changed uses of case to elim in Curnel * Changed uses of case* in Cur to use eliminators. Breaks case* API. * Fixed Coq generator to use eliminators * Fixed Latex generator
52 lines
1.3 KiB
Racket
52 lines
1.3 KiB
Racket
#lang s-exp "../redex-curnel.rkt"
|
|
(require "sugar.rkt" "bool.rkt")
|
|
;; TODO: override (all-defined-out) to enable exporting all these
|
|
;; properly.
|
|
(provide nat z s add1 sub1 plus )
|
|
(module+ test
|
|
(require rackunit))
|
|
|
|
(data nat : Type
|
|
(z : nat)
|
|
(s : (-> nat nat)))
|
|
|
|
(define (add1 (n : nat)) (s n))
|
|
(module+ test
|
|
(check-equal? (add1 (s z)) (s (s z))))
|
|
|
|
(define (sub1 (n : nat))
|
|
(case* nat n (lambda (x : nat) nat)
|
|
[z z]
|
|
[(s (x : nat)) IH: ((ih-n : nat)) x]))
|
|
(module+ test
|
|
(check-equal? (sub1 (s z)) z))
|
|
|
|
(define (plus (n1 : nat) (n2 : nat))
|
|
(case* nat n1 (lambda (x : nat) nat)
|
|
[z n2]
|
|
[(s (x : nat)) IH: ((ih-n1 : nat))
|
|
(s ih-n1)]))
|
|
(module+ test
|
|
(check-equal? (plus z z) z)
|
|
(check-equal? (plus (s (s z)) (s (s z))) (s (s (s (s z))))))
|
|
|
|
;; Credit to this function goes to Max
|
|
(define (nat-equal? (n1 : nat))
|
|
(elim nat n1 (lambda (x : nat) (-> nat bool))
|
|
(lambda (n2 : nat)
|
|
(elim nat n2 (lambda (x : nat) bool)
|
|
btrue
|
|
(lambda* (x : nat) (ih-n2 : bool) bfalse)))
|
|
(lambda* (x : nat) (ih : (-> nat bool))
|
|
(lambda (n2 : nat)
|
|
(elim nat n2 (lambda (x : nat) bool)
|
|
bfalse
|
|
(lambda* (x : nat) (ih-bla : bool)
|
|
(ih x)))))))
|
|
(module+ test
|
|
(check-equal? (nat-equal? z z) btrue)
|
|
(check-equal? (nat-equal? z (s z)) bfalse)
|
|
(check-equal? (nat-equal? (s z) (s z)) btrue))
|
|
|
|
|