Simplified the iterator protocol.
There is no need for :acc clauses to intoduce loop variables, or for :for clauses to introduce acc clauses. They are now changed. * goof.scm (cl-next/acc cl-next/for): removed the unused matchings for loop-vars and acc-vars respectively. * goof/iterators.scm (all iterators): simplified it.
This commit is contained in:
		
							parent
							
								
									7311da2ec2
								
							
						
					
					
						commit
						93aa5aa439
					
				
					 2 changed files with 26 additions and 53 deletions
				
			
		
							
								
								
									
										20
									
								
								goof.scm
									
										
									
									
									
								
							
							
						
						
									
										20
									
								
								goof.scm
									
										
									
									
									
								
							|  | @ -209,11 +209,11 @@ | ||||||
| (define-syntax cl-next/acc | (define-syntax cl-next/acc | ||||||
|   (syntax-rules (:acc) |   (syntax-rules (:acc) | ||||||
|     ;; :acc clause without any subloops |     ;; :acc clause without any subloops | ||||||
|     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) |     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         ((lets ...)) |         ((lets ...)) | ||||||
|         ((accs ...)) |         ((accs ...)) | ||||||
|         ((vars ...)) |         vars | ||||||
|         ((checks ...)) |         ((checks ...)) | ||||||
|         ((refs ...)) |         ((refs ...)) | ||||||
|         (finals ...) |         (finals ...) | ||||||
|  | @ -221,17 +221,17 @@ | ||||||
|       (cl orig name |       (cl orig name | ||||||
|           ((lets ... new-lets ...)) |           ((lets ... new-lets ...)) | ||||||
|           ((accs ... (accvar accinit accupdate) ...)) |           ((accs ... (accvar accinit accupdate) ...)) | ||||||
|           ((vars ... new-vars ...)) |           vars | ||||||
|           ((checks ... new-checks ...)) |           ((checks ... new-checks ...)) | ||||||
|           ((refs ... new-refs ...)) |           ((refs ... new-refs ...)) | ||||||
|           (finals ... new-finals ...) |           (finals ... new-finals ...) | ||||||
|           ff ul uw ub uf clauses . body)) |           ff ul uw ub uf clauses . body)) | ||||||
|     ;; We have ONE subloop! |     ;; We have ONE subloop! | ||||||
|     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) |     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         (lets ... (outermost-lets ...)) |         (lets ... (outermost-lets ...)) | ||||||
|         ((accs ...) ((oldacc oldinit oldupdate) ...)) |         ((accs ...) ((oldacc oldinit oldupdate) ...)) | ||||||
|         ((vars ...) . vars-rest) |         vars | ||||||
|         ((checks ...) . checks-rest) |         ((checks ...) . checks-rest) | ||||||
|         ((refs ...) . refs-rest) |         ((refs ...) . refs-rest) | ||||||
|         (finals ...) |         (finals ...) | ||||||
|  | @ -239,17 +239,17 @@ | ||||||
|       (cl orig name |       (cl orig name | ||||||
|           (lets ... (outermost-lets ... new-lets ...)) |           (lets ... (outermost-lets ... new-lets ...)) | ||||||
|           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...)) |           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...)) | ||||||
|           ((vars ... new-vars ...) . vars-rest) |           vars | ||||||
|           ((checks ... new-checks ...) . checks-rest) |           ((checks ... new-checks ...) . checks-rest) | ||||||
|           ((refs ... new-refs ...) . refs-rest) |           ((refs ... new-refs ...) . refs-rest) | ||||||
|           (finals ... new-finals ...) |           (finals ... new-finals ...) | ||||||
|           ff ul uw ub uf clauses . body)) |           ff ul uw ub uf clauses . body)) | ||||||
|     ;; We have several subloops! |     ;; We have several subloops! | ||||||
|     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) |     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         (lets ... (outermost-lets ...)) |         (lets ... (outermost-lets ...)) | ||||||
|         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) |         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) | ||||||
|         ((vars ...) . vars-rest) |         vars | ||||||
|         ((checks ...) . checks-rest) |         ((checks ...) . checks-rest) | ||||||
|         ((refs ...) . refs-rest) |         ((refs ...) . refs-rest) | ||||||
|         (finals ...) |         (finals ...) | ||||||
|  | @ -258,7 +258,7 @@ | ||||||
|           (lets ... (outermost-lets ... new-lets ...)) |           (lets ... (outermost-lets ... new-lets ...)) | ||||||
|           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... |           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... | ||||||
|            ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...)) |            ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...)) | ||||||
|           ((vars ... new-vars ...) . vars-rest) |           vars | ||||||
|           ((checks ... new-checks ...) . checks-rest) |           ((checks ... new-checks ...) . checks-rest) | ||||||
|           ((refs ... new-refs ...) . refs-rest) |           ((refs ... new-refs ...) . refs-rest) | ||||||
|           (finals ... new-finals ...) |           (finals ... new-finals ...) | ||||||
|  | @ -268,7 +268,7 @@ | ||||||
| ;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop | ;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop | ||||||
| (define-syntax cl-next/for | (define-syntax cl-next/for | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ (new-lets ...) () (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...) |     ((_ (new-lets ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         ((lets ...) . lets-rest) |         ((lets ...) . lets-rest) | ||||||
|         accs |         accs | ||||||
|  |  | ||||||
|  | @ -28,23 +28,15 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO iterators | ;; TODO iterators | ||||||
| ;; in-stream | ;; in-stream | ||||||
| ;; in-naturals |  | ||||||
| ;; in-hash with variations |  | ||||||
| 
 |  | ||||||
| ;; TODO: accumulators |  | ||||||
| ;; vectoring |  | ||||||
| ;; hashing |  | ||||||
| ;; hashqing |  | ||||||
| ;; hashving |  | ||||||
| 
 | 
 | ||||||
| (define-syntax in | (define-syntax in | ||||||
|   (syntax-rules ()  |   (syntax-rules ()  | ||||||
|   ((_ ((var) (init)) n . rest) |   ((_ ((var) (init)) n . rest) | ||||||
|    (n () () ((var init var)) () () () . rest)) |    (n () ((var init var)) () () () . rest)) | ||||||
|   ((_ ((var) (init step)) n . rest) |   ((_ ((var) (init step)) n . rest) | ||||||
|    (n () () ((var init step)) () () () . rest)) |    (n () ((var init step)) () () () . rest)) | ||||||
|   ((_ ((var) (init step stop)) n . rest) |   ((_ ((var) (init step stop)) n . rest) | ||||||
|    (n () () ((var init step)) (stop) () () . rest)))) |    (n () ((var init step)) (stop) () () . rest)))) | ||||||
| 
 | 
 | ||||||
| (define-syntax in-list | (define-syntax in-list | ||||||
|   (syntax-rules (:gen) |   (syntax-rules (:gen) | ||||||
|  | @ -58,9 +50,6 @@ | ||||||
|      (next |      (next | ||||||
|       ;; outer let bindings, bound outside the loop, unchanged during the loop |       ;; outer let bindings, bound outside the loop, unchanged during the loop | ||||||
|       () |       () | ||||||
|       ;; accumulators. These are the same as the bindings below, but values are |  | ||||||
|       ;; kept through subloops. |  | ||||||
|       () |  | ||||||
|       ;; iterator, init, step |       ;; iterator, init, step | ||||||
|       ((cursor source succ)) |       ((cursor source succ)) | ||||||
|       ;; tests to check whether the iterator is exhausted. |       ;; tests to check whether the iterator is exhausted. | ||||||
|  | @ -106,7 +95,6 @@ | ||||||
|      (in-lists ((elts pairs succ) (lol step null?)) next . rest)) |      (in-lists ((elts pairs succ) (lol step null?)) next . rest)) | ||||||
|     ((in-lists ((elts pairs succ) (lol step done?)) next . rest) |     ((in-lists ((elts pairs succ) (lol step done?)) next . rest) | ||||||
|      (next () |      (next () | ||||||
|            () |  | ||||||
|            ((pairs lol succ)) |            ((pairs lol succ)) | ||||||
|            ((let lp ((ls pairs)) ; an in-lined ANY |            ((let lp ((ls pairs)) ; an in-lined ANY | ||||||
|               (and (pair? ls) (if (done? (car ls)) #t (lp (cdr ls)))))) |               (and (pair? ls) (if (done? (car ls)) #t (lp (cdr ls)))))) | ||||||
|  | @ -145,7 +133,6 @@ | ||||||
|      (%in-idx ge + s e r tmp ((var index) (seq from (e tmp))) next . rest)) |      (%in-idx ge + s e r tmp ((var index) (seq from (e tmp))) next . rest)) | ||||||
|     ((%in-idx ge + s e r tmp ((var index) (seq from to)) next . rest) |     ((%in-idx ge + s e r tmp ((var index) (seq from to)) next . rest) | ||||||
|      (next ((tmp seq) (end to)) |      (next ((tmp seq) (end to)) | ||||||
|            () |  | ||||||
|            ((index from (+ tmp index))) |            ((index from (+ tmp index))) | ||||||
|            ((ge index end)) |            ((ge index end)) | ||||||
|            ((var (r tmp index))) |            ((var (r tmp index))) | ||||||
|  | @ -165,7 +152,6 @@ | ||||||
|      (in-port ((var p) (port read-char eof-object?)) next . rest)) |      (in-port ((var p) (port read-char eof-object?)) next . rest)) | ||||||
|     ((in-port ((var p) (port reader eof?)) next . rest) |     ((in-port ((var p) (port reader eof?)) next . rest) | ||||||
|      (next ((p port)) |      (next ((p port)) | ||||||
|            () |  | ||||||
|            ((var (reader p) (reader p))) |            ((var (reader p) (reader p))) | ||||||
|            ((eof? var)) |            ((eof? var)) | ||||||
|            () |            () | ||||||
|  | @ -182,7 +168,6 @@ | ||||||
|       (in-file ((var p) (file reader eof-object?)) next . rest)) |       (in-file ((var p) (file reader eof-object?)) next . rest)) | ||||||
|      ((in-file ((var p) (file reader eof?)) next . rest) |      ((in-file ((var p) (file reader eof?)) next . rest) | ||||||
|       (next ((p (open-input-file file)) (r reader) (e? eof?)) |       (next ((p (open-input-file file)) (r reader) (e? eof?)) | ||||||
|             () |  | ||||||
|             ((var (r p) (r p))) |             ((var (r p) (r p))) | ||||||
|             ((e? var)) |             ((e? var)) | ||||||
|             () |             () | ||||||
|  | @ -192,7 +177,6 @@ | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ ((var) (source)) next . rest) |     ((_ ((var) (source)) next . rest) | ||||||
|      (next ((gen source)) |      (next ((gen source)) | ||||||
|            () |  | ||||||
|            ((var (gen) (gen))) |            ((var (gen) (gen))) | ||||||
|            ((eof-object? var)) |            ((eof-object? var)) | ||||||
|            () |            () | ||||||
|  | @ -205,22 +189,21 @@ | ||||||
|      (up-from ((var) . args) next . rest)) |      (up-from ((var) . args) next . rest)) | ||||||
|     ((up-from ((var) (start (to limit) (by step))) next . rest) |     ((up-from ((var) (start (to limit) (by step))) next . rest) | ||||||
|      (next ((s start) (l limit) (e step)) |      (next ((s start) (l limit) (e step)) | ||||||
|            () |  | ||||||
|            ((var s (+ var e))) |            ((var s (+ var e))) | ||||||
|            ((>= var l)) |            ((>= var l)) | ||||||
|            () () . rest)) |            () () . rest)) | ||||||
|     ((up-from ((var) (start (to limit))) next . rest) |     ((up-from ((var) (start (to limit))) next . rest) | ||||||
|      (next ((s start) (l limit)) () ((var s (+ var 1))) |      (next ((s start) (l limit)) ((var s (+ var 1))) | ||||||
|            ((>= var l)) () () . rest)) |            ((>= var l)) () () . rest)) | ||||||
|     ((up-from ((var) (start (by step))) next . rest) |     ((up-from ((var) (start (by step))) next . rest) | ||||||
|      (next ((s start) (e step))() |      (next ((s start) (e step)) | ||||||
|            ((var s (+ var e))) () () () . rest)) |            ((var s (+ var e))) () () () . rest)) | ||||||
|     ((up-from ((var) (start)) next . rest) |     ((up-from ((var) (start)) next . rest) | ||||||
|      (next ((s start)) () ((var s (+ var 1))) |      (next ((s start)) ((var s (+ var 1))) | ||||||
|            () () () . rest)) |            () () () . rest)) | ||||||
|     ;; Extra convenience, make it act like (in-range ...) from racket, but only for positive numbers. |     ;; Extra convenience, make it act like (in-range ...) from racket, but only for positive numbers. | ||||||
|     ((up-from ((var) (start limit step)) next . rest) |     ((up-from ((var) (start limit step)) next . rest) | ||||||
|      (next ((s start) (l limit) (e step)) () ((var s (+ var e))) ((>= var l)) () () . rest)) |      (next ((s start) (l limit) (e step)) ((var s (+ var e))) ((>= var l)) () () . rest)) | ||||||
|     ((up-from ((var) (start limit)) next . rest) |     ((up-from ((var) (start limit)) next . rest) | ||||||
|      (up-from ((var) (start limit 1)) next . rest)))) |      (up-from ((var) (start limit 1)) next . rest)))) | ||||||
| 
 | 
 | ||||||
|  | @ -230,21 +213,20 @@ | ||||||
|      (down-from ((var) . args) next . rest)) |      (down-from ((var) . args) next . rest)) | ||||||
|     ((down-from ((var) (start (to limit) (by step))) next . rest) |     ((down-from ((var) (start (to limit) (by step))) next . rest) | ||||||
|      (next ((s start) (l limit) (e step)) |      (next ((s start) (l limit) (e step)) | ||||||
|            () |  | ||||||
|            ((var (- s e) (- var e))) |            ((var (- s e) (- var e))) | ||||||
|            ((< var l)) |            ((< var l)) | ||||||
|            () () . rest)) |            () () . rest)) | ||||||
|     ((down-from ((var) (start (to limit))) next . rest) |     ((down-from ((var) (start (to limit))) next . rest) | ||||||
|      (next ((s start) (l limit)) () ((var (- s 1) (- var 1))) |      (next ((s start) (l limit)) ((var (- s 1) (- var 1))) | ||||||
|            ((< var l)) () () . rest)) |            ((< var l)) () () . rest)) | ||||||
|     ((down-from ((var) (start (by step))) next . rest) |     ((down-from ((var) (start (by step))) next . rest) | ||||||
|      (next ((s start) (e step)) () ((var (- s e) (- var e))) |      (next ((s start) (e step)) ((var (- s e) (- var e))) | ||||||
|            () () () . rest)) |            () () () . rest)) | ||||||
|     ((down-from ((var) (start)) next . rest) |     ((down-from ((var) (start)) next . rest) | ||||||
|      (next ((s start)) () ((var (- s 1) (- var 1))) |      (next ((s start)) ((var (- s 1) (- var 1))) | ||||||
|            () () () . rest)) |            () () () . rest)) | ||||||
|     ((down-from ((var) (start limit step)) next . rest) |     ((down-from ((var) (start limit step)) next . rest) | ||||||
|      (next ((s start) (l limit) (e step)) () ((var (- s e) (- var e))) ((< var l)) () () . rest)) |      (next ((s start) (l limit) (e step)) ((var (- s e) (- var e))) ((< var l)) () () . rest)) | ||||||
|     ((down-from ((var) (start limit)) next . rest) |     ((down-from ((var) (start limit)) next . rest) | ||||||
|      (down-from ((var) (start limit 1)) next . rest)))) |      (down-from ((var) (start limit 1)) next . rest)))) | ||||||
| 
 | 
 | ||||||
|  | @ -253,7 +235,6 @@ | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ ((bindings) (expr)) n . rest) |     ((_ ((bindings) (expr)) n . rest) | ||||||
|      (n |      (n | ||||||
|       () |  | ||||||
|       () |       () | ||||||
|       ((cursor (hash-map->list cons expr) (cdr cursor))) |       ((cursor (hash-map->list cons expr) (cdr cursor))) | ||||||
|       ((not (pair? cursor))) |       ((not (pair? cursor))) | ||||||
|  | @ -273,7 +254,6 @@ | ||||||
|         ((cursor init (if check (tmp-kons expr cursor) cursor))) |         ((cursor init (if check (tmp-kons expr cursor) cursor))) | ||||||
|         () |         () | ||||||
|         () |         () | ||||||
|         () |  | ||||||
|         ((var (final cursor))) |         ((var (final cursor))) | ||||||
|         . rest)) |         . rest)) | ||||||
|     ((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest) |     ((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest) | ||||||
|  | @ -281,7 +261,6 @@ | ||||||
|         ((cursor init (tmp-kons expr cursor))) |         ((cursor init (tmp-kons expr cursor))) | ||||||
|         () |         () | ||||||
|         () |         () | ||||||
|         () |  | ||||||
|         ((var (final cursor))) |         ((var (final cursor))) | ||||||
|         . rest)))) |         . rest)))) | ||||||
| 
 | 
 | ||||||
|  | @ -290,7 +269,7 @@ | ||||||
|     ((_ :acc ((var) (init update (if guard))) n . rest) |     ((_ :acc ((var) (init update (if guard))) n . rest) | ||||||
|      (n () |      (n () | ||||||
|         ((var init (if guard update var))) |         ((var init (if guard update var))) | ||||||
|         () () () |         () () | ||||||
|         ((var var)) |         ((var var)) | ||||||
|         . rest)) |         . rest)) | ||||||
|     ((_ :acc ((var) (init update)) n . rest) |     ((_ :acc ((var) (init update)) n . rest) | ||||||
|  | @ -352,7 +331,6 @@ | ||||||
|            ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f)))) |            ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f)))) | ||||||
|            () |            () | ||||||
|            () |            () | ||||||
|            () |  | ||||||
|            ((var hash)) |            ((var hash)) | ||||||
|            . rest))))))) |            . rest))))))) | ||||||
| 
 | 
 | ||||||
|  | @ -389,7 +367,6 @@ | ||||||
|         ((index 0 (+ index 1)) (var (make-vector 32) (vector-set!? var index expr))) |         ((index 0 (+ index 1)) (var (make-vector 32) (vector-set!? var index expr))) | ||||||
|         () |         () | ||||||
|         () |         () | ||||||
|         () |  | ||||||
|         ((var (vector-shrink? var index))) |         ((var (vector-shrink? var index))) | ||||||
|         . rest)) |         . rest)) | ||||||
|     ((_ :acc ((var index) (expr (:length len))) n . rest) |     ((_ :acc ((var index) (expr (:length len))) n . rest) | ||||||
|  | @ -404,7 +381,6 @@ | ||||||
|            ((index 0 (begin (vector-set! var index expr) (+ index 1)))) |            ((index 0 (begin (vector-set! var index expr) (+ index 1)))) | ||||||
|            () |            () | ||||||
|            () |            () | ||||||
|            () |  | ||||||
|            ((var var)) |            ((var var)) | ||||||
|            o n l a v c r fi ff ul uw ((ub ... (= index len)) . ub-rest) uf |            o n l a v c r fi ff ul uw ((ub ... (= index len)) . ub-rest) uf | ||||||
|            . rest)))) |            . rest)))) | ||||||
|  | @ -428,7 +404,6 @@ | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ ((id) (source)) n . rest) |     ((_ ((id) (source)) n . rest) | ||||||
|      (n ((gen (generator-cycle source))) |      (n ((gen (generator-cycle source))) | ||||||
|         () |  | ||||||
|         () |         () | ||||||
|         () |         () | ||||||
|         ((id (gen))) |         ((id (gen))) | ||||||
|  | @ -444,16 +419,14 @@ | ||||||
|             (values res res) |             (values res res) | ||||||
|             (begin |             (begin | ||||||
|               (set! i (+ i 1)) |               (set! i (+ i 1)) | ||||||
|               (values index res))))))) |               (cons index res))))))) | ||||||
| 
 | 
 | ||||||
| ;; Somewhat of a hack :) |  | ||||||
| (define-syntax in-indexed | (define-syntax in-indexed | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ ((i val) (source)) n . rest) |     ((_ ((binding) (source)) n . rest) | ||||||
|      (n ((gen (generator-indexed source))) |      (n ((gen (generator-indexed source))) | ||||||
|         () |         ((i (gen) (gen))) | ||||||
|         ((i 0 i)) |  | ||||||
|         ((eof-object? i)) |         ((eof-object? i)) | ||||||
|         ((i val (gen))) |         ((binding i)) | ||||||
|         () |         () | ||||||
|         . rest)))) |         . rest)))) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus