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

goof/iterators.scm

@@ -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))
+           ((var init))
-           ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f))))
+           ((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!)

tests.scm

@@ -1,82 +1,5 @@
-;; This testrunner is shamelessly stolen from rednosehacker.com
-;; and is copyrighted as
-;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
-;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co>
-;;; Copyright © 2019 Jérémy Korwin-Zmijowski <jeremy@korwin-zmijowski.fr>
-;;;
-;;; This program is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-;;
-;; Thus, this file is under the GPL v.3 or any later version.
-
 (use-modules (srfi srfi-64)
-             (goof)
+             (goof))
-             (ice-9 pretty-print)
-             (srfi srfi-26))
-
-(define* (test-display field value  #:optional (port (current-output-port))
-                       #:key pretty?)
-  "Display 'FIELD: VALUE\n' on PORT."
-  (if pretty?
-      (begin
-        (format port "~A:~%" field)
-        (pretty-print value port #:per-line-prefix "+ "))
-      (format port "~A: ~S~%" field value)))
-
-(define* (result->string symbol)
-  "Return SYMBOL as an upper case string.  Use colors when COLORIZE is #t."
-  (let ((result (string-upcase (symbol->string symbol))))
-    (string-append (case symbol
-                     ((pass)       "")  ;green
-                     ((xfail)      "")  ;light green
-                     ((skip)       "")  ;blue
-                     ((fail xpass) "")  ;red
-                     ((error)      "")) ;magenta
-                   result
-                   "")))
-
-(define* (test-runner-kata)
-
-  (define (test-on-test-end-kata runner)
-    (let* ((results (test-result-alist runner))
-           (result? (cut assq <> results))
-           (result  (cut assq-ref results <>)))
-      (if (equal? 'fail (result 'result-kind))
-	      (begin
-	        (newline)
-	        (format #t "~a ~A~%"
-		            (result->string (result 'result-kind))
-		            (result 'test-name))
-	        (when (result? 'expected-value)
-              (test-display "expected-value" (result 'expected-value)))
-	        (when (result? 'expected-error)
-              (test-display "expected-error" (result 'expected-error) #:pretty? #t))
-	        (when (result? 'actual-value)
-              (test-display "actual-value" (result 'actual-value)))
-	        (when (result? 'actual-error)
-	          (test-display "actual-error" (result 'actual-error) #:pretty? #t))
-	        (newline))
-	      (begin
-	        (format #t "~a ~A~%"
-		            (result->string (result 'result-kind))
-		            (result 'test-name))))))
-
-  (let ((runner (test-runner-null)))
-    (test-runner-on-test-end! runner test-on-test-end-kata)
-    runner))
-
-(test-runner-current (test-runner-kata))
-
 
 (test-begin "basic workings")
 (test-equal
@@ -193,7 +116,8 @@
   (loop/list/parallel ((a (in-list '(1 2 3 4))))
     (+ a 1))
   '(2 3 4 5))
-(test-end "simple-forms")
+
+(test-end "simple forms")
 
 
 (test-begin ":for-clauses")