Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

simplify opt-lambda def; copy list tail for rest arguments

Browse source
This commit is contained in:
Alex Shinn 2021-11-25 22:01:59 +09:00
parent f29af14e2e
commit 6e636594a5
4 changed files with 9 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lib/chibi/optional-test.sld
View file

@ -73,6 +73,11 @@
(let-optionals* ls ((a (begin (set! ls '(a b)) 'default-a))
(b 'default-b))
(test '(default-a default-b) (list a b))))
(let ((ls (list 0 1 2)))
(let-optionals ls (a . b)
(set-car! (cdr ls) 3)
(test '(0 3 2) ls)
(test '(0 1 2) (cons a b))))
(test 5 (keyword-ref '(a: b: b: 5) 'b: #f))
(test 5 (keyword-ref* '(a: b: b: 5) 'b: #f))
(cond-expand

15
lib/chibi/optional.scm
View file

@ -76,7 +76,7 @@
(define-syntax opt-lambda
(syntax-rules ()
((opt-lambda vars . body)
(opt-lambda/aux let-optionals () vars . body))))
(lambda args (let-optionals args vars . body)))))
;;> \macro{(opt-lambda* ((var default) ... [rest]) body ...)}
;;>
@ -86,18 +86,7 @@
(define-syntax opt-lambda*
(syntax-rules ()
((opt-lambda* vars . body)
(opt-lambda/aux let-optionals* () vars . body))))
(define-syntax opt-lambda/aux
(syntax-rules ()
((opt-lambda/aux let-opt (args ...) ((var . default) . vars) . body)
(lambda (args ... . o)
(let-opt o ((var . default) . vars) . body)))
((opt-lambda/aux let-opt (args ...) (var . vars) . body)
(opt-lambda/aux let-opt (args ... var) vars . body))
((opt-lambda/aux let-op (args ...) () . body)
(lambda (args ... . o)
. body))))
(lambda args (let-optionals* args vars . body)))))
;;> \macro{(define-opt (name (var default) ... [rest]) body ...)}
;;>

2
lib/chibi/optional.sld
View file

@ -36,7 +36,7 @@
(var (if (pair? tmp) (car tmp) default)))
(let-optionals* tmp2 rest . body)))
((let-optionals* tmp tail . body)
(let ((tail tmp)) . body))))
(let ((tail (list-copy tmp))) . body))))
(define-syntax symbol->keyword*
(syntax-rules ()
((symbol->keyword* sym)

2
lib/init-7.scm
View file

@ -1146,7 +1146,7 @@
(let ((var (car tmp)))
(let-optionals* (cdr tmp) rest . body)))
((let-optionals* tmp tail . body)
(let ((tail tmp)) . body))))
(let ((tail (list-copy tmp))) . body))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; exceptions