From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: srfi-11 let-values using make-symbol Date: Sun, 18 Apr 2004 09:34:28 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <874qrirxff.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1082245055 4192 80.91.224.253 (17 Apr 2004 23:37:35 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 17 Apr 2004 23:37:35 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Apr 18 01:37:27 2004 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1BEzNF-0002Uv-00 for ; Sun, 18 Apr 2004 01:37:25 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BEzMu-0007Ct-2f for guile-devel@m.gmane.org; Sat, 17 Apr 2004 19:37:04 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1BEzMO-0006lJ-Jk for guile-devel@gnu.org; Sat, 17 Apr 2004 19:36:32 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1BEzKe-0004Iw-W4 for guile-devel@gnu.org; Sat, 17 Apr 2004 19:35:16 -0400 Original-Received: from [61.8.0.84] (helo=mailout1.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BEzKd-0004H7-TD for guile-devel@gnu.org; Sat, 17 Apr 2004 19:34:44 -0400 Original-Received: from mailproxy2.pacific.net.au (mailproxy2.pacific.net.au [61.8.0.87]) by mailout1.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i3HNYf4u017589 for ; Sun, 18 Apr 2004 09:34:41 +1000 Original-Received: from localhost (ppp25C7.dyn.pacific.net.au [61.8.37.199]) by mailproxy2.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i3HNYdHV010142 for ; Sun, 18 Apr 2004 09:34:40 +1000 Original-Received: from gg by localhost with local (Exim 3.36 #1 (Debian)) id 1BEzKP-0005cK-00; Sun, 18 Apr 2004 09:34:29 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.110002 (No Gnus v0.2) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:3607 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3607 --=-=-= I guess make-symbol now allows a FIXME in srfi-11 to be addressed, * srfi-11.scm (let-values): Use make-symbol rather than gensym, for guaranteed uniqueness of temp variable symbols. And just so I'm not accused of making an untested change :), * tests/srfi-11.test: New file. * Makefile.am (SCM_TESTS): Add it. --=-=-= Content-Disposition: inline; filename=srfi-11.scm.make-symbol.diff --- srfi-11.scm.~1.10.~ 2003-04-07 08:05:29.000000000 +1000 +++ srfi-11.scm 2004-04-18 09:31:13.000000000 +1000 @@ -1,6 +1,6 @@ ;;; srfi-11.scm --- let-values and let*-values -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2004 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 @@ -67,6 +67,7 @@ ;; I originally wrote this as a define-macro, but then I found out ;; that guile's gensym/gentemp was broken, so I tried rewriting it as ;; a syntax-rules statement. +;; [make-symbol now fixes gensym/gentemp problems.] ;; ;; Since syntax-rules didn't seem powerful enough to implement ;; let-values in one definition without exposing illegal syntax (or @@ -167,9 +168,6 @@ ; ((_ ((vars binding) ...) body ...) ; (lv-builder ((vars binding) ...) () body ...))))) -;; FIXME: This is currently somewhat unsafe (b/c gentemp/gensym is -;; broken -- right now (as of 1.4.1, it doesn't generate unique -;; symbols) (define-macro (let-values vars . body) (define (map-1-dot proc elts) @@ -189,7 +187,7 @@ (define (let-values-helper vars body prev-let-vars) (let* ((var-binding (car vars)) - (new-tmps (map-1-dot (lambda (sym) (gensym)) + (new-tmps (map-1-dot (lambda (sym) (make-symbol "let-values-var")) (car var-binding))) (let-vars (map (lambda (sym tmp) (list sym tmp)) (undot-list (car var-binding)) --=-=-= Content-Disposition: inline; filename=srfi-11.test ;;;; srfi-11.test --- exercise SRFI-11 let-values ;;;; ;;;; Copyright 2004 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by ;;;; the Free Software Foundation; either version 2, or (at your option) ;;;; any later version. ;;;; ;;;; This program 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 General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with this software; see the file COPYING. If not, write to ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; Boston, MA 02111-1307 USA (define-module (test-suite test-srfi-11) #:use-module (test-suite lib) #:use-module (srfi srfi-11)) ;; ;; let-values ;; (with-test-prefix "let-values" (with-test-prefix "no exprs" (pass-if "no values" (let-values () #t))) (with-test-prefix "one expr" (pass-if "no values" (let-values ((() (values))) #t)) (pass-if "one value" (let-values (((x) (values 1))) (equal? x 1))) (pass-if "one value as rest" (let-values ((x (values 1))) (equal? x '(1)))) (pass-if "two values" (let-values (((x y) (values 1 2))) (and (equal? x 1) (equal? y 2))))) (with-test-prefix "two exprs" (pass-if "no values each" (let-values ((() (values)) (() (values))) #t)) (pass-if "one value / no values" (let-values (((x) (values 1)) (() (values))) (equal? x 1))) (pass-if "one value each" (let-values (((x) (values 1)) ((y) (values 2))) (and (equal? x 1) (equal? y 2)))) (pass-if-exception "first binding invisible to second expr" '(unbound-variable . ".*") (let-values (((x) (values 1)) ((y) (values (1+ x)))) #f)))) ;; ;; let*-values ;; (with-test-prefix "let*-values" (with-test-prefix "no exprs" (pass-if "no values" (let*-values () #t))) (with-test-prefix "one expr" (pass-if "no values" (let*-values ((() (values))) #t)) (pass-if "one value" (let*-values (((x) (values 1))) (equal? x 1))) (pass-if "one value as rest" (let-values ((x (values 1))) (equal? x '(1)))) (pass-if "two values" (let*-values (((x y) (values 1 2))) (and (equal? x 1) (equal? y 2))))) (with-test-prefix "two exprs" (pass-if "no values each" (let*-values ((() (values)) (() (values))) #t)) (pass-if "one value / no values" (let*-values (((x) (values 1)) (() (values))) (equal? x 1))) (pass-if "one value each" (let*-values (((x) (values 1)) ((y) (values 2))) (and (equal? x 1) (equal? y 2)))) (pass-if "first binding visible to second expr" (let*-values (((x) (values 1)) ((y) (values (1+ x)))) (and (equal? x 1) (equal? y 2)))))) --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--