move experimental/lambda.scm
This commit is contained in:
parent
c76690c4da
commit
685d08301a
1
Makefile
1
Makefile
|
@ -9,7 +9,6 @@ PICRIN_OBJS = \
|
||||||
$(PICRIN_SRCS:.c=.o)
|
$(PICRIN_SRCS:.c=.o)
|
||||||
PICRIN_LIBS = \
|
PICRIN_LIBS = \
|
||||||
piclib/picrin/macro.scm\
|
piclib/picrin/macro.scm\
|
||||||
piclib/picrin/experimental/lambda.scm\
|
|
||||||
piclib/picrin/syntax-rules.scm\
|
piclib/picrin/syntax-rules.scm\
|
||||||
piclib/picrin/test.scm
|
piclib/picrin/test.scm
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,24 @@
|
||||||
|
(define-library (picrin destructuring-bind)
|
||||||
|
(import (picrin base)
|
||||||
|
(picrin macro))
|
||||||
|
|
||||||
|
(define-syntax (destructuring-bind formal value . body)
|
||||||
|
(cond
|
||||||
|
((variable? formal)
|
||||||
|
#`(let ((#,formal #,value))
|
||||||
|
#,@body))
|
||||||
|
((pair? formal)
|
||||||
|
#`(let ((value #,value))
|
||||||
|
(destructuring-bind #,(car formal) (car value)
|
||||||
|
(destructuring-bind #,(cdr formal) (cdr value)
|
||||||
|
#,@body))))
|
||||||
|
((vector? formal)
|
||||||
|
;; TODO
|
||||||
|
(error "fixme"))
|
||||||
|
(else
|
||||||
|
#`(if (equal? #,value '#,formal)
|
||||||
|
(begin
|
||||||
|
#,@body)
|
||||||
|
(error "match failure" #,value '#,formal)))))
|
||||||
|
|
||||||
|
(export destructuring-bind))
|
|
@ -0,0 +1 @@
|
||||||
|
CONTRIB_LIBS += $(wildcard contrib/50.destructuring-bind/*.scm)
|
|
@ -1,37 +0,0 @@
|
||||||
(define-library (picrin experimental lambda)
|
|
||||||
(import (picrin base)
|
|
||||||
(picrin macro))
|
|
||||||
|
|
||||||
(define-syntax (destructuring-let formal value . body)
|
|
||||||
(cond
|
|
||||||
((variable? formal)
|
|
||||||
#`(let ((#,formal #,value))
|
|
||||||
#,@body))
|
|
||||||
((pair? formal)
|
|
||||||
#`(let ((value #,value))
|
|
||||||
(destructuring-let #,(car formal) (car value)
|
|
||||||
(destructuring-let #,(cdr formal) (cdr value)
|
|
||||||
#,@body))))
|
|
||||||
((vector? formal)
|
|
||||||
;; TODO
|
|
||||||
(error "fixme"))
|
|
||||||
(else
|
|
||||||
#`(if (equal? #,value '#,formal)
|
|
||||||
(begin
|
|
||||||
#,@body)
|
|
||||||
(error "match failure" #,value '#,formal)))))
|
|
||||||
|
|
||||||
(define-syntax (destructuring-lambda formal . body)
|
|
||||||
#`(lambda args
|
|
||||||
(destructuring-let #,formal args #,@body)))
|
|
||||||
|
|
||||||
(define-syntax (destructuring-define formal . body)
|
|
||||||
(if (variable? formal)
|
|
||||||
#`(define #,formal #,@body)
|
|
||||||
#`(destructuring-define #,(car formal)
|
|
||||||
(destructuring-lambda #,(cdr formal)
|
|
||||||
#,@body))))
|
|
||||||
|
|
||||||
(export (rename destructuring-let let)
|
|
||||||
(rename destructuring-lambda lambda)
|
|
||||||
(rename destructuring-define define)))
|
|
Loading…
Reference in New Issue