/[guile]/guile/guile-core/ice-9/boot-9.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/boot-9.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.316 by dirk, Tue May 27 18:33:18 2003 UTC revision 1.317 by kryde, Tue Aug 12 21:38:21 2003 UTC
# Line 2491  Line 2491 
2491          (loop (1- count) (cons count result)))))          (loop (1- count) (cons count result)))))
2492    
2493    
 ;;; {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)))))  
   
2494  ;;; {collect}  ;;; {collect}
2495  ;;;  ;;;
2496  ;;; Similar to `begin' but returns a list of the results of all constituent  ;;; Similar to `begin' but returns a list of the results of all constituent
# Line 2560  Line 2548 
2548        (else        (else
2549         (error "define-syntax-macro can only be used at the top level")))))         (error "define-syntax-macro can only be used at the top level")))))
2550    
2551    ;;; {While}
2552    ;;;
2553    ;;; with `continue' and `break'.
2554    ;;;
2555    
2556    ;; The inner `do' loop avoids re-establishing a catch every iteration,
2557    ;; that's only necessary if continue is actually used.
2558    ;;
2559    (define-macro (while cond . body)
2560      (let ((key (make-symbol "while-key")))
2561        `(,do ((break    ,(lambda () (throw key #t)))
2562               (continue ,(lambda () (throw key #f))))
2563             ((,catch (,quote ,key)
2564                      (,lambda ()
2565                        (,do ()
2566                            ((,not ,cond))
2567                          ,@body)
2568                        #t)
2569                      ,(lambda (key arg) arg))))))
2570    
2571    
2572  ;;; {Module System Macros}  ;;; {Module System Macros}
2573  ;;;  ;;;

Legend:
Removed from v.1.316  
changed lines
  Added in v.1.317

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26