Re: what about dropping rest-lists?

["Neil W. Van Dyke" <neil@xxxxxxxxxxxxxxx>]

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)   '())

 )