Added generator sequences
Basic hack of in-cycle and in-indexed
This commit is contained in:
		
							parent
							
								
									30b73286b3
								
							
						
					
					
						commit
						17d72f2cea
					
				
					 2 changed files with 71 additions and 7 deletions
				
			
		
							
								
								
									
										8
									
								
								goof.scm
									
										
									
									
									
								
							
							
						
						
									
										8
									
								
								goof.scm
									
										
									
									
									
								
							|  | @ -35,7 +35,9 @@ | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| (use-modules (helpers) | (use-modules (helpers) | ||||||
|              (srfi srfi-71)) |              ((srfi srfi-1) #:select (circular-list)) | ||||||
|  |              (srfi srfi-71) | ||||||
|  |              (rnrs io simple)) | ||||||
| 
 | 
 | ||||||
| (define-aux-syntaxes | (define-aux-syntaxes | ||||||
|   ;; Auxiliary syntax for the loop clauses |   ;; Auxiliary syntax for the loop clauses | ||||||
|  | @ -101,13 +103,9 @@ | ||||||
|      (cl orig name l a v c r f ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub (clauses ...) . body)) |      (cl orig name l a v c r f ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub (clauses ...) . body)) | ||||||
|     ((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub (:let* (id id* ... expr) clauses ...) . body) |     ((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub (:let* (id id* ... expr) clauses ...) . body) | ||||||
|      (cl orig name l a v c r f ((cur-ul ... (:let* id id* ... expr)) . ul-rest) (clauses ...) . body)) |      (cl orig name l a v c r f ((cur-ul ... (:let* id id* ... expr)) . ul-rest) (clauses ...) . body)) | ||||||
| 
 |  | ||||||
|     ;; Explicit subloop. Shorthand for (:when #t) |     ;; Explicit subloop. Shorthand for (:when #t) | ||||||
|     ((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub (:subloop clauses ...) . body) |     ((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub (:subloop clauses ...) . body) | ||||||
|      (cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ub (clauses ...) . body)) |      (cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ub (clauses ...) . body)) | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
|      |  | ||||||
|     ;; :for-clauses |     ;; :for-clauses | ||||||
|     ;; found a for clause when we have a :when or :unless clause. Push new subloop |     ;; found a for clause when we have a :when or :unless clause. Push new subloop | ||||||
|     ((_ orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((for-rest ...) clauses ...) . body) |     ((_ orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((for-rest ...) clauses ...) . body) | ||||||
|  |  | ||||||
|  | @ -47,7 +47,7 @@ | ||||||
|    (n () () ((var init step)) (stop) () () . rest)))) |    (n () () ((var init step)) (stop) () () . rest)))) | ||||||
| 
 | 
 | ||||||
| (define-syntax in-list | (define-syntax in-list | ||||||
|   (syntax-rules () |   (syntax-rules (:gen) | ||||||
|     ((_ ((var) source) next . rest) |     ((_ ((var) source) next . rest) | ||||||
|      (in-list ((var cursor) source) next . rest)) |      (in-list ((var cursor) source) next . rest)) | ||||||
|     ((_       ((var cursor) source) next . rest) |     ((_       ((var cursor) source) next . rest) | ||||||
|  | @ -71,9 +71,25 @@ | ||||||
|       ;; final bindings: things bound in the final function. |       ;; final bindings: things bound in the final function. | ||||||
|       () |       () | ||||||
|       ;; the continuation. |       ;; the continuation. | ||||||
|       . rest)))) |       . rest)) | ||||||
| 
 | 
 | ||||||
|  |     ;; Generator-clauses | ||||||
|  |     ((_ lst) | ||||||
|  |      (gen-list lst)) | ||||||
|  |     ((_ :gen (var) (expr step)) | ||||||
|  |      (gen-list lst step)))) | ||||||
| 
 | 
 | ||||||
|  | (define gen-list | ||||||
|  |   (case-lambda | ||||||
|  |     ((lst) | ||||||
|  |      (gen-list lst cdr)) | ||||||
|  |     ((lst by) | ||||||
|  |      (lambda () | ||||||
|  |        (if (null? lst) | ||||||
|  |            (eof-object) | ||||||
|  |            (let ((res (car lst))) | ||||||
|  |              (set! lst (by lst)) | ||||||
|  |              res)))))) | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| (define-syntax in-lists | (define-syntax in-lists | ||||||
|  | @ -342,3 +358,53 @@ | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((multiplying args next . rest) |     ((multiplying args next . rest) | ||||||
|      (accumulating (* (lambda (x) x) 1) args next . rest)))) |      (accumulating (* (lambda (x) x) 1) args next . rest)))) | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | ;;; Here starts generator clauses. | ||||||
|  | 
 | ||||||
|  | (define (generator->list gen) | ||||||
|  |   (let ((res (gen))) | ||||||
|  |     (if (eof-object? res) | ||||||
|  |         '() | ||||||
|  |         (cons res (generator->list gen))))) | ||||||
|  | 
 | ||||||
|  | (define (generator-cycle gen) | ||||||
|  |   (let ((circle (apply circular-list (generator->list gen)))) | ||||||
|  |     (lambda () | ||||||
|  |       (let ((res (car circle))) | ||||||
|  |         (set! circle (cdr circle)) | ||||||
|  |         res)))) | ||||||
|  |          | ||||||
|  | (define-syntax in-cycle | ||||||
|  |   (syntax-rules () | ||||||
|  |     ((_ ((id) (source)) n . rest) | ||||||
|  |      (n ((gen (generator-cycle source))) | ||||||
|  |         () | ||||||
|  |         ((id (gen) (gen))) | ||||||
|  |         ((eof-object? id)) | ||||||
|  |         () | ||||||
|  |         () | ||||||
|  |         . rest)))) | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | (define (generator-indexed gen) | ||||||
|  |   (let ((i 0)) | ||||||
|  |     (lambda () | ||||||
|  |       (let ((res (gen)) (index i)) | ||||||
|  |         (if (eof-object? res) | ||||||
|  |             (values res res) | ||||||
|  |             (begin | ||||||
|  |               (set! i (+ i 1)) | ||||||
|  |               (values index res))))))) | ||||||
|  | 
 | ||||||
|  | ;; Somewhat of a hack :) | ||||||
|  | (define-syntax in-indexed | ||||||
|  |   (syntax-rules () | ||||||
|  |     ((_ ((i val) (source)) n . rest) | ||||||
|  |      (n ((gen (generator-indexed source))) | ||||||
|  |         () | ||||||
|  |         ((i 0 i)) | ||||||
|  |         ((eof-object? i)) | ||||||
|  |         ((i val (gen))) | ||||||
|  |         () | ||||||
|  |         . rest)))) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus