Compare commits

..

2 commits

Author SHA1 Message Date
31e29cf18e Add more exports 2025-05-12 16:57:44 -04:00
f418c383f3 Add pi types
All checks were successful
ci/woodpecker/push/woodpecker Pipeline was successful
2025-05-12 16:28:54 -04:00
4 changed files with 26 additions and 6 deletions

1
.gitignore vendored Normal file
View file

@ -0,0 +1 @@
compiled

View file

@ -97,4 +97,5 @@
(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,14 +5,17 @@
(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)
@ -29,9 +32,9 @@
a a
(ρ (- i 1))))) (ρ (- i 1)))))
(: interp-fun (-> Term denv D)) (: interp-fun (-> Term denv (-> (Promise D) D)))
(define (interp-fun a ρ) (define (interp-fun a ρ)
(list 'fun (λ (x) (interp a (ext ρ x))))) (λ (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 ρ)
@ -56,6 +59,7 @@
(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 ρ)))]
@ -63,18 +67,26 @@
(interp a ρ) (interp a ρ)
(delay (interp b ρ)) (delay (interp b ρ))
(interp-fun2 c ρ))] (interp-fun2 c ρ))]
[`(λ ,a) (interp-fun a ρ)] [`(λ ,a) (list 'fun (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
@ -85,14 +97,15 @@
(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 (max 0 (- n (+ i 1))))])) [`(idx ,i) (list 'var (var-to-idx n i))]))
(: idsub (-> V V D)) (: idsub (-> V V D))
(define (idsub s i) `(neu (idx ,(max 0 (- s (+ i 1)))))) (define (idsub s i) `(neu (idx ,(var-to-idx s i))))
(: 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)]
@ -115,6 +128,7 @@
(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))]
@ -133,6 +147,8 @@
(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))
@ -152,4 +168,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 V βη-eq?) (provide reify interp normalize β-eq? Term D D-ne V βη-eq? ext subst1 subst idsub-tm)

2
type-checker.rkt Normal file
View file

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