restore some R6RS forms to letrec*-like int-def handling
svn: r9293
This commit is contained in:
parent
a33562b9dc
commit
49c843742f
|
@ -18,7 +18,7 @@
|
||||||
(rename-out [r5rs:quote quote])
|
(rename-out [r5rs:quote quote])
|
||||||
|
|
||||||
;; 11.4.2
|
;; 11.4.2
|
||||||
(rename-out [r5rs:lambda lambda])
|
(rename-out [r6rs:lambda lambda])
|
||||||
|
|
||||||
;; 11.4.3
|
;; 11.4.3
|
||||||
(rename-out [r5rs:if if])
|
(rename-out [r5rs:if if])
|
||||||
|
@ -32,7 +32,7 @@
|
||||||
|
|
||||||
;; 11.4.6
|
;; 11.4.6
|
||||||
let let*
|
let let*
|
||||||
(rename-out [r5rs:letrec letrec]
|
(rename-out [r6rs:letrec letrec]
|
||||||
[letrec letrec*]
|
[letrec letrec*]
|
||||||
[r6rs:let-values let-values]
|
[r6rs:let-values let-values]
|
||||||
[r6rs:let*-values let*-values])
|
[r6rs:let*-values let*-values])
|
||||||
|
@ -363,6 +363,13 @@
|
||||||
(define-generalized-qq r6rs:quasiquote
|
(define-generalized-qq r6rs:quasiquote
|
||||||
r5rs:quasiquote unquote unquote-splicing values)
|
r5rs:quasiquote unquote unquote-splicing values)
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; letrec
|
||||||
|
;; Need bindings like R5RS, but int-def body like MzScheme
|
||||||
|
|
||||||
|
(define-syntax-rule (r6rs:letrec bindings . body)
|
||||||
|
(r5rs:letrec bindings (let () . body)))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; let[*]-values
|
;; let[*]-values
|
||||||
|
|
||||||
|
@ -407,21 +414,32 @@
|
||||||
#`[#,ids
|
#`[#,ids
|
||||||
(call-with-values
|
(call-with-values
|
||||||
(lambda () #,expr)
|
(lambda () #,expr)
|
||||||
(r5rs:lambda #,formals
|
(r6rs:lambda #,formals
|
||||||
(values . #,ids)))])))
|
(values . #,ids)))])))
|
||||||
(syntax->list #'(formals ...))
|
(syntax->list #'(formals ...))
|
||||||
(syntax->list #'(expr ...)))])
|
(syntax->list #'(expr ...)))])
|
||||||
#'(dest:let-values bindings body0 body ...))]))]))
|
#'(dest:let-values bindings body0 body ...))]))]))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; define
|
;; lambda & define
|
||||||
|
;; Need rest-arg conversion like R5RS, but int-def handlign like MzScheme
|
||||||
|
|
||||||
|
(define-syntax (r6rs:lambda stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ (id ...) . body)
|
||||||
|
(andmap identifier? (syntax->list #'(id ...)))
|
||||||
|
(syntax/loc stx (lambda (id ...) . body))]
|
||||||
|
[(_ args . body)
|
||||||
|
(syntax/loc stx (r5rs:lambda args (let () . body)))]))
|
||||||
|
|
||||||
(define-syntax (r6rs:define stx)
|
(define-syntax (r6rs:define stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ id)
|
[(_ id)
|
||||||
(identifier? #'id)
|
(identifier? #'id)
|
||||||
#'(define id (void))]
|
(syntax/loc stx (define id (void)))]
|
||||||
[(_ . rest) #'(r5rs:define . rest)]))
|
[(_ (name . args) . body)
|
||||||
|
(syntax/loc stx (r5rs:define (name . args) (let () . body)))]
|
||||||
|
[(_ . rest) #'(define . rest)]))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; define-syntax: wrap a transformer to
|
;; define-syntax: wrap a transformer to
|
||||||
|
|
Loading…
Reference in New Issue
Block a user