Extracted the innermost recuring form into a separate form to facilitate inlining
Guile wasn't properly doing DCE when there are no :final guards, so I did it as a macro.
This commit is contained in:
		
							parent
							
								
									2dc4a72790
								
							
						
					
					
						commit
						aab9fcabb0
					
				
					 1 changed files with 14 additions and 4 deletions
				
			
		
							
								
								
									
										18
									
								
								goof.scm
									
										
									
									
									
								
							
							
						
						
									
										18
									
								
								goof.scm
									
										
									
									
									
								
							|  | @ -466,6 +466,17 @@ | ||||||
|   (syntax-case stx () |   (syntax-case stx () | ||||||
|     ((a ...) #'(a ...)))) |     ((a ...) #'(a ...)))) | ||||||
| 
 | 
 | ||||||
|  | (define-syntax inner-recur | ||||||
|  |   (syntax-rules () | ||||||
|  |     ((_ loop-name final-fun () ((v s) ...)) | ||||||
|  |      (loop-name s ...)) | ||||||
|  |     ((_ loop-name final-fun (user-finals ...) ((v s) ...)) | ||||||
|  |      (let ((v s) ...) | ||||||
|  |        (if (or user-finals ...) | ||||||
|  |            final-fun | ||||||
|  |            (loop-name v ...)))))) | ||||||
|  |           | ||||||
|  | 
 | ||||||
| (define-syntax let-kw-form | (define-syntax let-kw-form | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ macro-name final-fun (user-finals ...) (loop-name (var step) ...) . body) |     ((_ macro-name final-fun (user-finals ...) (loop-name (var step) ...) . body) | ||||||
|  | @ -476,10 +487,9 @@ | ||||||
|                                   (params (list #'(var step) ...))) |                                   (params (list #'(var step) ...))) | ||||||
|                          (if (null? lst) |                          (if (null? lst) | ||||||
|                              (with-syntax ((((v s) :::) params)) |                              (with-syntax ((((v s) :::) params)) | ||||||
|                                #'(let ((v s) :::) |                                #'(inner-recur loop-name final-fun | ||||||
|                                    (if (or user-finals ...) |                                               (user-finals ...) | ||||||
|                                        final-fun |                                               ((v s) :::))) | ||||||
|                                        (loop-name v :::)))) |  | ||||||
|                              (syntax-case (car lst) (=>) |                              (syntax-case (car lst) (=>) | ||||||
|                                ((=> name val) |                                ((=> name val) | ||||||
|                                 (loop (cdr lst) (update-name params #'name #'val))) |                                 (loop (cdr lst) (update-name params #'name #'val))) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus