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

allow non-optional bindings in let-optionals[*]

Browse source
This commit is contained in:
Alex Shinn 2021-11-25 00:14:15 +09:00
parent 7a6aae39a0
commit 1eee928e67
3 changed files with 16 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -63,6 +63,12 @@
(test '(0 1 (2 3 4))
(let-optionals '(0 1 2 3 4) ((a 10) (b 11) . c)
(list a b c)))
(test '(0 1 (2 3 4))
(let-optionals* '(0 1 2 3 4) (a (b 11) . c)
(list a b c)))
(test '(0 1 (2 3 4))
(let-optionals '(0 1 2 3 4) (a (b 11) . c)
(list a b c)))
(let ((ls '()))
(let-optionals* ls ((a (begin (set! ls '(a b)) 'default-a))
(b 'default-b))

12
lib/chibi/optional.scm
View file

@ -9,9 +9,11 @@
(define-syntax let*-to-let
(syntax-rules ()
((let*-to-let letstar ls (vars ...) ((v . d) . rest) . body)
(let*-to-let letstar ls (vars ... (v tmp . d)) rest . body))
((let*-to-let letstar ls ((var tmp . d) ...) rest . body)
(letstar ls ((tmp . d) ... . rest)
(let*-to-let letstar ls (vars ... (v tmp (tmp . d))) rest . body))
((let*-to-let letstar ls (vars ...) (v . rest) . body)
(let*-to-let letstar ls (vars ... (v tmp tmp)) rest . body))
((let*-to-let letstar ls ((var tmp bind) ...) rest . body)
(letstar ls (bind ... . rest)
(let ((var tmp) ...) . body)))))
;;> \macro{(let-optionals ls ((var default) ... [rest]) body ...)}
@ -54,8 +56,8 @@
(define-syntax let-optionals
(syntax-rules ()
((let-optionals ls ((var default) ... . rest) body ...)
(let*-to-let let-optionals* ls () ((var default) ... . rest) body ...))))
((let-optionals ls (var&default ... . rest) body ...)
(let*-to-let let-optionals* ls () (var&default ... . rest) body ...))))
;;> \macro{(let-optionals* ls ((var default) ... [rest]) body ...)}
;;>

3
lib/init-7.scm
View file

@ -1142,6 +1142,9 @@
(let ((var (if (pair? tmp) (car tmp) default))
(tmp2 (if (pair? tmp) (cdr tmp) '())))
(let-optionals* tmp2 rest . body)))
((let-optionals* tmp (var . rest) . body)
(let ((var (car tmp)))
(let-optionals* (cdr tmp) rest . body)))
((let-optionals* tmp tail . body)
(let ((tail tmp)) . body))))