Added stop-after and stop-before
These are equivalent to their racket for loop counterparts, and creates an iterator that signals exhaustion befor or after yielding a value where a predicate returns true. Not useful in non-nested loops, but could be useful in inner loops where you want to exit to an outerloop instead of :break-ing. Also fixed some bugs in other generator clauses.
This commit is contained in:
		
							parent
							
								
									3908019bbc
								
							
						
					
					
						commit
						a38170a25b
					
				
					 2 changed files with 82 additions and 46 deletions
				
			
		
							
								
								
									
										85
									
								
								goof.scm
									
										
									
									
									
								
							
							
						
						
									
										85
									
								
								goof.scm
									
										
									
									
									
								
							|  | @ -32,57 +32,57 @@ | ||||||
| (define-module (goof) | (define-module (goof) | ||||||
|   #:use-module (goof helpers) |   #:use-module (goof helpers) | ||||||
|   #:use-module (goof ref-let) |   #:use-module (goof ref-let) | ||||||
|   #:use-module (rnrs io simple) |   #:use-module ((rnrs io simple) #:select (eof-object)) | ||||||
|   #:use-module ((srfi srfi-1) #:select (any circular-list find)) |   #:use-module ((srfi srfi-1) #:select (any circular-list find)) | ||||||
|   #:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!)) |   #:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!)) | ||||||
|   #:use-module (srfi srfi-71) |   #:use-module (srfi srfi-71) | ||||||
|   #:use-module (ice-9 futures) |   #:use-module (ice-9 futures) | ||||||
|   #:export (loop |   #:export (loop | ||||||
|  |                loop/list | ||||||
|  |              loop/sum | ||||||
|  |              loop/product | ||||||
|  |              loop/first | ||||||
|  |              loop/last | ||||||
|  |              loop/and | ||||||
|  |              loop/or | ||||||
|  |              loop/list/parallel | ||||||
| 
 | 
 | ||||||
|             loop/list |              :when :unless :break :final :let :let* :subloop :for :acc | ||||||
|             loop/sum |              :length :fill | ||||||
|             loop/product |              :to :by | ||||||
|             loop/first |  | ||||||
|             loop/last |  | ||||||
|             loop/and |  | ||||||
|             loop/or |  | ||||||
|             loop/list/parallel |  | ||||||
| 
 | 
 | ||||||
|             :when :unless :break :final :let :let* :subloop :for :acc |              in | ||||||
|             :length :fill |              in-list | ||||||
|             :to :by |              in-lists | ||||||
| 
 | 
 | ||||||
|             in |              in-vector in-reverse-vector | ||||||
|             in-list |              in-string in-reverse-string | ||||||
|             in-lists |              in-hash | ||||||
| 
 | 
 | ||||||
|             in-vector in-reverse-vector |              in-port | ||||||
|             in-string in-reverse-string |              in-file | ||||||
|             in-hash |              in-generator | ||||||
|  |              up-from | ||||||
|  |              down-from | ||||||
|  |              accumulating | ||||||
|  |              folding | ||||||
|  |              listing | ||||||
|  |              listing-reverse | ||||||
|  |              appending | ||||||
|  |              appending-reverse | ||||||
|  |              summing | ||||||
|  |              multiplying | ||||||
|  |              hashing | ||||||
|  |              vectoring | ||||||
| 
 | 
 | ||||||
|             in-port |              ;; generator clauses | ||||||
|             in-file |              in-cycle | ||||||
|             in-generator |              in-indexed | ||||||
|             up-from |              stop-before | ||||||
|             down-from |              stop-after | ||||||
|             accumulating |              ;; Syntax for adding clauses | ||||||
|             folding |              register-loop-clause)) | ||||||
|             listing |  | ||||||
|             listing-reverse |  | ||||||
|             appending |  | ||||||
|             appending-reverse |  | ||||||
|             summing |  | ||||||
|             multiplying |  | ||||||
|             hashing |  | ||||||
|             vectoring |  | ||||||
| 
 | 
 | ||||||
|             ;; generator clauses |  | ||||||
|             in-cycle |  | ||||||
|             in-indexed |  | ||||||
| 
 |  | ||||||
|             ;; Syntax for adding clauses |  | ||||||
|             register-loop-clause |  | ||||||
|             )) |  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| ;; This contains the portable parts of goof-loop. | ;; This contains the portable parts of goof-loop. | ||||||
|  | @ -104,6 +104,8 @@ | ||||||
|                                                 ;; generator clauses |                                                 ;; generator clauses | ||||||
|                                                 #'in-cycle |                                                 #'in-cycle | ||||||
|                                                 #'in-indexed |                                                 #'in-indexed | ||||||
|  |                                                 #'stop-before | ||||||
|  |                                                 #'stop-after | ||||||
|                                                 ))) |                                                 ))) | ||||||
| (define valid-acc-clauses (make-parameter (list #'folding | (define valid-acc-clauses (make-parameter (list #'folding | ||||||
|                                                 #'listing |                                                 #'listing | ||||||
|  | @ -177,6 +179,9 @@ | ||||||
| 
 | 
 | ||||||
| (define-syntax inner-recur | (define-syntax inner-recur | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|  |     ;; If we have no final tests, don't bother producing the code. The guile | ||||||
|  |     ;; inliner/DCE stops trying to do more work if the loop is very deep | ||||||
|  |     ;; meaning in deeply nested loops, we could end up producing slow code. | ||||||
|     ((_ loop-name final-fun () ((v s) ...)) |     ((_ loop-name final-fun () ((v s) ...)) | ||||||
|      (loop-name s ...)) |      (loop-name s ...)) | ||||||
|     ;; This is somewhat of an ugly thing. We want to test (or user-finals ...) |     ;; This is somewhat of an ugly thing. We want to test (or user-finals ...) | ||||||
|  |  | ||||||
|  | @ -244,7 +244,7 @@ | ||||||
| 
 | 
 | ||||||
| (define-syntax in-generator | (define-syntax in-generator | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ :for ((var) (source)) next . rest) |     ((_ :for ((var) source) next . rest) | ||||||
|      (next ((gen source)) |      (next ((gen source)) | ||||||
|            ((var (gen) (gen))) |            ((var (gen) (gen))) | ||||||
|            ((eof-object? var)) |            ((eof-object? var)) | ||||||
|  | @ -307,7 +307,7 @@ | ||||||
| 
 | 
 | ||||||
| (define-syntax in-hash | (define-syntax in-hash | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((in-hash :for ((bindings) (expr)) n . rest) |     ((in-hash :for ((bindings) expr) n . rest) | ||||||
|      (n |      (n | ||||||
|       () |       () | ||||||
|       ((cursor (hash-map->list cons expr) (cdr cursor))) |       ((cursor (hash-map->list cons expr) (cdr cursor))) | ||||||
|  | @ -472,7 +472,7 @@ | ||||||
|          |          | ||||||
| (define-syntax in-cycle | (define-syntax in-cycle | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ ((id) (source)) n . rest) |     ((_ :for ((id) (source)) n . rest) | ||||||
|      (n ((gen (generator-cycle source))) |      (n ((gen (generator-cycle source))) | ||||||
|         () |         () | ||||||
|         () |         () | ||||||
|  | @ -492,11 +492,42 @@ | ||||||
|               (cons index res))))))) |               (cons index res))))))) | ||||||
| 
 | 
 | ||||||
| (define-syntax in-indexed | (define-syntax in-indexed | ||||||
|   (syntax-rules () |   (syntax-rules (:for) | ||||||
|     ((_ ((binding) (source)) n . rest) |     ((_ :for ((binding) (source)) n . rest) | ||||||
|      (n ((gen (generator-indexed source))) |      (n ((gen (generator-indexed source))) | ||||||
|         ((i (gen) (gen))) |         ((i (gen) (gen))) | ||||||
|         ((eof-object? i)) |         ((eof-object? i)) | ||||||
|         ((binding i)) |         ((binding i)) | ||||||
|         () |         () | ||||||
|         . rest)))) |         . rest)))) | ||||||
|  | 
 | ||||||
|  | (define (stop-before-generator gen pred) | ||||||
|  |   (lambda () | ||||||
|  |     (let ((v (gen))) | ||||||
|  |       (if (pred v) | ||||||
|  |           (eof-object) | ||||||
|  |           v)))) | ||||||
|  | 
 | ||||||
|  | (define (stop-after-generator gen pred) | ||||||
|  |   (let ((done? #f)) | ||||||
|  |     (lambda () | ||||||
|  |       (if done? | ||||||
|  |           (eof-object) | ||||||
|  |           (let ((v (gen))) | ||||||
|  |             (when (pred v) | ||||||
|  |               (set! done? #t)) | ||||||
|  |             v))))) | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | (define-syntax stop-before | ||||||
|  |   (syntax-rules (:for) | ||||||
|  |     ((_ :for ((binding) (source pred)) n . rest) | ||||||
|  |      (in-generator :for ((binding) (stop-before-generator source pred)) n . rest)) | ||||||
|  |     ((_ expr pred) | ||||||
|  |      (stop-before-generator expr pred)))) | ||||||
|  | 
 | ||||||
|  | (define-syntax stop-after | ||||||
|  |   (syntax-rules (:for) | ||||||
|  |     ((_ :for ((binding) (source pred)) n . rest) | ||||||
|  |      (in-generator :for ((binding) (stop-after-generator source pred)) n . rest)) | ||||||
|  |     ((_ expr pred) (stop-after-generator expr pred)))) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus