Re: what about dropping rest-lists?
Neil W. Van Dyke 18 May 2005 19:45 UTC
For purposes of discussion, here's a quick R5RS implementation of the
"let" variant described in my last post.
;; $Id: let.scm,v 1.12 2005/05/18 19:34:15 neil Exp $
;; This implementation was informed by the Lars T Hansen's SRFI-11 reference
;; implementation, and initially derived from it, although the different
;; problem necessitated a rewrite.
;; SBE : source binding expression. "(SINGLE-VAR0 ... [REST-VAR] EXPR)"
;; aka "(VS0 ... EXPR)"
;; VSE : variable syntax or expression. "VAR" or "(rest VAR)" or "EXPR"
;; TVB : temp variable binding. "(DEST-VAR TEMP-VAR)"
;; TV : temp variable
;; RTV : rest temp variable
;; BODYS : list of body expressions
(define-syntax srfi-let
;; (_ SBES BODY0 BODY1 ...)
(syntax-rules ()
((_ (SBE0 ...) BODY0 BODY1 ...)
(%srfi71:let:bind (SBE0 ...) () (BODY0 BODY1 ...)))
))
(define-syntax %srfi71:let:bind
;; (_ SBES TVBS BODYS)
(syntax-rules (rest)
;; No more source bindings, so finish with R5RS "let":
((_ () TVBS (BODY0 ...))
(let TVBS BODY0 ...))
;; Zero-values binding:
((_ ((EXPR) SBE1 ...) TVBS BODYS)
(begin EXPR (%srfi71:let:bind (SBE1 ...) TVBS BODYS)))
;; All-values binding:
((_ (((rest VAR) EXPR) SBE1 ...) (TVB0 ...) BODYS)
(call-with-values (lambda () EXPR)
(lambda temp
(%srfi71:let:bind (SBE1 ...) (TVB0 ... (VAR temp)) BODYS))))
;; Single-value binding:
((_ ((VAR EXPR) SBE1 ...) (TVB0 ...) BODYS)
(let ((temp EXPR))
(%srfi71:let:bind (SBE1 ...) (TVB0 ... (VAR temp)) BODYS)))
;; Multiple-values binding:
((_ ((VSE0 ...) SBE1 ...) TVBS BODYS)
(%srfi71:let:multbind (VSE0 ...) () (SBE1 ...) TVBS BODYS))
))
(define-syntax %srfi71:let:multbind
;; (_ VSES TVS SBES TVBS BODYS)
(syntax-rules (rest)
;; Last VSE, which is the expression:
((_ (EXPR) TVS SBES TVBS BODYS)
(call-with-values (lambda () EXPR)
(lambda TVS
(%srfi71:let:bind SBES TVBS BODYS))))
;; Rest-variable, which must be last:
((_ ((rest VAR) EXPR) (TV0 ...) SBES (TVB0 ...) BODYS)
(call-with-values (lambda () EXPR)
(lambda (TV0 ... . temp)
(%srfi71:let:bind SBES (TVB0 ... (VAR temp)) BODYS))))
;; Normal-variable:
((_ (VAR VSE1 ...) (TV0 ...) SBES (TVB0 ...) BODYS)
(%srfi71:let:multbind
(VSE1 ...) (TV0 ... temp) SBES (TVB0 ... (VAR temp)) BODYS))
))
;; Start of test suite using Testeez ("http://www.neilvandyke.org/testeez/"):
(testeez
"multiple-value let"
(test/equal "" (srfi-let ( (a b c (values 1 2 3)) ) c) 3)
(test/equal "" (srfi-let ( (a b (values 1 2 )) ) b) 2)
(test/equal "" (srfi-let ( (a (values 1 )) ) a) 1)
(test/equal "" (srfi-let ( ( (values )) ) #f) #f)
(test/equal "" (srfi-let ( (a b c (rest x) (values 1 2 3)) ) x) '())
(test/equal "" (srfi-let ( (a b (rest x) (values 1 2 3)) ) x) '(3))
(test/equal "" (srfi-let ( (a (rest x) (values 1 2 3)) ) x) '(2 3))
(test/equal "" (srfi-let ( ( (rest x) (values 1 2 3)) ) x) '(1 2 3))
(test/equal "" (srfi-let ( ( (rest x) (values 1 2 3)) ) x) '(1 2 3))
(test/equal "" (srfi-let ( ( (rest x) (values 1 2 )) ) x) '(1 2))
(test/equal "" (srfi-let ( ( (rest x) (values 1 )) ) x) '(1))
(test/equal "" (srfi-let ( ( (rest x) (values )) ) x) '())
)