From cec55dfe4170b253642c10c89a56c0717874ac18 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 21 Oct 2012 17:22:16 +0900
Subject: [PATCH] Adding let-optionals* to core as recommended way of handling
 optional arguments. This is much faster (in chibi) and more concise than
 case-lambda.  Also adding (chibi optional) for the let-optionals and
 opt-lambda variants. Still need to add let-keywords*.

---
 lib/chibi/optional.scm | 15 +++++++++++++++
 lib/chibi/optional.sld |  5 +++++
 lib/init-7.scm         | 14 ++++++++++++++
 3 files changed, 34 insertions(+)
 create mode 100644 lib/chibi/optional.scm
 create mode 100644 lib/chibi/optional.sld

diff --git a/lib/chibi/optional.scm b/lib/chibi/optional.scm
new file mode 100644
index 00000000..737d4638
--- /dev/null
+++ b/lib/chibi/optional.scm
@@ -0,0 +1,15 @@
+
+(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))))
+
+(define-syntax opt-lambda
+  (syntax-rules ()
+    ((opt-lambda vars . body)
+     (lambda args (let-optionals args vars . body)))))
diff --git a/lib/chibi/optional.sld b/lib/chibi/optional.sld
new file mode 100644
index 00000000..8dabac12
--- /dev/null
+++ b/lib/chibi/optional.sld
@@ -0,0 +1,5 @@
+
+(define-library (chibi optional)
+  (export let-optionals let-optionals* opt-lambda)
+  (import (chibi))
+  (include "optional.scm"))
diff --git a/lib/init-7.scm b/lib/init-7.scm
index 21b71212..2c9c315b 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -861,6 +861,20 @@
     ((letrec* ((var val) ...) . body)
      (let () (define var val) ... . body))))
 
+(define-syntax let-optionals*
+  (syntax-rules ()
+    ((let-optionals* opt-ls () . body)
+     (begin . body))
+    ((let-optionals* (op . args) vars . body)
+     (let ((tmp (op . args)))
+       (let-optionals* tmp vars . body)))
+    ((let-optionals* tmp ((var default) . rest) . body)
+     (let ((var (if (pair? tmp) (car tmp) default))
+           (tmp2 (if (pair? tmp) (cdr tmp) '())))
+       (let-optionals* tmp2 rest . body)))
+    ((let-optionals* tmp tail . body)
+     (let ((tail tmp)) . body))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; exceptions