Add the vectoring accumulator.
Currently undocumented and untested.
This commit is contained in:
		
							parent
							
								
									f492a5278b
								
							
						
					
					
						commit
						7311da2ec2
					
				
					 2 changed files with 53 additions and 0 deletions
				
			
		|  | @ -360,7 +360,54 @@ | |||
| (define-hashing hashving (make-hash-table) hashv-set!) | ||||
| (define-hashing hashqing (make-hash-table) hashq-set!) | ||||
| 
 | ||||
| (define (vector-grow v factor len) | ||||
|   (define newlen (* len factor)) | ||||
|   (define new (make-vector newlen)) | ||||
|   (vector-copy! new 0 v 0 len) | ||||
|   new) | ||||
| 
 | ||||
| (define (vector-set!? vec index value) | ||||
|   (cond ((= index (vector-length vec)) | ||||
|          (let ((newvec (vector-grow vec 2 (vector-length vec)))) | ||||
|            (vector-set! newvec index value) | ||||
|            newvec)) | ||||
|         (else | ||||
|          (vector-set! vec index value) | ||||
|          vec))) | ||||
| 
 | ||||
| (define (vector-shrink? vec index) | ||||
|   (if (= index (vector-length vec)) | ||||
|       vec | ||||
|       (vector-copy vec 0 index))) | ||||
| 
 | ||||
| (define-syntax vectoring | ||||
|   (syntax-rules (:acc :length :fill) | ||||
|     ((_ :acc ((var) expr) n . rest) | ||||
|      (vectoring :acc ((var index) expr) n . rest)) | ||||
|     ((_ :acc ((var index) (expr)) n . rest) | ||||
|      (n () | ||||
|         ((index 0 (+ index 1)) (var (make-vector 32) (vector-set!? var index expr))) | ||||
|         () | ||||
|         () | ||||
|         () | ||||
|         ((var (vector-shrink? var index))) | ||||
|         . rest)) | ||||
|     ((_ :acc ((var index) (expr (:length len))) n . rest) | ||||
|      (vectoring  :acc ((var index) (expr (:length len) (:fill (if #f #f)))) n . rest)) | ||||
| 
 | ||||
|     ;; I am truly sorry. Currently this relies on pushing a :break clause WITHOUT | ||||
|     ;; the :when #t to ensure a subloop. It is the solution I would have used | ||||
|     ;; otherwise as well, but I would have wished for it to be more elegant. | ||||
|     ((_ :acc ((var index) (expr (:length len) (:fill f))) next | ||||
|         o n l a v c r fi ff ul uw ((ub ...) . ub-rest) uf . rest) | ||||
|      (next ((var (make-vector len f))) | ||||
|            ((index 0 (begin (vector-set! var index expr) (+ index 1)))) | ||||
|            () | ||||
|            () | ||||
|            () | ||||
|            ((var var)) | ||||
|            o n l a v c r fi ff ul uw ((ub ... (= index len)) . ub-rest) uf | ||||
|            . rest)))) | ||||
| 
 | ||||
| ;;; Here starts generator clauses. | ||||
| 
 | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus