65dcf4e500
specification of keywords beyond the MzScheme core forms. Define both kernel-sytnax-case and kernel-sytnax-case* in terms of (new) kernel-sytnax-case-internal. svn: r4089
65 lines
2.1 KiB
Scheme
65 lines
2.1 KiB
Scheme
|
|
(module kerncase mzscheme
|
|
|
|
(define-syntax kernel-syntax-case-internal
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ stxv trans? (extras ...) kernel-context clause ...)
|
|
(quasisyntax/loc
|
|
stx
|
|
(syntax-case* stxv #,(datum->syntax-object
|
|
#'kernel-context
|
|
(append (syntax->list #'(extras ...))
|
|
'(quote
|
|
quote-syntax #%datum #%top
|
|
lambda case-lambda
|
|
let-values letrec-values
|
|
begin begin0 set!
|
|
with-continuation-mark
|
|
if #%app
|
|
define-values define-syntaxes define-values-for-syntax
|
|
module #%plain-module-begin require provide
|
|
require-for-syntax require-for-template
|
|
#%variable-reference)))
|
|
(if trans? module-transformer-identifier=? module-identifier=?)
|
|
clause ...))])))
|
|
|
|
(define-syntax kernel-syntax-case
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ stxv trans? clause ...)
|
|
(quasisyntax/loc stx
|
|
(kernel-syntax-case-internal stxv trans? () #,stx clause ...))])))
|
|
|
|
(define-syntax kernel-syntax-case*
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ stxv trans? (extras ...) clause ...)
|
|
(quasisyntax/loc stx
|
|
(kernel-syntax-case-internal stxv trans? (extras ...) #,stx clause ...))])))
|
|
|
|
(define (kernel-form-identifier-list stx)
|
|
(map (lambda (s)
|
|
(datum->syntax-object stx s #f))
|
|
'(begin
|
|
define-values
|
|
define-syntaxes
|
|
define-values-for-syntax
|
|
set!
|
|
let-values
|
|
letrec-values
|
|
lambda
|
|
case-lambda
|
|
if
|
|
quote
|
|
letrec-syntaxes+values
|
|
with-continuation-mark
|
|
#%app
|
|
#%top
|
|
#%datum
|
|
#%variable-reference)))
|
|
|
|
(provide kernel-syntax-case
|
|
kernel-syntax-case*
|
|
kernel-form-identifier-list))
|