[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
Hi.
I'd like to revive this SRFI-92 as following attached file.
--
Joo ChurlSoo
Title
qlambda and qlambda*
Author
Joo ChurlSoo
Abstract
This SRFI introduces qlambda and qlambda*, each of which creates a procedure
that checks actual arguments and takes optional variables including `fixed',
`non-fixed named', and `non-fixed unnamed' variables.
Rationale
The syntax reduces not only the clutter of various error conditionals by
checking actual arguments but also somewhat lengthy code by combining optional
argument handling methods such as let-optionals and let-keywords into a single
syntax.
Optional variables include not only optional fixed variables but also optional
non-fixed variables. The formers are the same as those of `opt' form of ALET
and the latters are the same as those of `key' and `cat' forms of ALET (see
SRFI-86). The following are examples to show the similarities.
1. optional fixed variables (`opt' form):
((lambda (v . r)
(alet ((opt r (n 2) (c #\a) (s "opt alet")))
(list v n c s)))
10 3 #\o) => (10 3 #\o "opt alet")
((qlambda (v , (n 2) (c #\a) (s "opt qlambda"))
(list v n c s))
10 3 #\o) => (10 3 #\o "opt qlambda")
2. optional non-fixed named variables (`key' form):
((lambda (v . r)
(alet ((key r (n 2) (c #\a) (s "")))
(list v n c s)))
10 's "key alet" 'c #\k) => (10 2 #\k "key alet")
((qlambda (v , ('n 2) ('c #\a) ('s ""))
(list v n c s))
10 's "key qlambda" 'c #\k) => (10 2 #\k "key qlambda")
3. optional non-fixed unnamed variables (`cat' form):
((lambda (v . r)
(alet ((cat r (n 2 (number? n)) (c #\a (char? c)) (s "" (string? s))))
(list v n c s)))
10 "cat alet" #\c) => (10 2 #\c "cat alet")
((qlambda (v , (`n 2 (number? n)) (`c #\a (char? c)) (`s "" (string? s)))
(list v n c s))
10 "cat qlambda" #\c) => (10 2 #\c "cat qlambda")
Like optional variables, required variables can be divded into three groups,
namely, conventional required fixed variables, required non-fixed named
variables, and required non-fixed unnamed variables. These are best explained
by simple examples.
1. required fixed variables:
(define str-ref-req
(qlambda* ((s (string? s))
(n (and (integer? n) (<= 0 n) (< n (string-length s)))))
(string-ref s n)))
(str-ref-req "str" 1) => #\t
(str-ref-req 1 "str") => qlambda[*]: bad argument 1 s (string? s)
2. required non-fixed named variables:
(define str-ref-key
(qlambda* (('s (string? s))
('n (and (integer? n) (<= 0 n) (< n (string-length s)))))
(string-ref s n)))
(str-ref-key 'n 1 's "str") => #\t
(str-ref-key 'n 1 's 123) => qlambda[*]: bad argument 123 s (string? s)
(str-ref-key 'n 1 's) => error: expects 4 arguments, given 3: n 1 s
3. required non-fixed unnamed variables:
(define str-ref-cat
(qlambda* ((`s (string? s))
(`n (and (integer? n) (<= 0 n) (< n (string-length s)))))
(string-ref s n)))
(str-ref-cat "str" 1) => #\t
(str-ref-cat 1 "str") => #\t
(str-ref-cat 1 123) => qlambda[*]: bad arguments (1 123) s (string? s)
(str-ref-cat "str" 1 2) => error: expects 2 arguments, given 3: "str" 1 2
Specification
The syntax is defined in the extended BNF of R5RS.
(qlambda <extended formals> <body>)
(qlambda* <extended formals> <body>)
<extended formals> --> (<required spec>)
| (, <optional spec>)
| (<required spec> , <optional spec>)
<required spec> --> <fixed required spec>+ <named required spec>*
| <fixed required spec>+ <unnamed required spec>*
| <named required spec>+
| <unnamed required spec>+
<optional spec> --> <fixed optional spec>+ <named optional spec>*
| <fixed optional spec>+ <unnamed optional spec>*
| <named optional spec>+
| <unnamed optional spec>+
<fixed required spec> --> <variable> | (<variable> <test spec>)
<fixed optional spec> --> <variable> | (<variable> <default spec>)
<named required spec> --> '<variable> | ('<variable> <test spec>)
| (('<variable> <keyword>) <test spec>)
| (('<variable> <keyword> <proc>) <test spec>)
<named optional spec> --> '<variable> | ('<variable> <default spec>)
| (('<variable> <keyword>) <default spec>)
| (('<variable> <keyword> <proc>) <default spec>)
<unnamed required spec> --> `<variable> | (`<variable> <test spec>)
<unnamed optional spec> --> `<variable> | (`<variable> <default spec>)
<default spec> --> <default> <test spec> | <empty>
<test spec> --> <test>
| <test> <true substitute>
| <test> <true substitute> <false substitute>
| <empty>
<proc> --> eq? | eqv? | equal? | <other equivalence predicate>
<keyword> --> <any scheme object>
<variable> --> <identifier>
<default>, <test>, <true substitute>, <false substitute> --> <expression>
The qlambda* is to the qlambda what the let* is to the let. The <default>s,
<test>s, <true substitute>s, and <false substitute>s of qlambda* are evaluated
in an environment that all the bindings of previous <variable>s are visible.
There are three kinds of required variables, namely, required fixed variable,
required non-fixed unnamed variable, and required non-fixed named variable.
They determine the number of required actual arguments, that is, the minimum
arity of the resulting procedure.
The required fixed variables are bound to successive actual arguments starting
with the first actual argument. If there is a <test>, it is evaluated. If it
returns a false value and there is no <false substitute>, an error is
signaled. If it returns a false value and there is a <false substitute>, the
variable is rebound to the result of evaluating <false substitute> instead of
signaling an error. If it returns a true value and there is a <true
substitute>, the variable is rebound to the result of evaluating <true
substitute>.
The required non-fixed unnamed variable is temporarily bound to each of
remaining required actual arguments sequentially, until <test> returns a true
value, then the variable is finally bound to the passed argument. If there is
no <test>, the first one of the remaining required actual arguments is
regarded as passing. If any actual argument does not pass <test>, an error is
signaled. If there is a <false substitute> and <test> returns a false value,
the variable is finally bound to the result of evaluating <false substitute>
instead of the above process. If there is a <true substitute> and <test>
returns a true value, the variable is rebound to the result of evaluating
<true substitute>.
The keyword used at a call site for the corresponding variable is a symbol of
the same name as the variable. But the keyword can be any scheme object when
the required parameter is specified as a double parenthesized variable and a
keyword, or a double parenthesized variable, a keyword, and a equivalence
predicate. If a particular equivalence predicate is not specified, the
default predicate is `eq?'. The remaining required actual arguments must be
an even number. They are sequentially interpreted as a series of pairs, where
the first member of each pair is a keyword corresponding to the variable, and
the second is the corresponding value. If there is no element for a
particular keyword, an error is signaled. When there is a <test>, it is
evaluated. If it returns a false value and there is no <false substitute>, an
error is signaled. If it returns a false value and there is a <false
substitute>, the variable is rebound to the result of evaluating <false
substitute> instead of signaling an error. If it returns a true value and
there is a <true substitute>, the variable is rebound to the result of
evaluating <true substitute>.
The binding method of the optional fixed variables is the same as that of the
required fixed variables except that each variable is bound to the result of
evaluating <default> instead of signaling an error if there are no remaining
actual arguments. If <default> is not specified, #f is the default.
The binding method the optional non-fixed unnamed variables is the same as
that of the required non-fixed unnamed variables except that each variable is
bound to the result of evaluating <default> instead of signaling an error if
any actual argument does not pass <test>. If <default> is not specified, #f
is the default.
The binding method of the optional non-fixed named variables is the same as
that of the required non-fixed named variables except that each variable is
bound to the result of evaluating <default> instead of signaling an error if
there is no corresponding value to the particular keyword. If <default> is
not specified, #f is the default.
When there are remaining actual arguments, an error is signaled if dotted rest
variable is not given. If dotted rest variable is given, it is bound to the
remaining actual arguments.
Examples
(define ranking
(qlambda (, (country 'Canada)
(('1st 1 =) "Ben Hur")
(('2nd 2 =) "Mission")
(('3rd 3 =) "Sting")
(('4th 4 =) "Escape"))
(list country 1st 2nd 3rd 4th)))
(ranking) => (Canada "Ben Hur" "Mission" "Sting" "Escape")
(ranking 'Canada 2 "Sting" 3 "Mission")
=> (Canada "Ben Hur" "Sting" "Mission" "Escape")
(ranking 'USA 4 "Mission Impossible")
=> (USA "Ben Hur" "Mission" "Sting" "Mission Impossible")
Implementation
The following implementation is written in R5RS hygienic macros and requires
SRFI-23 (Error reporting mechanism).
;;; auxilliaries
(define-syntax wow-opt
(syntax-rules ()
((wow-opt n v)
v)
((wow-opt n v t)
(let ((n v))
(if t n (error "qlambda[*]: bad argument" n 'n 't))))
((wow-opt n v t ts)
(let ((n v))
(if t ts (error "qlambda[*]: bad argument" n 'n 't))))
((wow-opt n v t ts fs)
(let ((n v))
(if t ts fs)))))
(define-syntax wow-cat!
(syntax-rules ()
((wow-cat! z n d)
(let ((n (car z)))
(set! z (cdr z)) n))
((wow-cat! z n d t)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) n)
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
d
(let ((n (car tail)))
(if t
(begin (set! z (append (reverse head) (cdr tail))) n)
(lp (cons n head) (cdr tail)))))))))
((wow-cat! z n d t ts)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
d
(let ((n (car tail)))
(if t
(begin (set! z (append (reverse head) (cdr tail))) ts)
(lp (cons n head) (cdr tail)))))))))
((wow-cat! z n d t ts fs)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(begin (set! z (cdr z)) fs))))))
(define-syntax wow-key!
(syntax-rules ()
((wow-key! z (n key p) d)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (p key x)
(begin (set! z (cdr y)) (car y))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (p key x)
(begin (set! z (append (reverse head) (cdr y)))
(car y))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (n key p) d t)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) n)
(error "qlambda[*]: bad argument" n 'n 't)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
n)
(error "qlambda[*]: bad argument"
n 'n 't)))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (n key p) d t ts)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(error "qlambda[*]: bad argument" n 'n 't)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(error "qlambda[*] bad argument"
n 'n 't)))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))
((wow-key! z (n key p) d t ts fs)
(let ((x (car z))
(y (cdr z)))
(if (null? y)
d
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(begin (set! z (cdr y)) fs)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
d
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
d
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(begin (set! z (append (reverse head)
(cdr y)))
fs)))
(lp (cons (car y) (cons x head))
(cdr y)))))))))))))
(define-syntax req-cat!
(syntax-rules ()
((req-cat! z n)
(let ((n (car z)))
(set! z (cdr z)) n))
((req-cat! z n t)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) n)
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
(error "qlambda[*]: bad arguments" (reverse head) 'n 't)
(let ((n (car tail)))
(if t
(begin (set! z (append (reverse head) (cdr tail))) n)
(lp (cons n head) (cdr tail)))))))))
((req-cat! z n t ts)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(let lp ((head (list n)) (tail (cdr z)))
(if (null? tail)
(error "qlambda[*]: bad arguments" (reverse head) 'n 't)
(let ((n (car tail)))
(if t
(begin (set! z (append (reverse head) (cdr tail))) ts)
(lp (cons n head) (cdr tail)))))))))
((req-cat! z n t ts fs)
(let ((n (car z)))
(if t
(begin (set! z (cdr z)) ts)
(begin (set! z (cdr z)) fs))))))
(define-syntax req-key!
(syntax-rules ()
((req-key! z (n key p))
(let ((x (car z))
(y (cdr z)))
(if (p key x)
(begin (set! z (cdr y)) (car y))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
(error "qlambda[*]: no corresponding value to key"
key (reverse head))
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
(error "qlambda[*]: no corresponding value to key"
key (append (reverse head) tail))
(if (p key x)
(begin (set! z (append (reverse head) (cdr y)))
(car y))
(lp (cons (car y) (cons x head)) (cdr y))))))))))
((req-key! z (n key p) t)
(let ((x (car z))
(y (cdr z)))
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) n)
(error "qlambda[*]: bad argument" n 'n 't)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
(error "qlambda[*]: no corresponding value to key"
key (reverse head))
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
(error "qlambda[*]: no corresponding value to key"
key (append (reverse head) tail))
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
n)
(error "qlambda[*]: bad argument" n 'n 't)))
(lp (cons (car y) (cons x head)) (cdr y))))))))))
((req-key! z (n key p) t ts)
(let ((x (car z))
(y (cdr z)))
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(error "qlambda[*]: bad argument" n 'n 't)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
(error "qlambda[*]: no corresponding value to key"
key (reverse head))
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
(error "qlambda[*]: no corresponding value to key"
key (append (reverse head) tail))
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(error "qlambda[*]: bad argument" n 'n 't)))
(lp (cons (car y) (cons x head)) (cdr y))))))))))
((req-key! z (n key p) t ts fs)
(let ((x (car z))
(y (cdr z)))
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (cdr y)) ts)
(begin (set! z (cdr y)) fs)))
(let lp ((head (list (car y) x)) (tail (cdr y)))
(if (null? tail)
(error "qlambda[*]: no corresponding value to key"
key (reverse head))
(let ((x (car tail))
(y (cdr tail)))
(if (null? y)
(error "qlambda[*]: no corresponding value to key"
key (append (reverse head) tail))
(if (p key x)
(let ((n (car y)))
(if t
(begin (set! z (append (reverse head)
(cdr y)))
ts)
(begin (set! z (append (reverse head)
(cdr y)))
fs)))
(lp (cons (car y) (cons x head)) (cdr y))))))))))))
(define-syntax opt-key-cat
(syntax-rules ()
((opt-key-cat z (nd ...) ((n d t ...) odt ...) kdt cdt e bd ...)
(let ((y (if (null? z) z (cdr z)))
(x (if (null? z)
d
(wow-opt n (car z) t ...))))
(opt-key-cat y (nd ... (n x)) (odt ...) kdt cdt e bd ...)))
((opt-key-cat z (nd ...) () (((n k p) d t ...) kdt ...) cdt e bd ...)
(let ((x (if (null? z)
d
(wow-key! z (n k p) d t ...))))
(opt-key-cat z (nd ... (n x)) () (kdt ...) cdt e bd ...)))
((opt-key-cat z (nd ...) () () ((n d t ...) cdt ...) e bd ...)
(let ((x (if (null? z)
d
(wow-cat! z n d t ...))))
(opt-key-cat z (nd ... (n x)) () () (cdt ...) e bd ...)))
((opt-key-cat z (nd ...) () () () () bd ...)
(if (null? z)
(let (nd ...) bd ...)
(error "qlambda: too many arguments" z)))
((opt-key-cat z (nd ...) () () () e bd ...)
(let (nd ... (e z)) bd ...))))
(define-syntax opt-key-cat*
(syntax-rules ()
((opt-key-cat* z ((n d t ...) odt ...) kdt cdt e bd ...)
(let ((y (if (null? z) z (cdr z)))
(n (if (null? z)
d
(wow-opt n (car z) t ...))))
(opt-key-cat* y (odt ...) kdt cdt e bd ...)))
((opt-key-cat* z () (((n k p) d t ...) kdt ...) cdt e bd ...)
(let ((n (if (null? z)
d
(wow-key! z (n k p) d t ...))))
(opt-key-cat* z () (kdt ...) cdt e bd ...)))
((opt-key-cat* z () () ((n d t ...) cdt ...) e bd ...)
(let ((n (if (null? z)
d
(wow-cat! z n d t ...))))
(opt-key-cat* z () () (cdt ...) e bd ...)))
((opt-key-cat* z () () () () bd ...)
(if (null? z)
(let () bd ...)
(error "qlambda*: too many arguments" z)))
((opt-key-cat* z () () () e bd ...)
(let ((e z)) bd ...))))
;; (define-syntax opt-keycat
;; (syntax-rules ()
;; ((opt-keycat z (nd ...) (((n k p) d t ...) . e) bd ...)
;; (let ((x (if (null? z)
;; d
;; (wow-key! z (n k p) d t ...))))
;; (opt-keycat z (nd ... (n x)) e bd ...)))
;; ((opt-keycat z (nd ...) (((n) d t ...) . e) bd ...)
;; (let ((x (if (null? z)
;; d
;; (wow-cat! z n d t ...))))
;; (opt-keycat z (nd ... (n x)) e bd ...)))
;; ((opt-keycat z (nd ...) ((n d t ...) . e) bd ...)
;; (let ((y (if (null? z) z (cdr z)))
;; (x (if (null? z)
;; d
;; (wow-opt n (car z) t ...))))
;; (opt-keycat y (nd ... (n x)) e bd ...)))
;; ((opt-keycat z (nd ...) () bd ...)
;; (if (null? z)
;; (let (nd ...) bd ...)
;; (error "qlambda: too many arguments" z)))
;; ((opt-keycat z (nd ...) e bd ...)
;; (let (nd ... (e z)) bd ...))))
;; (define-syntax opt-keycat*
;; (syntax-rules ()
;; ((opt-keycat* z (((n k p) d t ...) . e) bd ...)
;; (let ((n (if (null? z)
;; d
;; (wow-key! z (n k p) d t ...))))
;; (opt-keycat* z e bd ...)))
;; ((opt-keycat* z (((n) d t ...) . e) bd ...)
;; (let ((n (if (null? z)
;; d
;; (wow-cat! z n d t ...))))
;; (opt-keycat* z e bd ...)))
;; ((opt-keycat* z ((n d t ...) . e) bd ...)
;; (let ((y (if (null? z) z (cdr z)))
;; (n (if (null? z)
;; d
;; (wow-opt n (car z) t ...))))
;; (opt-keycat* y e bd ...)))
;; ((opt-keycat* z () bd ...)
;; (if (null? z)
;; (let () bd ...)
;; (error "qlambda*: too many arguments" z)))
;; ((opt-keycat* z e bd ...)
;; (let ((e z)) bd ...))))
;;; main
(define-syntax qlambda
(syntax-rules ()
((qlambda (g . e) bd ...)
(%a% () () () () () (g . e) () () () () bd ...))
((qlambda e bd ...)
(lambda e bd ...))))
(define-syntax %a%
(syntax-rules (quote quasiquote unquote)
((%a% i j rr rk rc (, (('n w p) d t ...) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n w p) d t ...)) () bd ...))
((%a% i j rr rk rc (, (('n w) d t ...) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n w eq?) d t ...)) () bd ...))
((%a% i j rr rk rc (, (('n w p)) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n w p) #f)) () bd ...))
((%a% i j rr rk rc (, (('n w)) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n w eq?) #f)) () bd ...))
((%a% i j rr rk rc (, ('n d t ...) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n 'n eq?) d t ...)) () bd ...))
((%a% i j rr rk rc (, (`n d t ...) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () () ((n d t ...)) bd ...))
((%a% i j rr rk rc (, ('n) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n 'n eq?) #f)) () bd ...))
((%a% i j rr rk rc (, (`n) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () () ((n #f)) bd ...))
((%a% i j rr rk rc (, 'n . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () (((n 'n eq?) #f)) () bd ...))
((%a% i j rr rk rc (, `n . e) () () () () bd ...)
(%a% i j rr rk rc e (()) () () ((n #f)) bd ...))
((%a% i j rr rk rc (, (n d t ...) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) ((n d t ...)) () () bd ...))
((%a% i j rr rk rc (, (n) . e) () () () () bd ...)
(%a% i j rr rk rc e (()) ((n #f)) () () bd ...))
((%a% i j rr rk rc (, n . e) () () () () bd ...)
(%a% i j rr rk rc e (()) ((n #f)) () () bd ...))
((%a% i (j ...) rr (rk ...) () ((('n w p) t ...) . e) () o k c bd ...)
(%a% i (j ... j1 j2) rr (rk ... ((n w p) t ...)) () e () o k c bd ...))
((%a% i (j ...) rr (rk ...) () ((('n w) t ...) . e) () o k c bd ...)
(%a% i (j ... j1 j2) rr (rk ... ((n w eq?) t ...)) () e () o k c bd ...))
((%a% i (j ...) rr (rk ...) () (('n t ...) . e) () o k c bd ...)
(%a% i (j ... j1 j2) rr (rk ... ((n 'n eq?) t ...)) () e () o k c bd ...))
((%a% i (j ...) rr () (rc ...) ((`n t ...) . e) () o k c bd ...)
(%a% i (j ... j1) rr () (rc ... (n t ...)) e () o k c bd ...))
((%a% i (j ...) rr (rk ...) () ('n . e) () o k c bd ...)
(%a% i (j ... j1 j2) rr (rk ... ((n 'n eq?))) () e () o k c bd ...))
((%a% i (j ...) rr () (rc ...) (`n . e) () o k c bd ...)
(%a% i (j ... j1) rr () (rc ... (n)) e () o k c bd ...))
((%a% (i ...) () (rr ...) () () ((n t ...) . e) () o k c bd ...)
(%a% (i ... i1) () (rr ... (n t ...)) () () e () o k c bd ...))
((%a% (i ...) () (rr ...) () () (n . e) () o k c bd ...)
(%a% (i ... i1) () (rr ... (n)) () () e () o k c bd ...))
((%a% i j rr rk rc ((('n w p) d t ...) . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n w p) d t ...)) () bd ...))
((%a% i j rr rk rc ((('n w) d t ...) . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n w eq?) d t ...)) () bd ...))
((%a% i j rr rk rc ((('n w p)) . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n w p) #f)) () bd ...))
((%a% i j rr rk rc ((('n w)) . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n w eq?) #f)) () bd ...))
((%a% i j rr rk rc (('n d t ...) . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n 'n eq?) d t ...)) () bd ...))
((%a% i j rr rk rc ((`n d t ...) . e) (()) o () (c ...) bd ...)
(%a% i j rr rk rc e (()) o () (c ... (n d t ...)) bd ...))
((%a% i j rr rk rc (('n) . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n 'n eq?) #f)) () bd ...))
((%a% i j rr rk rc ((`n) . e) (()) o () (c ...) bd ...)
(%a% i j rr rk rc e (()) o () (c ... (n #f)) bd ...))
((%a% i j rr rk rc ('n . e) (()) o (k ...) () bd ...)
(%a% i j rr rk rc e (()) o (k ... ((n 'n eq?) #f)) () bd ...))
((%a% i j rr rk rc (`n . e) (()) o () (c ...) bd ...)
(%a% i j rr rk rc e (()) o () (c ... (n #f)) bd ...))
((%a% i j rr rk rc ((n d t ...) . e) (()) (o ...) () () bd ...)
(%a% i j rr rk rc e (()) (o ... (n d t ...)) () () bd ...))
((%a% i j rr rk rc ((n) . e) (()) (o ...) () () bd ...)
(%a% i j rr rk rc e (()) (o ... (n #f)) () () bd ...))
((%a% i j rr rk rc (n . e) (()) (o ...) () () bd ...)
(%a% i j rr rk rc e (()) (o ... (n #f)) () () bd ...))
;; main
((%a% i () ((n) ...) () () e () () () () bd ...)
(lambda (n ... . e) bd ...))
((%a% (i ...) () ((n) ...) () () e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (i ... . te)
(opt-key-cat te ((n i) ...) (o ...) (k ...) (c ...) e bd ...)))
((%a% (i ...) () ((n t ...) ...) () () () () () () () bd ...)
(lambda (i ...)
(let ((n (wow-opt n i t ...)) ...) bd ...)))
((%a% (i ...) () ((n t ...) ...) () () e () () () () bd ...)
(lambda (i ... . te)
(let ((n (wow-opt n i t ...)) ... (e te)) bd ...)))
((%a% (i ...) () ((n t ...) ...) ()
() e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (i ... . te)
(opt-key-cat te ((n (wow-opt n i t ...)) ...)
(o ...) (k ...) (c ...) e bd ...)))
((%a% (i ...) (j ...) ((n) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) () () () () () bd ...)
(lambda (i ... j ...)
(let ((zz (list j ...)))
(let ((n i) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
bd ...))))
((%a% (i ...) (j ...) ((n) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e () () () () bd ...)
(lambda (i ... j ... . te)
(let ((zz (list j ...)))
(let ((n i) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...
(e te))
bd ...))))
((%a% (i ...) (j ...) ((n) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (i ... j ... . te)
(let ((zz (list j ...)))
(opt-key-cat te ((n i) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
(o ...) (k ...) (c ...) e bd ...))))
((%a% (i ...) (j ...) ((n t ...) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) () () () () () bd ...)
(lambda (i ... j ...)
(let ((zz (list j ...)))
(let ((n (wow-opt n i t ...)) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
bd ...))))
((%a% (i ...) (j ...) ((n t ...) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e () () () () bd ...)
(lambda (i ... j ... . te)
(let ((zz (list j ...)))
(let ((n (wow-opt n i t ...)) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...
(e te))
bd ...))))
((%a% (i ...) (j ...) ((n t ...) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (i ... j ... . te)
(let ((zz (list j ...)))
(opt-key-cat te ((n (wow-opt n i t ...)) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
(o ...) (k ...) (c ...) e bd ...))))))
(define-syntax qlambda*
(syntax-rules ()
((qlambda* (g . e) bd ...)
(%b% () () () () () (g . e) () () () () bd ...))
((qlambda* e bd ...)
(lambda e bd ...))))
(define-syntax %b%
(syntax-rules (quote quasiquote unquote)
((%b% i j rr rk rc (, (('n w p) d t ...) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n w p) d t ...)) () bd ...))
((%b% i j rr rk rc (, (('n w) d t ...) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n w eq?) d t ...)) () bd ...))
((%b% i j rr rk rc (, (('n w p)) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n w p) #f)) () bd ...))
((%b% i j rr rk rc (, (('n w)) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n w eq?) #f)) () bd ...))
((%b% i j rr rk rc (, ('n d t ...) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n 'n eq?) d t ...)) () bd ...))
((%b% i j rr rk rc (, (`n d t ...) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () () ((n d t ...)) bd ...))
((%b% i j rr rk rc (, ('n) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n 'n eq?) #f)) () bd ...))
((%b% i j rr rk rc (, (`n) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () () ((n #f)) bd ...))
((%b% i j rr rk rc (, 'n . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () (((n 'n eq?) #f)) () bd ...))
((%b% i j rr rk rc (, `n . e) () () () () bd ...)
(%b% i j rr rk rc e (()) () () ((n #f)) bd ...))
((%b% i j rr rk rc (, (n d t ...) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) ((n d t ...)) () () bd ...))
((%b% i j rr rk rc (, (n) . e) () () () () bd ...)
(%b% i j rr rk rc e (()) ((n #f)) () () bd ...))
((%b% i j rr rk rc (, n . e) () () () () bd ...)
(%b% i j rr rk rc e (()) ((n #f)) () () bd ...))
((%b% i (j ...) rr (rk ...) () ((('n w p) t ...) . e) () o k c bd ...)
(%b% i (j ... j1 j2) rr (rk ... ((n w p) t ...)) () e () o k c bd ...))
((%b% i (j ...) rr (rk ...) () ((('n w) t ...) . e) () o k c bd ...)
(%b% i (j ... j1 j2) rr (rk ... ((n w eq?) t ...)) () e () o k c bd ...))
((%b% i (j ...) rr (rk ...) () (('n t ...) . e) () o k c bd ...)
(%b% i (j ... j1 j2) rr (rk ... ((n 'n eq?) t ...)) () e () o k c bd ...))
((%b% i (j ...) rr () (rc ...) ((`n t ...) . e) () o k c bd ...)
(%b% i (j ... j1) rr () (rc ... (n t ...)) e () o k c bd ...))
((%b% i (j ...) rr (rk ...) () ('n . e) () o k c bd ...)
(%b% i (j ... j1 j2) rr (rk ... ((n 'n eq?))) () e () o k c bd ...))
((%b% i (j ...) rr () (rc ...) (`n . e) () o k c bd ...)
(%b% i (j ... j1) rr () (rc ... (n)) e () o k c bd ...))
((%b% (i ...) () (rr ...) () () ((n t ...) . e) () o k c bd ...)
(%b% (i ... i1) () (rr ... (n t ...)) () () e () o k c bd ...))
((%b% (i ...) () (rr ...) () () (n . e) () o k c bd ...)
(%b% (i ... i1) () (rr ... (n)) () () e () o k c bd ...))
((%b% i j rr rk rc ((('n w p) d t ...) . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n w p) d t ...)) () bd ...))
((%b% i j rr rk rc ((('n w) d t ...) . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n w eq?) d t ...)) () bd ...))
((%b% i j rr rk rc ((('n w p)) . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n w p) #f)) () bd ...))
((%b% i j rr rk rc ((('n w)) . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n w eq?) #f)) () bd ...))
((%b% i j rr rk rc (('n d t ...) . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n 'n eq?) d t ...)) () bd ...))
((%b% i j rr rk rc ((`n d t ...) . e) (()) o () (c ...) bd ...)
(%b% i j rr rk rc e (()) o () (c ... (n d t ...)) bd ...))
((%b% i j rr rk rc (('n) . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n 'n eq?) #f)) () bd ...))
((%b% i j rr rk rc ((`n) . e) (()) o () (c ...) bd ...)
(%b% i j rr rk rc e (()) o () (c ... (n #f)) bd ...))
((%b% i j rr rk rc ('n . e) (()) o (k ...) () bd ...)
(%b% i j rr rk rc e (()) o (k ... ((n 'n eq?) #f)) () bd ...))
((%b% i j rr rk rc (`n . e) (()) o () (c ...) bd ...)
(%b% i j rr rk rc e (()) o () (c ... (n #f)) bd ...))
((%b% i j rr rk rc ((n d t ...) . e) (()) (o ...) () () bd ...)
(%b% i j rr rk rc e (()) (o ... (n d t ...)) () () bd ...))
((%b% i j rr rk rc ((n) . e) (()) (o ...) () () bd ...)
(%b% i j rr rk rc e (()) (o ... (n #f)) () () bd ...))
((%b% i j rr rk rc (n . e) (()) (o ...) () () bd ...)
(%b% i j rr rk rc e (()) (o ... (n #f)) () () bd ...))
;; main
((%b% i () ((n) ...) () () e () () () () bd ...)
(lambda (n ... . e) bd ...))
((%b% i () ((n) ...) () () e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (n ... . te)
(opt-key-cat* te (o ...) (k ...) (c ...) e bd ...)))
((%b% (i ...) () ((n t ...) ...) () () () () () () () bd ...)
(lambda (i ...)
(let* ((n (wow-opt n i t ...)) ...) bd ...)))
((%b% (i ...) () ((n t ...) ...) () () e () () () () bd ...)
(lambda (i ... . te)
(let* ((n (wow-opt n i t ...)) ... (e te)) bd ...)))
((%b% (i ...) () ((n t ...) ...) ()
() e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (i ... . te)
(let* ((n (wow-opt n i t ...)) ...)
(opt-key-cat* te (o ...) (k ...) (c ...) e bd ...))))
((%b% i (j ...) ((n) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) () () () () () bd ...)
(lambda (n ... j ...)
(let ((zz (list j ...)))
(let* ((rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
bd ...))))
((%b% i (j ...) ((n) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e () () () () bd ...)
(lambda (n ... j ... . te)
(let ((zz (list j ...)))
(let* ((rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...
(e te))
bd ...))))
((%b% i (j ...) ((n) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (n ... j ... . te)
(let ((zz (list j ...)))
(let* ((rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
(opt-key-cat* te (o ...) (k ...) (c ...) e bd ...)))))
((%b% (i ...) (j ...) ((n t ...) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) () () () () () bd ...)
(lambda (i ... j ...)
(let ((zz (list j ...)))
(let* ((n (wow-opt n i t ...)) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
bd ...))))
((%b% (i ...) (j ...) ((n t ...) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e () () () () bd ...)
(lambda (i ... j ... . te)
(let ((zz (list j ...)))
(let* ((n (wow-opt n i t ...)) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...
(e te))
bd ...))))
((%b% (i ...) (j ...) ((n t ...) ...) (((rk w p) tt ...) ...)
((rc rt ...) ...) e (()) (o ...) (k ...) (c ...) bd ...)
(lambda (i ... j ... . te)
(let ((zz (list j ...)))
(let* ((n (wow-opt n i t ...)) ...
(rk (req-key! zz (rk w p) tt ...)) ...
(rc (req-cat! zz rc rt ...)) ...)
(opt-key-cat* te (o ...) (k ...) (c ...) e bd ...)))))))
;;; eof
References
[R5RS] Richard Kelsey, William Clinger, and Jonathan Rees: Revised(5)
Report on the Algorithmic Language Scheme
http://www.schemers.org/Documents/Standards/R5Rs/
[SRFI 86] Joo ChurlSoo: MU and NU simulating VALUES & CALL-WITH-VALUES,
and their related LET-syntax.
http://srfi.schemers.org/srfi-86/
[SRFI 89] Marc Feeley: Optional and named parameters.
http://srfi.schemers.org/srfi-89/
Copyright
Copyright (c) 2006 Joo ChurlSoo.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the ``Software''), to
deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.