add destructuring lambda

piclib/CMakeLists.txt

@@ -1,9 +1,12 @@
 list(APPEND PICLIB_SCHEME_LIBS
   ${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/base.scm
+
   ${PROJECT_SOURCE_DIR}/piclib/picrin/array.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/dictionary.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/test.scm
+  ${PROJECT_SOURCE_DIR}/piclib/picrin/experimental/lambda.scm
+
   ${PROJECT_SOURCE_DIR}/piclib/scheme/cxr.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/file.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/case-lambda.scm
@@ -11,6 +14,7 @@ list(APPEND PICLIB_SCHEME_LIBS
   ${PROJECT_SOURCE_DIR}/piclib/scheme/eval.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/r5rs.scm
   ${PROJECT_SOURCE_DIR}/piclib/scheme/null.scm
+
   ${PROJECT_SOURCE_DIR}/piclib/srfi/1.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/8.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/26.scm

piclib/picrin/experimental/lambda.scm

@@ -0,0 +1,41 @@
+(define-library (picrin experimental lambda)
+  (import (rename (scheme base)
+                  (lambda lambda%))
+          (picrin macro))
+
+  (define uniq
+    (let ((counter 0))
+      (lambda% ()
+        (let ((sym (string->symbol (string-append "lv$" (number->string counter)))))
+          (set! counter (+ counter 1))
+          sym))))
+
+  (define-syntax lambda
+    (ir-macro-transformer
+     (lambda% (form inject compare)
+
+       (define (bind val args)
+         (cond
+          ((symbol? args)
+           `(define ,args ,val))
+          ((pair? args)
+           (let ((a (uniq))
+                 (b (uniq)))
+             `(begin
+                (define ,a (car ,val))
+                (define ,b (cdr ,val))
+                ,(bind a (car args))
+                ,(bind b (cdr args)))))
+          ((vector? args)
+           ;; TODO
+           (error "fixme"))
+          (else
+           `(unless (equal? ,val ',args)
+              (error "match failure" ,val ',args)))))
+
+       (let ((args (car (cdr form)))
+             (body (cdr (cdr form))))
+         (let ((var (uniq)))
+          `(lambda% ,var ,(bind var args) ,@body))))))
+
+  (export lambda))