54 lines
1.6 KiB
Scheme
54 lines
1.6 KiB
Scheme
|
|
;;----------------------------------------------------------------------
|
|
;; #%stxcase-scheme: adds let-syntax, letrec-syntax, etc.
|
|
|
|
(module letstx-scheme '#%kernel
|
|
(#%require "small-scheme.ss" "stx.ss" "stxcase.ss" "with-stx.ss" "stxloc.ss"
|
|
(for-syntax '#%kernel "small-scheme.ss" "stx.ss" "stxcase.ss"
|
|
"with-stx.ss" "stxloc.ss"))
|
|
|
|
(-define-syntax letrec-syntaxes
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ ([(id ...) expr] ...) body1 body ...)
|
|
(syntax/loc stx
|
|
(letrec-syntaxes+values ([(id ...) expr] ...)
|
|
()
|
|
body1 body ...))])))
|
|
|
|
(-define-syntax letrec-syntax
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ ([id expr] ...) body1 body ...)
|
|
(syntax/loc stx
|
|
(letrec-syntaxes+values ([(id) expr] ...)
|
|
()
|
|
body1 body ...))])))
|
|
|
|
(-define-syntax let-syntaxes
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ ([(id ...) expr] ...) body1 body ...)
|
|
(with-syntax ([((tmp ...) ...)
|
|
(map
|
|
generate-temporaries
|
|
(syntax->list (syntax ((id ...) ...))))])
|
|
(syntax/loc stx
|
|
(letrec-syntaxes+values ([(tmp ...) expr] ...) ()
|
|
(letrec-syntaxes+values ([(id ...) (values
|
|
(make-rename-transformer (quote-syntax tmp))
|
|
...)] ...)
|
|
()
|
|
body1 body ...))))])))
|
|
|
|
(-define-syntax let-syntax
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ ([id expr] ...) body1 body ...)
|
|
(syntax/loc stx
|
|
(let-syntaxes ([(id) expr] ...)
|
|
body1 body ...))])))
|
|
|
|
(#%provide (all-from "small-scheme.ss")
|
|
letrec-syntaxes letrec-syntax let-syntaxes let-syntax ))
|