Adding let-keywords[*].

This commit is contained in:
Alex Shinn 2013-07-08 22:09:42 +09:00
parent fef8c1a459
commit ac35703685
2 changed files with 38 additions and 7 deletions

View file

@ -1,15 +1,45 @@
;; let-optionals* is in the core
(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 ((var tmp) ...) . body)))))
(define-syntax let-optionals (define-syntax let-optionals
(syntax-rules () (syntax-rules ()
((let-optionals ("step") ls (vars ...) ((v d) . rest) . body)
(let-optionals ("step") ls (vars ... (v tmp d)) rest . body))
((let-optionals ("step") ls ((var tmp default) ...) rest . body)
(let-optionals* ls ((tmp default) ... . rest)
(let ((var tmp) ...) . body)))
((let-optionals ls vars . body) ((let-optionals ls vars . body)
(let-optionals ("step") ls () vars . body)))) (let*-to-let let-optionals* ls () vars . body))))
(define-syntax opt-lambda (define-syntax opt-lambda
(syntax-rules () (syntax-rules ()
((opt-lambda vars . body) ((opt-lambda vars . body)
(lambda args (let-optionals args vars . body))))) (lambda args (let-optionals args vars . body)))))
(define (keyword-ref ls key . o)
(cond ((memq key ls) => cadr)
(else (and (pair? o) (car o)))))
(define-syntax let-keywords*
(syntax-rules ()
((let-keywords* opt-ls () . body)
(begin . body))
((let-keywords* (op . args) vars . body)
(let ((tmp (op . args)))
(let-keywords* tmp vars . body)))
((let-keywords* opt-ls ((var default) . rest) . body)
(let ((var (keyword-ref opt-ls var default)))
(let-keywords* opt-ls rest . body)))
((let-keywords* opt-ls ((var key default) . rest) . body)
(let ((var (keyword-ref opt-ls key default)))
(let-keywords* opt-ls rest . body)))
((let-keywords* opt-ls tail . body)
(let ((tail opt-ls)) . body))))
(define-syntax let-keywords
(syntax-rules ()
((let-keywords ls vars . body)
(let*-to-let let-keywords* ls () vars . body))))

View file

@ -1,5 +1,6 @@
(define-library (chibi optional) (define-library (chibi optional)
(export let-optionals let-optionals* opt-lambda) (export let-optionals let-optionals* opt-lambda
let-keywords let-keywords* keyword-ref)
(import (chibi)) (import (chibi))
(include "optional.scm")) (include "optional.scm"))