Made all mutating accumulators visible in the body

Previously hashing and vectoring hid the resulting hash before
the final-function. This is no longer the case.

Also, now some of the tests work...
This commit is contained in:
Linus 2021-05-12 12:54:29 +02:00
parent 5d07594f53
commit cccc324ecd
2 changed files with 65 additions and 88 deletions

View file

@ -176,8 +176,8 @@
((ge index end))
((var (r tmp index)))
()
. rest))
))
. rest))))
(define-syntax in-port
(syntax-rules ()
@ -257,6 +257,21 @@
(lambda ()
(g))))))
(define (make-up-from-generator/bounded start limit step)
(lambda ()
(if (>= start limit)
(eof-object)
(let ((res start))
(set! start (+ start step))
res))))
(define (make-up-from-generator/unbounded start step)
(lambda ()
(let ((res start))
(set! start (+ start step))
res)))
(define-syntax up-from
(syntax-rules (:to :by)
((up-from :for (() . args) next . rest)
@ -279,7 +294,34 @@
((up-from :for ((var) (start limit step)) next . rest)
(next ((s start) (l limit) (e step)) ((var s (+ var e))) ((>= var l)) () () . rest))
((up-from :for ((var) (start limit)) next . rest)
(up-from :for ((var) (start limit 1)) next . rest))))
(up-from :for ((var) (start limit 1)) next . rest))
;; Generator clauses
((up-from start (:to limit) (:by step))
(make-up-from-generator/bounded start limit step))
((up-from start (:to limit))
(make-up-from-generator/bounded start limit 1))
((up-from start (:by step))
(make-up-from-generator/unbounded start step))
((up-from start)
(make-up-from-generator/unbounded start 1))
((up-from start limit step)
(make-up-from-generator/bounded start limit step))
((up-from start limit) (make-up-from-generator/bounded start limit 1))))
(define (make-down-from-generator/bounded start end step)
(lambda ()
(if (< start end)
(eof-object)
(let ((res start))
(set! start (- start step))
res))))
(define (make-down-from-generator/unbounded start step)
(lambda ()
(let ((res start))
(set! start (- start step))
res)))
(define-syntax down-from
(syntax-rules (:to :by)
@ -302,7 +344,18 @@
((down-from :for ((var) (start limit step)) next . rest)
(next ((s start) (l limit) (e step)) ((var (- s e) (- var e))) ((< var l)) () () . rest))
((down-from :for ((var) (start limit)) next . rest)
(down-from :for ((var) (start limit 1)) next . rest))))
(down-from :for ((var) (start limit 1)) next . rest))
;;generator clauses
((down-from start (:to limit) (:by step))
(make-down-from-generator/bounded start limit step))
((down-from start (:to limit))
(make-down-from-generator/bounded start limit 1))
((down-from start (:by step))
(make-down-from-generator/unbounded start step))
((down-from start limit step)
(make-down-from-generator/bounded start limit step))
((down-from start limit) (make-down-from-generator/bounded start limit 1))
((down-from start) (make-down-from-generator/unbounded start 1))))
(define-syntax in-hash
@ -316,7 +369,7 @@
()
. rest))
((in-hash hash-expr)
(in-list :for (hash-map->list cons hash-expr)))))
(in-list (hash-map->list cons hash-expr)))))
(define-syntax accumulating
@ -392,7 +445,7 @@
(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))
(name :acc ((var) (key value (if #t) (initial default-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))
@ -403,11 +456,11 @@
(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 init))
((dummy (if #f #f) (if guard (setter var key value) (if #f #f))))
()
()
((var hash))
((var var))
. rest)))))))
(define-hashing hashing (make-hash-table) hash-set!)