Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 03:36:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Fixing rest handling of let-keywords to only include unknown keys.

Browse source
This commit is contained in:
Alex Shinn 2014-07-16 22:33:13 +09:00
parent eb5cce75ce
commit 931233a844
1 changed files with 42 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
lib/chibi/optional.scm
View file

@ -44,6 +44,7 @@
;;> (eof-object? b))) ;;> (eof-object? b)))
;;> (write-u8 b out)))} ;;> (write-u8 b out)))}
;;> ;;>
;;> \emph{Example:}
;;> \example{ ;;> \example{
;;> (let-optionals '(0) ((a 10) (b 11) (c 12)) ;;> (let-optionals '(0) ((a 10) (b 11) (c 12))
;;> (list a b c))} ;;> (list a b c))}
@ -126,9 +127,13 @@
;;> is not found, \var{var} is bound to \var{default}, even if unused ;;> is not found, \var{var} is bound to \var{default}, even if unused
;;> names remain in \var{ls}. ;;> names remain in \var{ls}.
;;> ;;>
;;> Note Chibi does not have any automatically quoted keywords, so ;;> If an optional trailing identifier \var{rest} is provided, it is
;;> when passing keyword arguments they must be quoted (or otherwise ;;> bound to the list of unused arguments not bound to any \var{var}.
;;> evaluated). ;;>
;;> Note R7RS does not have a disjoint keyword type or auto-quoting
;;> syntax for keywords - they are simply identifiers. Thus when
;;> passing keyword arguments they must be quoted (or otherwise
;;> dynamically evaluated).
;;> ;;>
;;> \emph{Example:} ;;> \emph{Example:}
;;> \example{ ;;> \example{
@ -142,13 +147,37 @@
;;> (make-person 'name: "Methuselah" 'age: 969) ;;> (make-person 'name: "Methuselah" 'age: 969)
;;> (make-person 'name: "Dr. Who" 'job: 'time-lord 'age: 1500)) ;;> (make-person 'name: "Dr. Who" 'job: 'time-lord 'age: 1500))
;;> } ;;> }
;;>
;;> \emph{Example:}
;;> \example{
;;> (let-keywords '(b: 2 a: 1 other: 9)
;;> ((a 0) (b 0) (c 0) rest)
;;> (list a b c rest))
;;> }
(define-syntax let-keywords (define-syntax let-keywords
(syntax-rules () (syntax-rules ()
((let-keywords ls vars . body) ((let-keywords ls vars . body)
(let-key*-to-let ls () vars . body)))) (let-key*-to-let ls () vars . body))))
;;> \macro{(let-keywords* ls ((var default) ... [rest]) body ...)} (define (remove-keywords ls keywords)
(let lp ((ls ls) (res '()))
(if (and (pair? ls) (pair? (cdr ls)))
(if (memq (car ls) keywords)
(lp (cddr ls) res)
(lp (cddr ls) (cons (cadr ls) (cons (car ls) res))))
(reverse res))))
(define-syntax remove-keywords*
(syntax-rules ()
((remove-keywords* opt-ls (keys ...) ((var key default) . rest))
(remove-keywords* opt-ls (keys ... key) rest))
((remove-keywords* opt-ls (keys ...) ((var default) . rest))
(remove-keywords* opt-ls (keys ... ,(symbol->keyword* 'var)) rest))
((remove-keywords* opt-ls (keys ...) ())
(remove-keywords opt-ls `(keys ...)))))
;;> \macro{(let-keywords* ls ((var [keyword] default) ... [rest]) body ...)}
;;> ;;>
;;> \scheme{let*} equivalent to \scheme{let-keywords*}. Any required ;;> \scheme{let*} equivalent to \scheme{let-keywords*}. Any required
;;> \var{default} values are evaluated in left-to-right order, with ;;> \var{default} values are evaluated in left-to-right order, with
@ -161,13 +190,14 @@
((let-keywords* (op . args) vars . body) ((let-keywords* (op . args) vars . body)
(let ((tmp (op . args))) (let ((tmp (op . args)))
(let-keywords* tmp vars . body))) (let-keywords* tmp vars . body)))
((let-keywords* opt-ls ((var) . rest) . body) ((let-keywords* opt-ls ((var) (vars . x) ...) . body)
(let-keywords* opt-ls ((var #f) . rest) . body)) (let-keywords* opt-ls ((var #f) (vars . x) ...) . body))
((let-keywords* opt-ls ((var default) . rest) . body) ((let-keywords* opt-ls ((var default) (vars . x) ...) . body)
(let ((var (keyword-ref* opt-ls (symbol->keyword* 'var) default))) (let ((var (keyword-ref* opt-ls (symbol->keyword* 'var) default)))
(let-keywords* opt-ls rest . body))) (let-keywords* opt-ls ((vars . x) ...) . body)))
((let-keywords* opt-ls ((var key default) . rest) . body) ((let-keywords* opt-ls ((var key default) (vars . x) ...) . body)
(let ((var (keyword-ref* opt-ls `key default))) (let ((var (keyword-ref* opt-ls `key default)))
(let-keywords* opt-ls rest . body))) (let-keywords* opt-ls ((vars . x) ...) . body)))
((let-keywords* opt-ls tail . body) ((let-keywords* opt-ls ((vars . x) ... tail) . body)
(let ((tail opt-ls)) . body)))) (let ((tail (remove-keywords* opt-ls () ((vars . x) ...))))
(let-keywords* opt-ls ((vars . x) ...) . body)))))