Intermediate loops
goof.scm * Changed cl-next to properly push all intermediate loops * Changed emit-many/rest to emit intermediate loops * Added loop/list as a shorthand for just accumulating lists. tests.scm * Collected some things I wanted ta have to track regressions. README.md * Reflect above changes
This commit is contained in:
		
							parent
							
								
									f2496604d5
								
							
						
					
					
						commit
						be9ac1a55d
					
				
					 3 changed files with 108 additions and 54 deletions
				
			
		
							
								
								
									
										27
									
								
								README.md
									
										
									
									
									
								
							
							
						
						
									
										27
									
								
								README.md
									
										
									
									
									
								
							|  | @ -26,7 +26,19 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes | ||||||
|   => acc) |   => acc) | ||||||
| ``` | ``` | ||||||
| 
 | 
 | ||||||
| This will sum all the sublists of lst and produce the result 21. Any :when, :unless, or :break clause will break out a subloop if any subsequent for clauses are found. | This will sum all the sublists of lst and produce the result 21. Any :when, :unless, :break, or :subloop clause will break out a subloop if any subsequent for clauses are found. | ||||||
|  | 
 | ||||||
|  | Accumulators can be in any of the loop's stages: | ||||||
|  | 
 | ||||||
|  | ``` | ||||||
|  | (loop ((:for a (in-list '(1 2 3))) | ||||||
|  |        (:acc aa (summing a)) | ||||||
|  |        :subloop | ||||||
|  |        (:for b (up-from a (to (+ a 2)))) | ||||||
|  |        (:acc ab (listing b))) | ||||||
|  |   => (values aa ab)) | ||||||
|  | ;; => (values 6  (1 2 2 3 3 4)) | ||||||
|  | ``` | ||||||
| 
 | 
 | ||||||
| ## Differences from foof-loop | ## Differences from foof-loop | ||||||
| 
 | 
 | ||||||
|  | @ -42,11 +54,13 @@ with-clauses are removed in favour of (:for var (in init [step [stop]])) | ||||||
| 
 | 
 | ||||||
| accumulators are no longer for-clauses, but should be prepended with :acc. | accumulators are no longer for-clauses, but should be prepended with :acc. | ||||||
| 
 | 
 | ||||||
| ### Regressions | ### Regressions compared to foof-loop | ||||||
| 
 | 
 | ||||||
| only :acc clauses are visible in the final-expression. This is due to for-clauses not being promoted through to outer loops (since they should not keep their state). | only :acc clauses are visible in the final-expression. This is due to for-clauses not being promoted through to outer loops (since they should not keep their state). | ||||||
| 
 | 
 | ||||||
| :for clauses cannot finalize, due to the above thing. The reason for distinguishing between :for and :acc is to be able to promote accumulators outwards and finalizers inwards. This is not implemented. | :for clauses cannot finalize, due to the above thing. The reason for distinguishing between :for and :acc is to be able to promote accumulators outwards and finalizers inwards. This is not implemented yet, however. | ||||||
|  | 
 | ||||||
|  | Due to clause reordering, positional updates are not supported. If you want to update your loop vars, do so using named update (see below).  | ||||||
| 
 | 
 | ||||||
| ### changes | ### changes | ||||||
| 
 | 
 | ||||||
|  | @ -54,8 +68,6 @@ only :acc clauses are visible in the final-expression. This is due to for-clause | ||||||
| 
 | 
 | ||||||
| (with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var))) | (with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var))) | ||||||
| 
 | 
 | ||||||
| Positional updates of variables is not supported, due to goof-loop reordering the loop-vars - which there are reasons for. |  | ||||||
| 
 |  | ||||||
| ### similarities | ### similarities | ||||||
| 
 | 
 | ||||||
| You can of course still have a larger control of your loops: | You can of course still have a larger control of your loops: | ||||||
|  | @ -90,11 +102,6 @@ Named updates also work. | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| ## Todo | ## Todo | ||||||
| 
 |  | ||||||
| Currently, there is a bug if you have subloops more than 2 loops deep where all accumulators are reset. This should be an easy fix. |  | ||||||
| 
 |  | ||||||
| Regarding the above: fixing that bug does nothing! I can only output loops of at most 2. |  | ||||||
| 
 |  | ||||||
| Should we add finalizers for :for-clauses? I can't see the need outside of a potential (in-file ...), which can't be properly supported anyway since I won't do any dynamic-wind stuff. | Should we add finalizers for :for-clauses? I can't see the need outside of a potential (in-file ...), which can't be properly supported anyway since I won't do any dynamic-wind stuff. | ||||||
| 
 | 
 | ||||||
| Is (:for var (in init step stop)) and (:acc var (in init update)) good syntax? the :with clause of foof-loop is nice, but what should it be called for accumulators? Should we go back to calling both :acc and :for just ":for" and re-add :with and an accumulating counterpart? What should that accumulating counterpart be called? :acc? | Is (:for var (in init step stop)) and (:acc var (in init update)) good syntax? the :with clause of foof-loop is nice, but what should it be called for accumulators? Should we go back to calling both :acc and :for just ":for" and re-add :with and an accumulating counterpart? What should that accumulating counterpart be called? :acc? | ||||||
|  |  | ||||||
							
								
								
									
										110
									
								
								goof.scm
									
										
									
									
									
								
							
							
						
						
									
										110
									
								
								goof.scm
									
										
									
									
									
								
							|  | @ -54,20 +54,6 @@ | ||||||
| 
 | 
 | ||||||
| (include "iterators.scm") | (include "iterators.scm") | ||||||
| 
 | 
 | ||||||
| ;; TODO: Add intermediate subloops. Make sure that accumulators are properly propagated. |  | ||||||
| ;; DONE: fix let-kw-form. Don't use mutation. This should be tested: |  | ||||||
| ;; (define (partition predicate list) |  | ||||||
| ;;   (loop continue ((:for element (in-list list)) |  | ||||||
| ;;                   (:acc satisfied (in  '())) |  | ||||||
| ;;                   (:acc  unsatisfied  (in '()))) |  | ||||||
| ;;     => (values (reverse satisfied) |  | ||||||
| ;;                (reverse unsatisfied)) |  | ||||||
| ;;     (if (predicate element) |  | ||||||
| ;;         (continue (=> satisfied (cons element satisfied))) |  | ||||||
| ;;         (continue (=> unsatisfied (cons element unsatisfied)))))) |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| (define-aux-syntaxes :for :when :unless :break :final :let :let* :acc :subloop) | (define-aux-syntaxes :for :when :unless :break :final :let :let* :acc :subloop) | ||||||
| 
 | 
 | ||||||
| (define-syntax loop | (define-syntax loop | ||||||
|  | @ -166,24 +152,10 @@ | ||||||
|     )) |     )) | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| ;; cl-next integrates the results | ;; HOLY CODE-DUPLICATION-BATMAN! | ||||||
| ;; THIS WILL NEED TO BE UPDATED TO PROPERLY PUSH (accvar accinit accvar) ... down to the first accumulator. currently it | ;; cl-next integrates any bindings introduced by a :for or :acc clause. The complexity comes from pushing :acc-clauses | ||||||
| ;; will be re-initialized for every previous loop except the innermost one. | ;; into the outer loops. Since accumulators need to be available in the (final-fun ...), they need to be visible also | ||||||
| ;; THIS needs to work: | ;; in the outer loops if the loop exits there. | ||||||
| ;; (loop ((:for a (in-list '((1 2) (3 4) (5 6)))) |  | ||||||
| ;;        (:when #t) |  | ||||||
| ;;        (:for b (in-list a)) |  | ||||||
| ;;        (:for acc (listing b))) |  | ||||||
| ;;   => acc) |  | ||||||
| ;; as well as this: |  | ||||||
| ;; (loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7))))) |  | ||||||
| ;;        (:when #t) |  | ||||||
| ;;        (:for b (in-list a)) |  | ||||||
| ;;        (:when :t)   |  | ||||||
| ;;        (:for c (in-list b)) |  | ||||||
| ;;        (:for acc (listing c))) |  | ||||||
| ;;   => acc) |  | ||||||
| 
 |  | ||||||
| (define-syntax cl-next | (define-syntax cl-next | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) |     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|  | @ -202,18 +174,36 @@ | ||||||
|           ((refs ... new-refs ...)) |           ((refs ... new-refs ...)) | ||||||
|           (finals ... new-finals ...) |           (finals ... new-finals ...) | ||||||
|           ul uw ub clauses . body)) |           ul uw ub clauses . body)) | ||||||
|     ;; We have a subloop! |     ;; We have ONE subloop! | ||||||
|     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) |     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         ((lets ...) . lets-rest) |         ((lets ...) . lets-rest) | ||||||
|         ((accs ...) ((oldacc oldinit oldupdate) ...) ...) |         ((accs ...) ((oldacc oldinit oldupdate) ...)) | ||||||
|         ((vars ...) . vars-rest) |         ((vars ...) . vars-rest) | ||||||
|         ((checks ...) . checks-rest) |         ((checks ...) . checks-rest) | ||||||
|         ((refs ...) . refs-rest) |         ((refs ...) . refs-rest) | ||||||
|         (finals ...) ul uw ub clauses . body) |         (finals ...) ul uw ub clauses . body) | ||||||
|       (cl orig name |       (cl orig name | ||||||
|           ((lets ... new-lets ...) . lets-rest) |           ((lets ... new-lets ...) . lets-rest) | ||||||
|           ((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) | ||||||
|  |           ((checks ... new-checks ...) . checks-rest) | ||||||
|  |           ((refs ... new-refs ...) . refs-rest) | ||||||
|  |           (finals ... new-finals ...) | ||||||
|  |           ul uw ub clauses . body)) | ||||||
|  |     ;; We have several subloops! | ||||||
|  |     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|  |         orig name | ||||||
|  |         ((lets ...) . lets-rest) | ||||||
|  |         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) | ||||||
|  |         ((vars ...) . vars-rest) | ||||||
|  |         ((checks ...) . checks-rest) | ||||||
|  |         ((refs ...) . refs-rest) | ||||||
|  |         (finals ...) ul uw ub clauses . body) | ||||||
|  |       (cl orig name | ||||||
|  |           ((lets ... new-lets ...) . lets-rest) | ||||||
|  |           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... | ||||||
|  |            ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...)) | ||||||
|           ((vars ... new-vars ...) . vars-rest) |           ((vars ... new-vars ...) . vars-rest) | ||||||
|           ((checks ... new-checks ...) . checks-rest) |           ((checks ... new-checks ...) . checks-rest) | ||||||
|           ((refs ... new-refs ...) . refs-rest) |           ((refs ... new-refs ...) . refs-rest) | ||||||
|  | @ -327,7 +317,7 @@ | ||||||
|     ;; match innermost loop |     ;; match innermost loop | ||||||
|     ((_ orig |     ((_ orig | ||||||
|         name |         name | ||||||
|         next |         outer | ||||||
|         ((lets ...)) |         ((lets ...)) | ||||||
|         (((accvar accinit accstep) ...)) |         (((accvar accinit accstep) ...)) | ||||||
|         (((var init step) ...)) |         (((var init step) ...)) | ||||||
|  | @ -338,11 +328,11 @@ | ||||||
|         ((user-whens ...)) |         ((user-whens ...)) | ||||||
|         ((user-breaks ...)) |         ((user-breaks ...)) | ||||||
|         . body) |         . body) | ||||||
|      (let innermost-loop ((accvar accinit) ... |      (let* (lets ...) | ||||||
|                           (var init) ...) |        (let innermost-loop ((accvar accinit) ... | ||||||
|        (let* (lets ...) |                             (var init) ...) | ||||||
|          (if (or checks ...) |          (if (or checks ...) | ||||||
|              next |              outer | ||||||
|              (let (refs ...) |              (let (refs ...) | ||||||
|                (user-let () () (user-lets ...) |                (user-let () () (user-lets ...) | ||||||
|                  (if (and user-whens ...)          |                  (if (and user-whens ...)          | ||||||
|  | @ -356,10 +346,10 @@ | ||||||
|     ;; Any intermediate loops |     ;; Any intermediate loops | ||||||
|     ((_ orig |     ((_ orig | ||||||
|         name |         name | ||||||
|         next |         outer | ||||||
|         (next-lets ... (lets ...)) |         (next-lets ... (lets ...)) | ||||||
|         (next-accs ... ((accvar accinit accupdate) ...)) |         (next-accs ... ((accvar accinit accstep) ...)) | ||||||
|         (next-vars ... ((var init update) ...)) |         (next-vars ... ((var init step) ...)) | ||||||
|         (next-checks ... (checks ...)) |         (next-checks ... (checks ...)) | ||||||
|         (next-refs ... (refs ...)) |         (next-refs ... (refs ...)) | ||||||
|         final |         final | ||||||
|  | @ -367,7 +357,32 @@ | ||||||
|         (uw-next ... (user-whens ...)) |         (uw-next ... (user-whens ...)) | ||||||
|         (ub-next ... (user-breaks ...)) |         (ub-next ... (user-breaks ...)) | ||||||
|         . body) |         . body) | ||||||
|      (display "not implemented")))) |      (let* (lets ...) | ||||||
|  |        (let intermediate-loop ((accvar accinit) ... | ||||||
|  |                                (var init) ...) | ||||||
|  |          (if (or checks ...) | ||||||
|  |              outer | ||||||
|  |              (let (refs ...) | ||||||
|  |                (user-let () () (user-lets ...) | ||||||
|  |                  (if (and user-whens ...) | ||||||
|  |                      (if (or user-breaks ...) | ||||||
|  |                          final | ||||||
|  |                          (emit-many/rest | ||||||
|  |                           orig | ||||||
|  |                           name | ||||||
|  |                           (intermediate-loop accstep ... step ...) | ||||||
|  |                           (next-lets ...) | ||||||
|  |                           (next-accs ...) | ||||||
|  |                           (next-vars ...) | ||||||
|  |                           (next-checks ...) | ||||||
|  |                           (next-refs ...) | ||||||
|  |                           final | ||||||
|  |                           (ul-next ...) | ||||||
|  |                           (uw-next ...) | ||||||
|  |                           (ub-next ...) | ||||||
|  |                           . body)) | ||||||
|  |                      (intermediate-loop accvar ... step ...)))))))))) | ||||||
|  |               | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| ;; Helper procedures for let-kw-form | ;; Helper procedures for let-kw-form | ||||||
|  | @ -404,3 +419,10 @@ | ||||||
|        . body)))) |        . body)))) | ||||||
|                         |                         | ||||||
|                         |                         | ||||||
|  | 
 | ||||||
|  | (define-syntax loop/list | ||||||
|  |   (syntax-rules () | ||||||
|  |     ((_  (clauses ...) body ...) | ||||||
|  |      (loop loop-name (clauses ...) | ||||||
|  |        => '() | ||||||
|  |        (cons (let () body ...) (loop-name)))))) | ||||||
|  |  | ||||||
							
								
								
									
										25
									
								
								tests.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										25
									
								
								tests.scm
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,25 @@ | ||||||
|  | ;; This is just a file with things that should be written as a test. Dump file. | ||||||
|  | 
 | ||||||
|  | (loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7))))) | ||||||
|  |        (:when #t) | ||||||
|  |        (:for b (in-list a)) | ||||||
|  |        (:when #t)   | ||||||
|  |        (:for c (in-list b)) | ||||||
|  |        (:for acc (listing c))) | ||||||
|  |   => acc) | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | (loop ((:for a (in-list '((1 2) (3 4) (5 6)))) | ||||||
|  |        (:when #t) | ||||||
|  |        (:for b (in-list a)) | ||||||
|  |        (:for acc (listing b))) | ||||||
|  |   => acc) | ||||||
|  | 
 | ||||||
|  | (loop ((:for a (in-list '(1 2 3))) | ||||||
|  |        (:acc oa (summing a)) | ||||||
|  |        :subloop | ||||||
|  |        (:for b (up-from a (to (+ a 2)))) | ||||||
|  |        (:acc ob (listing b))) | ||||||
|  |   => (values oa ob)) | ||||||
|  | ;; Should return 6 and (1 2 2 3 3 4 | ||||||
|  | 
 | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus