mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
adding opt-lambda* and define-opt*
This commit is contained in:
parent
0fbd89dd00
commit
378b56a0c3
3 changed files with 42 additions and 8 deletions
|
@ -47,6 +47,16 @@
|
||||||
((opt-lambda (a (b 11) (c 12))
|
((opt-lambda (a (b 11) (c 12))
|
||||||
(list a b c))
|
(list a b c))
|
||||||
0))
|
0))
|
||||||
|
(test '(0 11 2)
|
||||||
|
(let ((b 1))
|
||||||
|
((opt-lambda (a (b 11) (c (* b 2)))
|
||||||
|
(list a b c))
|
||||||
|
0)))
|
||||||
|
(test '(0 11 22)
|
||||||
|
(let ((b 1))
|
||||||
|
((opt-lambda* (a (b 11) (c (* b 2)))
|
||||||
|
(list a b c))
|
||||||
|
0)))
|
||||||
(test '(0 1 (2 3 4))
|
(test '(0 1 (2 3 4))
|
||||||
(let-optionals* '(0 1 2 3 4) ((a 10) (b 11) . c)
|
(let-optionals* '(0 1 2 3 4) ((a 10) (b 11) . c)
|
||||||
(list a b c)))
|
(list a b c)))
|
||||||
|
|
|
@ -71,16 +71,26 @@
|
||||||
(define-syntax opt-lambda
|
(define-syntax opt-lambda
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((opt-lambda vars . body)
|
((opt-lambda vars . body)
|
||||||
(opt-lambda/aux () vars . body))))
|
(opt-lambda/aux let-optionals () vars . body))))
|
||||||
|
|
||||||
|
;;> \macro{(opt-lambda* ((var default) ... [rest]) body ...)}
|
||||||
|
;;>
|
||||||
|
;;> Variant of \scheme{opt-lambda} which binds using
|
||||||
|
;;> \scheme{let-optionals*}.
|
||||||
|
|
||||||
|
(define-syntax opt-lambda*
|
||||||
|
(syntax-rules ()
|
||||||
|
((opt-lambda* vars . body)
|
||||||
|
(opt-lambda/aux let-optionals* () vars . body))))
|
||||||
|
|
||||||
(define-syntax opt-lambda/aux
|
(define-syntax opt-lambda/aux
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((opt-lambda/aux (args ...) ((var . default) . vars) . body)
|
((opt-lambda/aux let-opt (args ...) ((var . default) . vars) . body)
|
||||||
(lambda (args ... . o)
|
(lambda (args ... . o)
|
||||||
(let-optionals o ((var . default) . vars) . body)))
|
(let-opt o ((var . default) . vars) . body)))
|
||||||
((opt-lambda/aux (args ...) (var . vars) . body)
|
((opt-lambda/aux let-opt (args ...) (var . vars) . body)
|
||||||
(opt-lambda/aux (args ... var) vars . body))
|
(opt-lambda/aux let-opt (args ... var) vars . body))
|
||||||
((opt-lambda/aux (args ...) () . body)
|
((opt-lambda/aux let-op (args ...) () . body)
|
||||||
(lambda (args ... . o)
|
(lambda (args ... . o)
|
||||||
. body))))
|
. body))))
|
||||||
|
|
||||||
|
@ -95,6 +105,17 @@
|
||||||
((define-opt (name . vars) . body)
|
((define-opt (name . vars) . body)
|
||||||
(define name (opt-lambda vars . body)))))
|
(define name (opt-lambda vars . body)))))
|
||||||
|
|
||||||
|
;;> \macro{(define-opt* (name (var default) ... [rest]) body ...)}
|
||||||
|
;;>
|
||||||
|
;;> Shorthand for
|
||||||
|
;;> \schemeblock{
|
||||||
|
;;> (define name (opt-lambda* (var default) ... [rest]) body ...)}
|
||||||
|
|
||||||
|
(define-syntax define-opt*
|
||||||
|
(syntax-rules ()
|
||||||
|
((define-opt* (name . vars) . body)
|
||||||
|
(define name (opt-lambda* vars . body)))))
|
||||||
|
|
||||||
(define (mem-key key ls)
|
(define (mem-key key ls)
|
||||||
(and (pair? ls)
|
(and (pair? ls)
|
||||||
(pair? (cdr ls))
|
(pair? (cdr ls))
|
||||||
|
|
|
@ -1,7 +1,10 @@
|
||||||
|
|
||||||
(define-library (chibi optional)
|
(define-library (chibi optional)
|
||||||
(export let-optionals let-optionals* opt-lambda define-opt
|
(export let-optionals let-optionals*
|
||||||
let-keywords let-keywords* keyword-ref keyword-ref*)
|
opt-lambda opt-lambda*
|
||||||
|
define-opt define-opt*
|
||||||
|
let-keywords let-keywords*
|
||||||
|
keyword-ref keyword-ref*)
|
||||||
(cond-expand
|
(cond-expand
|
||||||
(chibi
|
(chibi
|
||||||
(import (chibi))
|
(import (chibi))
|
||||||
|
|
Loading…
Add table
Reference in a new issue