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: Re: while break and continue Date: Thu, 14 Aug 2003 07:49:30 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87znid1b4l.fsf@zip.com.au> References: <87isrtmhfw.fsf@zip.com.au> <87he79ic44.fsf@zagadka.ping.de> <878yshe1ux.fsf@zip.com.au> <87n0gf0zbc.fsf@zagadka.ping.de> <87fzm3m2n9.fsf@zip.com.au> <87smosrpp0.fsf@zagadka.ping.de> <8765lmkwpb.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1060725108 19616 80.91.224.253 (12 Aug 2003 21:51:48 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 12 Aug 2003 21:51:48 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Aug 12 23:51:46 2003 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 19mh3S-00059x-00 for ; Tue, 12 Aug 2003 23:51:46 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.20) id 19mh22-0007dG-RD for guile-devel@m.gmane.org; Tue, 12 Aug 2003 17:50:18 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.20) id 19mh1y-0007cz-ST for guile-devel@gnu.org; Tue, 12 Aug 2003 17:50:14 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.20) id 19mh1S-0007XC-Jg for guile-devel@gnu.org; Tue, 12 Aug 2003 17:50:13 -0400 Original-Received: from [61.8.0.36] (helo=snoopy.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.20) id 19mh1R-0007WP-Hx for guile-devel@gnu.org; Tue, 12 Aug 2003 17:49:41 -0400 Original-Received: from sunny.pacific.net.au (sunny.pacific.net.au [203.2.228.40]) by snoopy.pacific.net.au (8.12.3/8.12.3/Debian-6.4) with ESMTP id h7CLne0J007524 for ; Wed, 13 Aug 2003 07:49:40 +1000 Original-Received: from wisma.pacific.net.au (wisma.pacific.net.au [210.23.129.72]) by sunny.pacific.net.au with ESMTP id h7CLndkv025271 for ; Wed, 13 Aug 2003 07:49:39 +1000 (EST) Original-Received: from localhost (ppp123.dyn228.pacific.net.au [203.143.228.123]) by wisma.pacific.net.au (8.12.9/8.12.9) with ESMTP id h7CLnaos007829 for ; Wed, 13 Aug 2003 07:49:37 +1000 (EST) Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 19n3Up-0001Xv-00; Thu, 14 Aug 2003 07:49:31 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.090019 (Oort Gnus v0.19) Emacs/21.2 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.2 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:2691 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2691 --=-=-= I applied this * boot-9.scm (while): Rewrite, continue as a proper escape, break doesn't take a return value, break and continue procs new for each while form allowing use in nested whiles, don't depend on bindings in expansion environment. * tests/syntax.test (while): New tests. * scheme-control.texi (while do): Update `while' for code rewrite, in particular describe break and continue. - syntax: while cond body ... Run a loop executing the BODY forms while COND is true. COND is tested at the start of each iteration, so if it's `#f' the first time then BODY is not executed at all. The return value is unspecified. Within `while', two extra bindings are provided, they can be used from both COND and BODY. - Scheme Procedure: break Break out of the `while' form. - Scheme Procedure: continue Abandon the current iteration, go back to the start and test COND again, etc. Each `while' form gets its own `break' and `continue' procedures, operating on that `while'. This means when loops are nested the outer `break' can be used to escape all the way out. For example, (while (test1) (let ((outer-break break)) (while (test2) (if (something) (outer-break #f)) ...))) Note that each `break' and `continue' procedure can only be used within the dynamic extent of its `while'. Outside the `while' their behaviour is unspecified. --=-=-= Content-Disposition: attachment; filename=boot-9.scm.while.diff --- boot-9.scm.~1.316.~ 2003-05-30 08:40:07.000000000 +1000 +++ boot-9.scm 2003-08-14 07:38:41.000000000 +1000 @@ -2491,18 +2491,6 @@ (loop (1- count) (cons count result))))) -;;; {While} -;;; -;;; with `continue' and `break'. -;;; - -(defmacro while (cond . body) - `(letrec ((continue (lambda () (or (not ,cond) (begin (begin ,@ body) (continue))))) - (break (lambda val (apply throw 'break val)))) - (catch 'break - (lambda () (continue)) - (lambda v (cadr v))))) - ;;; {collect} ;;; ;;; Similar to `begin' but returns a list of the results of all constituent @@ -2560,6 +2548,26 @@ (else (error "define-syntax-macro can only be used at the top level"))))) +;;; {While} +;;; +;;; with `continue' and `break'. +;;; + +;; The inner `do' loop avoids re-establishing a catch every iteration, +;; that's only necessary if continue is actually used. +;; +(define-macro (while cond . body) + (let ((key (make-symbol "while-key"))) + `(,do ((break ,(lambda () (throw key #t))) + (continue ,(lambda () (throw key #f)))) + ((,catch (,quote ,key) + (,lambda () + (,do () + ((,not ,cond)) + ,@body) + #t) + ,(lambda (key arg) arg)))))) + ;;; {Module System Macros} ;;; --=-=-= Content-Disposition: attachment; filename=syntax.test.while.diff --- syntax.test.~1.10.~ 2003-04-28 07:51:30.000000000 +1000 +++ syntax.test 2003-08-12 22:30:55.000000000 +1000 @@ -550,3 +550,171 @@ exception:missing/extra-expr (eval '(quote a b) (interaction-environment))))) + +(with-test-prefix "while" + + (define (unreachable) + (error "unreachable code has been reached!")) + + ;; an environment with no bindings at all + (define empty-environment + (make-module 1)) + + ;; Return a new procedure COND which when called (COND) will return #t the + ;; first N times, then #f, then any further call is an error. N=0 is + ;; allowed, in which case #f is returned by the first call. + (define (make-iterations-cond n) + (lambda () + (cond ((not n) + (error "oops, condition re-tested after giving false")) + ((= 0 n) + (set! n #f) + #f) + (else + (set! n (1- n)) + #t)))) + + + (pass-if-exception "too few args" exception:wrong-num-args + (while)) + + (with-test-prefix "empty body" + (do ((n 0 (1+ n))) + ((> n 5)) + (pass-if n + (let ((cond (make-iterations-cond n))) + (while (cond))) + #t))) + + (pass-if "initially false" + (while #f + (unreachable)) + #t) + + (with-test-prefix "in empty environment" + + (pass-if "empty body" + (eval `(,while #f) + empty-environment) + #t) + + (pass-if "initially false" + (eval `(,while #f + #f) + empty-environment) + #t) + + (pass-if "iterating" + (let ((cond (make-iterations-cond 3))) + (eval `(,while (,cond) + 123 456) + empty-environment)) + #t)) + + (with-test-prefix "iterations" + (do ((n 0 (1+ n))) + ((> n 5)) + (pass-if n + (let ((cond (make-iterations-cond n)) + (i 0)) + (while (cond) + (set! i (1+ i))) + (= i n))))) + + (with-test-prefix "break" + + (pass-if-exception "too many args" exception:wrong-num-args + (while #t + (break 1))) + + (with-test-prefix "from cond" + (pass-if "first" + (while (begin + (break) + (unreachable)) + (unreachable)) + #t) + + (do ((n 0 (1+ n))) + ((> n 5)) + (pass-if n + (let ((cond (make-iterations-cond n)) + (i 0)) + (while (if (cond) + #t + (begin + (break) + (unreachable))) + (set! i (1+ i))) + (= i n))))) + + (with-test-prefix "from body" + (pass-if "first" + (while #t + (break) + (unreachable)) + #t) + + (do ((n 0 (1+ n))) + ((> n 5)) + (pass-if n + (let ((cond (make-iterations-cond n)) + (i 0)) + (while #t + (if (not (cond)) + (begin + (break) + (unreachable))) + (set! i (1+ i))) + (= i n))))) + + (pass-if "from nested" + (while #t + (let ((outer-break break)) + (while #t + (outer-break) + (unreachable))) + (unreachable)) + #t)) + + (with-test-prefix "continue" + + (pass-if-exception "too many args" exception:wrong-num-args + (while #t + (continue 1))) + + (with-test-prefix "from cond" + (do ((n 0 (1+ n))) + ((> n 5)) + (pass-if n + (let ((cond (make-iterations-cond n)) + (i 0)) + (while (if (cond) + (begin + (set! i (1+ i)) + (continue) + (unreachable)) + #f) + (unreachable)) + (= i n))))) + + (with-test-prefix "from body" + (do ((n 0 (1+ n))) + ((> n 5)) + (pass-if n + (let ((cond (make-iterations-cond n)) + (i 0)) + (while (cond) + (set! i (1+ i)) + (continue) + (unreachable)) + (= i n))))) + + (pass-if "from nested" + (let ((cond (make-iterations-cond 3))) + (while (cond) + (let ((outer-continue continue)) + (while #t + (outer-continue) + (unreachable))))) + #t))) --=-=-= 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 --=-=-=--