From 93aa5aa439d3ea281c0aecb3e7a01c54a0299ca5 Mon Sep 17 00:00:00 2001
From: Linus <bjornstam.linus@fastmail.se>
Date: Wed, 6 Jan 2021 21:24:15 +0100
Subject: [PATCH] Simplified the iterator protocol.

There is no need for :acc clauses to intoduce loop variables, or for :for clauses to introduce acc clauses.
They are now changed.

 * goof.scm (cl-next/acc cl-next/for): removed the unused matchings for loop-vars and acc-vars respectively.
 * goof/iterators.scm (all iterators): simplified it.
---
 goof.scm           | 20 ++++++++--------
 goof/iterators.scm | 59 +++++++++++++---------------------------------
 2 files changed, 26 insertions(+), 53 deletions(-)

diff --git a/goof.scm b/goof.scm
index 63fbc17..e5de9d4 100644
--- a/goof.scm
+++ b/goof.scm
@@ -209,11 +209,11 @@
 (define-syntax cl-next/acc
   (syntax-rules (:acc)
     ;; :acc clause without any subloops
-    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
+    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
         ((lets ...))
         ((accs ...))
-        ((vars ...))
+        vars
         ((checks ...))
         ((refs ...))
         (finals ...)
@@ -221,17 +221,17 @@
       (cl orig name
           ((lets ... new-lets ...))
           ((accs ... (accvar accinit accupdate) ...))
-          ((vars ... new-vars ...))
+          vars
           ((checks ... new-checks ...))
           ((refs ... new-refs ...))
           (finals ... new-finals ...)
           ff ul uw ub uf clauses . body))
     ;; We have ONE subloop!
-    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
+    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
         (lets ... (outermost-lets ...))
         ((accs ...) ((oldacc oldinit oldupdate) ...))
-        ((vars ...) . vars-rest)
+        vars
         ((checks ...) . checks-rest)
         ((refs ...) . refs-rest)
         (finals ...)
@@ -239,17 +239,17 @@
       (cl orig name
           (lets ... (outermost-lets ... new-lets ...))
           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
-          ((vars ... new-vars ...) . vars-rest)
+          vars
           ((checks ... new-checks ...) . checks-rest)
           ((refs ... new-refs ...) . refs-rest)
           (finals ... new-finals ...)
           ff ul uw ub uf clauses . body))
     ;; We have several subloops!
-    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
+    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
         (lets ... (outermost-lets ...))
         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...))
-        ((vars ...) . vars-rest)
+        vars
         ((checks ...) . checks-rest)
         ((refs ...) . refs-rest)
         (finals ...)
@@ -258,7 +258,7 @@
           (lets ... (outermost-lets ... new-lets ...))
           ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
            ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...))
-          ((vars ... new-vars ...) . vars-rest)
+          vars
           ((checks ... new-checks ...) . checks-rest)
           ((refs ... new-refs ...) . refs-rest)
           (finals ... new-finals ...)
@@ -268,7 +268,7 @@
 ;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop
 (define-syntax cl-next/for
   (syntax-rules ()
-    ((_ (new-lets ...) () (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...)
+    ((_ (new-lets ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...)
         orig name
         ((lets ...) . lets-rest)
         accs
diff --git a/goof/iterators.scm b/goof/iterators.scm
index eb76863..9539f17 100644
--- a/goof/iterators.scm
+++ b/goof/iterators.scm
@@ -28,23 +28,15 @@
 
 ;; TODO iterators
 ;; in-stream
-;; in-naturals
-;; in-hash with variations
-
-;; TODO: accumulators
-;; vectoring
-;; hashing
-;; hashqing
-;; hashving
 
 (define-syntax in
   (syntax-rules () 
   ((_ ((var) (init)) n . rest)
-   (n () () ((var init var)) () () () . rest))
+   (n () ((var init var)) () () () . rest))
   ((_ ((var) (init step)) n . rest)
-   (n () () ((var init step)) () () () . rest))
+   (n () ((var init step)) () () () . rest))
   ((_ ((var) (init step stop)) n . rest)
-   (n () () ((var init step)) (stop) () () . rest))))
+   (n () ((var init step)) (stop) () () . rest))))
 
 (define-syntax in-list
   (syntax-rules (:gen)
@@ -58,9 +50,6 @@
      (next
       ;; outer let bindings, bound outside the loop, unchanged during the loop
       ()
-      ;; accumulators. These are the same as the bindings below, but values are
-      ;; kept through subloops.
-      ()
       ;; iterator, init, step
       ((cursor source succ))
       ;; tests to check whether the iterator is exhausted.
@@ -106,7 +95,6 @@
      (in-lists ((elts pairs succ) (lol step null?)) next . rest))
     ((in-lists ((elts pairs succ) (lol step done?)) next . rest)
      (next ()
-           ()
            ((pairs lol succ))
            ((let lp ((ls pairs)) ; an in-lined ANY
               (and (pair? ls) (if (done? (car ls)) #t (lp (cdr ls))))))
@@ -145,7 +133,6 @@
      (%in-idx ge + s e r tmp ((var index) (seq from (e tmp))) next . rest))
     ((%in-idx ge + s e r tmp ((var index) (seq from to)) next . rest)
      (next ((tmp seq) (end to))
-           ()
            ((index from (+ tmp index)))
            ((ge index end))
            ((var (r tmp index)))
@@ -165,7 +152,6 @@
      (in-port ((var p) (port read-char eof-object?)) next . rest))
     ((in-port ((var p) (port reader eof?)) next . rest)
      (next ((p port))
-           ()
            ((var (reader p) (reader p)))
            ((eof? var))
            ()
@@ -182,7 +168,6 @@
       (in-file ((var p) (file reader eof-object?)) next . rest))
      ((in-file ((var p) (file reader eof?)) next . rest)
       (next ((p (open-input-file file)) (r reader) (e? eof?))
-            ()
             ((var (r p) (r p)))
             ((e? var))
             ()
@@ -192,7 +177,6 @@
   (syntax-rules ()
     ((_ ((var) (source)) next . rest)
      (next ((gen source))
-           ()
            ((var (gen) (gen)))
            ((eof-object? var))
            ()
@@ -205,22 +189,21 @@
      (up-from ((var) . args) next . rest))
     ((up-from ((var) (start (to limit) (by step))) next . rest)
      (next ((s start) (l limit) (e step))
-           ()
            ((var s (+ var e)))
            ((>= var l))
            () () . rest))
     ((up-from ((var) (start (to limit))) next . rest)
-     (next ((s start) (l limit)) () ((var s (+ var 1)))
+     (next ((s start) (l limit)) ((var s (+ var 1)))
            ((>= var l)) () () . rest))
     ((up-from ((var) (start (by step))) next . rest)
-     (next ((s start) (e step))()
+     (next ((s start) (e step))
            ((var s (+ var e))) () () () . rest))
     ((up-from ((var) (start)) next . rest)
-     (next ((s start)) () ((var s (+ var 1)))
+     (next ((s start)) ((var s (+ var 1)))
            () () () . rest))
     ;; Extra convenience, make it act like (in-range ...) from racket, but only for positive numbers.
     ((up-from ((var) (start limit step)) next . rest)
-     (next ((s start) (l limit) (e step)) () ((var s (+ var e))) ((>= var l)) () () . rest))
+     (next ((s start) (l limit) (e step)) ((var s (+ var e))) ((>= var l)) () () . rest))
     ((up-from ((var) (start limit)) next . rest)
      (up-from ((var) (start limit 1)) next . rest))))
 
@@ -230,21 +213,20 @@
      (down-from ((var) . args) next . rest))
     ((down-from ((var) (start (to limit) (by step))) next . rest)
      (next ((s start) (l limit) (e step))
-           ()
            ((var (- s e) (- var e)))
            ((< var l))
            () () . rest))
     ((down-from ((var) (start (to limit))) next . rest)
-     (next ((s start) (l limit)) () ((var (- s 1) (- var 1)))
+     (next ((s start) (l limit)) ((var (- s 1) (- var 1)))
            ((< var l)) () () . rest))
     ((down-from ((var) (start (by step))) next . rest)
-     (next ((s start) (e step)) () ((var (- s e) (- var e)))
+     (next ((s start) (e step)) ((var (- s e) (- var e)))
            () () () . rest))
     ((down-from ((var) (start)) next . rest)
-     (next ((s start)) () ((var (- s 1) (- var 1)))
+     (next ((s start)) ((var (- s 1) (- var 1)))
            () () () . rest))
     ((down-from ((var) (start limit step)) next . rest)
-     (next ((s start) (l limit) (e step)) () ((var (- s e) (- var e))) ((< var l)) () () . rest))
+     (next ((s start) (l limit) (e step)) ((var (- s e) (- var e))) ((< var l)) () () . rest))
     ((down-from ((var) (start limit)) next . rest)
      (down-from ((var) (start limit 1)) next . rest))))
 
@@ -253,7 +235,6 @@
   (syntax-rules ()
     ((_ ((bindings) (expr)) n . rest)
      (n
-      ()
       ()
       ((cursor (hash-map->list cons expr) (cdr cursor)))
       ((not (pair? cursor)))
@@ -273,7 +254,6 @@
         ((cursor init (if check (tmp-kons expr cursor) cursor)))
         ()
         ()
-        ()
         ((var (final cursor)))
         . rest))
     ((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest)
@@ -281,7 +261,6 @@
         ((cursor init (tmp-kons expr cursor)))
         ()
         ()
-        ()
         ((var (final cursor)))
         . rest))))
 
@@ -290,7 +269,7 @@
     ((_ :acc ((var) (init update (if guard))) n . rest)
      (n ()
         ((var init (if guard update var)))
-        () () ()
+        () ()
         ((var var))
         . rest))
     ((_ :acc ((var) (init update)) n . rest)
@@ -352,7 +331,6 @@
            ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f))))
            ()
            ()
-           ()
            ((var hash))
            . rest)))))))
 
@@ -389,7 +367,6 @@
         ((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)
@@ -404,7 +381,6 @@
            ((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))))
@@ -428,7 +404,6 @@
   (syntax-rules ()
     ((_ ((id) (source)) n . rest)
      (n ((gen (generator-cycle source)))
-        ()
         ()
         ()
         ((id (gen)))
@@ -444,16 +419,14 @@
             (values res res)
             (begin
               (set! i (+ i 1))
-              (values index res)))))))
+              (cons index res)))))))
 
-;; Somewhat of a hack :)
 (define-syntax in-indexed
   (syntax-rules ()
-    ((_ ((i val) (source)) n . rest)
+    ((_ ((binding) (source)) n . rest)
      (n ((gen (generator-indexed source)))
-        ()
-        ((i 0 i))
+        ((i (gen) (gen)))
         ((eof-object? i))
-        ((i val (gen)))
+        ((binding i))
         ()
         . rest))))