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

syntax/kerncase.ss: Added kernel-syntax-case*, which allows additional

Browse Source 
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
This commit is contained in:
Sam Tobin-Hochstadt 2006-08-18 20:10:16 +00:00
parent ff01d5857c
commit 65dcf4e500
1 changed files with 34 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/syntax/kerncase.ss
View File

@ -1,27 +1,42 @@
(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
(syntax-case* stxv #,(datum->syntax-object
stx
'(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 ...))])))
(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)
@ -45,4 +60,5 @@
#%variable-reference)))
(provide kernel-syntax-case
kernel-form-identifier-list))
kernel-syntax-case*
kernel-form-identifier-list))