Polishing the README and iterator protocol.

* README.md: added some small documentation and loop expansion.
 * goof.scm: Changed the iterator protocol to not use unnecessary :acc and :fors.
 * iterators.scm: see above.
 * ref-let.scm: a new macro to allow multiple values and pattern matching to co-exist for body-bindings.

README.md

@@ -7,7 +7,7 @@ goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (
 ```
 (loop ((:for a (in 0 b))
        (:for b (in 1 (+ a b)))
-       (count (up-from 0 (to 1000)))
+       (:for count (up-from 0 (to 1000)))
        (:acc acc (listing b)))
   => acc
   (display b) (newline))
@@ -44,13 +44,13 @@ Accumulators can be in any of the loop's stages:
 
 ### syntactical
 
-for-clauses are split into :for and :let clauses. This is because the addition of subloops means we have to treat accumulators differently.
+for-clauses are split into :for and :acc clauses. This is because the addition of subloops means we have to treat accumulators differently.
 
 while and until are removed in favour of :break.
 
 :when and :unless are added to better control when the loop body is executed (and accumulators accumulated)
 
-with-clauses are removed in favour of (:forvar (in init [step [stop]])) or (:acc var (folding init [step])) in case of accumulators.
+with-clauses are removed in favour of (:for var (in init [step [stop]])) or (:acc var (folding init [step])) in case of accumulators.
 
 ### Regressions compared to foof-loop
 
@@ -96,12 +96,158 @@ Named updates also work.
 ;; => (values (1 3 5) (2 4))
 ```
 
+### Simple forms
+I also provide simplified forms for many common operations. Omitting :for is allowed, and :acc clauses are not allowed.
+
+```
+(loop/list ((a (up-from 0 3)))
+  a)
+;; => (0 1 2)
+
+(loop/sum ((:for a (up-from 1 4))) a)
+;; => 6
+
+(loop/product ((a (in-list '(2 3 4))))
+  a)
+;; => 24  
+
+(loop/first ((a (in-list '(a b c 3 4 d))) :when (integer? a))
+  (display a)
+  a)
+;; => displays 3 and returns 3.   
+
+(loop/last ((a (in-list '(a b c d e f))) :break (eq? a 'e))
+  a)
+;; => 'd
+
+(loop/and ((a (in-list '(1 2 3 'error))))
+  (< a 3))
+;; => #f
+
+(loop/or ((a (in-list '(1 2 3 4))))
+  (symbol? a))
+;; => #f
+
+(loop/list/parallel ((a (in-list '(42 41 43))))
+  (expensive-function a))
+;; => same result as loop/list, but faster if the problem parallelizes well  
+
+```
+
+### Loop expansion
+
+A goof loop expands into something looking like this:
+
+```
+(let* (<outer-let>)
+  (letrec ((final-function (lambda (<final-binding>) <final-expr>))
+           (goof-loop (lambda (<accumulator> ... <loop-var> ...)
+                        (if (or <check> ...)
+                            (begin
+                              <for-clause-finalizer> ...
+                              (final-function (<accumulator-finalizer> <accumulator>) ...))
+                            (let ((<body-binding> ... <body-binding-expr>) ...)
+                              (let ((<user-binding> ... <user-binding-expr>) ...)
+                                (match-let ((<parenthesised-pattern> <match-expr>))
+                                  (if (and <when-expr> ...)            
+                                      (cond
+                                        ((or <user-break> ...)
+                                         <for-clause-finalizer> ...
+                                         (final-function (<accumulator-finalizer> <accumulator>) ...))
+                                        (else
+                                          <loop-body>
+                                          (goof-loop <accumulate> ... <loop-var-next> ...))
+                                      (goof-loop <accumulator> ... <loop-var-next>  ...))))))))
+    (goof-loop <accumulator-init> ... <loop-var-init> ...)))
+```
+
+<outer-let>: are provided by accumulators or for clauses for bindings that are not passed as an argument to the loop, for example a vector. The vector is bound here, and the index into the vector is the thing iterated over.
+
+<final-binding> and <final-expr>: When the iteration ends, this function is called with the results of the :acc clauses. In the case of (:acc lst-acc (listing ...)), the name of the accumulator is never lst-acc in the loop body, but only in the <final-expr>. In case of (listing ...) the accumulated results are reversed before the final function.
+
+<accumulator> and  <loop-variable>: <accumulator> holds the current state of an accumulator clause. This is not necessarily the same binding as the user provided as the name, as described above. <loop-var> is the current state of a :for clause. 
+
+<check>: Checks for :for-clauses. In the case of (in-list ...) this would check for (not (pair? ...)).
+
+<for-clause-finalizer>: some :for clauses need to be finalized. In the case of (in-file ...) the open file handle is closed at any point where the iteration stops.
+
+<accumulator-finalizer>: <accumulator-finalizer> is any preprocessing done to <accumulator> before passing it on to the final-function. In the case of (listing ...) that would be (reverse ...).
+
+<body-binding> and <body-binding-expr>:<body-binding> are the names the user provided for the body bindings. In the case of (:for a (in-list '(1 2 3))) the body binding would be (a (car name-of-loop-variable)). The body binding may be an (ice-9 match) pattern. More on that below.
+
+<parenthesised-pattern> and <match-expr>: If a <user-binding> is not an identifier, it is presumed to be a match-let pattern. The result is bound to a variable and matched against this match-let.
+
+<when-expr>: the user supplied :when or :unless guard expression.
+
+<user-break>: user-supplied :break guard.
+
+<loop-body>, <accumulate>, and <loop-var-next>: The user supplied body of the loop. If the loop is not named (i.e: in loops where the user controls the iteration) an expression for the next loop iteration is added to the body. <accumulate> is the expression the accumulator clause provided to accumulate a new value. For (:acc acc (listing elem)) that is (cons elem acc). <loop-var-next> is the expression evaluated to get the next iteration's loop variable. In the case of (in-list lst) that is (cdr lst). If a loop name is provided there is no implicit next loop. 
+
+<accumulator-init> and <loop-var-init>: <accumulator-init> are ALL accumulator init values, including the ones in subloops. For (listing ...) that is the empty list. <loop-var-init> is the initial loop vars.
+
+
+In case of subloops, those are placed instead of <loop-body>. They use the same final-function, and instead of quitting when any <check> triggers they go out to the outer loop.
+
+### Speed
+
+Speed is good. Despite the rather involved expansion above, due to dead-code elimination, the actual expansion shows some good code:
+
+```
+> ,opt (loop ((:for a (in-list '(1 2 3 4)))
+              :when (even? a)
+              (:acc acc (listing a)))
+         => acc)
+$1 = (let loopy-loop ((cursor-1 '()) (cursor '(1 2 3 4)))
+  (if (pair? cursor)
+    (let ((a (car cursor)) (succ (cdr cursor)))
+      (if (even? a)
+        (loopy-loop (cons a cursor-1) succ)
+        (loopy-loop cursor-1 succ)))
+    (reverse cursor-1)))
+    
+;; loop/list, being less general, produces faster code that can be more easily unroled and optimized.    
+> ,opt (loop/list ((a (in-list '(1 2 3 4)))
+                   :when (even? a))
+         a)
+$2 = (list 2 4)
+
+;; Removing the opportunity to completely remove the loop
+> ,opt (loop/list ((a (in-list (read)))
+                   :when (even? a))
+         a)
+         
+$5 = (let loopy-loop ((cursor (read)))
+  (if (pair? cursor)
+    (let ((a (car cursor)) (succ (cdr cursor)))
+      (if (even? a)
+        (cons a (loopy-loop succ))
+        (loopy-loop
+
+
+;; The code expansion of the partition procedure above produces
+(define (partition list predicate)
+  (let loopy-loop ((satisfied '()) (unsatisfied '()) (cursor list))
+    (if (pair? cursor)
+      (let ((element (car cursor)) (succ (cdr cursor)))
+        (if (predicate element)
+          (loopy-loop (cons element satisfied)
+                      unsatisfied
+                      succ)
+          (loopy-loop satisfied
+                      (cons element unsatisfied)
+                      succ)))
+      (values (reverse satisfied) (reverse unsatisfied)))))
+
+
+```
 
 ## Todo
 Tests and documentation.
 
 Fix the inlining behavious of some of the :for iterators.
 
+add generator support for all provided iterators
+
 ## foof, what a guy
 
 I have previously expressed some admiration for Alex and I will do it again. The source of chibi loop is extremely elegant, and all but the hairiest part is written in syntax-rules. Not only has he written my two favourite SRFIs, his input in all the other discussions I have seen is always on-point, pragmatic and generally fantastic. He neither knows of this project, nor embraces it in any way. Y'all should go look at the source of (chibi loop) though.

goof.scm

@@ -35,11 +35,11 @@
 ;; TODO add :let and :let* to forify
 
 (use-modules (helpers)
+             (ref-let)
              ((srfi srfi-1) #:select (circular-list))
              (srfi srfi-71)
              (rnrs io simple)
-             (ice-9 futures)
+             (ice-9 futures))
-             (ice-9 match))
 
 (define-aux-syntaxes
   ;; Auxiliary syntax for the loop clauses
@@ -165,7 +165,7 @@
 (define-syntax cl-next/acc
   (syntax-rules (:acc)
     ;; :acc clause without any subloops
-    ((_ :acc (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
+    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
         ((lets ...))
         ((accs ...))
@@ -183,7 +183,7 @@
           (finals ... new-finals ...)
           ff ul uw ub uf clauses . body))
     ;; We have ONE subloop!
-    ((_ :acc (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
+    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
         ((lets ...) . lets-rest)
         ((accs ...) ((oldacc oldinit oldupdate) ...))
@@ -201,7 +201,7 @@
           (finals ... new-finals ...)
           ff ul uw ub uf clauses . body))
     ;; We have several subloops!
-    ((_ :acc (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
+    ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
         ((lets ...) . lets-rest)
         ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...))
@@ -298,7 +298,7 @@
              (begin
                ff-cur ...
                (final-fun final-value ...))
-             (match-let (refs ...)
+             (ref-let (refs ...)
                (user-let () () (user-lets ...)
                  (if (and user-whens ...)
                      (let-kw-form name
@@ -311,7 +311,7 @@
                          (final-fun final-value ...))
                         (else
                          (let () (if #f #f) . body))))
-                     (loopy-loop accvar ... step ...))))))
+                     (loopy-loop accvar ... step ...) )))))
        (loopy-loop accinit ... init ...)))))
 
 ;; Emit-many/first emits the outermost let loop and binds the final lambda.
@@ -339,7 +339,7 @@
              (begin
                ff-cur ...
                (final-fun final-value ...))
-             (match-let (refs ...)
+             (ref-let (refs ...)
                (user-let () () (user-lets ...)
                  (if (and user-whens ...)
                      (cond
@@ -389,7 +389,7 @@
              (begin
                ff-cur ...
                outer)
-             (match-let (refs ...)
+             (ref-let (refs ...)
                (user-let () () (user-lets ...)
                  (if (and user-whens ...)         
                      (cond
@@ -424,7 +424,7 @@
              (begin
                ff-cur ...
                outer)
-             (match-let (refs ...)
+             (ref-let (refs ...)
                (user-let () () (user-lets ...)
                  (if (and user-whens ...)
                      (cond
@@ -499,7 +499,7 @@
 
 
 (define-syntax forify
-  (syntax-rules (:for :acc :when :unless :break :final :subloop %acc)
+  (syntax-rules (:for :acc :when :unless :break :final :subloop :let :let* %acc)
     ((forify o n done-clauses () . body)
      (cl 1 n
          (()) (()) (()) (()) (()) () ((() ())) (()) (()) (()) ()
@@ -516,6 +516,10 @@
      (forify o n (s ... :final expr) (clauses ...) . body))
     ((_      o n (s ...) (:subloop clauses ...) . body)
      (forify o n (s ... :subloop) (clauses ...) . body))
+    ((_      o n (s ...) ((:let id id* ... expr) clauses ...) . body)
+     (forify o n (s ... (:let id id* ... expr)) (clauses ...) . body))
+    ((_      o n (s ...) ((:let* id id* ... expr) clauses ...) . body)
+     (forify o n (s ... (:let* id id* ... expr)) (clauses ...) . body))
     ((_      o n (s ...) ((%acc c-rest ...) clauses ...) . body)
      (forify o n (s ... (:acc c-rest ...)) (clauses ...) . body))
     ((_      o n (s ...) ((:acc c-rest ...) clauses ...) . body)

iterators.scm

@@ -255,7 +255,7 @@
     ((accumulating :acc (kons final init) ((var cursor) ((initial i) . x)) n . rest)
      (accumulating :acc (kons final i) ((var cursor) x) n . rest))
     ((accumulating :acc (kons final init) ((var cursor) (expr (if check))) n . rest)
-     (n :acc ((tmp-kons kons))
+     (n ((tmp-kons kons))
         ((cursor init (if check (tmp-kons expr cursor) cursor)))
         ()
         ()
@@ -263,7 +263,7 @@
         ((var (final cursor)))
         . rest))
     ((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest)
-     (n :acc ((tmp-kons kons))
+     (n ((tmp-kons kons))
         ((cursor init (tmp-kons expr cursor)))
         ()
         ()
@@ -280,9 +280,9 @@
         ((var var))
         . rest))
     ((_ :acc ((var) (init update)) n . rest)
-     (folding ((var) (init update (if #t))) n . rest))
+     (folding :acc ((var) (init update (if #t))) n . rest))
     ((_ :acc ((var) (init)) n . rest)
-     (folding ((var) (init var (if #t))) n . rest))))
+     (folding :acc ((var) (init var (if #t))) n . rest))))
 
 (define-syntax listing
   (syntax-rules (:acc)

ref-let.scm

@@ -0,0 +1,51 @@
+(define-module (ref-let)
+  #:export (ref-let)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-71))
+
+(define-syntax ref-let
+  (syntax-rules ()
+    ((ref-let ids body ...)
+     (rl () () ids body ...))))
+
+(define-syntax rl
+  (syntax-rules (values)
+    ;; emit simple case, no match
+    ((_ (lets ...) () () body ...)
+     (let (lets ...)
+       body ...))
+    ;; emit, hard case.
+    ((rl (lets ...) (matches ...) () body ...)
+     (let (lets ...)
+       (match-let (matches ...)
+         body ...)))
+
+
+    ;; a (values ...) clause:
+    ((rl (l ...) m (((values . v) expr) . clause-rest) . body)
+     (rl (l ... ((values . v) expr)) m clause-rest . body))
+    
+    ;; Simple cases
+    ;; (rl ((a 5)) () (((b . _) (cons 1 2))) (+ a b))
+    ((_ (l ...) (m ...) (((p . p-rest) expr) . clause-rest) body ...)
+     (rl (l ... (dummy expr)) (m ... ((p . p-rest) dummy)) clause-rest body ...))
+
+    
+    ((rl (l ...) (m ...) ((binding expr) . clause-rest) body ...)
+     (rl (l ... (binding expr)) (m ...) clause-rest body ...))
+
+    ;; More than one id
+    ((rl l m ((id id* ... expr) . clause-rest) . body)
+     (extract () () (id id* ... expr) l m clause-rest . body))))
+
+(define-syntax extract
+  (syntax-rules ()
+    ((_ let-binding (match-bindings ...) () (l ...) (m ...) clauses . body)
+     (rl (l ... let-binding) (m ... match-bindings ...) clauses . body))
+    ((_ (lb ...) mb (expr) . rest)
+     (extract (lb ... expr) mb () . rest))
+    ;; Pattern
+    ((_ (lb ...) (mb ...) ((p . p-rest) ids ...) . rest)
+     (extract (lb ... dummy) (mb ... ((p . p-rest) dummy)) (ids ...) . rest))
+    ((_ (lb ...) mb (id ids ...) . rest)
+     (extract (lb ... id) mb (ids ...) . rest))))