Compare commits

..

No commits in common. "31e29cf18ed6be74e8e6327aab042217748b7610" and "da9ea4ed936ec1f77ce2b329d0a665938ef9fb68" have entirely different histories.

4 changed files with 6 additions and 26 deletions

1
.gitignore vendored
View file

@ -1 +0,0 @@
compiled

View file

@ -97,5 +97,4 @@
(tm-pnat 12000)) (tm-pnat 12000))
(check βη-eq? (tm-padd (tm-pnat 10000) (tm-pnat 2000)) (tm-pnat 12000)) (check βη-eq? (tm-padd (tm-pnat 10000) (tm-pnat 2000)) (tm-pnat 12000))
(check βη-eq? (tm-abs (tm-app (tm-var 1) (tm-var 0))) (tm-app tm-id (tm-var 0))) (check βη-eq? (tm-abs (tm-app (tm-var 1) (tm-var 0))) (tm-app tm-id (tm-var 0)))
(check βη-eq? `(Π (U 0) (Π (var 0) ,(tm-app tm-id '(var 1)))) '(Π (U 0) (Π (var 0) (var 1))))
(check-false (βη-eq? '(U 0) '(var 0))) (check-false (βη-eq? '(U 0) '(var 0)))

28
nbe.rkt
View file

@ -5,17 +5,14 @@
(define-type denv (-> V (Promise D))) (define-type denv (-> V (Promise D)))
(define-type V Nonnegative-Integer) (define-type V Nonnegative-Integer)
(define-type Term ( 'zero (define-type Term ( 'zero
'nat
(List 'succ Term) (List 'succ Term)
(List 'var V) (List 'var V)
(List 'λ Term) (List 'λ Term)
(List 'app Term Term) (List 'app Term Term)
(List 'ind Term Term Term) (List 'ind Term Term Term)
(List 'Π Term Term)
(List 'U V))) (List 'U V)))
(define-type D ( 'zero (define-type D ( 'zero
(List 'Π (Promise D) (-> (Promise D) D))
(List 'succ (Promise D)) (List 'succ (Promise D))
(List 'fun (-> (Promise D) D)) (List 'fun (-> (Promise D) D))
(List 'neu D-ne) (List 'neu D-ne)
@ -32,9 +29,9 @@
a a
(ρ (- i 1))))) (ρ (- i 1)))))
(: interp-fun (-> Term denv (-> (Promise D) D))) (: interp-fun (-> Term denv D))
(define (interp-fun a ρ) (define (interp-fun a ρ)
(λ (x) (interp a (ext ρ x)))) (list 'fun (λ (x) (interp a (ext ρ x)))))
(: interp-fun2 (-> Term denv (-> (Promise D) (Promise D) D))) (: interp-fun2 (-> Term denv (-> (Promise D) (Promise D) D)))
(define (interp-fun2 a ρ) (define (interp-fun2 a ρ)
@ -59,7 +56,6 @@
(define (interp a ρ) (define (interp a ρ)
(match a (match a
[`(U ,_) a] [`(U ,_) a]
[`(Π ,A ,B) `(Π ,(delay (interp A ρ)) ,(interp-fun B ρ))]
[`(var ,i) (force (ρ i))] [`(var ,i) (force (ρ i))]
['zero 'zero] ['zero 'zero]
[`(succ ,a) `(succ ,(delay (interp a ρ)))] [`(succ ,a) `(succ ,(delay (interp a ρ)))]
@ -67,26 +63,18 @@
(interp a ρ) (interp a ρ)
(delay (interp b ρ)) (delay (interp b ρ))
(interp-fun2 c ρ))] (interp-fun2 c ρ))]
[`(λ ,a) (list 'fun (interp-fun a ρ))] [`(λ ,a) (interp-fun a ρ)]
[`(app ,a ,b) (ap a b ρ)])) [`(app ,a ,b) (ap a b ρ)]))
(: reify (-> V D Term)) (: reify (-> V D Term))
(define (reify n a) (define (reify n a)
(match a (match a
[`(Π ,A ,B) `(Π ,(reify n (force A)) ,(reify (+ n 1) (B (delay `(neu (idx ,n))))))]
['zero 'zero] ['zero 'zero]
[`(succ ,a) `(succ ,(reify n (force a)))] [`(succ ,a) `(succ ,(reify n (force a)))]
[`(U ,_) a] [`(U ,_) a]
[`(fun ,f) (list 'λ (reify (+ n 1) (f (delay `(neu (idx ,n))))))] [`(fun ,f) (list 'λ (reify (+ n 1) (f (delay `(neu (idx ,n))))))]
[`(neu ,a) (reify-neu n a)])) [`(neu ,a) (reify-neu n a)]))
(: var-to-idx (-> V V V))
(define (var-to-idx s v)
(let ([ret (- s (+ v 1))])
(if (< ret 0)
(error "variable to index conversion failed")
ret)))
(: reify-neu (-> V D-ne Term)) (: reify-neu (-> V D-ne Term))
(define (reify-neu n a) (define (reify-neu n a)
(match a (match a
@ -97,15 +85,14 @@
(c (delay `(neu (idx ,n))) (c (delay `(neu (idx ,n)))
(delay `(neu (idx ,(+ 1 n)))))))] (delay `(neu (idx ,(+ 1 n)))))))]
[`(app ,u ,v) (list 'app (reify-neu n u) (reify n v))] [`(app ,u ,v) (list 'app (reify-neu n u) (reify n v))]
[`(idx ,i) (list 'var (var-to-idx n i))])) [`(idx ,i) (list 'var (max 0 (- n (+ i 1))))]))
(: idsub (-> V V D)) (: idsub (-> V V D))
(define (idsub s i) `(neu (idx ,(var-to-idx s i)))) (define (idsub s i) `(neu (idx ,(max 0 (- s (+ i 1))))))
(: scope (-> Term V)) (: scope (-> Term V))
(define (scope a) (define (scope a)
(match a (match a
[`(Π ,A ,B) (max (scope A) (- (scope B) 2))]
[`(U ,_) 0] [`(U ,_) 0]
['zero 0] ['zero 0]
[`(succ ,a) (scope a)] [`(succ ,a) (scope a)]
@ -128,7 +115,6 @@
(define (subst ρ a) (define (subst ρ a)
(match a (match a
[`(U ,_) a] [`(U ,_) a]
[`(Π ,A ,B) `(Π ,(subst ρ A) ,(subst (up 1 ρ) B))]
[`(var ,i) (ρ i)] [`(var ,i) (ρ i)]
[`(app ,a ,b) `(app ,(subst ρ a) ,(subst ρ b))] [`(app ,a ,b) `(app ,(subst ρ a) ,(subst ρ b))]
[`(λ ,a) `(λ ,(subst (up 1 ρ) a))] [`(λ ,a) `(λ ,(subst (up 1 ρ) a))]
@ -147,8 +133,6 @@
(define (η-eq? a b) (define (η-eq? a b)
(match (list a b) (match (list a b)
[`((U ,i) (U ,j)) (eqv? i j) ] [`((U ,i) (U ,j)) (eqv? i j) ]
[`((Π ,A0 ,B0) (Π ,A1 ,B1))
(and (η-eq? A0 A1) (η-eq? B0 B1))]
['(zero zero) true] ['(zero zero) true]
[`((succ ,a) (succ ,b)) (η-eq? a b)] [`((succ ,a) (succ ,b)) (η-eq? a b)]
[`((ind ,a ,b ,c) (ind ,a0 ,b0 ,c0)) [`((ind ,a ,b ,c) (ind ,a0 ,b0 ,c0))
@ -168,4 +152,4 @@
(define (β-eq? a b) (define (β-eq? a b)
(equal? (normalize a) (normalize b))) (equal? (normalize a) (normalize b)))
(provide reify interp normalize β-eq? Term D D-ne V βη-eq? ext subst1 subst idsub-tm) (provide reify interp normalize β-eq? Term D V βη-eq?)

View file

@ -1,2 +0,0 @@
#lang typed/racket
(require "nbe.rkt")