mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
1733efe236
The current implementation of srfi-11s let-values allows later clauses to access and modify variables bound in earlier clauses when the clause is not a proper list. * module/srfi/srfi-11.scm (let-values): Fix switched variable names. * test-suite/tests/srfi-11.test (let-values): Add test checking that the variable cannot be changed in later clauses.
146 lines
5.4 KiB
Scheme
146 lines
5.4 KiB
Scheme
;;; 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
|