refactor define-values

This commit is contained in:
Yuichi Nishiwaki 2014-07-19 14:30:29 +09:00
parent 6a203d236a
commit d5a314b186
2 changed files with 8 additions and 15 deletions

View File

@ -1,5 +1,5 @@
list(APPEND PICLIB_SCHEME_LIBS list(APPEND PICLIB_SCHEME_LIBS
${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm ${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm # the only dependency prelude requires
${PROJECT_SOURCE_DIR}/piclib/prelude.scm ${PROJECT_SOURCE_DIR}/piclib/prelude.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

View File

@ -329,18 +329,6 @@
expr) expr)
(reverse list))) (reverse list)))
(define (predefine var)
`(define ,var #f))
(define (predefines vars)
(map predefine vars))
(define (assign var val)
`(set! ,var ,val))
(define (assigns vars vals)
(map assign vars vals))
(define uniq (define uniq
(let ((counter 0)) (let ((counter 0))
(lambda (x) (lambda (x)
@ -355,10 +343,15 @@
(formal* (walk uniq formal)) (formal* (walk uniq formal))
(exprs (cddr form))) (exprs (cddr form)))
`(begin `(begin
,@(predefines (flatten formal)) ,@(map
(lambda (var) `(define ,var #f))
(flatten formal))
(call-with-values (lambda () ,@exprs) (call-with-values (lambda () ,@exprs)
(lambda ,formal* (lambda ,formal*
,@(assigns (flatten formal) (flatten formal*))))))))) ,@(map
(lambda (var val) `(set! ,var ,val))
(flatten formal)
(flatten formal*)))))))))
(export let-values (export let-values
let*-values let*-values