Added hashing, hashqing hashving och in-hash.
This commit is contained in:
		
							parent
							
								
									5f96ef4fb0
								
							
						
					
					
						commit
						f492a5278b
					
				
					 3 changed files with 82 additions and 26 deletions
				
			
		|  | @ -248,6 +248,20 @@ | |||
|     ((down-from ((var) (start limit)) next . rest) | ||||
|      (down-from ((var) (start limit 1)) next . rest)))) | ||||
| 
 | ||||
| 
 | ||||
| (define-syntax in-hash | ||||
|   (syntax-rules () | ||||
|     ((_ ((bindings) (expr)) n . rest) | ||||
|      (n | ||||
|       () | ||||
|       () | ||||
|       ((cursor (hash-map->list cons expr) (cdr cursor))) | ||||
|       ((not (pair? cursor))) | ||||
|       ((bindings (car cursor))) | ||||
|       () | ||||
|       . rest)))) | ||||
| 
 | ||||
| 
 | ||||
| (define-syntax accumulating | ||||
|   (syntax-rules (initial if :acc) | ||||
|     ((accumulating :acc (kons final init) ((var) . x) next . rest) | ||||
|  | @ -317,6 +331,36 @@ | |||
|     ((multiplying :acc args next . rest) | ||||
|      (accumulating :acc (* (lambda (x) x) 1) args next . rest)))) | ||||
| 
 | ||||
| (define-syntax define-hashing | ||||
|   (syntax-rules () | ||||
|     ((_ name default-make setter) | ||||
|      (define-syntax name | ||||
|        (syntax-rules (:acc if initial) | ||||
|          ((_ :acc ((var) (key value)) n . rest) | ||||
|           (name :acc ((var) (key value (if #t) (initial defualt-make))) n . rest)) | ||||
|          ;; either init or if | ||||
|          ((_ :acc ((var) (key value (if guard))) n . rest) | ||||
|           (name :acc ((var) (key value (if guard) (initial default-make))) n . rest)) | ||||
|          ((_ :acc ((var) (key value (initial init))) n . rest) | ||||
|           (name :acc ((var) (key value (if #t) (initial init))) n . rest)) | ||||
|          ;; both init and if | ||||
|          ((_ :acc ((var) (key value (initial init) (if guard))) n . rest) | ||||
|           (name ((var) (key value (if guard) (initial init))) n . rest)) | ||||
|          ((_ :acc ((var) (key value (if guard) (initial init))) n . rest) | ||||
|           (n | ||||
|            ((hash init)) | ||||
|            ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f)))) | ||||
|            () | ||||
|            () | ||||
|            () | ||||
|            ((var hash)) | ||||
|            . rest))))))) | ||||
| 
 | ||||
| (define-hashing hashing (make-hash-table) hash-set!) | ||||
| (define-hashing hashving (make-hash-table) hashv-set!) | ||||
| (define-hashing hashqing (make-hash-table) hashq-set!) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| ;;; Here starts generator clauses. | ||||
| 
 | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Linus
						Linus