Added hashing, hashqing hashving och in-hash.

This commit is contained in:
Linus 2021-01-02 12:03:03 +01:00
parent 5f96ef4fb0
commit f492a5278b
3 changed files with 82 additions and 26 deletions

View file

@ -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.