SWAMPy

✎ CARVE FLESH

EDITING: srfi-11.scm

;;; srfi-11.scm --- let-values and let*-values

;; Copyright (C) 2000, 2001, 2002, 2004, 2006, 2009 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;; 
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;; 
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Commentary:

;; This module exports two syntax forms: let-values and let*-values.
;;
;; Sample usage:
;;
;;   (let-values (((x y . z) (foo a b))
;;                ((p q) (bar c)))
;;     (baz x y z p q))
;;
;; This binds `x' and `y' to the first to values returned by `foo',
;; `z' to the rest of the values from `foo', and `p' and `q' to the
;; values returned by `bar'.  All of these are available to `baz'.
;;
;; let*-values : let-values :: let* : let
;;
;; This module is fully documented in the Guile Reference Manual.

;;; Code:

(define-module (srfi srfi-11)
  :export-syntax (let-values let*-values))

(cond-expand-provide (current-module) '(srfi-11))

;;;;;;;;;;;;;;
;; let-values
;;
;; Current approach is to translate
;;
;;   (let-values (((x y . z) (foo a b))
;;                ((p q) (bar c)))
;;     (baz x y z p q))
;;
;; into
;;
;;   (call-with-values (lambda () (foo a b))
;;     (lambda (<tmp-x> <tmp-y> . <tmp-z>)
;;       (call-with-values (lambda () (bar c))
;;         (lambda (<tmp-p> <tmp-q>)
;;           (let ((x <tmp-x>)
;;                 (y <tmp-y>)
;;                 (z <tmp-z>)
;;                 (p <tmp-p>)
;;                 (q <tmp-q>))
;;             (baz x y z p q))))))

;; We could really use quasisyntax here...
(define-syntax let-values
  (lambda (x)
    (syntax-case x ()
      ((_ ((binds exp)) b0 b1 ...)
       (syntax (call-with-values (lambda () exp)
                 (lambda binds b0 b1 ...))))
      ((_ (clause ...) b0 b1 ...)
       (let lp ((clauses (syntax (clause ...)))
                (ids '())
                (tmps '()))
         (if (null? clauses)
             (with-syntax (((id ...) ids)
                           ((tmp ...) tmps))
               (syntax (let ((id tmp) ...)
                         b0 b1 ...)))
             (syntax-case (car clauses) ()
               (((var ...) exp)
                (with-syntax (((new-tmp ...) (generate-temporaries 
                                              (syntax (var ...))))
                              ((id ...) ids)
                              ((tmp ...) tmps))
                  (with-syntax ((inner (lp (cdr clauses)
                                           (syntax (var ... id ...))
                                           (syntax (new-tmp ... tmp ...)))))
                    (syntax (call-with-values (lambda () exp)
                              (lambda (new-tmp ...) inner))))))
               ((vars exp)
                (with-syntax ((((new-var . new-tmp) ...)
                               (let lp ((vars (syntax vars)))
                                 (syntax-case vars ()
                                   ((id . rest)
                                    (acons (syntax id)
                                           (car
                                            (generate-temporaries (syntax (id))))
                                           (lp (syntax rest))))
                                   (id (acons (syntax id)
                                              (car
                                               (generate-temporaries (syntax (id))))
                                              '())))))
                              ((id ...) ids)
                              ((tmp ...) tmps))
                  (with-syntax ((inner (lp (cdr clauses)
                                           (syntax (new-var ... id ...))
                                           (syntax (new-tmp ... tmp ...))))
                                (args (let lp ((tmps (syntax (new-tmp ...))))
                                        (syntax-case tmps ()
                                          ((id) (syntax id))
                                          ((id . rest) (cons (syntax id)
                                                             (lp (syntax rest))))))))
                    (syntax (call-with-values (lambda () exp)
                              (lambda args inner)))))))))))))

;;;;;;;;;;;;;;
;; let*-values
;;
;; Current approach is to translate
;;
;;   (let*-values (((x y z) (foo a b))
;;                ((p q) (bar c)))
;;     (baz x y z p q))
;;
;; into
;;
;;   (call-with-values (lambda () (foo a b))
;;     (lambda (x y z)
;;       (call-with-values (lambda (bar c))
;;         (lambda (p q)
;;           (baz x y z p q)))))

(define-syntax let*-values
  (syntax-rules ()
    ((let*-values () body ...)
     (let () body ...))
    ((let*-values ((vars-1 binding-1) (vars-2 binding-2) ...) body ...)
     (call-with-values (lambda () binding-1)
       (lambda vars-1
         (let*-values ((vars-2 binding-2) ...)
           body ...))))))

;;; srfi-11.scm ends here

CANCEL

Name	Type	Size	Modified	Actions
↩ ..	DIR	—	—
📁 srfi-171/	DIR	—	2026-03-17 11:31
📁 srfi-4/	DIR	—	2026-03-17 11:31
📁 srfi-42/	DIR	—	2026-03-17 11:31
📁 srfi-64/	DIR	—	2026-03-17 11:31
📁 srfi-67/	DIR	—	2026-03-17 11:31
📁 srfi-9/	DIR	—	2026-03-17 11:31
📄 srfi-1.scm	SCM	30.5 KB	2023-01-23 21:52	EDIT
📄 srfi-10.scm	SCM	2.8 KB	2023-01-23 21:52	EDIT
📄 srfi-11.scm	SCM	5.4 KB	2023-01-23 21:52	EDIT
📄 srfi-111.scm	SCM	1.3 KB	2023-01-23 21:52	EDIT
📄 srfi-13.scm	SCM	2.7 KB	2023-01-23 21:52	EDIT
📄 srfi-14.scm	SCM	2.3 KB	2023-01-23 21:52	EDIT
📄 srfi-16.scm	SCM	1.8 KB	2023-01-23 21:52	EDIT
📄 srfi-17.scm	SCM	6.4 KB	2023-01-23 21:52	EDIT
📄 srfi-171.scm	SCM	13.2 KB	2023-01-23 21:52	EDIT
📄 srfi-18.scm	SCM	12.1 KB	2023-01-23 21:52	EDIT
📄 srfi-19.scm	SCM	54.9 KB	2023-01-23 21:52	EDIT
📄 srfi-2.scm	SCM	1.1 KB	2023-01-23 21:52	EDIT
📄 srfi-26.scm	SCM	2.6 KB	2023-01-23 21:52	EDIT
📄 srfi-27.scm	SCM	3 KB	2023-01-23 21:52	EDIT
📄 srfi-28.scm	SCM	1.2 KB	2023-01-23 21:52	EDIT
📄 srfi-31.scm	SCM	1.4 KB	2023-01-23 21:52	EDIT
📄 srfi-34.scm	SCM	1.4 KB	2023-01-23 21:52	EDIT
📄 srfi-35.scm	SCM	5.8 KB	2023-01-23 21:52	EDIT
📄 srfi-37.scm	SCM	8.4 KB	2023-01-23 21:52	EDIT
📄 srfi-38.scm	SCM	8.2 KB	2023-01-23 21:52	EDIT
📄 srfi-39.scm	SCM	2.1 KB	2023-01-23 21:52	EDIT
📄 srfi-4.scm	SCM	5.1 KB	2023-01-23 21:52	EDIT
📄 srfi-41.scm	SCM	19.9 KB	2023-01-23 21:52	EDIT
📄 srfi-42.scm	SCM	1.8 KB	2023-01-23 21:52	EDIT
📄 srfi-43.scm	SCM	37.5 KB	2023-01-23 21:52	EDIT
📄 srfi-45.scm	SCM	3.5 KB	2023-01-23 21:52	EDIT
📄 srfi-6.scm	SCM	1.1 KB	2023-01-23 21:52	EDIT
📄 srfi-60.scm	SCM	2.1 KB	2023-01-23 21:52	EDIT
📄 srfi-64.scm	SCM	2.6 KB	2023-01-23 21:52	EDIT
📄 srfi-67.scm	SCM	2.3 KB	2023-01-23 21:52	EDIT
📄 srfi-69.scm	SCM	12.7 KB	2023-01-23 21:52	EDIT
📄 srfi-71.scm	SCM	10.1 KB	2023-01-23 21:52	EDIT
📄 srfi-8.scm	SCM	1.1 KB	2023-01-23 21:52	EDIT
📄 srfi-88.scm	SCM	1.7 KB	2023-01-23 21:52	EDIT
📄 srfi-9.scm	SCM	13.1 KB	2023-01-23 21:52	EDIT
📄 srfi-98.scm	SCM	1.6 KB	2023-01-23 21:52	EDIT