suzanne.soy/cur
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Started cross-module work

Browse Source
This commit is contained in:
William J. Bowman 2015-01-29 18:26:38 -05:00
parent b0e350885a
commit 7170ed2496
1 changed files with 16 additions and 11 deletions

27
cur-redex.rkt
View File

@ -610,12 +610,13 @@
(provide (provide
;; Basic syntax ;; Basic syntax
require require
provide
for-syntax for-syntax
only-in only-in
module+ module+
#%module-begin #%module-begin
(rename-out (rename-out
[dep-provide provide]
[dep-lambda lambda] [dep-lambda lambda]
[dep-lambda λ] [dep-lambda λ]
[dep-app #%app] [dep-app #%app]
@ -685,19 +686,18 @@
(define (extend-env/term env x t) (define (extend-env/term env x t)
(term (,(env) ,x : ,t))) (term (,(env) ,x : ,t)))
(define (extend-env/term! env x t) (env (extend-env/term env x t)))
(define (extend-env/syn env x t) (define (extend-env/syn env x t)
(term (,(env) ,(syntax->datum x) : ,(cur->datum t)))) (term (,(env) ,(syntax->datum x) : ,(cur->datum t))))
(define bound (make-parameter '())) (define (extend-env/syn! env x t) (env (extend-env/syn env x t)))
(define (extend-bound id) (cons id (bound)))
(define orig-insp (variable-reference->module-declaration-inspector (define orig-insp (variable-reference->module-declaration-inspector
(#%variable-reference))) (#%variable-reference)))
(define (disarm syn) (syntax-disarm syn orig-insp)) (define (disarm syn) (syntax-disarm syn orig-insp))
(define (core-expand syn) (denote syn (cur->datum syn))) (define (core-expand syn) (denote syn (cur->datum syn)))
(define (denote syn t) (define (denote syn t)
@ -724,8 +724,7 @@
[(b:id (x:id : t) e) [(b:id (x:id : t) e)
(let* ([x (syntax->datum #'x)] (let* ([x (syntax->datum #'x)]
[t (core-expand #'t)] [t (core-expand #'t)]
[e (parameterize ([gamma (extend-env/term gamma x t)] [e (parameterize ([gamma (extend-env/term gamma x t)])
[bound (extend-bound x)])
(core-expand #'e))]) (core-expand #'e))])
(term (,(syntax->datum #'b) (,x : ,t) ,e)))] (term (,(syntax->datum #'b) (,x : ,t) ,e)))]
[(case e (ec eb) ...) [(case e (ec eb) ...)
@ -762,6 +761,14 @@
dep-fix dep-forall dep-var)))))) dep-fix dep-forall dep-var))))))
#;(define-syntax (dep-datum syn) (denote #'syn)) #;(define-syntax (dep-datum syn) (denote #'syn))
;; TODO: Add extend-env calls. Will be tricky with sigma and gamma
;; being separate.
(define-syntax (dep-provide syn)
(syntax-parse syn
[(_ name ...)
#`(provide name ...)
#;#`(begin-for-syntax
(extend-env/syn! ))]))
;; TODO: Can these be simplified further? ;; TODO: Can these be simplified further?
;; TODO: Can we make core-expand some kind of parameter that is only ;; TODO: Can we make core-expand some kind of parameter that is only
@ -791,12 +798,10 @@
(syntax-case syn (:) (syntax-case syn (:)
[(_ i : ti (x1 : t1) ...) [(_ i : ti (x1 : t1) ...)
(begin (begin
(sigma (extend-env/syn sigma #'i #'ti)) (extend-env/syn! sigma #'i #'ti)
(bound (extend-bound #'i))
(for ([x (syntax->list #`(x1 ...))] (for ([x (syntax->list #`(x1 ...))]
[t (syntax->list #`(t1 ...))]) [t (syntax->list #`(t1 ...))])
(sigma (extend-env/syn sigma x t)) (extend-env/syn! sigma x t))
(bound (extend-bound x)))
#'(void))])) #'(void))]))
;; TODO: Not sure if this is the correct behavior for #%top ;; TODO: Not sure if this is the correct behavior for #%top