From ac357036850626468ade6b2a15ba65114f1ad9bf Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Mon, 8 Jul 2013 22:09:42 +0900
Subject: [PATCH] Adding let-keywords[*].

---
 lib/chibi/optional.scm | 42 ++++++++++++++++++++++++++++++++++++------
 lib/chibi/optional.sld |  3 ++-
 2 files changed, 38 insertions(+), 7 deletions(-)

diff --git a/lib/chibi/optional.scm b/lib/chibi/optional.scm
index 737d4638..35b7c79b 100644
--- a/lib/chibi/optional.scm
+++ b/lib/chibi/optional.scm
@@ -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
   (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 ("step") ls () vars . body))))
+     (let*-to-let let-optionals* ls () vars . body))))
 
 (define-syntax opt-lambda
   (syntax-rules ()
     ((opt-lambda 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))))
diff --git a/lib/chibi/optional.sld b/lib/chibi/optional.sld
index 8dabac12..a77b3e33 100644
--- a/lib/chibi/optional.sld
+++ b/lib/chibi/optional.sld
@@ -1,5 +1,6 @@
 
 (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))
   (include "optional.scm"))