add destructuring lambda

This commit is contained in:
Yuichi Nishiwaki 2014-08-05 12:53:33 +09:00
parent db7c129e71
commit d669d48aa7
2 changed files with 45 additions and 0 deletions

View File

@ -1,9 +1,12 @@
list(APPEND PICLIB_SCHEME_LIBS list(APPEND PICLIB_SCHEME_LIBS
${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm ${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm
${PROJECT_SOURCE_DIR}/piclib/scheme/base.scm ${PROJECT_SOURCE_DIR}/piclib/scheme/base.scm
${PROJECT_SOURCE_DIR}/piclib/picrin/array.scm ${PROJECT_SOURCE_DIR}/piclib/picrin/array.scm
${PROJECT_SOURCE_DIR}/piclib/picrin/dictionary.scm ${PROJECT_SOURCE_DIR}/piclib/picrin/dictionary.scm
${PROJECT_SOURCE_DIR}/piclib/picrin/test.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/cxr.scm
${PROJECT_SOURCE_DIR}/piclib/scheme/file.scm ${PROJECT_SOURCE_DIR}/piclib/scheme/file.scm
${PROJECT_SOURCE_DIR}/piclib/scheme/case-lambda.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/eval.scm
${PROJECT_SOURCE_DIR}/piclib/scheme/r5rs.scm ${PROJECT_SOURCE_DIR}/piclib/scheme/r5rs.scm
${PROJECT_SOURCE_DIR}/piclib/scheme/null.scm ${PROJECT_SOURCE_DIR}/piclib/scheme/null.scm
${PROJECT_SOURCE_DIR}/piclib/srfi/1.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/1.scm
${PROJECT_SOURCE_DIR}/piclib/srfi/8.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/8.scm
${PROJECT_SOURCE_DIR}/piclib/srfi/26.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/26.scm

View File

@ -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))