Promote accumulator lets to the outermost let
This is a bug I never hit, due to me only having accumulators that gets passed along. However, something like vectoring or hashing should behave like (in-vector ...), which means the let binding needs to be propagated upwards. * goof.scm change cl-next/acc to promote let bindings for accumulators to the outermost let.
This commit is contained in:
		
							parent
							
								
									02fd0199ec
								
							
						
					
					
						commit
						5f96ef4fb0
					
				
					 1 changed files with 5 additions and 5 deletions
				
			
		
							
								
								
									
										8
									
								
								goof.scm
									
										
									
									
									
								
							
							
						
						
									
										8
									
								
								goof.scm
									
										
									
									
									
								
							|  | @ -221,7 +221,7 @@ | ||||||
|     ;; 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-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         ((lets ...) . lets-rest) |         (lets ... (outermost-lets ...)) | ||||||
|         ((accs ...) ((oldacc oldinit oldupdate) ...)) |         ((accs ...) ((oldacc oldinit oldupdate) ...)) | ||||||
|         ((vars ...) . vars-rest) |         ((vars ...) . vars-rest) | ||||||
|         ((checks ...) . checks-rest) |         ((checks ...) . checks-rest) | ||||||
|  | @ -229,7 +229,7 @@ | ||||||
|         (finals ...) |         (finals ...) | ||||||
|         ff ul uw ub uf clauses . body) |         ff ul uw ub uf clauses . body) | ||||||
|       (cl orig name |       (cl orig name | ||||||
|           ((lets ... new-lets ...) . lets-rest) |           (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 ... new-vars ...) . vars-rest) | ||||||
|           ((checks ... new-checks ...) . checks-rest) |           ((checks ... new-checks ...) . checks-rest) | ||||||
|  | @ -239,7 +239,7 @@ | ||||||
|     ;; 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-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) | ||||||
|         orig name |         orig name | ||||||
|         ((lets ...) . lets-rest) |         (lets ... (outermost-lets ...)) | ||||||
|         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) |         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) | ||||||
|         ((vars ...) . vars-rest) |         ((vars ...) . vars-rest) | ||||||
|         ((checks ...) . checks-rest) |         ((checks ...) . checks-rest) | ||||||
|  | @ -247,7 +247,7 @@ | ||||||
|         (finals ...) |         (finals ...) | ||||||
|         ff ul uw ub uf clauses . body) |         ff ul uw ub uf clauses . body) | ||||||
|      (cl orig name |      (cl orig name | ||||||
|           ((lets ... new-lets ...) . lets-rest) |           (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 ... new-vars ...) . vars-rest) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus