From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ian Price Newsgroups: gmane.lisp.guile.devel Subject: Two r6rs bugs Date: Thu, 22 Nov 2012 10:35:38 +0000 Message-ID: <873902x6v9.fsf@googlemail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1353580571 7074 80.91.229.3 (22 Nov 2012 10:36:11 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 22 Nov 2012 10:36:11 +0000 (UTC) Cc: "Mark H. Weaver" To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Nov 22 11:36:23 2012 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1TbU8q-0001EC-PK for guile-devel@m.gmane.org; Thu, 22 Nov 2012 11:36:20 +0100 Original-Received: from localhost ([::1]:34331 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TbU8g-0004Kt-7j for guile-devel@m.gmane.org; Thu, 22 Nov 2012 05:36:10 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:48426) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TbU8Y-0004KR-6B for guile-devel@gnu.org; Thu, 22 Nov 2012 05:36:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TbU8V-0004ip-K2 for guile-devel@gnu.org; Thu, 22 Nov 2012 05:36:01 -0500 Original-Received: from plane.gmane.org ([80.91.229.3]:44043) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TbU8V-0004ij-8t for guile-devel@gnu.org; Thu, 22 Nov 2012 05:35:59 -0500 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1TbU8b-0000xM-DO for guile-devel@gnu.org; Thu, 22 Nov 2012 11:36:05 +0100 Original-Received: from host86-182-157-241.range86-182.btcentralplus.com ([86.182.157.241]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 22 Nov 2012 11:36:05 +0100 Original-Received: from ianprice90 by host86-182-157-241.range86-182.btcentralplus.com with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 22 Nov 2012 11:36:05 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 216 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: host86-182-157-241.range86-182.btcentralplus.com User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.3 (gnu/linux) Cancel-Lock: sha1:LeOeBrbnjBHkL8WdxgKJAMM2nqg= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 80.91.229.3 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 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 Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:15231 Archived-At: --=-=-= I've attached two patches. The first replaces the definition of string-for-each in (rnrs base). R6RS's version of string-for-each is not the same as srfi 13's string for each (which guile provides by default). Rather, it is more closely analogous to the usual multi-list definition of for-each. The R6RS specifies that all arguments must have the same length, and so I've thrown an &assertion in this case. The second one is a change to resolve-r6rs-interface. Previously mark-weaver [0], changes this so that it would correctly look up submodules under the srfi namespace, but in doing so took into account the srfi 97[1] library name, which it should not have done. I have added a comment to this effect in the source. I should have noticed this at the time, but I didn't until I rebuilt and my .guile broke :) 0. https://lists.gnu.org/archive/html/guile-devel/2012-11/msg00011.html 1. http://srfi.schemers.org/srfi-97/srfi-97.html -- Ian Price -- shift-reset.com "Programming is like pinball. The reward for doing it well is the opportunity to do it again" - from "The Wizardy Compiled" --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-R6RS-string-for-each-should-accept-multiple-string-a.patch Content-Description: string-for-each patch >From 5f06983d26ccbd7410891730664aa83bef79e763 Mon Sep 17 00:00:00 2001 From: Ian Price Date: Thu, 22 Nov 2012 09:45:12 +0000 Subject: [PATCH 1/2] R6RS `string-for-each' should accept multiple string arguments * module/rnrs/base.scm (string-for-each): Rewrite. * test-suite/tests/r6rs-base.test ("string-for-each"): Add tests. --- module/rnrs/base.scm | 39 +++++++++++++++++++++++++++++++++++++- test-suite/tests/r6rs-base.test | 40 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 1 deletions(-) diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index 499a224..9fedac0 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -73,7 +73,7 @@ let-syntax letrec-syntax syntax-rules identifier-syntax) - (import (rename (except (guile) error raise map) + (import (rename (except (guile) error raise map string-for-each) (log log-internal) (euclidean-quotient div) (euclidean-remainder mod) @@ -86,6 +86,43 @@ (inexact->exact exact)) (srfi srfi-11)) + (define string-for-each + (case-lambda + ((proc string) + (let ((end (string-length string))) + (let loop ((i 0)) + (unless (= i end) + (proc (string-ref string i)) + (loop (+ i 1)))))) + ((proc string1 string2) + (let ((end1 (string-length string1)) + (end2 (string-length string2))) + (unless (= end1 end2) + (assertion-violation 'string-for-each + "string arguments must all have the same length" + string1 string2)) + (let loop ((i 0)) + (unless (= i end1) + (proc (string-ref string1 i) + (string-ref string2 i)) + (loop (+ i 1)))))) + ((proc string . strings) + (let ((end (string-length string)) + (ends (map string-length strings))) + (for-each (lambda (x) + (unless (= end x) + (apply assertion-violation + 'string-for-each + "string arguments must all have the same length" + string strings))) + ends) + (let loop ((i 0)) + (unless (= i end) + (apply proc + (string-ref string i) + (map (lambda (s) (string-ref s i)) strings)) + (loop (+ i 1)))))))) + (define map (case-lambda ((f l) diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test index df11d67..fb49141 100644 --- a/test-suite/tests/r6rs-base.test +++ b/test-suite/tests/r6rs-base.test @@ -196,3 +196,43 @@ (guard (condition ((assertion-violation? condition) #t)) (assert #f) #f))) + +(with-test-prefix "string-for-each" + (pass-if "reverse string" + (let ((s "reverse me") (l '())) + (string-for-each (lambda (x) (set! l (cons x l))) s) + (equal? "em esrever" (list->string l)))) + (pass-if "two strings good" + (let ((s1 "two legs good") + (s2 "four legs bad") + (c '())) + (string-for-each (lambda (c1 c2) + (set! c (cons* c2 c1 c))) + s1 s2) + (equal? (list->string c) + "ddaobo gs gsegle lr uoowft"))) + (pass-if "two strings bad" + (let ((s1 "frotz") + (s2 "veeblefetzer")) + (guard (condition ((assertion-violation? condition) #t)) + (string-for-each (lambda (s1 s2) #f) s1 s2) + #f))) + (pass-if "many strings good" + (let ((s1 "foo") + (s2 "bar") + (s3 "baz") + (s4 "zot") + (c '())) + (string-for-each (lambda (c1 c2 c3 c4) + (set! c (cons* c4 c3 c2 c1 c))) + s1 s2 s3 s4) + (equal? (list->string c) + "tzrooaaozbbf"))) + (pass-if "many strings bad" + (let ((s1 "foo") + (s2 "bar") + (s3 "baz") + (s4 "quux")) + (guard (condition ((assertion-violation? condition) #t)) + (string-for-each (lambda _ #f) s1 s2 s3 s4) + #f)))) -- 1.7.7.6 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-R6RS-srfi-library-names-should-ignore-first-identifi.patch Content-Description: r6rs libraries patch >From 3c73a30c89e005927dcd6239b54e752c05c2a48f Mon Sep 17 00:00:00 2001 From: Ian Price Date: Thu, 22 Nov 2012 10:16:44 +0000 Subject: [PATCH 2/2] R6RS srfi library names should ignore first identifier after the :n * module/ice-9/r6rs-libraries.scm (resolve-r6rs-interface): (srfi :n name ids ...) -> (srfi srfi-n ids ...) * test-suite/tests/rnrs-libraries.test ("srfi"): Add test. --- module/ice-9/r6rs-libraries.scm | 6 +++++- test-suite/tests/rnrs-libraries.test | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm index 019a6a7..9fef7a2 100644 --- a/module/ice-9/r6rs-libraries.scm +++ b/module/ice-9/r6rs-libraries.scm @@ -40,7 +40,11 @@ (substring (symbol->string (syntax->datum #'colon-n)) 1))))) (resolve-r6rs-interface - #`(library (srfi #,srfi-n rest ... (version ...)))))) + (if (null? #'(rest ...)) + #`(library (srfi #,srfi-n (version ...))) + ;; SRFI 97 says that the first identifier after the colon-n + ;; is used for the libraries name, so it must be ignored. + #`(library (srfi #,srfi-n #,@(cdr #'(rest ...)) (version ...))))))) ((library (name name* ... (version ...))) (and-map sym? #'(name name* ...)) diff --git a/test-suite/tests/rnrs-libraries.test b/test-suite/tests/rnrs-libraries.test index e961c28..9add98a 100644 --- a/test-suite/tests/rnrs-libraries.test +++ b/test-suite/tests/rnrs-libraries.test @@ -183,7 +183,9 @@ (with-test-prefix "srfi" (pass-if "renaming works" (eq? (resolve-interface '(srfi srfi-1)) - (resolve-r6rs-interface '(srfi :1))))) + (resolve-r6rs-interface '(srfi :1))) + (eq? (resolve-interface '(srfi srfi-1)) + (resolve-r6rs-interface '(srfi :1 lists))))) (with-test-prefix "macro" (pass-if "multiple clauses" -- 1.7.7.6 --=-=-=--