From 5d07594f534f297aab58de8c361b8658704c2193 Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 11 May 2021 13:36:05 +0200 Subject: [PATCH 01/27] Tagged a release --- example.scm | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/example.scm b/example.scm index c67eab1..dc63661 100644 --- a/example.scm +++ b/example.scm @@ -1,9 +1,18 @@ -(load "goof.scm") - +(import (goof)) (define (erathostenes n) (define vec (make-vector n #t)) - (loop/list ((:for i (up-from 2 (to n))) + (loop ((:for i (up-from 2 (:to n))) + (:when (vector-ref vec i)) + (:acc lst (listing i)) + (:for j (up-from (* 3 i) (:to n) (:by (* i 2))))) + => lst + (vector-set! vec j #f))) + +(define (erathostenes2 n) + (define vec (make-vector n #t)) + (loop/list ((:for i (up-from 2 (:to n))) (:when (vector-ref vec i))) - (loop ((:for j (up-from (* 2 i) (to n) (by i)))) + ;; Here we set all multiples of i to #f + (loop ((:for j (up-from (* 3 i) (:to n) (:by (* i 2))))) (vector-set! vec j #f)) i)) From cccc324ecd14325d9f2fe4c7eabd8bc217823d32 Mon Sep 17 00:00:00 2001 From: Linus Date: Wed, 12 May 2021 12:54:29 +0200 Subject: [PATCH 02/27] 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 | 71 ++++++++++++++++++++++++++++++++++----- tests.scm | 82 ++-------------------------------------------- 2 files changed, 65 insertions(+), 88 deletions(-) diff --git a/goof/iterators.scm b/goof/iterators.scm index cfca749..a2f4807 100644 --- a/goof/iterators.scm +++ b/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)) - ((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!) diff --git a/tests.scm b/tests.scm index 4eed26c..1ca615a 100644 --- a/tests.scm +++ b/tests.scm @@ -1,82 +1,5 @@ -;; This testrunner is shamelessly stolen from rednosehacker.com -;; and is copyrighted as -;; Copyright © 2015, 2016 Mathieu Lirzin -;;; Copyright © 2019 Alex Sassmannshausen -;;; Copyright © 2019 Jérémy Korwin-Zmijowski -;;; -;;; 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 . -;; -;; Thus, this file is under the GPL v.3 or any later version. - (use-modules (srfi srfi-64) - (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)) - + (goof)) (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") From 769553832bb9e28ce7d4eb48fba73fbb76360b4c Mon Sep 17 00:00:00 2001 From: Linus Date: Sun, 16 May 2021 20:09:06 +0200 Subject: [PATCH 03/27] Start of something big This marks a deviation from the foof-loop inheritance, and a path towards a more lexical scope. :for clauses are now bound to the top of each loop, and the following :bind, :when, :unless, :break, :final and :acc clauses now follow a the lexical order of when they were introduced... At least, that's the plan. This commit makes :for, :bind, :when, :unless and :break work. The rest is broken. and :let+:let* are no more. --- goof-impl.scm | 236 ++++++++++++++++++++++---------------------------- goof.scm | 2 +- 2 files changed, 103 insertions(+), 135 deletions(-) diff --git a/goof-impl.scm b/goof-impl.scm index b944a41..019e2b1 100644 --- a/goof-impl.scm +++ b/goof-impl.scm @@ -29,7 +29,7 @@ (define-aux-syntaxes ;; Auxiliary syntax for the loop clauses - :when :unless :break :final :let :let* :subloop :for :acc + :when :unless :break :final :bind :subloop :for :acc ;; Auxiliary syntax for the iterators. :gen ;; auxiliary auxiliary syntax @@ -40,7 +40,9 @@ ;; Internal syntax. %acc is turned into :acc by the forify macro ;; it is used make it possible to report an error if :acc is used in ;; one of the simple macros. - %acc) + %acc + ;; nop. Used by CL + :nop) @@ -76,7 +78,7 @@ (syntax-rules (:for :acc :break :subloop :when :unless :final DONE) ((_ DONE clauses () orig name . body) (cl orig name - (()) (()) (()) (()) (()) () ((() ())) (()) (()) (()) () + (()) (()) (()) (()) (()) () ((() ())) (()) clauses . body)) ;; Ensure that a subloop gets run at least once @@ -103,7 +105,7 @@ (define-syntax push-new-subloop (syntax-rules () ((_ orig name (lets ...) (accs ...) (vars ...) (checks ...) (refs ...) f (((ff-cur ...) (ff-above ...)) . ff-rest) - (ul ...) (uw ...) (ub ...) uf clauses . body) + (user ...) clauses . body) (cl orig name (() lets ...) (() accs ...) @@ -113,58 +115,55 @@ f ;; propagate :for-finalizers to subloop to be run in case of :break ((() (ff-cur ... ff-above ...)) ((ff-cur ...) (ff-above ...)) . ff-rest) - (() ul ...) - (() uw ...) - (() ub ...) - uf + (() user ...) clauses . body)))) ;; cl sorts all the clauses into subloops and positions everything where it should be. (define-syntax cl - (syntax-rules (=> :for :acc :when :unless :break :final :let :let* :subloop) - ((_ orig name l a v c r f ff ul uw ub uf () => expr . body) - (emit orig name l a v c r f ff ul uw ub uf expr . body)) - ((_ orig name l a v c r f ff ul uw ub uf () . body) - (emit orig name l a v c r f ff ul uw ub uf (if #f #f) . body)) + (syntax-rules (=> :for :acc :when :unless :break :final :bind :subloop) + ((_ orig name l a v c r f ff user () => expr . body) + (emit orig name l a v c r f ff user expr . body)) + ((_ orig name l a v c r f ff user () . body) + (emit orig name l a v c r f ff user (if #f #f) . body)) + + ;; user bindings + ((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) ((:bind (id id* ... expr) ...) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-ul ... (:bind (id id* ... expr) ...)) . ul-rest) (clauses ...) . body)) - ;; USER LETS - ((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) uw ub uf ((:let id id* ... expr) clauses ...) . body) - (cl orig name l a v c r f ff ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub uf (clauses ...) . body)) - ((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) uw ub uf ((:let* id id* ... expr) clauses ...) . body) - (cl orig name l a v c r f ff ((cur-ul ... (:let* id id* ... expr)) . ul-rest) uw ub uf (clauses ...) . body)) ;; user-whens - ((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf ((:when test) clauses ...) . body) - (cl orig name l a v c r f ff ul ((cur-uw ... test) . uw-rest) ub uf (clauses ...) . body)) - ((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf ((:unless test) clauses ...) . body) - (cl orig name l a v c r f ff ul ((cur-uw ... (not test)) . uw-rest) ub uf (clauses ...) . body)) + ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:when test) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-uw ... (:when test)) . uw-rest) (clauses ...) . body)) + ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:unless test) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-uw ... (:when (not test))) . uw-rest) (clauses ...) . body)) + ;; USER BREAKS ;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards. - ((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ((cur-ub ...) . ub-rest) uf ((:break expr) clauses ...) . body) - (cl orig name l a v c r f ff ul ((cur-uw ... #t) . uw-rest) ((cur-ub ... expr) . ub-rest) uf (clauses ...) . body)) + ((_ orig name l a v c r f ff ((cur-ub ...) . ub-rest) ((:break expr) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-ub ... (:break expr)) . ub-rest) (clauses ...) . body)) ;; user final ;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards. - ((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub (cur-uf ...) ((:final expr) clauses ...) . body) - (cl orig name l a v c r f ff ul ((cur-uw ... #t) . uw-rest) ub (cur-uf ... expr) (clauses ...) . body)) + ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest)((:final expr) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-uw ... (:final expr)) . uw-rest) (clauses ...) . body)) ;; Explicit subloop. Shorthand for (:when #t) - ((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf (:subloop clauses ...) . body) - (cl orig name l a v c r f ff ul ((cur-uw ... #t) . uw-rest) ub uf (clauses ...) . body)) + ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) (:subloop clauses ...) . body) + (cl orig name l a v c r f ff ((cur-uw ... :nop) . uw-rest) (clauses ...) . body)) ;; :for-clauses ;; found a for clause when we have a :when or :unless clause. Push new subloop - ((_ orig name l a v c r f ff ul ((uw uw* ...) . uw-rest) ub uf ((:for for-rest ...) clauses ...) . body) - (push-new-subloop orig name l a v c r f ff ul ((uw uw* ...) . uw-rest) ub uf ((:for for-rest ...) clauses ...) . body)) + ((_ orig name l a v c r f ff ((uw uw* ...) . uw-rest) ((:for for-rest ...) clauses ...) . body) + (push-new-subloop orig name l a v c r f ff ((uw uw* ...) . uw-rest) ((:for for-rest ...) clauses ...) . body)) ;; For clause with a sequence creator. - ((_ orig name l a v c r f ff ul uw ub uf ((:for id ids ... (iterator source ...)) clauses ...) . body) - (valid-clause? iterator :for ((id ids ...) (source ...)) cl-next/for orig name l a v c r f ff ul uw ub uf (clauses ...) . body)) + ((_ orig name l a v c r f ff user((:for id ids ... (iterator source ...)) clauses ...) . body) + (valid-clause? iterator :for ((id ids ...) (source ...)) cl-next/for orig name l a v c r f ff user (clauses ...) . body)) ;; accumulator clause - ((_ orig name l a v c r f ff ul uw ub uf ((:acc id ids ... (accumulator source ...)) clauses ...) . body) - (valid-clause? accumulator :acc ((id ids ...) (source ...)) cl-next/acc orig name l a v c r f ff ul uw ub uf (clauses ...) . body)) + ((_ orig name l a v c r f ff user ((:acc id ids ... (accumulator source ...)) clauses ...) . body) + (valid-clause? accumulator :acc ((id ids ...) (source ...)) cl-next/acc orig name l a v c r f ff user (clauses ...) . body)) ;; ERROR HANDLING? - ((_ orig name l a v c r f ff ul uw ub uf (clause . rest) . body) + ((_ orig name l a v c r f ff user (clause . rest) . body) (syntax-error "Invalid clause in loop" clause orig)) )) @@ -245,7 +244,7 @@ ((refs ...) . refs-rest) finals (((ff-cur ...) (ff-above ...)) . ff-rest) - ul uw ub uf clauses . body) + user clauses . body) (cl orig name ((lets ... new-lets ...) . lets-rest) accs @@ -254,33 +253,32 @@ ((refs ... new-refs ...) . refs-rest) finals (((ff-cur ... new-for-finals ...) (ff-above ...)) . ff-rest) - ul uw ub uf clauses . body)) + user clauses . body)) ((cl err ...) (cl err ...)))) -(define-syntax user-let - (syntax-rules (:let :let*) - ((_ () () () body ...) + +(define-syntax user + (syntax-rules (:when :bind :break :final :nop) + ((_ final-expr next outer () body ...) (begin body ...)) - ((_ (lets ...) () () . body) - (let (lets ...) - . body)) - ((_ () (stars ...) () . body) - (let* (stars ...) . body)) - ;; These twe clauses handle let type changes. - ((_ () (stars ... last) ((:let id id* ... expr) clauses ...) . body) - (let* (stars ...) - (user-let (last (id id* ... expr)) () (clauses ...) . body))) - ((_ (lets ...) () ((:let* id id* ... expr) clauses ...) . body) - (let (lets ...) - (user-let () ((id id* ... expr)) (clauses ...) . body))) + ((_ f n o (:nop . rest) . body) + (user f n o rest . body)) - ;; 2 clauses new of the same that already existed - ((_ (lets ...) () ((:let id id* ... expr) clauses ...) . body) - (user-let (lets ... (id id* ... expr)) () (clauses ...) . body)) - ((_ () (stars ...) ((:let* id id* ... expr) clauses ...) . body) - (user-let () (stars ... (id id* ... expr)) (clauses ...) . body)))) + ((_ f n o ((:bind pairs ...) . rest) . body) + (let (pairs ...) + (user f n o rest . body))) + ((_ f n o ((:when test) . rest) . body) + (cond + (test (user f n o rest . body)) + (else n))) + ((_ (final-expr ...) n o ((:break expr) . rest) . body) + (cond + (expr final-expr ...) + (else (user (final-expr ...) n o rest . body)))) + + )) ;; If there are no subloops, we emit to the simple case (define-syntax emit @@ -300,7 +298,7 @@ ((refs ...)) ((final-binding final-value) ...) (((ff-cur ...) (ff-above ...))) - ((user-lets ...)) ((user-whens ...)) ((user-breaks ...)) uf + ((us ...)) final-expr . body) (let* ((final-fun (lambda (final-binding ...) final-expr)) lets ...) @@ -310,19 +308,15 @@ ff-cur ... (final-fun final-value ...)) (ref-let (refs ...) - (user-let () () (user-lets ...) - (if (and user-whens ...) - (let-kw-form name - (final-fun final-value ...) - uf - (loop (accvar accstep) ... (var step) ...) - (cond - ((or user-breaks ...) - ff-above ... ff-cur ... - (final-fun final-value ...)) - (else - (let () (if #f #f) . body)))) - (loop accvar ... step ...) ))))))))) + (user (ff-above ... ff-cur ... (final-fun final-value ...)) + (loop accvar ... step ...) + #f + (us ...) + (let-kw-form name + (final-fun final-value ...) + () + (loop (accvar accstep) ... (var step) ...) + (let () (if #f #f) . body)))))))))) ;; Emit-many/first emits the outermost let loop and binds the final lambda. (define-syntax emit-many/first @@ -335,10 +329,7 @@ (refs-next ... (refs ...)) ((final-binding final-value) ...) (ff-next ... ((ff-cur ...) ())) - (ul-next ... (user-lets ...)) - (uw-next ... (user-whens ...)) - (ub-next ... (user-breaks ...)) - uf + (us-next ... (us ...)) final-expr . body) (let* ((final-fun (lambda (final-binding ...) final-expr)) @@ -350,29 +341,23 @@ ff-cur ... (final-fun final-value ...)) (ref-let (refs ...) - (user-let () () (user-lets ...) - (if (and user-whens ...) - (cond - ((or user-breaks ...) - ff-cur ... - (final-fun final-value ...)) - (else (emit-many/rest orig - name - (outer-loop accstep ... step ...) - (lets-next ...) - (accs-next ...) - (vars-next ...) - (checks-next ...) - (refs-next ...) - ;; THIS IS NOW A COMPLETE call to final - (final-fun final-value ...) - (ff-next ...) - (ul-next ...) - (uw-next ...) - (ub-next ...) - uf - . body))) - (outer-loop accvar ... step ...)))))))))) + (user (ff-cur ... (final-fun final-value ...)) + (outer-loop accvar ... step ...) + #f + (us ...) + (emit-many/rest orig + name + (outer-loop accstep ... step ...) + (lets-next ...) + (accs-next ...) + (vars-next ...) + (checks-next ...) + (refs-next ...) + ;; THIS IS NOW A COMPLETE call to final + (final-fun final-value ...) + (ff-next ...) + (us-next ...) + . body))))))))) (define-syntax emit-many/rest (syntax-rules () @@ -387,10 +372,7 @@ ((refs ...)) final (((ff-cur ...) (ff-above ...))) - ((user-lets ...)) - ((user-whens ...)) - ((user-breaks ...)) - uf + ((us ...)) . body) (let* (lets ...) (let innermost-loop ((accvar accinit) ... @@ -400,16 +382,12 @@ ff-cur ... outer) (ref-let (refs ...) - (user-let () () (user-lets ...) - (if (and user-whens ...) - (cond - ((or user-breaks ...) - ff-above ... ff-cur ... - final) - (else - (let-kw-form name final uf (innermost-loop (accvar accstep) ... (var step) ...) - . body))) - (innermost-loop accvar ... step ...)))))))) + (user (ff-cur ... ff-above ... final) + (innermost-loop accstep ... step ...) + #f + (us ...) + (let-kw-form name final () (innermost-loop (accvar accstep) ... (var step) ...) + . body))))))) ;; Any intermediate loops ((_ orig @@ -422,10 +400,7 @@ (next-refs ... (refs ...)) final (next-ff ... ((ff-cur ...) (ff-above ...))) - (ul-next ... (user-lets ...)) - (uw-next ... (user-whens ...)) - (ub-next ... (user-breaks ...)) - uf + (us-next ... (us ...)) . body) (let* (lets ...) (let intermediate-loop ((accvar accinit) ... @@ -435,13 +410,10 @@ ff-cur ... outer) (ref-let (refs ...) - (user-let () () (user-lets ...) - (if (and user-whens ...) - (cond - ((or user-breaks ...) - ff-above ... ff-cur ... - final) - (else (emit-many/rest orig + (user (ff-cur ... ff-above ... final) + (intermediate-loop accstep ... step ...) + #f + (emit-many/rest orig name (intermediate-loop accstep ... step ...) (next-lets ...) @@ -451,19 +423,15 @@ (next-refs ...) final (next-ff ...) - (ul-next ...) - (uw-next ...) - (ub-next ...) - uf - . body))) - (intermediate-loop accvar ... step ...)))))))))) + (us-next ...) + . body))))))))) (define-syntax forify - (syntax-rules (%acc) - ((_ orig name () ((%acc . acc-rest) . argsrest) . body) - (forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body)) - ((_ . rest) - (forify* . rest)))) +(syntax-rules (%acc) + ((_ orig name () ((%acc . acc-rest) . argsrest) . body) + (forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body)) + ((_ . rest) + (forify* . rest)))) (define-syntax forify* (syntax-rules (:for :acc :when :unless :break :final :subloop :let :let* %acc) diff --git a/goof.scm b/goof.scm index aea751e..4e5de58 100644 --- a/goof.scm +++ b/goof.scm @@ -47,7 +47,7 @@ loop/or loop/list/parallel - :when :unless :break :final :let :let* :subloop :for :acc + :when :unless :break :final :bind :subloop :for :acc :length :fill :to :by From 2c323be36234d24b3db39ee1eaad082b821e715f Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 18:12:01 +0200 Subject: [PATCH 04/27] Big change: lexical scoping This introduces lexical scoping of for clauses. See README.md --- README.md | 107 ++++++++++++++++++++++++++++++++------------- goof-impl.scm | 67 +++++++++++++++------------- goof.scm | 2 +- goof/iterators.scm | 15 +++++++ tests.scm | 4 +- 5 files changed, 132 insertions(+), 63 deletions(-) diff --git a/README.md b/README.md index 725f91a..f07207e 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,6 @@ # goof-loop - a scheme looping facility -goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this: - -``` -(loop ((:for a (in 0 b)) - (:for b (in 1 (+ a b))) - (:for count (up-from 0 (to 1000))) - (:acc acc (listing b))) - => acc - (display b) (newline)) -``` - -The above example will display and accumulate the 1000 first fibonacci numbers. Doing the same thing in racket requires you to manually handle all the state in fold-variables using for/fold. It is a simple example, but proves the usefulness of goof-loop. +goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this. Compared to foof-loop, some things are added. Apart from minor syntactic changes, subloops are supported. The best way is to show: @@ -26,18 +15,6 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes This will sum all the sublists of lst and produce the result 21. Any :when, :unless, :break, :final, or :subloop clause will break out a subloop if any subsequent for clauses are found. -Accumulators can be in any of the loop's stages: - -``` -(loop ((:for a (in-list '(1 2 3))) - (:acc aa (summing a)) - :subloop - (:for b (up-from a (to (+ a 2)))) - (:acc ab (listing b))) - => (values aa ab)) -;; => (values 6 (1 2 2 3 3 4)) -``` - ## Beta warning This is beta quality software, and some minor details are likely to change. I have gotten most kinks worked out though. @@ -51,6 +28,11 @@ It is written in a weird markdown/xml chimaera. You can find it in documentation ## Differences from foof-loop +### lexical + +foof-loop has a lot of code movement going on, and it can be hard to understand exactly where things end up. goof employs a more strict lexical hierarchy. The following is not possible in (chibi loop): +d into only after the above clauses have been evaluated. + ### syntactical for-clauses are split into :for and :acc clauses. This is because the addition of subloops means we have to treat accumulators differently. @@ -90,8 +72,20 @@ Due to clause reordering, positional updates are not supported. If you want to u guard was a procedure, but now it is an expression. (with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var))) +## Features -### similarities +### Lexical order of clauses + + (loop ((:for a (in-list 1 2 3) + (:bind b (expensive-operation1 a)) + (:when (test? b)) + (:bind c (expensive-operation2 b)) + (:when test2? c) + (:acc acc (listing c)))) + => acc) + + +### Loop naming to make it "fold right" You can of course still have a larger control of when to loop by naming your loop: @@ -105,7 +99,7 @@ You can of course still have a larger control of when to loop by naming your loo ;; => (-1 4 -9 16 -25 36 -49 64 -81 100) ``` -Named updates also work. +### Named updates ``` ;; Shamelessly stolen from Taylor Campbell's foof-loop documentation @@ -123,6 +117,61 @@ Named updates also work. ;; => (values (1 3 5) (2 4)) ``` +### Exposing loop variables + +The iterator protocol allows exposing the loop variables + +``` +(loop name ((:for elt pair (in-list '(1 2 3)))) + => '() + (if (null? (cdr pair)) + (list elt) + (cons* elt ': (name)))) + +;; => (1 : 2 : 3) +``` + +### :final is context sensitive (compared to Racket's #:final) + +``` scheme + +(loop ((:for elt (in-list '( 1 2 3))) + :final (= elt 2) + (:for ab (in-list '(a b))) + (:acc acc (listing (cons elt ab))) + => acc)) + +;; => ((1 . a) (1 . b) (2 . a) (2 . b)) +``` + +The racket counterpart would result in ((1 . a) (1 . b) (2 . a)) + +### for-clauses can refer to eachother + +The iterative fibonacci loop is weird to write using for/fold. goof fixes this: +``` scheme +(loop ((:for a (in 0 b)) + (:for b (in 1 (+ a b))) + (:for count (up-from 0 (to 100))) + (:acc acc (listing b))) + => acc + (display b) (newline)) +``` +### Accumulators and arbitrary code can be placed in subloops + +``` scheme +(loop ((:for a (in-list '(1 2 3))) + (:acc aa (summing a)) + (:do (display "Entering subloop!") (newline)) + :subloop + (:for b (up-from a (:to (+ a 2)))) + (:acc ab (listing b))) + => (values aa ab)) +;; => 6 (1 2 2 3 3 4) +``` + + + ### Simple forms I also provide simplified forms for many common operations. Omitting :for is allowed, and :acc clauses are not allowed. @@ -161,9 +210,9 @@ I also provide simplified forms for many common operations. Omitting :for is all ``` -### Speed +## Speed -Speed is good. Despite the rather involved expansion you can see in the documentation, due to dead-code elimination, the actual expansion shows some good code: +Speed is good. Despite the rather involved expansion you can see in the documentation, due to inlining and dead-code elimination, the actual expansion shows some good code: ``` > ,opt (loop ((:for a (in-list '(1 2 3 4))) @@ -220,8 +269,6 @@ Tests! Finish documentation. -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. diff --git a/goof-impl.scm b/goof-impl.scm index 019e2b1..ba68b59 100644 --- a/goof-impl.scm +++ b/goof-impl.scm @@ -29,7 +29,7 @@ (define-aux-syntaxes ;; Auxiliary syntax for the loop clauses - :when :unless :break :final :bind :subloop :for :acc + :when :unless :break :final :bind :do :subloop :for :acc ;; Auxiliary syntax for the iterators. :gen ;; auxiliary auxiliary syntax @@ -121,7 +121,7 @@ ;; cl sorts all the clauses into subloops and positions everything where it should be. (define-syntax cl - (syntax-rules (=> :for :acc :when :unless :break :final :bind :subloop) + (syntax-rules (=> :for :acc :when :unless :break :final :do :bind :subloop) ((_ orig name l a v c r f ff user () => expr . body) (emit orig name l a v c r f ff user expr . body)) ((_ orig name l a v c r f ff user () . body) @@ -143,8 +143,12 @@ (cl orig name l a v c r f ff ((cur-ub ... (:break expr)) . ub-rest) (clauses ...) . body)) ;; user final ;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards. - ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest)((:final expr) clauses ...) . body) - (cl orig name l a v c r f ff ((cur-uw ... (:final expr)) . uw-rest) (clauses ...) . body)) + ((_ orig name l a v c r f ff user ((:final expr) clauses ...) . body) + (final :acc ((_) (expr)) cl-next/acc orig name l a v c r f ff user (clauses ...) . body)) + + ;; User do - sideffecting stuff. + ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:do expr ...) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-uw ... (:do expr ...)) . uw-rest) (clauses ...) . body)) ;; Explicit subloop. Shorthand for (:when #t) ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) (:subloop clauses ...) . body) @@ -164,9 +168,9 @@ ;; ERROR HANDLING? ((_ orig name l a v c r f ff user (clause . rest) . body) - (syntax-error "Invalid clause in loop" clause orig)) + (syntax-error "Invalid clause in loop" clause orig)))) + - )) ;; HOLY CODE-DUPLICATION-BATMAN! @@ -184,15 +188,15 @@ checks ((refs ...)) (finals ...) - ff ul uw ((cur-ub ...) . ub-rest) uf clauses . body) + ff ((cur-ub ...) . ub-rest) clauses . body) (cl orig name ((lets ... new-lets ...)) - ((accs ... (accvar accinit accupdate) ...)) + ((accs ... (accvar accinit accvar) ...)) vars checks ((refs ... new-refs ...)) (finals ... new-finals ...) - ff ul uw ((cur-ub ... new-checks ...) . ub-rest) uf clauses . body)) + ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body)) ;; We have ONE subloop! ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...) orig name @@ -202,15 +206,15 @@ checks ((refs ...) . refs-rest) (finals ...) - ff ul uw ((cur-ub ...) . ub-rest) uf clauses . body) + ff ((cur-ub ...) . ub-rest) clauses . body) (cl orig name (lets ... (outermost-lets ... new-lets ...)) - ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...)) + ((accs ... (accvar accvar accvar) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...)) vars checks ((refs ... new-refs ...) . refs-rest) (finals ... new-finals ...) - ff ul uw ((cur-ub ... new-checks ...) . ub-rest) uf clauses . body)) + ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body)) ;; We have several subloops! ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...) orig name @@ -220,16 +224,16 @@ checks ((refs ...) . refs-rest) (finals ...) - ff ul uw ((cur-ub ...) . ub-rest) uf clauses . body) + ff ((cur-ub ...) . ub-rest) clauses . body) (cl orig name (lets ... (outermost-lets ... new-lets ...)) - ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... + ((accs ... (accvar accvar accvar) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...)) vars checks ((refs ... new-refs ...) . refs-rest) (finals ... new-finals ...) - ff ul uw ((cur-ub ... new-checks ...) . ub-rest) uf clauses . body)))) + ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body)))) ;; Integrating for clauses is not as involved, since they only want to be introduced into the current ;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop @@ -259,15 +263,13 @@ (define-syntax user - (syntax-rules (:when :bind :break :final :nop) + (syntax-rules (:when :bind :break :do :nop) ((_ final-expr next outer () body ...) (begin body ...)) - ((_ f n o (:nop . rest) . body) (user f n o rest . body)) - ((_ f n o ((:bind pairs ...) . rest) . body) - (let (pairs ...) + (ref-let (pairs ...) (user f n o rest . body))) ((_ f n o ((:when test) . rest) . body) (cond @@ -277,8 +279,12 @@ (cond (expr final-expr ...) (else (user (final-expr ...) n o rest . body)))) + ((_ f n o ((:do expr ...) . rest) . body) + (begin + expr ... + (user f n o rest . body))))) + - )) ;; If there are no subloops, we emit to the simple case (define-syntax emit @@ -413,6 +419,7 @@ (user (ff-cur ... ff-above ... final) (intermediate-loop accstep ... step ...) #f + (us ...) (emit-many/rest orig name (intermediate-loop accstep ... step ...) @@ -427,14 +434,14 @@ . body))))))))) (define-syntax forify -(syntax-rules (%acc) - ((_ orig name () ((%acc . acc-rest) . argsrest) . body) - (forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body)) - ((_ . rest) - (forify* . rest)))) + (syntax-rules (%acc) + ((_ orig name () ((%acc . acc-rest) . argsrest) . body) + (forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body)) + ((_ . rest) + (forify* . rest)))) (define-syntax forify* - (syntax-rules (:for :acc :when :unless :break :final :subloop :let :let* %acc) + (syntax-rules (:for :acc :when :unless :break :final :subloop :bind :do %acc) ((_ o n done-clauses () . body) (%loop o n done-clauses . body)) ((_ o n (s ...) ((:for c-rest ...) clauses ...) . body) @@ -447,12 +454,12 @@ (forify* o n (s ... (:break expr)) (clauses ...) . body)) ((_ o n (s ...) ((:final expr) clauses ...) . body) (forify* o n (s ... (:final expr)) (clauses ...) . body)) + ((_ o n (s ...) ((:do expr ...) clauses ...) . body) + (forify* o n (s ... (:do 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 ...) ((:bind pairs ...) clauses ...) . body) + (forify* o n (s ... (:bind pairs ...)) (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) diff --git a/goof.scm b/goof.scm index 4e5de58..021a0ac 100644 --- a/goof.scm +++ b/goof.scm @@ -47,7 +47,7 @@ loop/or loop/list/parallel - :when :unless :break :final :bind :subloop :for :acc + :when :unless :break :final :bind :subloop :do :for :acc :length :fill :to :by diff --git a/goof/iterators.scm b/goof/iterators.scm index a2f4807..c5f982d 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -508,6 +508,21 @@ ((var var)) . rest)))) + +;; this is an internal "accumulator". It is used for final tests +;; :final in goof differs from in racket. It is lexical, meaning it +;; is tested where it is placed in the clauses, and any subloop is +;; executed completely. +(define-syntax final + (syntax-rules (:acc) + ((_ :acc ((var) (test)) n . rest) + (n () + ((final #f test)) + (final) + () + () + . rest)))) + ;;; Here starts generator clauses. (define (generator->list gen) diff --git a/tests.scm b/tests.scm index 1ca615a..d1366f3 100644 --- a/tests.scm +++ b/tests.scm @@ -37,8 +37,8 @@ a) '(0 1 2 3)) -(test-equal ":let and :let*" - (loop/list ((a (up-from 0 5)) (:let b (+ a 1)) (:let* c (+ b 1))) +(test-equal ":bind" + (loop/list ((a (up-from 0 5)) (:bind (b (+ a 1))) (:bind (c (+ b 1)))) c) '(2 3 4 5 6)) From 20471c01c272c6f7066a8789a75bb209325a6d0c Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 18:14:25 +0200 Subject: [PATCH 05/27] Added annotations for code highlighting --- README.md | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index f07207e..ccbffbd 100644 --- a/README.md +++ b/README.md @@ -76,20 +76,21 @@ Due to clause reordering, positional updates are not supported. If you want to u ### Lexical order of clauses - (loop ((:for a (in-list 1 2 3) - (:bind b (expensive-operation1 a)) - (:when (test? b)) - (:bind c (expensive-operation2 b)) - (:when test2? c) - (:acc acc (listing c)))) - => acc) - +``` scheme +(loop ((:for a (in-list 1 2 3) + (:bind b (expensive-operation1 a)) + (:when (test? b)) + (:bind c (expensive-operation2 b)) + (:when test2? c) + (:acc acc (listing c)))) + => acc) +``` ### Loop naming to make it "fold right" You can of course still have a larger control of when to loop by naming your loop: -``` +``` scheme (loop loopy-loop ((:for a (up-from 1 (to 11)))) => '() (if (odd? a) @@ -101,7 +102,7 @@ You can of course still have a larger control of when to loop by naming your loo ### Named updates -``` +``` scheme ;; Shamelessly stolen from Taylor Campbell's foof-loop documentation (define (partition list predicate) (loop continue ((:for element (in-list list)) @@ -121,7 +122,7 @@ You can of course still have a larger control of when to loop by naming your loo The iterator protocol allows exposing the loop variables -``` +``` scheme (loop name ((:for elt pair (in-list '(1 2 3)))) => '() (if (null? (cdr pair)) @@ -175,7 +176,7 @@ The iterative fibonacci loop is weird to write using for/fold. goof fixes this: ### Simple forms I also provide simplified forms for many common operations. Omitting :for is allowed, and :acc clauses are not allowed. -``` +``` scheme (loop/list ((a (up-from 0 3))) a) ;; => (0 1 2) @@ -214,7 +215,7 @@ I also provide simplified forms for many common operations. Omitting :for is all Speed is good. Despite the rather involved expansion you can see in the documentation, due to inlining and dead-code elimination, the actual expansion shows some good code: -``` +``` scheme > ,opt (loop ((:for a (in-list '(1 2 3 4))) (:when (even? a)) (:acc acc (listing a))) From c65ab9cb15d41e65f263be6fd05c807941b08674 Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 18:15:41 +0200 Subject: [PATCH 06/27] Some more changes to readme --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index ccbffbd..b9c9a5f 100644 --- a/README.md +++ b/README.md @@ -72,6 +72,7 @@ Due to clause reordering, positional updates are not supported. If you want to u guard was a procedure, but now it is an expression. (with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var))) + ## Features ### Lexical order of clauses From f6d22792b0cf0907b8d2936e03c7cbf226d1d36c Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 18:17:10 +0200 Subject: [PATCH 07/27] Don't know git. --- README.md | 1 - 1 file changed, 1 deletion(-) diff --git a/README.md b/README.md index b9c9a5f..276df61 100644 --- a/README.md +++ b/README.md @@ -97,7 +97,6 @@ You can of course still have a larger control of when to loop by naming your loo (if (odd? a) (cons (* a (- a)) (loopy-loop)) (cons (* a a) (loopy-loop)))) - ;; => (-1 4 -9 16 -25 36 -49 64 -81 100) ``` From aa77fef2ad841b751fc5b2ee71276de500d84f13 Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 18:18:17 +0200 Subject: [PATCH 08/27] Fix example in readme forgot parens. --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 276df61..1a25c14 100644 --- a/README.md +++ b/README.md @@ -79,9 +79,9 @@ Due to clause reordering, positional updates are not supported. If you want to u ``` scheme (loop ((:for a (in-list 1 2 3) - (:bind b (expensive-operation1 a)) + (:bind (b (expensive-operation1 a))) (:when (test? b)) - (:bind c (expensive-operation2 b)) + (:bind (c (expensive-operation2 b))) (:when test2? c) (:acc acc (listing c)))) => acc) From 7a1137e57983969d1bdaa85212e2e9d248d37bc4 Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 19:57:02 +0200 Subject: [PATCH 09/27] Changed accumulator test/bind order to bind/test This means vectoring exits directly when the index loop variable = :length. It also means :final has to change. --- README.md | 123 +++++++++++++++++++++++---------------------- goof-impl.scm | 8 +-- goof/iterators.scm | 6 +-- 3 files changed, 71 insertions(+), 66 deletions(-) diff --git a/README.md b/README.md index 1a25c14..e11aa5b 100644 --- a/README.md +++ b/README.md @@ -1,78 +1,32 @@ # goof-loop - a scheme looping facility -goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this. +goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this. Compared to foof-loop, some things are added. Apart from minor syntactic changes, subloops are supported. The best way is to show: -``` +``` scheme (define lst '((1 2) dud (3 4) (5 6))) (loop ((:for a (in-list lst)) (:when (pair? a)) (:for b (in-list a)) (:acc acc (summing b))) => acc) +;; => 21 ``` -This will sum all the sublists of lst and produce the result 21. Any :when, :unless, :break, :final, or :subloop clause will break out a subloop if any subsequent for clauses are found. + Any :when, :unless, :break, :final, :bind, :do or :subloop clause will break out a subloop if any subsequent for clauses are found. ## Beta warning -This is beta quality software, and some minor details are likely to change. I have gotten most kinks worked out though. +This is beta quality software, and some minor details are likely to change. I have gotten most kinks worked out though, but if I ever figure out how to include branching, the body-part of the macro will become a :body clause. ## Documentation -The current WIP documentation can be found here: https://bjoli.srht.site/doc.html +The current WIP documentation can be found here: https://bjoli.srht.site/doc.html (WARNING: for 0.1, not master) It is written in a weird markdown/xml chimaera. You can find it in documentation doc.xml (for the weird format) and documentation/doc.html for the slightly more accessible HTML format. -## Differences from foof-loop - -### lexical - -foof-loop has a lot of code movement going on, and it can be hard to understand exactly where things end up. goof employs a more strict lexical hierarchy. The following is not possible in (chibi loop): -d into only after the above clauses have been evaluated. - -### syntactical - -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 (:for var (in init [step [stop]])) in case of loop clauses, or (:acc var (folding init [step])) in case of accumulators. - -### Higher order loop protocol - -goof supports a higher order looping protocol, based on srfi-158 generators: - - (loop ((:for food (in-list '(banana cake grape cake bean cake))) - (:for true? (in-cycle (in-list '(#t #f))))) - (display "The ") - (display food) - (display " is a ") - (if true? - (display food) - (display "LIE!")) - (newline)) - -In the above example true? never ends, but restarts every time the list is exhausted. - -### Regressions compared to foof-loop - -only accumulating clauses are visible in the final-expression. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state if an inner loop is exited). - -Due to clause reordering, positional updates are not supported. If you want to update your loop vars, do so using named update (see below). - -### changes - - (with var [init [step [guard]]]) => (:for var (in init [step [stop-expr]])). - - guard was a procedure, but now it is an expression. - - (with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var))) - ## Features ### Lexical order of clauses @@ -87,6 +41,18 @@ Due to clause reordering, positional updates are not supported. If you want to u => acc) ``` +There is one caveat to this: some accumulating clauses (currently only vectoring with :length specified) have an implicit :break clause. This is tested AFTER the accumulation takes place. So: if the last position of the vector is set, the loop halts. + +``` scheme +(loop ((:for a (in-list '(1 2 3))) + (:acc vec (vectoring a (:length 2))) + ;; implicit :break (= vec-index 2) + (:acc sum (summing a))) + => (values vec sum)) +;; => #(1 2) 1 + +``` + ### Loop naming to make it "fold right" You can of course still have a larger control of when to loop by naming your loop: @@ -131,6 +97,26 @@ The iterator protocol allows exposing the loop variables ;; => (1 : 2 : 3) ``` +In the above example, pair is bound to the pair where elt is the car. + +### Higher order loop protocol + +goof supports a higher order looping protocol, based on srfi-158 generators: + +``` scheme + +(loop ((:for food (in-list '(banana cake grape cake bean cake))) + (:for true? (in-cycle (in-list '(#t #f))))) + (display "The ") + (display food) + (display " is a ") + (if true? + (display food) + (display "LIE!")) + (newline)) +``` + +In the above example true? never ends, but restarts every time the list is exhausted. ### :final is context sensitive (compared to Racket's #:final) @@ -145,9 +131,9 @@ The iterator protocol allows exposing the loop variables ;; => ((1 . a) (1 . b) (2 . a) (2 . b)) ``` -The racket counterpart would result in ((1 . a) (1 . b) (2 . a)) +The racket counterpart would result in ((1 . a) (1 . b) (2 . a)). This comes at :final clauses being less efficient than racket's #:final, but not by much. -### for-clauses can refer to eachother +### :for-clauses can refer to eachother The iterative fibonacci loop is weird to write using for/fold. goof fixes this: ``` scheme @@ -171,7 +157,18 @@ The iterative fibonacci loop is weird to write using for/fold. goof fixes this: ;; => 6 (1 2 2 3 3 4) ``` +### Pattern matching +For clauses which bind "body bindings" (every one except (in ...)) can use pattern matching based on Alex Shinn's excellent match.scm. + +``` scheme +(loop ((:for (key . val) (in-list '((a . 1) (b . 2) c . 3))) + (:acc sum (summing val))) + => sum) +;; => 6 + +This also works with :bind clauses. +``` ### Simple forms I also provide simplified forms for many common operations. Omitting :for is allowed, and :acc clauses are not allowed. @@ -245,7 +242,7 @@ $5 = (let loopy-loop ((cursor (read))) (let ((a (car cursor)) (succ (cdr cursor))) (if (even? a) (cons a (loopy-loop succ)) - (loopy-loop + (loopy-loop))))) ;; The code expansion of the partition procedure above produces @@ -265,15 +262,23 @@ $5 = (let loopy-loop ((cursor (read))) ``` + +## Differences from foof-loop + +This used to be a pretty vast collection of examples. goof-loof is now different enough from foof loop that you can't expect to carry your foof-loop skills over to goof-loop. There are however two notable regressions. + +### Regressions compared to foof-loop +only accumulating clauses are visible in the final-expression. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state if an inner loop is exited). + +Due to clause reordering, positional updates are not supported. If you want to update your loop vars, do so using named update (see below). + ## Todo Tests! Finish documentation. ## 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. +I have previously expressed some admiration for Alex Shinn 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. ## Licence - -The same BSD-styled license Alex uses for chibi-loop. +goof started off by copying the iterator protocol of (chibi loop), and things sort of went downhill from there. Despite this, there is still quite a lot of code (especially in iterators.scm) that I didn't write myself. I only made it ugly. Thus goof is licensed under the same BSD-styled license Alex uses for chibi-loop. diff --git a/goof-impl.scm b/goof-impl.scm index ba68b59..50abfc6 100644 --- a/goof-impl.scm +++ b/goof-impl.scm @@ -54,6 +54,7 @@ ((loop . rest) (%loop (loop . rest) . rest)))) + (define-syntax %loop (syntax-rules (=>) ((%loop o () => expr body ...) @@ -142,9 +143,8 @@ ((_ orig name l a v c r f ff ((cur-ub ...) . ub-rest) ((:break expr) clauses ...) . body) (cl orig name l a v c r f ff ((cur-ub ... (:break expr)) . ub-rest) (clauses ...) . body)) ;; user final - ;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards. - ((_ orig name l a v c r f ff user ((:final expr) clauses ...) . body) - (final :acc ((_) (expr)) cl-next/acc orig name l a v c r f ff user (clauses ...) . body)) + ((_ orig name l a v c r f ff ((cur-user ...) . user-rest) ((:final expr) clauses ...) . body) + (final :acc ((fin) (expr)) cl-next/acc orig name l a v c r f ff ((cur-user ... (:break fin)) . user-rest) (clauses ...) . body)) ;; User do - sideffecting stuff. ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:do expr ...) clauses ...) . body) @@ -196,7 +196,7 @@ checks ((refs ... new-refs ...)) (finals ... new-finals ...) - ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body)) + ff ((cur-ub ... (:bind (accvar accupdate) ...) (:break new-checks) ... ) . ub-rest) clauses . body)) ;; We have ONE subloop! ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...) orig name diff --git a/goof/iterators.scm b/goof/iterators.scm index c5f982d..f332b28 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -512,13 +512,13 @@ ;; this is an internal "accumulator". It is used for final tests ;; :final in goof differs from in racket. It is lexical, meaning it ;; is tested where it is placed in the clauses, and any subloop is -;; executed completely. +;; executed until exhaustion. (define-syntax final (syntax-rules (:acc) ((_ :acc ((var) (test)) n . rest) (n () - ((final #f test)) - (final) + ((var #f test)) + () () () . rest)))) From 93134a1b2121af6148864a4a7b537e8e14a1c8d9 Mon Sep 17 00:00:00 2001 From: Linus Date: Tue, 18 May 2021 20:39:37 +0200 Subject: [PATCH 10/27] Made => implicit if we have accumulators If there are accumulators, their final values will be returned if no final-expr is given. (loop ((:for a (up-from 1 11)) (:acc lst (listing (* a a)))) => lst) becomes simply: (loop ((:for a (up-from 1 11)) (:acc lst (listing (* a a))))) --- README.md | 49 ++++++++++++++++++++++++++++--------------------- goof-impl.scm | 16 ++++++++-------- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index e11aa5b..7c77338 100644 --- a/README.md +++ b/README.md @@ -9,8 +9,7 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes (loop ((:for a (in-list lst)) (:when (pair? a)) (:for b (in-list a)) - (:acc acc (summing b))) - => acc) + (:acc acc (summing b)))) ;; => 21 ``` @@ -37,8 +36,7 @@ It is written in a weird markdown/xml chimaera. You can find it in documentation (:when (test? b)) (:bind (c (expensive-operation2 b))) (:when test2? c) - (:acc acc (listing c)))) - => acc) + (:acc acc (listing c))))) ``` There is one caveat to this: some accumulating clauses (currently only vectoring with :length specified) have an implicit :break clause. This is tested AFTER the accumulation takes place. So: if the last position of the vector is set, the loop halts. @@ -47,10 +45,22 @@ There is one caveat to this: some accumulating clauses (currently only vectoring (loop ((:for a (in-list '(1 2 3))) (:acc vec (vectoring a (:length 2))) ;; implicit :break (= vec-index 2) - (:acc sum (summing a))) - => (values vec sum)) + (:acc sum (summing a)))) ;; => #(1 2) 1 +``` +### Ability to be explicit about returned values +If you have no "final expression", denoted by => expr, one is added that returns all final values of the :acc clauses in the loop. If none is present, the return value is unspecified. + +``` scheme +(loop ((:for a (up-from 1 5)) + (:acc sum (summing a)))) +;; => 10 + +(loop ((:for a (up-from 1 5)) + (:acc sum (summing a))) + => (- sum)) +;; => -10 ``` ### Loop naming to make it "fold right" @@ -66,6 +76,8 @@ You can of course still have a larger control of when to loop by naming your loo ;; => (-1 4 -9 16 -25 36 -49 64 -81 100) ``` +Replace that cons with stream-cons and you have a lazy construct. + ### Named updates ``` scheme @@ -81,7 +93,7 @@ You can of course still have a larger control of when to loop by naming your loo (continue (=> unsatisfied (cons element unsatisfied)))))) (partition '(1 2 3 4 5) odd?) -;; => (values (1 3 5) (2 4)) +;; => (1 3 5) (2 4) ``` ### Exposing loop variables @@ -123,15 +135,14 @@ In the above example true? never ends, but restarts every time the list is exhau ``` scheme (loop ((:for elt (in-list '( 1 2 3))) - :final (= elt 2) + (:final (= elt 2)) (:for ab (in-list '(a b))) - (:acc acc (listing (cons elt ab))) - => acc)) + (:acc acc (listing (cons elt ab)))) ;; => ((1 . a) (1 . b) (2 . a) (2 . b)) ``` -The racket counterpart would result in ((1 . a) (1 . b) (2 . a)). This comes at :final clauses being less efficient than racket's #:final, but not by much. +The racket counterpart would result in ((1 . a) (1 . b) (2 . a)). This comes at :final clauses being marginally less efficient than racket's #:final. ### :for-clauses can refer to eachother @@ -139,9 +150,8 @@ The iterative fibonacci loop is weird to write using for/fold. goof fixes this: ``` scheme (loop ((:for a (in 0 b)) (:for b (in 1 (+ a b))) - (:for count (up-from 0 (to 100))) + (:for count (up-from 0 (:to 100))) (:acc acc (listing b))) - => acc (display b) (newline)) ``` ### Accumulators and arbitrary code can be placed in subloops @@ -152,8 +162,7 @@ The iterative fibonacci loop is weird to write using for/fold. goof fixes this: (:do (display "Entering subloop!") (newline)) :subloop (:for b (up-from a (:to (+ a 2)))) - (:acc ab (listing b))) - => (values aa ab)) + (:acc ab (listing b)))) ;; => 6 (1 2 2 3 3 4) ``` @@ -163,8 +172,7 @@ For clauses which bind "body bindings" (every one except (in ...)) can use patte ``` scheme (loop ((:for (key . val) (in-list '((a . 1) (b . 2) c . 3))) - (:acc sum (summing val))) - => sum) + (:acc sum (summing val)))) ;; => 6 This also works with :bind clauses. @@ -183,12 +191,12 @@ I also provide simplified forms for many common operations. Omitting :for is all (loop/product ((a (in-list '(2 3 4)))) a) -;; => 24 +;; => 24 (loop/first ((a (in-list '(a b c 3 4 d))) (:when (integer? a))) (display a) a) -;; => displays 3 and returns 3. +;; => displays 3 and returns 3. (loop/last ((a (in-list '(a b c d e f))) (:break (eq? a 'e))) a) @@ -215,8 +223,7 @@ Speed is good. Despite the rather involved expansion you can see in the document ``` scheme > ,opt (loop ((:for a (in-list '(1 2 3 4))) (:when (even? a)) - (:acc acc (listing a))) - => acc) + (:acc acc (listing a)))) $1 = (let loopy-loop ((cursor-1 '()) (cursor '(1 2 3 4))) (if (pair? cursor) (let ((a (car cursor)) (succ (cdr cursor))) diff --git a/goof-impl.scm b/goof-impl.scm index 50abfc6..9197cad 100644 --- a/goof-impl.scm +++ b/goof-impl.scm @@ -56,14 +56,10 @@ (define-syntax %loop - (syntax-rules (=>) - ((%loop o () => expr body ...) - (%loop o ((:for ensure-once (up-from 0 1))) => expr body ...)) + (syntax-rules () ((%loop o () body ...) (%loop o ((:for ensure-once (up-from 0 1))) body ...)) - ((%loop o name () => expr body ...) - (%loop o name ((:for ensure-once (up-from 0 1))) => expr body ...)) - ((%loop o name () body ...) + ((%loop o name () body ...) (%loop o name ((:for ensure-once (up-from 0 1))) body ...)) ((%loop o (clauses ...) body ...) (ensure-for-clause #f () (clauses ...) o @@ -125,8 +121,12 @@ (syntax-rules (=> :for :acc :when :unless :break :final :do :bind :subloop) ((_ orig name l a v c r f ff user () => expr . body) (emit orig name l a v c r f ff user expr . body)) - ((_ orig name l a v c r f ff user () . body) - (emit orig name l a v c r f ff user (if #f #f) . body)) + ((_ orig name l a v c r () ff user () . body) + (emit orig name l a v c r () ff user (if #f #f) . body)) + + ;; If we have no final-expr, but we have final bindings, we return those. + ((_ orig name l a v c r ((final-binding expr) ...) ff user () . body) + (emit orig name l a v c r ((final-binding expr) ...) ff user (values final-binding ...) . body)) ;; user bindings ((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) ((:bind (id id* ... expr) ...) clauses ...) . body) From dd1589ab3a4ae7654cfe24decb804f09d3174c42 Mon Sep 17 00:00:00 2001 From: Linus Date: Fri, 21 May 2021 10:09:07 +0200 Subject: [PATCH 11/27] Changed documentation to reflect recent changes --- README.md | 62 +++++++++++++--- documentation/doc.html | 135 +++++++++++++++++++++------------ documentation/doc.xml | 164 ++++++++++++++++++++++++++--------------- 3 files changed, 244 insertions(+), 117 deletions(-) diff --git a/README.md b/README.md index 7c77338..2286400 100644 --- a/README.md +++ b/README.md @@ -41,6 +41,8 @@ It is written in a weird markdown/xml chimaera. You can find it in documentation There is one caveat to this: some accumulating clauses (currently only vectoring with :length specified) have an implicit :break clause. This is tested AFTER the accumulation takes place. So: if the last position of the vector is set, the loop halts. +This of course also means accumulation is done before the body is executed, which is a bit counterintuitive. + ``` scheme (loop ((:for a (in-list '(1 2 3))) (:acc vec (vectoring a (:length 2))) @@ -163,12 +165,15 @@ The iterative fibonacci loop is weird to write using for/fold. goof fixes this: :subloop (:for b (up-from a (:to (+ a 2)))) (:acc ab (listing b)))) +;; |> Entering subloop! +;; |> Entering subloop! +;; |> Entering subloop! ;; => 6 (1 2 2 3 3 4) ``` ### Pattern matching -For clauses which bind "body bindings" (every one except (in ...)) can use pattern matching based on Alex Shinn's excellent match.scm. +For clauses which bind "body bindings" (every one except (in ...), in-port, in-generator and in-file) can use pattern matching based on Alex Shinn's excellent match.scm. ``` scheme (loop ((:for (key . val) (in-list '((a . 1) (b . 2) c . 3))) @@ -221,16 +226,32 @@ I also provide simplified forms for many common operations. Omitting :for is all Speed is good. Despite the rather involved expansion you can see in the documentation, due to inlining and dead-code elimination, the actual expansion shows some good code: ``` scheme + ,expand (loop ((:for a (in-list '(1 2 3 4))) + (:when (even? a)) + (:acc acc (listing a)))) +$0 = (let* ((final-fun + (lambda (acc) ((@@ (goof) values) acc))) + (tmp-kons (@@ (goof) cons))) + (let loop ((cursor-1 '()) (cursor '(1 2 3 4))) + (if ((@@ (goof) not) ((@@ (goof) pair?) cursor)) + (final-fun ((@@ (goof) reverse) cursor-1)) + (let ((a ((@@ (goof) car) cursor)) + (succ ((@@ (goof) cdr) cursor))) + (if (even? a) + (let ((cursor (tmp-kons a cursor-1))) + (if #f #f) + (loop cursor succ)) + (loop cursor-1 succ)))))) + +;; This is mostly fluff that is removed using DCE, unrolling and inlining: > ,opt (loop ((:for a (in-list '(1 2 3 4))) (:when (even? a)) (:acc acc (listing a)))) -$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))) + +$1 = (let* ((cursor (list 2)) (cursor (cons 4 cursor))) + ((@@ (goof) reverse) cursor)) + +;; well dang, the loop was optimized away almost completely... ;; loop/list, being less general, produces faster code that can be more easily optimized > ,opt (loop/list ((a (in-list '(1 2 3 4))) @@ -244,7 +265,7 @@ $2 = (list 2 4) a) ;; This is actually the preferred way to do it in guile. Guile re-sizes the stack, so no stack overflows -$5 = (let loopy-loop ((cursor (read))) +$3 = (let loopy-loop ((cursor (read))) (if (pair? cursor) (let ((a (car cursor)) (succ (cdr cursor))) (if (even? a) @@ -284,6 +305,29 @@ Tests! Finish documentation. +Figure out if I can do anything about branching. I would love to remove the body and just have loop clauses. I don't think I can do that without some serious voodoo if I want to keep the current syntax. One idea would be to define all accumulators in the start of the loop, and then bind identifiers using local macros: + +``` scheme +(loop (accumulators ...) + (clauses ...) + => final-expr) + +(loop ((vectoring a) + (listing b)) + (:for i (up-from 1 11)) + (:save b (* i i)) + (:if (odd? i) + (:subloop (:for ab (in-list '(a b))) + (:save a (cons i ab))) + (:subloop (:for cd (in-list '(c d))) + (:save a (cons i cd)))) + (:save a 'next)) +(1 4 9 16 ...) +#((1 . a) (1 . b) next (2 . c) (2 . d) next ...) +``` + +But this solution isn't great. The current situation isn't either, though. The body is executed AFTER all other clauses and is only really useful for things like branching, which would be much nicer to have in the clauses. The few times one wants a right fold, a simple :body clause will do the trick. + ## foof, what a guy I have previously expressed some admiration for Alex Shinn 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. diff --git a/documentation/doc.html b/documentation/doc.html index 3d1654d..aa3f7b3 100644 --- a/documentation/doc.html +++ b/documentation/doc.html @@ -11,7 +11,8 @@
  • A looping facility that in almost all cases produces as fast code as a hand-written named let
  • An extensible looping facility, where new ways of iterating over data can be easily added
    • -

    The only other lisp looping facility that I know of that provides these things is Common Lisps iterate package. Iterate does however do a lot of things that are cumbersome to do in portable scheme, and would be prohibitively complicated to implement efficiently in a portable way. Unless, of course, one considers CPS-conversion of arbitrary scheme code using syntax-rules simple.

    +

    The only other lisp looping facility that I know of that provides these things is Common Lisps iterate package. Iterate does however do a lot of things that are cumbersome to do in portable scheme, and would be prohibitively complicated to implement efficiently in a portable way. Unless, of course, one considers CPS-conversion of arbitrary scheme code using syntax-rules simple

    +

    On a side note: if anyone has the source of Olin Shivers’ loop package described in his paper “Anatomy of a loop”, please send me an email.

    An example or two

    So, how does it look? A slightly contrived example, a naive sieve of Erathostenes:

     (define (erathostenes n)
@@ -19,22 +20,20 @@
   (loop/list ((:for i (up-from 2 (:to n)))
               (:when (vector-ref vec i)))
     ;; Here we set all multiples of i to #f
-    (loop ((:for j (up-from (* 3 i) (:to n) (:by (* i 2)))))
+    (loop ((:for j (up-from (* 2 i) (:to n) (:by i)))
       (vector-set! vec j #f))
     i))

    Calling (erathostenes 10) returns a list of all primes below 10.

    -

    The example above can also be written using “subloops”, but unless you know the expansion it can be somewhat surprising.

    +

    The example above can also be written using “subloops”:

     (define (erathostenes n)
   (define vec (make-vector n #t))
   (loop ((:for i (up-from 2 (:to n)))
-         (:acc lst (listing i))
          (:when (vector-ref vec i))
-         (:for j (up-from (* 3 i) (:to n) (:by (* i 2))))
-    => lst
+         (:acc lst (listing i))
+         (:for j (up-from (* 2 i) (:to n) (:by i))))
     (vector-set! vec j #f)))
-

    Any :for clause following a :break, :when, :unless or :final clause is considered to be a subloop. Any :when clause also affects when accumulating clauses collect values. The expression following => is the final expression: this is the expression returned after the loop ends.

    -

    Specification

    The loop grammar is the following:

    +

    Specification

    The loop grammar is the following:

     (loop [name] (loop-clause ...) [=> final-expr] body ...)
 
@@ -42,15 +41,19 @@
 
   loop-clause = (:for id id* ... seq-expr)
               | (:acc id id* ... seq-expr)
-              | (:let id expr)
-              | (:let* id expr)
+              | (:bind (id id* ... expr) ...)
               | (:when guard-expr)
               | (:unless guard-expr)
               | (:break break-expr)
               | (:final guard-expr)
+              | (:do expr ...)
               | :subloop
 
-     seq-expr = a macro that conforms to the looping protocol described below.
+    seq-expr = a macro that conforms to the looping protocol described below.
+  final-expr = The expression executed at loop finalization. If none is given,
+               one returning all :acc values is generated
+         body = A sequence of expressions executed after the loop clauses
+                mostly useful to control in which fashion subsequent loops execute.

    If a name is provided, it will be bound to a macro that allows named update of loop variables:

     (loop lp ((:for a (in 0 (+ a 1)))
@@ -60,13 +63,12 @@
       (cons a (lp (=> a 8)))
       (cons a (lp))))

    This rather inane example would return (0 1 2 3 4 8 9). Read more about this in the part about loop variables.

    -

    Subloops

    A subloop is a distinction between an outer loop and an inner loop. A subloop means that: for each element yielded by an outer loop, the inner loop is run until exhaustion. All non-binding clauses break out a subloop.

    +

    Subloops

    A subloop is a distinction between an outer loop and an inner loop. A subloop means that: for each element yielded by an outer loop, the inner loop is run until exhaustion. If a :for clause is placed after any non-:for clause, it is considered a subloop.

     (loop ((:for a (in-list '(1 2 3))) 
         :subloop
         (:for b (up-from 0 (to a)))
-        (:acc acc (listing (cons a b))))
-  => acc)
+        (:acc acc (listing (cons a b)))))
   
 ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))

    The above :subloop clause is equivalent to :when #t and :unless #f. A :break clause will immediately stop execution of the loop:

    @@ -74,20 +76,32 @@ (loop ((:for a (in-list '(1 2 3))) (:break (= 3 a)) (:for b (up-from 0 (to a))) - (:acc acc (listing (cons a b)))) - => acc) + (:acc acc (listing (cons a b))))) ;; => ((1 . 0) (2 . 0) (2 . 1)) -

    And a :final guard will let one more body be evaluated. This clause is evaluated in the innermost loop, and as such only one body will be evaluated:

    +

    And a :final guard will let the subsequent subloops execute once.

    -(loop ((:for a (in-list '(1 2 3))) 
+(loop ((:for a (in-list '(1 2 3 4)))
        (:final (= 3 a))
        (:for b (up-from 0 (to a)))
-       (:acc acc (listing (cons a b))))
-  => acc)
+       (:acc acc (listing (cons a b)))))
   
-;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0))
-

    Loop variables

    Both accumulating clauses and :for clauses have something called loop variables. In the case of (:for elt (in-list lst)) the loop variable would be the current pair where elt is the car. Some :acc- or :for-clauses may expose their loop variables so that they can be queried or even updated.

    +;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1)) +

    The :final clause is actually equivalent to something alike the following:

    +
    +(loop ((:for a (in-list '(1 2 3 4)))
+       ;; this works because :acc bindings are promoted "outwards".
+       (:break final)
+       (:acc final (in-value (initial #f) #t (if (= 3 a))))
+       (:acc acc (listing (cons a b)))))
+

    This means that any clause above the final binding will be executed an extra time before the loop exits:

    +
    +(loop ((:for a (up-from 1 4))
+       (:acc lst (listing a))
+       (:final (= a 2))
+       (:acc lst2 (listing a))))
+;; => (1 2 3) (1 2)
+

    Loop variables

    Both accumulating clauses and :for clauses have something called loop variables. In the case of (:for elt (in-list lst)) the loop variable would be the current pair where elt is the car. Some :acc- or :for-clauses may expose their loop variables so that they can be queried or even updated.

    In the case of the menioned in-list we can choo se to expose the name of the current pair, as in the following example:

     (define (interpose lst between)
@@ -152,13 +166,8 @@
 
    Scheme syntax: stop-after
    (:for binding (stop-after iterator pred))
    Binds binding to the values produced by iterator until pred applied to that value returns true. It then produces that last value. The iterator is then considered exhausted. Useful in subloops where one might want to end internal iteration without :break-ing.

    :acc-clauses

    Accumulating clauses differ from :for-clauses in 2 significant ways. They have a final value available in the final-expr, and they keep their state throughout the loop. In the case of a loop with one subloop, the :for-clauses reset their state every time the subloop is entered. :acc-clauses will always keep their state.

    Another small thing is that for some :acc-clauses, the binding may sometimes only be visible to the user in the final-expr, but like :for-clauses they sometimes offer the programmer to name the loop variables.

    -

    One general thing about accumulating clauses is that they all support a guarding if form. If such a clause is given, accumulation will only happen if the guard clause returns true. When a :when or :unless clause is given, they also have to return true for any result to be accumulated. The following code returns the empty list:

    -
    -(loop ((:for a (up-from 0 10))
-       (:acc acc (listing a (if (odd? a))))
-       (:when (even? a)))
-  => acc)
-
    Scheme syntax: listing
    (:acc binding (listing [(initial init)] expr [if guard]))

    Accumulates expr into a list. ´bindingis only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. Ifinitialis given that will be used as the tail of the accumulated results. It defaults to’()`.

    +

    Many accumulating clauses support an if form. If such a clause is given, accumulation will only happen if the guard clause returns true.

    +
    Scheme syntax: listing
    (:acc binding (listing [(initial init)] expr [if guard]))

    Accumulates expr into a list. ´bindingis only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. Ifinitialis given that will be used as the tail of the accumulated results. It defaults to’()`.

    Scheme syntax: listing-reverse
    (:acc binding (listing-reverse [(initial init)] expr [if guard]))

    The same as listing but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.

    Scheme syntax: appending
    (:acc binding (appending [(initial init)] expr [if guard]))

    expr evaluates to a list that is then appended to the accumulated result.

    @@ -174,11 +183,13 @@
   ;; => (4 3 2 1 0)
    Scheme syntax: summing
    (:acc binding (summing [(initial init)] expr [(if guard)]))

    Adds the result of expr together using +. The default initial value is 0.

    Scheme syntax: multiplying
    (:acc binding (multiplying [(initial init)] expr [(if guard)]))

    Multiplies the result of expr using *. The default initial value is 1.

    -
    Scheme syntax: hashing
    (:acc binding (hashing [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using equal?-hashing. The initial hash table is an empty hash-table.

    -
    Scheme syntax: hashving
    (:acc binding (hashving [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using eqv?-hashing. The initial hash table is an empty hash-table.

    -
    Scheme syntax: hashqing
    (:acc binding (hashqing [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.

    -
    Scheme syntax: vectoring
    (:acc var [index] (vectoring expr [(:length len) [(:fill fill)]]))

    Accumulates the result of expr into a vector. If len and fill is given the vector will be at most len elements long and any unfilled indexes will contain the element fill. The loop will exit when len elements have been accumulated.

    +
    Scheme syntax: hashing
    (:acc binding (hashing [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using equal?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    +
    Scheme syntax: hashving
    (:acc binding (hashving [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using eqv?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    +
    Scheme syntax: hashqing
    (:acc binding (hashqing [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.binding is bound to the hash table throughout the loop, and its can be mutated in the loop body.

    +
    Scheme syntax: vectoring
    (:acc binding [index] (vectoring expr [(:length len) [(:fill fill)]]))

    Accumulates the result of expr into a vector. If len and fill is given the vector will be at most len elements long and any unfilled indexes will contain the element fill. The loop will exit when len elements have been accumulated.

    If length is not given, the vector will be expanded as required.

    +

    A vectoring clause adds an implicit (:break (= index len)) after the vectoring clause. Once the last element of the vector is filled, the loop will stop and no subsequent clauses or body will be executed.

    +

    binding is bound to the vector throughout the loop, and its content mutated in the loop body.

    Loop protocol

    goof-loop is extensible using regular syntax-rules macros. The protocol for both :acc- and :for-clauses is identical, except that the behaviour of the different parts are slightly different.

    :for-clauses

    The following example defines the simple :for-driver in-alist:

    @@ -206,7 +217,7 @@

    In short, the clause (:for key value (in-alist alist-expr)) expands to:

     (in-alist ((key val) (alist-expr)) next-macro . rest)
-

    You almost never have to care about rest. That is the complete state of the expansion of loop, which we have to pass around since most of goof-loop is written in syntax-rules. (If you want to see how that is done, have a look at the source of vectoring which (ab)uses this to introduce a :break clause without breaking out a subloop).

    +

    You should never have to care about rest. That is the complete state of the expansion of loop, which we have to pass around since most of goof-loop is written in syntax-rules.

    Going from the top we first have the outer let bindings. These are bound outside the loop, and are mostly used for binding things like vectors or ports that do not change during the loop.

    The next one are loop variables. Here we provide three things: variable name, initial expression and update. The update expression is used to bind the variable to the next value of the sequence.

    Stop guards are just that. In this case, when (null? %cursor)) returns true, the sequence is considered exhausted. If the loop is in a subloop, the current loop stops and the outer loop continues. If there is only one loop, it halts.

    @@ -251,17 +262,46 @@ 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 ...))))))))) + (match-let ((PARENTHESISED-PATTERN MATCH-EXPR)) + (CLAUSES-EXPANSION + LOOP-BODY ...)))))) + +;; CLAUSES-EXPANSION: +;; ((:when test). rest) => +(if test + (begin . rest) + (goof-loop ACCUMULATOR ... LOOP-VAR-NEXT ...)) + +;; ((:unless test) . rest) +;; is the same as above, but the test is negated + +;; ((:acc var (accumulate-expr bleh)) . rest) +(let ((ACCUMULATOR ACCUMULATE) ...) + (if (or ACCUMULATOR-TESTS ...) + (begin FOR-CLAUSE-FINALIZER ... + (final-function (ACCUMULATOR-FINALIZER ACCUMULATOR) ...)) + (begin . rest))) + +;; ((:break test) . rest) +(if test + (begin FOR-CLAUSE-FINALIZER ... + (final-function (ACCUMULATOR-FINALIZER ACCUMULATOR) ...)) + (begin . rest)) + +;; ((:bind (USER-BINDING ... expr) ...) . rest) +(let ((USER-BINDING ... expr) ...) + (match-let ((PARENTHESISED-PATTERN MATCH-EXPR) ...) + . rest)) + +;; ((:do expr ...) . rest) +(begin expr ...) +. rest + +;; ((:final test) . rest) +((:break final) + (:acc final (special-final-accumulator (initial #f) #t (if test))) + . rest) +

    OUTER-BINDING: 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-VAR: 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.

    @@ -269,11 +309,10 @@

    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.

    +

    PARENTHESISED-PATTERN and MATCH-EXPR: If a USER-BINDING or BODY-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.

    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.

    +

    USER-BINDING: an identifier or an (ice-9 match) pattern. If any of the supplied USER-BINDINGs are patterns, they are destructured in the subsequent match-let. goof uses let and let* from srfi-71, and as such is multiple-values-aware. You can do (:bind (one (fst . snd) (values 1 (cons 3 4)))), and it will work as expected.

    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.

    Porting

    The bulk of goof-loop is written in portable syntax-rules. That code can be found in goof-impl.scm and all files under the goof directory. The major non-portable part is the macro that is bound in every loop to the user-given name of the loop. In the guile implementation this is implemented in syntax-case, and should be portable to any r6rs scheme. The guile implementation does a non-hygienic comparison of the variables in the named update, so to not have to deal with unwanted shadowing:

    diff --git a/documentation/doc.xml b/documentation/doc.xml
index 04cf11d..8751065 100644
--- a/documentation/doc.xml
+++ b/documentation/doc.xml
@@ -26,7 +26,9 @@
     * A looping facility that in almost all cases produces as fast code as a hand-written named let
     * An extensible looping facility, where new ways of iterating over data can be easily added
 
-    The only other lisp looping facility that I know of that provides these things is Common Lisps iterate package. Iterate does however do a lot of things that are cumbersome to do in portable scheme, and would be prohibitively complicated to implement efficiently in a portable way. Unless, of course, one considers CPS-conversion of arbitrary scheme code using syntax-rules simple.
+    The only other lisp looping facility that I know of that provides these things is Common Lisps iterate package. Iterate does however do a lot of things that are cumbersome to do in portable scheme, and would be prohibitively complicated to implement efficiently in a portable way. Unless, of course, one considers CPS-conversion of arbitrary scheme code using syntax-rules simple
+
+    On a side note: if anyone has the source of Olin Shivers' loop package described in his paper "Anatomy of a loop", please send me an email.
     
     
       So, how does it look? A slightly contrived example, a naive sieve of Erathostenes:
@@ -37,27 +39,25 @@
           (loop/list ((:for i (up-from 2 (:to n)))
                       (:when (vector-ref vec i)))
             ;; Here we set all multiples of i to #f
-            (loop ((:for j (up-from (* 3 i) (:to n) (:by (* i 2)))))
+            (loop ((:for j (up-from (* 2 i) (:to n) (:by i)))
               (vector-set! vec j #f))
             i))
         
 
         Calling `(erathostenes 10)` returns a list of all primes below 10.
 
-        The example above can also be written using "subloops", but unless you know the expansion it can be somewhat surprising.
+        The example above can also be written using "subloops":
 
         
           (define (erathostenes n)
             (define vec (make-vector n #t))
             (loop ((:for i (up-from 2 (:to n)))
-                   (:acc lst (listing i))
                    (:when (vector-ref vec i))
-                   (:for j (up-from (* 3 i) (:to n) (:by (* i 2))))
-              => lst
+                   (:acc lst (listing i))
+                   (:for j (up-from (* 2 i) (:to n) (:by i))))
               (vector-set! vec j #f)))
         
 
-        Any :for clause following a :break, :when, :unless or :final clause is considered to be a subloop. Any :when clause also affects when accumulating clauses collect values. The expression following => is the final expression: this is the expression returned after the loop ends.
 
     
   
@@ -72,15 +72,19 @@
 
         loop-clause = (:for id id* ... seq-expr)
                     | (:acc id id* ... seq-expr)
-                    | (:let id expr)
-                    | (:let* id expr)
+                    | (:bind (id id* ... expr) ...)
                     | (:when guard-expr)
                     | (:unless guard-expr)
                     | (:break break-expr)
                     | (:final guard-expr)
+                    | (:do expr ...)
                     | :subloop
 
-           seq-expr = a macro that conforms to the looping protocol described below.
+          seq-expr = a macro that conforms to the looping protocol described below.
+        final-expr = The expression executed at loop finalization. If none is given,
+                     one returning all :acc values is generated
+               body = A sequence of expressions executed after the loop clauses
+                      mostly useful to control in which fashion subsequent loops execute.
     
 
     If a `name` is provided, it will be bound to a macro that allows named update of loop variables:
@@ -97,14 +101,13 @@
     This rather inane example would return `(0 1 2 3 4 8 9)`. Read more about this in the part about loop variables.
     
     
-      A subloop is a distinction between an outer loop and an inner loop. A subloop means that: for each element yielded by an outer loop, the inner loop is run until exhaustion. All non-binding clauses break out a subloop.
+      A subloop is a distinction between an outer loop and an inner loop. A subloop means that: for each element yielded by an outer loop, the inner loop is run until exhaustion. If a :for clause is placed after any non-:for clause, it is considered a subloop.
       
       
         (loop ((:for a (in-list '(1 2 3))) 
                 :subloop
                 (:for b (up-from 0 (to a)))
-                (:acc acc (listing (cons a b))))
-          => acc)
+                (:acc acc (listing (cons a b)))))
           
         ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))
       
@@ -115,23 +118,41 @@
         (loop ((:for a (in-list '(1 2 3))) 
                (:break (= 3 a))
                (:for b (up-from 0 (to a)))
-               (:acc acc (listing (cons a b))))
-          => acc)
+               (:acc acc (listing (cons a b)))))
           
         ;; => ((1 . 0) (2 . 0) (2 . 1))
       
 
-      And a :final guard will let one more body be evaluated. This clause is evaluated in the innermost loop, and as such only one body will be evaluated:
+      And a :final guard will let the subsequent subloops execute once.
       
       
-        (loop ((:for a (in-list '(1 2 3))) 
+        (loop ((:for a (in-list '(1 2 3 4)))
                (:final (= 3 a))
                (:for b (up-from 0 (to a)))
-               (:acc acc (listing (cons a b))))
-          => acc)
+               (:acc acc (listing (cons a b)))))
           
-        ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0))
+        ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1))
       
+
+      The :final clause is actually equivalent to something alike the following:
+
+      
+        (loop ((:for a (in-list '(1 2 3 4)))
+               ;; this works because :acc bindings are promoted "outwards".
+               (:break final)
+               (:acc final (in-value (initial #f) #t (if (= 3 a))))
+               (:acc acc (listing (cons a b)))))
+      
+
+      This means that any clause above the final binding will be executed an extra time before the loop exits:
+
+      
+        (loop ((:for a (up-from 1 4))
+               (:acc lst (listing a))
+               (:final (= a 2))
+               (:acc lst2 (listing a))))
+        ;; => (1 2 3) (1 2)
+        
     
 
     
@@ -367,14 +388,7 @@
 
       Another small thing is that for some :acc-clauses, the `binding` may sometimes only be visible to the user in the `final-expr`, but like :for-clauses they sometimes offer the programmer to name the loop variables.
 
-      One general thing about accumulating clauses is that they all support a guarding `if` form. If such a clause is given, accumulation will only happen if the guard clause returns true. When a `:when` or `:unless` clause is given, they also have to return true for any result to be accumulated. The following code returns the empty list:
-
-      
-        (loop ((:for a (up-from 0 10))
-               (:acc acc (listing a (if (odd? a))))
-               (:when (even? a)))
-          => acc)
-      
+      Many accumulating clauses support an `if` form. If such a clause is given, accumulation will only happen if the guard clause returns true.
 
       
       
@@ -386,8 +400,7 @@
       
         
    (:acc binding (listing-reverse [(initial init)] expr [if guard]))
    
 
-        The same as `listing` but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will
-        not preform any reverse at the end.
+        The same as `listing` but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.
           
 
       
@@ -431,27 +444,31 @@
       
         
    (:acc binding (hashing [(initial init)] key value [(if guard)]))
    
 
-        Adds the mapping `(key => value)` to the hashtable `binding` using equal?-hashing. The initial hash table is an empty hash-table.
+        Adds the mapping `(key => value)` to the hashtable `binding` using equal?-hashing. The initial hash table is an empty hash-table. `binding` is bound to the hash table throughout the loop, and its content can be mutated in the loop body.
           
 
       
         
    (:acc binding (hashving [(initial init)] key value [(if guard)]))
    
 
-        Adds the mapping `(key => value)` to the hashtable `binding` using eqv?-hashing. The initial hash table is an empty hash-table.
+        Adds the mapping `(key => value)` to the hashtable `binding` using eqv?-hashing. The initial hash table is an empty hash-table. `binding` is bound to the hash table throughout the loop, and its content can be mutated in the loop body.
           
 
       
         
    (:acc binding (hashqing [(initial init)] key value [(if guard)]))
    
 
-        Adds the mapping `(key => value)` to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.
+        Adds the mapping `(key => value)` to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.`binding` is bound to the hash table throughout the loop, and its can be mutated in the loop body.
           
 
       
-        
    (:acc var [index] (vectoring expr [(:length len) [(:fill fill)]]))
    
+        
    (:acc binding [index] (vectoring expr [(:length len) [(:fill fill)]]))
    
 
         Accumulates the result of `expr` into a vector. If `len` and `fill` is given the vector will be at most `len` elements long and any unfilled indexes will contain the element `fill`. The loop will exit when `len` elements have been accumulated.
 
         If `length` is not given, the vector will be expanded as required.
+
+        A vectoring clause adds an implicit `(:break (= index len))` after the vectoring clause. Once the last element of the vector is filled, the loop will stop and no subsequent clauses or body will be executed.
+
+        `binding` is bound to the vector throughout the loop, and its content mutated in the loop body.
           
           
         
@@ -492,7 +509,7 @@
         (in-alist ((key val) (alist-expr)) next-macro . rest)
       
 
-      You almost never have to care about `rest`. That is the complete state of the expansion of loop, which we have to pass around since most of goof-loop is written in syntax-rules. (If you want to see how that is done, have a look at the source of `vectoring` which (ab)uses this to introduce a :break clause without breaking out a subloop).
+      You should never have to care about `rest`. That is the complete state of the expansion of loop, which we have to pass around since most of goof-loop is written in syntax-rules.
 
       Going from the top we first have the outer let bindings. These are bound outside the loop, and are mostly used for binding things like vectors or ports that do not change during the loop.
 
@@ -559,44 +576,71 @@
               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 ...)))))))))
+              (match-let ((PARENTHESISED-PATTERN MATCH-EXPR))
+                (CLAUSES-EXPANSION
+                  LOOP-BODY ...))))))
+
+      ;; CLAUSES-EXPANSION:
+      ;; ((:when test). rest) =>
+      (if test
+          (begin . rest)
+          (goof-loop ACCUMULATOR ... LOOP-VAR-NEXT ...))
+
+      ;; ((:unless test) . rest)
+      ;; is the same as above, but the test is negated
+
+      ;; ((:acc var (accumulate-expr bleh)) . rest)
+      (let ((ACCUMULATOR ACCUMULATE) ...)
+        (if (or ACCUMULATOR-TESTS ...)
+            (begin FOR-CLAUSE-FINALIZER ...
+                   (final-function (ACCUMULATOR-FINALIZER ACCUMULATOR) ...))
+            (begin . rest)))
+
+      ;; ((:break test) . rest)
+      (if test
+          (begin FOR-CLAUSE-FINALIZER ...
+                 (final-function (ACCUMULATOR-FINALIZER ACCUMULATOR) ...))
+          (begin . rest))
+
+      ;; ((:bind (USER-BINDING ... expr) ...) . rest)
+      (let ((USER-BINDING ... expr) ...)
+        (match-let ((PARENTHESISED-PATTERN MATCH-EXPR) ...)
+          . rest))
+
+      ;; ((:do expr ...) . rest)
+      (begin expr ...)
+      . rest
+
+      ;; ((:final test) . rest)
+      ((:break final)
+       (:acc final (special-final-accumulator (initial #f) #t (if test)))
+       . rest)
+
     
     OUTER-BINDING: 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.
+    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-VAR: 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.
+    ACCUMULATOR and  LOOP-VAR: 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? ...)).
+    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.
+    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 ...).
+    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.
+    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.
+    PARENTHESISED-PATTERN and MATCH-EXPR: If a USER-BINDING or BODY-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.
+    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.
+    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.
+
+    USER-BINDING: an identifier or an (ice-9 match) pattern. If any of the supplied USER-BINDINGs are patterns, they are destructured in the subsequent match-let. goof uses let and let* from srfi-71, and as such is multiple-values-aware. You can do `(:bind (one (fst . snd) (values 1 (cons 3 4))))`, and it will work as expected.
 
 
-     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.
+    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.
   
   
    
     The bulk of goof-loop is written in portable syntax-rules. That code can be found in `goof-impl.scm` and all files under the `goof` directory. The major non-portable part is the macro that is bound in every loop to the user-given name of the loop. In the guile implementation this is implemented in syntax-case, and should be portable to any r6rs scheme. The guile implementation does a non-hygienic comparison of the variables in the named update, so to not have to deal with unwanted shadowing:

From 10ba6bd9d23af32af4945fb408a7eeca144d0fa9 Mon Sep 17 00:00:00 2001
From: Linus 
Date: Fri, 21 May 2021 10:12:51 +0200
Subject: [PATCH 12/27] Fixed documentation warning

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 2286400..3be9603 100644
--- a/README.md
+++ b/README.md
@@ -21,7 +21,7 @@ This is beta quality software, and some minor details are likely to change. I ha
 
 ## Documentation
 
-The current WIP documentation can be found here: https://bjoli.srht.site/doc.html (WARNING: for 0.1, not master)
+The current WIP documentation can be found here: https://bjoli.srht.site/doc.html
 
 It is written in a weird markdown/xml chimaera. You can find it in documentation doc.xml (for the weird format) and documentation/doc.html for the slightly more accessible HTML format.
 

From 6d305d416bf48f0b20ee8c2881564e2be0a662d9 Mon Sep 17 00:00:00 2001
From: Linus 
Date: Fri, 21 May 2021 10:20:38 +0200
Subject: [PATCH 13/27] Added passage about maybe automagically looping

---
 README.md | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/README.md b/README.md
index 3be9603..a9998c2 100644
--- a/README.md
+++ b/README.md
@@ -98,6 +98,8 @@ Replace that cons with stream-cons and you have a lazy construct.
 ;; => (1 3 5) (2 4)
 ```
 
+In the presence of subloops, only the loop variables of the innermost loop are exposed to named updates.
+
 ### Exposing loop variables
 
 The iterator protocol allows exposing the loop variables
@@ -305,6 +307,8 @@ Tests!
 
 Finish documentation.
 
+Think long and hard about whether loop should loop even without clauses. Definitely not the case for loops that have an identity (the simple forms), but the general loop clause should probably loop indefinitely.
+
 Figure out if I can do anything about branching. I would love to remove the body and just have loop clauses. I don't think I can do that without some serious voodoo if I want to keep the current syntax. One idea would be to define all accumulators in the start of the loop, and then bind identifiers using local macros:
 
 ``` scheme

From 99884345542805bf7486216b336ff8b1a5a61a17 Mon Sep 17 00:00:00 2001
From: Linus 
Date: Fri, 21 May 2021 10:22:21 +0200
Subject: [PATCH 14/27] Clarified readme regarding final-expr

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index a9998c2..958ee41 100644
--- a/README.md
+++ b/README.md
@@ -52,7 +52,7 @@ This of course also means accumulation is done before the body is executed, whic
 ```
 
 ### Ability to be explicit about returned values
-If you have no "final expression", denoted by => expr, one is added that returns all final values of the :acc clauses in the loop. If none is present, the return value is unspecified.
+If you have no "final expression", denoted by => expr, one is added that returns all final values of the :acc clauses in the loop. If no :acc clause or explicit final-expression is present is present, the return value is unspecified.
 
 ``` scheme
 (loop ((:for a (up-from 1 5))

From e057a6b8fee4d0c5653eca4706e305e86fd4a58d Mon Sep 17 00:00:00 2001
From: Linus 
Date: Fri, 21 May 2021 20:42:10 +0200
Subject: [PATCH 15/27] loops without subloops can now use :for clauses in
 final-expr

---
 CHANGELOG     |  8 ++++++++
 README.md     |  2 +-
 goof-impl.scm | 12 ++++++++----
 3 files changed, 17 insertions(+), 5 deletions(-)
 create mode 100644 CHANGELOG

diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
index 0000000..fb5b3e3
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,8 @@
+v0.2 [unreleased]
+  - Made clauses execute in lexical order
+  - Loops without subloops can use :for clauses in the final expression.
+  - :final also obeys lexical order, and everything below it will run once
+     any subloop will run to exhaustion.
+
+
+v.0.1 First release
diff --git a/README.md b/README.md
index 958ee41..38e944e 100644
--- a/README.md
+++ b/README.md
@@ -298,7 +298,7 @@ $3 = (let loopy-loop ((cursor (read)))
 This used to be a pretty vast collection of examples. goof-loof is now different enough from foof loop that you can't expect to carry your foof-loop skills over to goof-loop. There are however two notable regressions.
 
 ### Regressions compared to foof-loop
-only accumulating clauses are visible in the final-expression. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state if an inner loop is exited).
+only accumulating clauses are guaranteed to be visible in the final-expression. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state if an inner loop is exited).
 
 Due to clause reordering, positional updates are not supported. If you want to update your loop vars, do so using named update (see below). 
 
diff --git a/goof-impl.scm b/goof-impl.scm
index 9197cad..5813ab5 100644
--- a/goof-impl.scm
+++ b/goof-impl.scm
@@ -306,15 +306,19 @@
         (((ff-cur ...) (ff-above ...)))
         ((us ...))
         final-expr . body)
-     (let* ((final-fun (lambda (final-binding ...) final-expr))
-            lets ...)
+     (let* (lets ...)
        (let loop ((accvar accinit) ... (var init) ...)
          (if (or checks ...)
              (begin
+               ff-above ...
                ff-cur ...
-               (final-fun final-value ...))
+               (let ((final-binding final-value) ...)
+                 final-expr))
              (ref-let (refs ...)
-                      (user (ff-above ... ff-cur ... (final-fun final-value ...))
+                      (user (ff-above ...
+                             ff-cur ...
+                             (let ((final-binding final-value) ...)
+                               final-expr))
                             (loop accvar ... step ...)
                             #f
                             (us ...)

From 307240383a9aa4e9bdd130d109806eb481f53785 Mon Sep 17 00:00:00 2001
From: Linus 
Date: Sun, 23 May 2021 22:10:23 +0200
Subject: [PATCH 16/27] Changed semantics of pure loop form

Now an empty clause list means execute body once.

any kind of clause means: loop. regardless of for or no for clause.
---
 goof-impl.scm | 50 ++++++++++++++++++++++++--------------------------
 1 file changed, 24 insertions(+), 26 deletions(-)

diff --git a/goof-impl.scm b/goof-impl.scm
index 5813ab5..b0f730f 100644
--- a/goof-impl.scm
+++ b/goof-impl.scm
@@ -1,6 +1,6 @@
 ;; goof-impl.scm - portable parts of goof loop..
 ;;
-;; Copyright 2020 Linus Björnstam
+;; Copyright 2020-2021 Linus Björnstam
 ;; Copyright 2000-2015 Alex Shinn (original author of chibi-loop)
 ;; All rights reserved.
 ;;
@@ -62,12 +62,14 @@
     ((%loop o name () body ...)
      (%loop o name ((:for ensure-once (up-from 0 1))) body ...))
     ((%loop o (clauses ...)  body ...)
-     (ensure-for-clause #f () (clauses ...) o
-                        loop-name
-                        body ... (loop-name)))
-    ((%loop o name (clauses ...) . body)
-     (ensure-for-clause #f () (clauses ...) o name
-                        . body))))
+     (cl o outer-loop
+         (()) (()) (()) (()) (()) () ((() ())) (())
+         (clauses ...) body ... (outer-loop)))
+    ((%loop o name clauses . body)
+     (cl o name
+         (()) (()) (()) (()) (()) () ((() ())) (())
+         clauses . body))))
+
 
 ;; This ensures that the first subloop has at least ONE for clause. If none is found
 ;; we add a dummy one!
@@ -437,39 +439,35 @@
                                             (us-next ...)
                                             . body)))))))))
 
-(define-syntax forify
-  (syntax-rules (%acc)
-    ((_ orig name () ((%acc . acc-rest) . argsrest) . body)
-     (forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body))
-    ((_ . rest)
-     (forify* . rest))))
 
-(define-syntax forify*
+(define-syntax forify
   (syntax-rules (:for :acc :when :unless :break :final :subloop :bind :do %acc)
-    ((_ o n done-clauses () . body)
-     (%loop o n done-clauses . body))
+    ((_ o n done-clauses ()  body ...)
+     (ensure-for-clause #f () done-clauses  o
+                        n
+                        body ...))
     ((_      o n (s ...) ((:for c-rest ...) clauses ...) . body)
-     (forify* o n (s ... (:for c-rest ...)) (clauses ...) . body))
+     (forify o n (s ... (:for c-rest ...)) (clauses ...) . body))
     ((_      o n (s ...) ((:when expr) clauses ...) . body)
-     (forify* o n (s ... (:when expr)) (clauses ...) . body))
+     (forify o n (s ... (:when expr)) (clauses ...) . body))
     ((_      o n (s ...) ((:unless expr) clauses ...) . body)
-     (forify* o n (s ... (:unless expr)) (clauses ...) . body))
+     (forify o n (s ... (:unless expr)) (clauses ...) . body))
     ((_      o n (s ...) ((:break expr) clauses ...) . body)
-     (forify* o n (s ... (:break expr)) (clauses ...) . body))
+     (forify o n (s ... (:break expr)) (clauses ...) . body))
     ((_      o n (s ...) ((:final expr) clauses ...) . body)
-     (forify* o n (s ... (:final expr)) (clauses ...) . body))
+     (forify o n (s ... (:final expr)) (clauses ...) . body))
     ((_      o n (s ...) ((:do expr ...) clauses ...) . body)
-     (forify* o n (s ... (:do expr ...)) (clauses ...) . body))
+     (forify o n (s ... (:do expr ...)) (clauses ...) . body))
     ((_      o n (s ...) (:subloop clauses ...) . body)
-     (forify* o n (s ... :subloop) (clauses ...) . body))
+     (forify o n (s ... :subloop) (clauses ...) . body))
     ((_      o n (s ...) ((:bind pairs ...) clauses ...) . body)
-     (forify* o n (s ... (:bind pairs ...)) (clauses ...) . body))
+     (forify o n (s ... (:bind pairs ...)) (clauses ...) . body))
     ((_      o n (s ...) ((%acc c-rest ...) clauses ...) . body)
-     (forify* 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)
      (syntax-error "Accumulating clauses are not allowed in simplified loop forms." o))
     ((_      o n (s ...) ((id id* ... (iterator source ...)) clauses ...) . body)
-     (forify* o n (s ... (:for id id* ... (iterator source ...))) (clauses ...) . body))))
+     (forify o n (s ... (:for id id* ... (iterator source ...))) (clauses ...) . body))))
 
 (define-syntax loop/list
   (syntax-rules ()

From 189f1d045d2d219843b4f98dfb4e16633f34e611 Mon Sep 17 00:00:00 2001
From: Linus 
Date: Tue, 25 May 2021 22:07:53 +0200
Subject: [PATCH 17/27] Made sure loop loops

Fix subloop :acc semantics.

clarify code comments.
---
 goof-impl.scm | 23 ++++++++++-------------
 1 file changed, 10 insertions(+), 13 deletions(-)

diff --git a/goof-impl.scm b/goof-impl.scm
index b0f730f..6e2c14b 100644
--- a/goof-impl.scm
+++ b/goof-impl.scm
@@ -48,19 +48,17 @@
 
 (include "goof/iterators.scm")
 
-
+;; This first step saves the original syntax.
 (define-syntax loop
   (syntax-rules ()
     ((loop . rest)
      (%loop (loop . rest) . rest))))
 
 
+;; This second step adds a loop name and makes sure it loops
+;; A loop form without name or clauses will run forever.
 (define-syntax %loop
   (syntax-rules ()
-    ((%loop o () body ...)
-     (%loop o ((:for ensure-once (up-from 0 1))) body ...))
-    ((%loop o name () body ...)
-     (%loop o name ((:for ensure-once (up-from 0 1))) body ...))
     ((%loop o (clauses ...)  body ...)
      (cl o outer-loop
          (()) (()) (()) (()) (()) () ((() ())) (())
@@ -71,8 +69,8 @@
          clauses . body))))
 
 
-;; This ensures that the first subloop has at least ONE for clause. If none is found
-;; we add a dummy one!
+;; This is only here for simplified forms with an identity. If the loop has no :for-clause in the
+;; outermost loop, we add a dummy one so that the first part is executed once.
 (define-syntax ensure-for-clause
   (syntax-rules (:for :acc :break :subloop :when :unless :final  DONE)
     ((_ DONE clauses () orig name  . body)
@@ -216,7 +214,7 @@
          checks
          ((refs ... new-refs ...) . refs-rest)
          (finals ... new-finals ...)
-         ff ((cur-ub ... (:break  new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))
+         ff ((cur-ub ... (:bind (accvar accupdate) ...) (:break  new-checks) ... ) . ub-rest) clauses . body))
     ;; We have several subloops!
     ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
         orig name
@@ -235,7 +233,7 @@
          checks
          ((refs ... new-refs ...) . refs-rest)
          (finals ... new-finals ...)
-         ff ((cur-ub ... (:break  new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))))
+         ff ((cur-ub ...(:bind (accvar accupdate) ...) (:break  new-checks) ...) . ub-rest) clauses . body))))
 
 ;; Integrating for clauses is not as involved, since they only want to be introduced into the current
 ;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop
@@ -263,11 +261,11 @@
     ((cl err ...)
      (cl err ...))))
 
-
+;; User is responsible for all non-acc/non-for clauses.
 (define-syntax user
   (syntax-rules (:when :bind :break :do :nop)
-    ((_ final-expr next outer () body ...)
-     (begin body ...))
+    ((_ final-expr next outer () . body)
+     (begin . body))
     ((_ f n o (:nop . rest) . body)
      (user f n o rest . body))
     ((_ f n o ((:bind pairs ...) . rest) . body)
@@ -287,7 +285,6 @@
        (user f n o rest . body)))))
 
 
-
 ;; If there are no subloops, we emit to the simple case
 (define-syntax emit
   (syntax-rules ()

From 1de0a624f597f6630822128885e4586049a270ef Mon Sep 17 00:00:00 2001
From: Linus 
Date: Wed, 26 May 2021 20:32:09 +0200
Subject: [PATCH 18/27] Updated readme

Small changes.
---
 README.md | 40 ++++++++++++++++++++--------------------
 1 file changed, 20 insertions(+), 20 deletions(-)

diff --git a/README.md b/README.md
index 38e944e..100c5f7 100644
--- a/README.md
+++ b/README.md
@@ -1,8 +1,8 @@
 # goof-loop - a scheme looping facility
 
-goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this. 
+goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's fantastic (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this. 
 
-Compared to foof-loop, some things are added. Apart from minor syntactic changes, subloops are supported. The best way is to show:
+Compared to foof-loop, some things are added. Apart from minor syntactic changes, subloops are supported and clauses are executed in order. The best way is to show:
 
 ``` scheme
 (define lst '((1 2) dud (3 4) (5 6)))
@@ -13,7 +13,7 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes
 ;; => 21
 ```
 
- Any :when, :unless, :break, :final, :bind, :do or :subloop clause will break out a subloop if any subsequent for clauses are found.
+ Any :when, :unless, :break, :final, :bind, :do, or :subloop clause will break out a subloop if any subsequent for clauses are found.
 
 ## Beta warning
 
@@ -25,7 +25,6 @@ The current WIP documentation can be found here: https://bjoli.srht.site/doc.htm
 
 It is written in a weird markdown/xml chimaera. You can find it in documentation doc.xml (for the weird format) and documentation/doc.html for the slightly more accessible HTML format.
 
-
 ## Features
 
 ### Lexical order of clauses
@@ -41,7 +40,7 @@ It is written in a weird markdown/xml chimaera. You can find it in documentation
 
 There is one caveat to this: some accumulating clauses (currently only vectoring with :length specified) have an implicit :break clause. This is tested AFTER the accumulation takes place. So: if the last position of the vector is set, the loop halts.
 
-This of course also means accumulation is done before the body is executed, which is a bit counterintuitive.
+This can lead to some things things that seem counter-intuitive, like:
 
 ``` scheme
 (loop ((:for a (in-list '(1 2 3)))
@@ -51,6 +50,8 @@ This of course also means accumulation is done before the body is executed, whic
 ;; => #(1 2) 1
 ```
 
+It also means that any loop body is executed _after_ values are accumulated. 
+
 ### Ability to be explicit about returned values
 If you have no "final expression", denoted by => expr, one is added that returns all final values of the :acc clauses in the loop. If no :acc clause or explicit final-expression is present is present, the return value is unspecified.
 
@@ -83,7 +84,7 @@ Replace that cons with stream-cons and you have a lazy construct.
 ### Named updates
 
 ``` scheme
-;; Shamelessly stolen from Taylor Campbell's foof-loop documentation
+;; Shamelessly stolen and adapted from Taylor Campbell's foof-loop documentation
 (define (partition list predicate)
   (loop continue ((:for element (in-list list))
                   (:acc satisfied (folding '()))
@@ -102,7 +103,7 @@ In the presence of subloops, only the loop variables of the innermost loop are e
 
 ### Exposing loop variables
 
-The iterator protocol allows exposing the loop variables
+The iterator protocol allows exposing the loop variables.
 
 ``` scheme
 (loop name ((:for elt pair (in-list '(1 2 3))))
@@ -121,14 +122,11 @@ goof supports a higher order looping protocol, based on srfi-158 generators:
 
 ``` scheme
 
-(loop ((:for food (in-list '(banana cake grape cake bean cake)))
+(loop ((:for word (in-list '(true false sant falskt wahr falsch)))
        (:for true? (in-cycle (in-list '(#t #f)))))
-  (display "The ") 
-  (display food)
-  (display " is a ")
-  (if true?
-     (display food)
-     (display "LIE!"))
+  (display word)
+  (display ": ")
+  (display true?)
   (newline))
 ```
 
@@ -231,12 +229,11 @@ Speed is good. Despite the rather involved expansion you can see in the document
  ,expand (loop ((:for a (in-list '(1 2 3 4)))
               (:when (even? a)) 
               (:acc acc (listing a))))
-$0 = (let* ((final-fun
-         (lambda (acc) ((@@ (goof) values) acc)))
-       (tmp-kons (@@ (goof) cons)))
+$0 = (let ((tmp-kons (@@ (goof) cons)))
   (let loop ((cursor-1 '()) (cursor '(1 2 3 4)))
     (if ((@@ (goof) not) ((@@ (goof) pair?) cursor))
-      (final-fun ((@@ (goof) reverse) cursor-1))
+      (let ((acc ((@@ (goof) reverse) cursor-1)))
+        ((@@ (goof) values) acc))
       (let ((a ((@@ (goof) car) cursor))
             (succ ((@@ (goof) cdr) cursor)))
         (if (even? a)
@@ -245,6 +242,7 @@ $0 = (let* ((final-fun
             (loop cursor succ))
           (loop cursor-1 succ))))))
 
+
 ;; This is mostly fluff that is removed using DCE, unrolling and inlining:
 > ,opt (loop ((:for a (in-list '(1 2 3 4)))
               (:when (even? a))
@@ -298,7 +296,7 @@ $3 = (let loopy-loop ((cursor (read)))
 This used to be a pretty vast collection of examples. goof-loof is now different enough from foof loop that you can't expect to carry your foof-loop skills over to goof-loop. There are however two notable regressions.
 
 ### Regressions compared to foof-loop
-only accumulating clauses are guaranteed to be visible in the final-expression. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state if an inner loop is exited).
+only accumulating clauses are guaranteed to be visible in the final-expression in loops that contain subloops. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state if an inner loop is exited).
 
 Due to clause reordering, positional updates are not supported. If you want to update your loop vars, do so using named update (see below). 
 
@@ -313,7 +311,7 @@ Figure out if I can do anything about branching. I would love to remove the body
 
 ``` scheme
 (loop (accumulators ...)
-      (clauses ...)
+      clauses ...
       => final-expr)
 
 (loop ((vectoring a)
@@ -335,5 +333,7 @@ But this solution isn't great. The current situation isn't either, though. The b
 ## foof, what a guy
 I have previously expressed some admiration for Alex Shinn 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.
 
+Don't let my code cast any shadow upon him! I just took his code and made it ugly. (chibi loop) is simple, clear, and - perhaps most important - deliberate. 
+
 ## Licence
 goof started off by copying the iterator protocol of (chibi loop), and things sort of went downhill from there. Despite this, there is still quite a lot of code (especially in iterators.scm) that I didn't write myself. I only made it ugly. Thus goof is licensed under the same BSD-styled license Alex uses for chibi-loop.

From 832c414260566a3bc3870c77d06b08b04a4ec0ed Mon Sep 17 00:00:00 2001
From: Linus 
Date: Tue, 17 Aug 2021 21:36:13 +0200
Subject: [PATCH 19/27] Changes for the better

 * goof-impl.scm (loop/first loop/last): add ability to specify a
:default value. Added auxiliary syntax :default.
 * goof/iterators.scm (accumulating hash(q|v)ing): changed auxiliary
keyword from initial -> :initial.
 * goof.scm: export extra keywords
 * doc.html
 * doc.xml : document changes. fix bugs.
---
 documentation/doc.html | 36 ++++++++++++++++++------------------
 documentation/doc.xml  | 40 ++++++++++++++++++++--------------------
 goof-impl.scm          | 37 +++++++++++++++++++++++--------------
 goof.scm               |  2 ++
 goof/iterators.scm     | 18 +++++++++---------
 tests.scm              |  5 +++++
 6 files changed, 77 insertions(+), 61 deletions(-)

diff --git a/documentation/doc.html b/documentation/doc.html
index aa3f7b3..ee926ea 100644
--- a/documentation/doc.html
+++ b/documentation/doc.html
@@ -67,7 +67,7 @@
 
     (loop ((:for a (in-list '(1 2 3))) 
         :subloop
-        (:for b (up-from 0 (to a)))
+        (:for b (up-from 0 (:to a)))
         (:acc acc (listing (cons a b)))))
   
 ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))
@@ -75,7 +75,7 @@
 
     (loop ((:for a (in-list '(1 2 3))) 
        (:break (= 3 a))
-       (:for b (up-from 0 (to a)))
+       (:for b (up-from 0 (:to a)))
        (:acc acc (listing (cons a b)))))
   
 ;; => ((1 . 0) (2 . 0) (2 . 1))
@@ -83,10 +83,10 @@
 
     (loop ((:for a (in-list '(1 2 3 4)))
        (:final (= 3 a))
-       (:for b (up-from 0 (to a)))
+       (:for b (up-from 0 (:to a)))
        (:acc acc (listing (cons a b)))))
   
-;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1))
+;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))
       
    The :final clause is actually equivalent to something alike the following:
    
 
     (loop ((:for a (in-list '(1 2 3 4)))
@@ -117,13 +117,13 @@
 
    Some loop clauses have the option of exposing their loop variable(s). The option to do so is documented under the documentation for each clause.

    Simple forms

    The pure loop macro is quite a big hammer for most tasks. Often we want to do simple things, like collect elements into a list or a vector, which means the extra housekeeping of separating accumulators and for clauses are too much heavy lifting. goof-loop provides several simpler forms that can be used in those cases. In these simpler forms :acc is disallowed, and everything not identified as anything else is assumed to be a :for clause. The loop below accumulates the 100 first fibonacci numbers into a list.

    -(loop/list ((count (up-from 0 (to 100)))
+(loop/list ((count (up-from 0 (:to 100)))
             (a (in 0 b))
             (b (in 1 (+ a b))))
   b)

    The simple forms provided by goof-loop are the following:

    -
    Scheme syntax: loop/first
    (loop/first (clauses ...) body ...)

    If any body is ever evaluated, stop and return the value of that evaluation. If no body is ever evaluated the return value is unspecified.

    -
    Scheme syntax: loop/last
    (loop/last (clauses ...) body ...)

    Returns the result of the last body to be evaluated. If no body is evaluated the return value is unspecified.

    +
    Scheme syntax: loop/first
    (loop/first [:default #f] (clauses ...) body ...)

    If any body is ever evaluated, stop and return the value of that evaluation. If no body is evaluated it returns the value specified by :default, which defaults to #f.

    +
    Scheme syntax: loop/last
    (loop/last [:default #f] (clauses ...) body ...)

    Returns the result of the last body to be evaluated. If no body is evaluated it returns the value specified by :default, which defaults to #f.

    Scheme syntax: loop/list
    (loop/list (clauses ...) body ...)

    Iterates over clauses and builds a list of the result of every evaluation of body. The order of the list is the same as the order body was evaluated in. The result of the first evaluation of body is the first element of the resulting list.

    The list returned is the same even when used with multi-shot continuations.

    If no body is evaluated, the result is the empty list.

    @@ -167,25 +167,25 @@

    :acc-clauses

    Accumulating clauses differ from :for-clauses in 2 significant ways. They have a final value available in the final-expr, and they keep their state throughout the loop. In the case of a loop with one subloop, the :for-clauses reset their state every time the subloop is entered. :acc-clauses will always keep their state.

    Another small thing is that for some :acc-clauses, the binding may sometimes only be visible to the user in the final-expr, but like :for-clauses they sometimes offer the programmer to name the loop variables.

    Many accumulating clauses support an if form. If such a clause is given, accumulation will only happen if the guard clause returns true.

    -
    Scheme syntax: listing
    (:acc binding (listing [(initial init)] expr [if guard]))

    Accumulates expr into a list. ´bindingis only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. Ifinitialis given that will be used as the tail of the accumulated results. It defaults to’()`.

    -
    Scheme syntax: listing-reverse
    (:acc binding (listing-reverse [(initial init)] expr [if guard]))

    The same as listing but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.

    -
    Scheme syntax: appending
    (:acc binding (appending [(initial init)] expr [if guard]))

    expr evaluates to a list that is then appended to the accumulated result.

    +
    Scheme syntax: listing
    (:acc binding (listing [(:initial init)] expr [if guard]))

    Accumulates expr into a list. ´bindingis only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. Ifinitialis given that will be used as the tail of the accumulated results. It defaults to’()`.

    +
    Scheme syntax: listing-reverse
    (:acc binding (listing-reverse [(:initial init)] expr [if guard]))

    The same as listing but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.

    +
    Scheme syntax: appending
    (:acc binding (appending [(:initial init)] expr [if guard]))

    expr evaluates to a list that is then appended to the accumulated result.

     (loop ((:for elt (in-list '((1 2) (3 4))))
-       (:acc acc (appending (initial '(0)) elt)))
+       (:acc acc (appending (:initial '(0)) elt)))
   => acc)
   ;; => (0 1 2 3 4)     
-
    Scheme syntax: appending-reverse
    (:acc binding (appending-reverse [(initial init)] expr [if guard]))

    expr evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is '().

    +
    Scheme syntax: appending-reverse
    (:acc binding (appending-reverse [(:initial init)] expr [if guard]))

    expr evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is '().

     (loop ((:for elt (in-list '((1 2) (3 4))))
-       (:acc acc (appending-reverse (initial '(0)) elt)))
+       (:acc acc (appending-reverse (:initial '(0)) elt)))
   => acc)
   ;; => (4 3 2 1 0)
-
    Scheme syntax: summing
    (:acc binding (summing [(initial init)] expr [(if guard)]))

    Adds the result of expr together using +. The default initial value is 0.

    -
    Scheme syntax: multiplying
    (:acc binding (multiplying [(initial init)] expr [(if guard)]))

    Multiplies the result of expr using *. The default initial value is 1.

    -
    Scheme syntax: hashing
    (:acc binding (hashing [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using equal?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    -
    Scheme syntax: hashving
    (:acc binding (hashving [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using eqv?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    -
    Scheme syntax: hashqing
    (:acc binding (hashqing [(initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.binding is bound to the hash table throughout the loop, and its can be mutated in the loop body.

    +
    Scheme syntax: summing
    (:acc binding (summing [(:initial init)] expr [(if guard)]))

    Adds the result of expr together using +. The default initial value is 0.

    +
    Scheme syntax: multiplying
    (:acc binding (multiplying [(:initial init)] expr [(if guard)]))

    Multiplies the result of expr using *. The default initial value is 1.

    +
    Scheme syntax: hashing
    (:acc binding (hashing [(:initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using equal?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    +
    Scheme syntax: hashving
    (:acc binding (hashving [(:initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using eqv?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    +
    Scheme syntax: hashqing
    (:acc binding (hashqing [(:initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.binding is bound to the hash table throughout the loop, and its can be mutated in the loop body.

    Scheme syntax: vectoring
    (:acc binding [index] (vectoring expr [(:length len) [(:fill fill)]]))

    Accumulates the result of expr into a vector. If len and fill is given the vector will be at most len elements long and any unfilled indexes will contain the element fill. The loop will exit when len elements have been accumulated.

    If length is not given, the vector will be expanded as required.

    A vectoring clause adds an implicit (:break (= index len)) after the vectoring clause. Once the last element of the vector is filled, the loop will stop and no subsequent clauses or body will be executed.

    diff --git a/documentation/doc.xml b/documentation/doc.xml index 8751065..5545149 100644 --- a/documentation/doc.xml +++ b/documentation/doc.xml @@ -106,7 +106,7 @@ (loop ((:for a (in-list '(1 2 3))) :subloop - (:for b (up-from 0 (to a))) + (:for b (up-from 0 (:to a))) (:acc acc (listing (cons a b))))) ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2)) @@ -117,7 +117,7 @@ (loop ((:for a (in-list '(1 2 3))) (:break (= 3 a)) - (:for b (up-from 0 (to a))) + (:for b (up-from 0 (:to a))) (:acc acc (listing (cons a b))))) ;; => ((1 . 0) (2 . 0) (2 . 1)) @@ -128,10 +128,10 @@ (loop ((:for a (in-list '(1 2 3 4))) (:final (= 3 a)) - (:for b (up-from 0 (to a))) + (:for b (up-from 0 (:to a))) (:acc acc (listing (cons a b))))) - ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1)) + ;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2)) The :final clause is actually equivalent to something alike the following: @@ -182,7 +182,7 @@ The pure `loop` macro is quite a big hammer for most tasks. Often we want to do simple things, like collect elements into a list or a vector, which means the extra housekeeping of separating accumulators and for clauses are too much heavy lifting. goof-loop provides several simpler forms that can be used in those cases. In these simpler forms :acc is disallowed, and everything not identified as anything else is assumed to be a :for clause. The loop below accumulates the 100 first fibonacci numbers into a list. - (loop/list ((count (up-from 0 (to 100))) + (loop/list ((count (up-from 0 (:to 100))) (a (in 0 b)) (b (in 1 (+ a b)))) b) @@ -192,15 +192,15 @@ -
    (loop/first (clauses ...) body ...)
    +
    (loop/first [:default #f] (clauses ...) body ...)
    - If any body is ever evaluated, stop and return the value of that evaluation. If no body is ever evaluated the return value is unspecified. + If any body is ever evaluated, stop and return the value of that evaluation. If no body is evaluated it returns the value specified by `:default`, which defaults to #f.     -
    (loop/last (clauses ...) body ...)
    +
    (loop/last [:default #f] (clauses ...) body ...)
    - Returns the result of the last body to be evaluated. If no body is evaluated the return value is unspecified. + Returns the result of the last body to be evaluated. If no body is evaluated it returns the value specified by `:default`, which defaults to #f.     @@ -392,69 +392,69 @@ -
    (:acc binding (listing [(initial init)] expr [if guard]))
    +
    (:acc binding (listing [(:initial init)] expr [if guard]))
    Accumulates `expr` into a list. ´binding` is only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. If `initial` is given that will be used as the tail of the accumulated results. It defaults to `'()`.     -
    (:acc binding (listing-reverse [(initial init)] expr [if guard]))
    +
    (:acc binding (listing-reverse [(:initial init)] expr [if guard]))
    The same as `listing` but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.     -
    (:acc binding (appending [(initial init)] expr [if guard]))
    +
    (:acc binding (appending [(:initial init)] expr [if guard]))
    `expr` evaluates to a list that is then appended to the accumulated result. (loop ((:for elt (in-list '((1 2) (3 4)))) - (:acc acc (appending (initial '(0)) elt))) + (:acc acc (appending (:initial '(0)) elt))) => acc) ;; => (0 1 2 3 4)     -
    (:acc binding (appending-reverse [(initial init)] expr [if guard]))
    +
    (:acc binding (appending-reverse [(:initial init)] expr [if guard]))
    `expr` evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is `'()`. (loop ((:for elt (in-list '((1 2) (3 4)))) - (:acc acc (appending-reverse (initial '(0)) elt))) + (:acc acc (appending-reverse (:initial '(0)) elt))) => acc) ;; => (4 3 2 1 0)     -
    (:acc binding (summing [(initial init)] expr [(if guard)]))
    +
    (:acc binding (summing [(:initial init)] expr [(if guard)]))
    Adds the result of `expr` together using `+`. The default initial value is 0.     -
    (:acc binding (multiplying [(initial init)] expr [(if guard)]))
    +
    (:acc binding (multiplying [(:initial init)] expr [(if guard)]))
    Multiplies the result of `expr` using `*`. The default initial value is 1.     -
    (:acc binding (hashing [(initial init)] key value [(if guard)]))
    +
    (:acc binding (hashing [(:initial init)] key value [(if guard)]))
    Adds the mapping `(key => value)` to the hashtable `binding` using equal?-hashing. The initial hash table is an empty hash-table. `binding` is bound to the hash table throughout the loop, and its content can be mutated in the loop body.     -
    (:acc binding (hashving [(initial init)] key value [(if guard)]))
    +
    (:acc binding (hashving [(:initial init)] key value [(if guard)]))
    Adds the mapping `(key => value)` to the hashtable `binding` using eqv?-hashing. The initial hash table is an empty hash-table. `binding` is bound to the hash table throughout the loop, and its content can be mutated in the loop body.     -
    (:acc binding (hashqing [(initial init)] key value [(if guard)]))
    +
    (:acc binding (hashqing [(:initial init)] key value [(if guard)]))
    Adds the mapping `(key => value)` to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.`binding` is bound to the hash table throughout the loop, and its can be mutated in the loop body.     diff --git a/goof-impl.scm b/goof-impl.scm index 6e2c14b..fab2f1e 100644 --- a/goof-impl.scm +++ b/goof-impl.scm @@ -32,11 +32,15 @@ :when :unless :break :final :bind :do :subloop :for :acc ;; Auxiliary syntax for the iterators. :gen + ;; auxiliary syntax for some accumulators + :initial ;; auxiliary auxiliary syntax ;; for vectoring :length :fill ;;for up-from and down-to :to :by + ;; used by for/first and for/last + :default ;; Internal syntax. %acc is turned into :acc by the forify macro ;; it is used make it possible to report an error if :acc is used in ;; one of the simple macros. @@ -491,27 +495,32 @@ => acc (product-loop))))) -(define sentinel (list 'unique)) - -;; TODO: maybe have a look at the expansion of this. It seems weird. +;; This exploits that we give the loop a name, but don't add the loop to the end of the +;; body, thus returning whatever the last expr of body returns. (define-syntax loop/first - (syntax-rules () - ((n (clauses ...) body ...) + (syntax-rules (:default) + ((n :default val (clauses ...) body ...) (forify (n (clauses ...) body ...) loop/first - () (clauses ... (:final #t)) - => #f - body ...)))) - - -(define-syntax loop/last - (syntax-rules () + () (clauses ...) + => val + body ...)) ((n (clauses ...) body ...) + (loop/first :default #f (clauses ...) body ...)))) + + +;; unique value used for loop/last +(define sentinel (list 'unique)) +(define-syntax loop/last + (syntax-rules (:default) + ((n :default val (clauses ...) body ...) (forify (n (clauses ...) body ...) loop-name () (clauses ... (%acc acc (folding sentinel))) - => (if (eq? sentinel acc) #f acc) + => (if (eq? sentinel acc) val acc) (let ((result (let () body ...))) - (loop-name (=> acc result))))))) + (loop-name (=> acc result))))) + ((n (clauses ...) body ...) + (loop/last :default #f (clauses ...) body ...)))) (define-syntax loop/and (syntax-rules () diff --git a/goof.scm b/goof.scm index 021a0ac..fb7b49c 100644 --- a/goof.scm +++ b/goof.scm @@ -48,8 +48,10 @@ loop/list/parallel :when :unless :break :final :bind :subloop :do :for :acc + :initial :length :fill :to :by + :default in in-list diff --git a/goof/iterators.scm b/goof/iterators.scm index f332b28..d8030c5 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -373,10 +373,10 @@ (define-syntax accumulating - (syntax-rules (initial if :acc) + (syntax-rules (:initial if :acc) ((accumulating :acc (kons final init) ((var) . x) next . rest) (accumulating :acc (kons final init) ((var cursor) . x) next . rest)) - ((accumulating :acc (kons final init) ((var cursor) ((initial i) . x)) n . rest) + ((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 ((tmp-kons kons)) @@ -443,18 +443,18 @@ (syntax-rules () ((_ name default-make setter) (define-syntax name - (syntax-rules (:acc if initial) + (syntax-rules (:acc if :initial) ((_ :acc ((var) (key value)) n . rest) - (name :acc ((var) (key value (if #t) (initial default-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)) + (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)) + (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) + ((_ :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 ((var init)) ((dummy (if #f #f) (if guard (setter var key value) (if #f #f)))) diff --git a/tests.scm b/tests.scm index d1366f3..5c03fb9 100644 --- a/tests.scm +++ b/tests.scm @@ -148,4 +148,9 @@ (loop/list ((a (up-from 1 (:by 2))) (b (in-list '(1 3 5)))) (+ a b)) '(2 6 10)) + +(test-equal "down-from-10" + (loop/sum ((a (down-from 11 (:to 1) (:by 2)))) + a) + 25) (test-end ":for-clauses") From 050f88d6788acf746b8e7129d4c1e6233bc76cbf Mon Sep 17 00:00:00 2001 From: Linus Date: Sat, 25 Sep 2021 21:21:29 +0200 Subject: [PATCH 20/27] Fixed misnamed export * goof.scm: in-vector-reverse and in-string-reverse now properly exported. --- goof.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/goof.scm b/goof.scm index fb7b49c..970b0eb 100644 --- a/goof.scm +++ b/goof.scm @@ -57,8 +57,8 @@ in-list in-lists - in-vector in-reverse-vector - in-string in-reverse-string + in-vector in-vector-reverse + in-string in-string-reverse in-hash in-port @@ -95,8 +95,8 @@ ;; default and I had to wrap it in something. Paremeters are available in the default environment ;; boxes are not. (define valid-for-clauses (make-parameter (list #'in #'in-list #'in-lists - #'in-vector #'in-reverse-vector - #'in-string #'in-reverse-string + #'in-vector #'in-vector-reverse + #'in-string #'in-string-reverse #'in-hash #'in-port #'in-file From f5a3629b56ab9913fd0fcf11e972552415ca60ac Mon Sep 17 00:00:00 2001 From: Linus Date: Sat, 25 Sep 2021 21:27:50 +0200 Subject: [PATCH 21/27] Make let-kw-form more portable to other syntax-case schemes * goof.scm (let-kw-form): don't use guile-specific with-ellipsis. --- goof.scm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/goof.scm b/goof.scm index 970b0eb..f147171 100644 --- a/goof.scm +++ b/goof.scm @@ -206,18 +206,17 @@ ((_ macro-name final-fun (user-finals ...) (loop-name (var step) ...) . body) (let-syntax ((macro-name (lambda (stx) - (with-ellipsis ::: (let loop ((lst (cdr (syntax->list stx))) (params (list #'(var step) ...))) (if (null? lst) - (with-syntax ((((v s) :::) params)) + (with-syntax ((((v s) (... ...)) params)) #'(inner-recur loop-name final-fun (user-finals ...) - ((v s) :::))) + ((v s) (... ...)))) (syntax-case (car lst) (=>) ((=> name val) (loop (cdr lst) (update-name params #'name #'val))) - (_ (error "Malformed looping clause in macro"))))))))) + (_ (error "Malformed looping clause in macro")))))))) . body)))) From 88f138849e60126ca0ea32de4fd917f3cc57997c Mon Sep 17 00:00:00 2001 From: Linus Date: Sat, 25 Sep 2021 21:31:48 +0200 Subject: [PATCH 22/27] Fix typo in readme * README.md: fix an example so that it actualy works. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 100c5f7..3e704f0 100644 --- a/README.md +++ b/README.md @@ -71,7 +71,7 @@ If you have no "final expression", denoted by => expr, one is added that returns You can of course still have a larger control of when to loop by naming your loop: ``` scheme -(loop loopy-loop ((:for a (up-from 1 (to 11)))) +(loop loopy-loop ((:for a (up-from 1 (:to 11)))) => '() (if (odd? a) (cons (* a (- a)) (loopy-loop)) From 2775e70fd0ad33b4316c53d1770d5d2dfd4abf70 Mon Sep 17 00:00:00 2001 From: Linus Date: Mon, 27 Sep 2021 21:36:02 +0200 Subject: [PATCH 23/27] guard if in accumulators is now :if. All auxiliary syntax is now prefixed by :. --- documentation/doc.html | 22 +++++++++++----------- documentation/doc.xml | 22 +++++++++++----------- goof-impl.scm | 2 +- goof/iterators.scm | 20 ++++++++++---------- 4 files changed, 33 insertions(+), 33 deletions(-) diff --git a/documentation/doc.html b/documentation/doc.html index ee926ea..65838c4 100644 --- a/documentation/doc.html +++ b/documentation/doc.html @@ -92,7 +92,7 @@ (loop ((:for a (in-list '(1 2 3 4))) ;; this works because :acc bindings are promoted "outwards". (:break final) - (:acc final (in-value (initial #f) #t (if (= 3 a)))) + (:acc final (in-value (:initial #f) #t (:if (= 3 a)))) (:acc acc (listing (cons a b)))))

    This means that any clause above the final binding will be executed an extra time before the loop exits:

    @@ -166,26 +166,26 @@
    Scheme syntax: stop-after
    (:for binding (stop-after iterator pred))

    Binds binding to the values produced by iterator until pred applied to that value returns true. It then produces that last value. The iterator is then considered exhausted. Useful in subloops where one might want to end internal iteration without :break-ing.

    :acc-clauses

    Accumulating clauses differ from :for-clauses in 2 significant ways. They have a final value available in the final-expr, and they keep their state throughout the loop. In the case of a loop with one subloop, the :for-clauses reset their state every time the subloop is entered. :acc-clauses will always keep their state.

    Another small thing is that for some :acc-clauses, the binding may sometimes only be visible to the user in the final-expr, but like :for-clauses they sometimes offer the programmer to name the loop variables.

    -

    Many accumulating clauses support an if form. If such a clause is given, accumulation will only happen if the guard clause returns true.

    -
    Scheme syntax: listing
    (:acc binding (listing [(:initial init)] expr [if guard]))

    Accumulates expr into a list. ´bindingis only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. Ifinitialis given that will be used as the tail of the accumulated results. It defaults to’()`.

    -
    Scheme syntax: listing-reverse
    (:acc binding (listing-reverse [(:initial init)] expr [if guard]))

    The same as listing but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.

    -
    Scheme syntax: appending
    (:acc binding (appending [(:initial init)] expr [if guard]))

    expr evaluates to a list that is then appended to the accumulated result.

    +

    Many accumulating clauses support an :if form. If such a clause is given, accumulation will only happen if the guard clause returns true.

    +
    Scheme syntax: listing
    (:acc binding (listing [(:initial init)] expr [(:if guard)]))

    Accumulates expr into a list. ´bindingis only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. Ifinitialis given that will be used as the tail of the accumulated results. It defaults to’()`.

    +
    Scheme syntax: listing-reverse
    (:acc binding (listing-reverse [(:initial init)] expr [(:if guard)]))

    The same as listing but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.

    +
    Scheme syntax: appending
    (:acc binding (appending [(:initial init)] expr [(:if guard)]))

    expr evaluates to a list that is then appended to the accumulated result.

     (loop ((:for elt (in-list '((1 2) (3 4))))
        (:acc acc (appending (:initial '(0)) elt)))
   => acc)
   ;; => (0 1 2 3 4)     
-
    Scheme syntax: appending-reverse
    (:acc binding (appending-reverse [(:initial init)] expr [if guard]))

    expr evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is '().

    +
    Scheme syntax: appending-reverse
    (:acc binding (appending-reverse [(:initial init)] expr [(:if guard)]))

    expr evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is '().

     (loop ((:for elt (in-list '((1 2) (3 4))))
        (:acc acc (appending-reverse (:initial '(0)) elt)))
   => acc)
   ;; => (4 3 2 1 0)
-
    Scheme syntax: summing
    (:acc binding (summing [(:initial init)] expr [(if guard)]))

    Adds the result of expr together using +. The default initial value is 0.

    -
    Scheme syntax: multiplying
    (:acc binding (multiplying [(:initial init)] expr [(if guard)]))

    Multiplies the result of expr using *. The default initial value is 1.

    -
    Scheme syntax: hashing
    (:acc binding (hashing [(:initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using equal?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    -
    Scheme syntax: hashving
    (:acc binding (hashving [(:initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to the hashtable binding using eqv?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    -
    Scheme syntax: hashqing
    (:acc binding (hashqing [(:initial init)] key value [(if guard)]))

    Adds the mapping (key => value) to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.binding is bound to the hash table throughout the loop, and its can be mutated in the loop body.

    +
    Scheme syntax: summing
    (:acc binding (summing [(:initial init)] expr [(:if guard)]))

    Adds the result of expr together using +. The default initial value is 0.

    +
    Scheme syntax: multiplying
    (:acc binding (multiplying [(:initial init)] expr [(:if guard)]))

    Multiplies the result of expr using *. The default initial value is 1.

    +
    Scheme syntax: hashing
    (:acc binding (hashing [(:initial init)] key value [(:if guard)]))

    Adds the mapping (key => value) to the hashtable binding using equal?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    +
    Scheme syntax: hashving
    (:acc binding (hashving [(:initial init)] key value [(:if guard)]))

    Adds the mapping (key => value) to the hashtable binding using eqv?-hashing. The initial hash table is an empty hash-table. binding is bound to the hash table throughout the loop, and its content can be mutated in the loop body.

    +
    Scheme syntax: hashqing
    (:acc binding (hashqing [(:initial init)] key value [(:if guard)]))

    Adds the mapping (key => value) to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.binding is bound to the hash table throughout the loop, and its can be mutated in the loop body.

    Scheme syntax: vectoring
    (:acc binding [index] (vectoring expr [(:length len) [(:fill fill)]]))

    Accumulates the result of expr into a vector. If len and fill is given the vector will be at most len elements long and any unfilled indexes will contain the element fill. The loop will exit when len elements have been accumulated.

    If length is not given, the vector will be expanded as required.

    A vectoring clause adds an implicit (:break (= index len)) after the vectoring clause. Once the last element of the vector is filled, the loop will stop and no subsequent clauses or body will be executed.

    diff --git a/documentation/doc.xml b/documentation/doc.xml index 5545149..b0fabbf 100644 --- a/documentation/doc.xml +++ b/documentation/doc.xml @@ -140,7 +140,7 @@ (loop ((:for a (in-list '(1 2 3 4))) ;; this works because :acc bindings are promoted "outwards". (:break final) - (:acc final (in-value (initial #f) #t (if (= 3 a)))) + (:acc final (in-value (:initial #f) #t (:if (= 3 a)))) (:acc acc (listing (cons a b))))) @@ -388,23 +388,23 @@ Another small thing is that for some :acc-clauses, the `binding` may sometimes only be visible to the user in the `final-expr`, but like :for-clauses they sometimes offer the programmer to name the loop variables. - Many accumulating clauses support an `if` form. If such a clause is given, accumulation will only happen if the guard clause returns true. + Many accumulating clauses support an `:if` form. If such a clause is given, accumulation will only happen if the guard clause returns true. -
    (:acc binding (listing [(:initial init)] expr [if guard]))
    +
    (:acc binding (listing [(:initial init)] expr [(:if guard)]))
    Accumulates `expr` into a list. ´binding` is only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. If `initial` is given that will be used as the tail of the accumulated results. It defaults to `'()`.     -
    (:acc binding (listing-reverse [(:initial init)] expr [if guard]))
    +
    (:acc binding (listing-reverse [(:initial init)] expr [(:if guard)]))
    The same as `listing` but the resulting list in in reverse order. If the order of the resulting list does not matter, this will be faster than the regular listing as it will not preform any reverse at the end.     -
    (:acc binding (appending [(:initial init)] expr [if guard]))
    +
    (:acc binding (appending [(:initial init)] expr [(:if guard)]))
    `expr` evaluates to a list that is then appended to the accumulated result. @@ -417,7 +417,7 @@     -
    (:acc binding (appending-reverse [(:initial init)] expr [if guard]))
    +
    (:acc binding (appending-reverse [(:initial init)] expr [(:if guard)]))
    `expr` evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is `'()`. @@ -430,31 +430,31 @@     -
    (:acc binding (summing [(:initial init)] expr [(if guard)]))
    +
    (:acc binding (summing [(:initial init)] expr [(:if guard)]))
    Adds the result of `expr` together using `+`. The default initial value is 0.     -
    (:acc binding (multiplying [(:initial init)] expr [(if guard)]))
    +
    (:acc binding (multiplying [(:initial init)] expr [(:if guard)]))
    Multiplies the result of `expr` using `*`. The default initial value is 1.     -
    (:acc binding (hashing [(:initial init)] key value [(if guard)]))
    +
    (:acc binding (hashing [(:initial init)] key value [(:if guard)]))
    Adds the mapping `(key => value)` to the hashtable `binding` using equal?-hashing. The initial hash table is an empty hash-table. `binding` is bound to the hash table throughout the loop, and its content can be mutated in the loop body.     -
    (:acc binding (hashving [(:initial init)] key value [(if guard)]))
    +
    (:acc binding (hashving [(:initial init)] key value [(:if guard)]))
    Adds the mapping `(key => value)` to the hashtable `binding` using eqv?-hashing. The initial hash table is an empty hash-table. `binding` is bound to the hash table throughout the loop, and its content can be mutated in the loop body.     -
    (:acc binding (hashqing [(:initial init)] key value [(if guard)]))
    +
    (:acc binding (hashqing [(:initial init)] key value [(:if guard)]))
    Adds the mapping `(key => value)` to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.`binding` is bound to the hash table throughout the loop, and its can be mutated in the loop body.     diff --git a/goof-impl.scm b/goof-impl.scm index fab2f1e..70d9be8 100644 --- a/goof-impl.scm +++ b/goof-impl.scm @@ -33,7 +33,7 @@ ;; Auxiliary syntax for the iterators. :gen ;; auxiliary syntax for some accumulators - :initial + :initial :if ;; auxiliary auxiliary syntax ;; for vectoring :length :fill diff --git a/goof/iterators.scm b/goof/iterators.scm index d8030c5..08a353d 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -373,12 +373,12 @@ (define-syntax accumulating - (syntax-rules (:initial if :acc) + (syntax-rules (:initial :if :acc) ((accumulating :acc (kons final init) ((var) . x) next . rest) (accumulating :acc (kons final init) ((var cursor) . x) next . rest)) ((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) + ((accumulating :acc (kons final init) ((var cursor) (expr (:if check))) n . rest) (n ((tmp-kons kons)) ((cursor init (if check (tmp-kons expr cursor) cursor))) () @@ -443,18 +443,18 @@ (syntax-rules () ((_ name default-make setter) (define-syntax name - (syntax-rules (:acc if :initial) + (syntax-rules (:acc :if :initial) ((_ :acc ((var) (key value)) n . rest) - (name :acc ((var) (key value (if #t) (:initial default-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)) + ((_ :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)) + (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) + ((_ :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 ((var init)) ((dummy (if #f #f) (if guard (setter var key value) (if #f #f)))) From ec2b65612c1609e56559cde8d1dde56d713f8f55 Mon Sep 17 00:00:00 2001 From: Linus Date: Sun, 6 Mar 2022 21:15:30 +0100 Subject: [PATCH 24/27] Simplified install --- goof-impl.scm => goof/goof-impl.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) rename goof-impl.scm => goof/goof-impl.scm (99%) diff --git a/goof-impl.scm b/goof/goof-impl.scm similarity index 99% rename from goof-impl.scm rename to goof/goof-impl.scm index 70d9be8..1aadf1d 100644 --- a/goof-impl.scm +++ b/goof/goof-impl.scm @@ -50,7 +50,7 @@ -(include "goof/iterators.scm") +(include "iterators.scm") ;; This first step saves the original syntax. (define-syntax loop From 5381bf5f6993fa978c614d6eaed43604ddcd769e Mon Sep 17 00:00:00 2001 From: Linus Date: Sun, 6 Mar 2022 21:17:38 +0100 Subject: [PATCH 25/27] Addendum simplified install Forgot to change a path. --- goof.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/goof.scm b/goof.scm index f147171..1fe8687 100644 --- a/goof.scm +++ b/goof.scm @@ -88,7 +88,7 @@ ;; This contains the portable parts of goof-loop. -(include "goof-impl.scm") +(include "goof/goof-impl.scm") ;; This part is only for an auxilary macro that checks whether the :for or :acc clause is ;; actually defined. The reason I use parameters here is because guile modules are immutable by From 5668706b883922605d0c7125355d2d3dc9b8eafc Mon Sep 17 00:00:00 2001 From: Linus Date: Sun, 6 Mar 2022 21:35:06 +0100 Subject: [PATCH 26/27] Added a simple installation instruction Very basic. --- README.md | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 3e704f0..96b4f81 100644 --- a/README.md +++ b/README.md @@ -25,6 +25,10 @@ The current WIP documentation can be found here: https://bjoli.srht.site/doc.htm It is written in a weird markdown/xml chimaera. You can find it in documentation doc.xml (for the weird format) and documentation/doc.html for the slightly more accessible HTML format. +## installation + +Do a git pull from this repo, go into the dir where goof.scm is located and start the guile repl with `guile -L .`. This adds the current directory to the list of load paths, so when you do `(import (goof))` it will find goof and you can run the examples below. The license is a BSD-styled one, so you can chose to either put goof.scm and the folder goof in you project dir, or in your guile site-dir. + ## Features ### Lexical order of clauses @@ -267,10 +271,11 @@ $2 = (list 2 4) ;; This is actually the preferred way to do it in guile. Guile re-sizes the stack, so no stack overflows $3 = (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))))) + (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 From a47d6d992b8a46304c82d745538a3db566f1d904 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Linus=20Bj=C3=B6rnstam?= Date: Mon, 30 Oct 2023 21:56:54 +0100 Subject: [PATCH 27/27] fix folding, add :continue Fix foldig to be an :acc version of in. :continue will stop the subloop and start the next iteration of the outer loop --- goof.scm | 10 +++++----- goof/goof-impl.scm | 18 +++++++++++++----- goof/iterators.scm | 21 +++++++++++++-------- 3 files changed, 31 insertions(+), 18 deletions(-) diff --git a/goof.scm b/goof.scm index 1fe8687..eb7c325 100644 --- a/goof.scm +++ b/goof.scm @@ -47,7 +47,7 @@ loop/or loop/list/parallel - :when :unless :break :final :bind :subloop :do :for :acc + :when :unless :break :continue :final :bind :subloop :do :for :acc :initial :length :fill :to :by @@ -107,8 +107,8 @@ #'in-cycle #'in-indexed #'stop-before - #'stop-after - ))) + #'stop-after))) + (define valid-acc-clauses (make-parameter (list #'folding #'listing #'listing-reverse @@ -119,8 +119,8 @@ #'hashing #'hashving #'hashqing - #'vectoring - ))) + #'vectoring))) + (define (add-clause type form) (cond ((eq? type 'for) diff --git a/goof/goof-impl.scm b/goof/goof-impl.scm index 1aadf1d..a33facf 100644 --- a/goof/goof-impl.scm +++ b/goof/goof-impl.scm @@ -29,7 +29,7 @@ (define-aux-syntaxes ;; Auxiliary syntax for the loop clauses - :when :unless :break :final :bind :do :subloop :for :acc + :when :unless :break :final :continue :bind :do :subloop :for :acc ;; Auxiliary syntax for the iterators. :gen ;; auxiliary syntax for some accumulators @@ -122,7 +122,7 @@ ;; cl sorts all the clauses into subloops and positions everything where it should be. (define-syntax cl - (syntax-rules (=> :for :acc :when :unless :break :final :do :bind :subloop) + (syntax-rules (=> :for :acc :when :unless :break :continue :final :do :bind :subloop) ((_ orig name l a v c r f ff user () => expr . body) (emit orig name l a v c r f ff user expr . body)) ((_ orig name l a v c r () ff user () . body) @@ -150,6 +150,10 @@ ((_ orig name l a v c r f ff ((cur-user ...) . user-rest) ((:final expr) clauses ...) . body) (final :acc ((fin) (expr)) cl-next/acc orig name l a v c r f ff ((cur-user ... (:break fin)) . user-rest) (clauses ...) . body)) + ;; USER continue + ((_ orig name l a v c r f ff ((cur-co ...) . co-rest) ((:continue expr) clauses ...) . body) + (cl orig name l a v c r f ff ((cur-co ... (:continue expr)) . co-rest) (clauses ...) . body)) + ;; User do - sideffecting stuff. ((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:do expr ...) clauses ...) . body) (cl orig name l a v c r f ff ((cur-uw ... (:do expr ...)) . uw-rest) (clauses ...) . body)) @@ -267,7 +271,7 @@ ;; User is responsible for all non-acc/non-for clauses. (define-syntax user - (syntax-rules (:when :bind :break :do :nop) + (syntax-rules (:when :bind :break :continue :do :nop) ((_ final-expr next outer () . body) (begin . body)) ((_ f n o (:nop . rest) . body) @@ -283,6 +287,10 @@ (cond (expr final-expr ...) (else (user (final-expr ...) n o rest . body)))) + ((_ f n outer ((:continue expr) . rest) . body) + (cond + (expr outer) + (else (user f n outer rest . body)))) ((_ f n o ((:do expr ...) . rest) . body) (begin expr ... @@ -397,7 +405,7 @@ (ref-let (refs ...) (user (ff-cur ... ff-above ... final) (innermost-loop accstep ... step ...) - #f + outer (us ...) (let-kw-form name final () (innermost-loop (accvar accstep) ... (var step) ...) . body))))))) @@ -425,7 +433,7 @@ (ref-let (refs ...) (user (ff-cur ... ff-above ... final) (intermediate-loop accstep ... step ...) - #f + outer (us ...) (emit-many/rest orig name diff --git a/goof/iterators.scm b/goof/iterators.scm index 08a353d..165768b 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -30,7 +30,7 @@ ;; in-stream (define-syntax in - (syntax-rules () + (syntax-rules (:for) ((in :for ((var) (init)) n . rest) (n () ((var init var)) () () () . rest)) ((in :for ((var) (init step)) n . rest) @@ -393,18 +393,23 @@ ((var (final cursor))) . rest)))) +;; This looks wonky because it needs to reset var to the init value when the loop is re-entered +;; if it is a subloop. It does so by also binding var to folding-init in the outer binding of the current +;; loop. It has to do this because :acc clauses propagates all acc bindings to outside +;; the outermost loop. (define-syntax folding - (syntax-rules (if :acc) - ((_ :acc ((var) (init update (if guard))) n . rest) - (n () - ((var init (if guard update var))) - () () + (syntax-rules (:acc) + ((_ :acc ((var) (init update stop)) n orig name ((lets ...) . l-rest) . rest) + (n ((folding-init init)) + ((var folding-init update)) + (stop) () ((var var)) + orig name ((lets ... (var folding-init)) . l-rest) . rest)) ((_ :acc ((var) (init update)) n . rest) - (folding :acc ((var) (init update (if #t))) n . rest)) + (folding :acc ((var) (init update #f)) n . rest)) ((_ :acc ((var) (init)) n . rest) - (folding :acc ((var) (init var (if #t))) n . rest)))) + (folding :acc ((var) (init var #f)) n . rest)))) (define-syntax listing (syntax-rules (:acc)