From e7b9510656a0a494a8684b241c9bc340f92306f0 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Sat, 24 Aug 2019 22:34:20 +0800
Subject: [PATCH] allowing required args in opt-lambda, adding define-opt

---
 lib/chibi/optional-test.sld | 30 ++++++++++++++++++++++++++++++
 lib/chibi/optional.scm      | 26 ++++++++++++++++++++++++--
 lib/chibi/optional.sld      |  2 +-
 3 files changed, 55 insertions(+), 3 deletions(-)
 create mode 100644 lib/chibi/optional-test.sld

diff --git a/lib/chibi/optional-test.sld b/lib/chibi/optional-test.sld
new file mode 100644
index 00000000..574fb3b2
--- /dev/null
+++ b/lib/chibi/optional-test.sld
@@ -0,0 +1,30 @@
+
+(define-library (chibi optional-test)
+  (import (scheme base) (chibi optional) (chibi test))
+  (export run-tests)
+  (begin
+    (define (run-tests)
+      (test-begin "optional")
+      (test '(0 11 12)
+          (let-optionals '(0) ((a 10) (b 11) (c 12))
+            (list a b c)))
+      (test '(0 11 12)
+          ((opt-lambda ((a 10) (b 11) (c 12))
+             (list a b c))
+           0))
+      (test '(0 11 12)
+          ((opt-lambda (a (b 11) (c 12))
+             (list a b c))
+           0))
+      (test-error '(0 11 12)
+          ((opt-lambda (a (b 11) (c 12))
+             (list a b c))))
+      (let ()
+        (define-opt (f a (b 11) (c 12))
+          (list a b c))
+        (test-error (f))
+        (test '(0 11 12) (f 0))
+        (test '(0 1 12) (f 0 1))
+        (test '(0 1 2) (f 0 1 2))
+        (test '(0 1 2) (f 0 1 2 3)))
+      (test-end))))
diff --git a/lib/chibi/optional.scm b/lib/chibi/optional.scm
index ddc09969..8eb9efa5 100644
--- a/lib/chibi/optional.scm
+++ b/lib/chibi/optional.scm
@@ -64,14 +64,36 @@
 ;;>
 ;;> Shorthand for
 ;;> \schemeblock{
-;;> (lambda o
+;;> (lambda (required ... . o)
 ;;>   (let-optionals o ((var default) ... [rest])
 ;;>      body ...))}
 
 (define-syntax opt-lambda
   (syntax-rules ()
     ((opt-lambda vars . body)
-     (lambda args (let-optionals args vars . body)))))
+     (opt-lambda/aux () vars . body))))
+
+(define-syntax opt-lambda/aux
+  (syntax-rules ()
+    ((opt-lambda/aux (args ...) ((var . default) . vars) . body)
+     (lambda (args ... . o)
+       (let-optionals o ((var . default) . vars) . body)))
+    ((opt-lambda/aux (args ...) (var . vars) . body)
+     (opt-lambda/aux (args ... var) vars . body))
+    ((opt-lambda/aux (args ...) () . body)
+     (lambda (args ... . o)
+       . body))))
+
+;;> \macro{(define-opt (name (var default) ... [rest]) body ...)}
+;;>
+;;> Shorthand for
+;;> \schemeblock{
+;;> (define name (opt-lambda (var default) ... [rest]) body ...)}
+
+(define-syntax define-opt
+  (syntax-rules ()
+    ((define-opt (name . vars) . body)
+     (define name (opt-lambda vars . body)))))
 
 ;;> \procedure{(keyword-ref ls key [default])}
 ;;>
diff --git a/lib/chibi/optional.sld b/lib/chibi/optional.sld
index 02084635..4aa0243a 100644
--- a/lib/chibi/optional.sld
+++ b/lib/chibi/optional.sld
@@ -1,6 +1,6 @@
 
 (define-library (chibi optional)
-  (export let-optionals let-optionals* opt-lambda
+  (export let-optionals let-optionals* opt-lambda define-opt
           let-keywords let-keywords* keyword-ref keyword-ref*)
   (cond-expand
    (chibi