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

specialize code for body and no keywords (and no optionals)

Browse Source 
svn: r4440
This commit is contained in:
Eli Barzilay 2006-09-26 15:28:05 +00:00
parent 13b9ef2d9d
commit d1e22794f4
1 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/mzlib/kw.ss
View File

@ -283,7 +283,7 @@
[clauses '()])
(if (null? opts)
;; fast order: first the all-variable section, then from vars up
(cons (with-syntax ([vars (append! (reverse vars) rest)]
(cons (with-syntax ([vars (append (reverse vars) rest)]
[expr expr])
#'[vars expr])
(reverse clauses))
@ -423,11 +423,11 @@
(when (null? keys)
(let ([r (or all-keys other-keys other-keys+body body rest)])
(if allow-other-keys?
;; allow-other-keys?
;; allow-other-keys? ==>
(unless r
(serror #f "cannout allow other keys ~a"
"without using them in some way"))
;; (not allow-other-keys?)
;; (not allow-other-keys?) ==>
(begin
;; can use #:body with no keys to forbid all keywords
(when (and r (not (eq? r body)))
@ -439,24 +439,36 @@
;; ------------------------------------------------------------------------
;; body generation starts here
(cond
;; no optionals or keys (or body or other-keys) => plain lambda
[(and (null? opts) (null? keys) (not (or body allow-other-keys?)))
(with-syntax ([vars (append! vars (or rest '()))] [expr expr])
(syntax/loc stx (lambda vars expr)))]
;; no optionals or keys (or other-keys) => plain lambda
[(and (null? opts) (null? keys) (not allow-other-keys?))
(if (not body)
;; really just a plain lambda
(with-syntax ([vars (append vars (or rest '()))] [expr expr])
(syntax/loc stx (lambda vars expr)))
;; has body => forbid keywords
(with-syntax ([vars (append vars body)] [expr expr] [body body])
(syntax/loc stx
(lambda vars
(if (and (pair? body) (keyword? (car body)))
(error* 'name "unknown keyword: ~e" (car body))
expr)))))]
;; no keys => make a case-lambda for optionals
[(and (null? keys) (not (or body allow-other-keys?)))
;; cannot write a special case for having `body' here, because it
;; requires the special pop-non-keywords-for-optionals that is done
;; below, and generalizing that is a hassle with little benefit
(let ([clauses (make-opt-clauses expr (or rest '()))])
(with-syntax ([name name] [clauses clauses])
(syntax/loc stx (letrec ([name (case-lambda . clauses)]) name))))]
;; no opts => normal processing of keywords etc
[(null? opts)
(with-syntax ([vars (append! vars rest*)]
(with-syntax ([vars (append vars rest*)]
[body (make-keys-body expr)])
(syntax/loc stx (lambda vars body)))]
;; both opts and keys => combine the above two
;; (the problem with this is that things that follow the required
;; arguments are always taken as optionals, even if they're keywords, so
;; the following piece of code is used.)
;; the next piece of code is used.)
#;
[else
(let ([clauses (make-opt-clauses (make-keys-body expr) rest*)])
@ -466,7 +478,7 @@
[else
(with-syntax
([rest rest*]
[vars (append! vars rest*)]
[vars (append vars rest*)]
[body (make-keys-body expr)]
[((optvar optexpr) ...)
(apply append