Compare commits

..

27 commits
v0.1 ... master

Author SHA1 Message Date
Linus Björnstam
a47d6d992b 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
2023-10-30 21:56:54 +01:00
Linus
5668706b88 Added a simple installation instruction
Very basic.
2022-03-06 21:35:06 +01:00
Linus
5381bf5f69 Addendum simplified install
Forgot to change a path.
2022-03-06 21:17:38 +01:00
Linus
ec2b65612c Simplified install 2022-03-06 21:15:30 +01:00
Linus
2775e70fd0 guard if in accumulators is now :if.
All auxiliary syntax is now prefixed by :.
2021-09-27 21:36:02 +02:00
Linus
88f138849e Fix typo in readme
* README.md: fix an example so that it actualy works.
2021-09-25 21:31:48 +02:00
Linus
f5a3629b56 Make let-kw-form more portable to other syntax-case schemes
* goof.scm (let-kw-form): don't use guile-specific with-ellipsis.
2021-09-25 21:27:50 +02:00
Linus
050f88d678 Fixed misnamed export
* goof.scm: in-vector-reverse and in-string-reverse now properly
exported.
2021-09-25 21:21:29 +02:00
Linus
832c414260 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.
2021-08-17 21:36:13 +02:00
Linus
1de0a624f5 Updated readme
Small changes.
2021-05-26 20:32:09 +02:00
Linus
189f1d045d Made sure loop loops
Fix subloop :acc semantics.

clarify code comments.
2021-05-25 22:07:53 +02:00
Linus
307240383a 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.
2021-05-23 22:10:23 +02:00
Linus
e057a6b8fe loops without subloops can now use :for clauses in final-expr 2021-05-21 20:42:10 +02:00
Linus
9988434554 Clarified readme regarding final-expr 2021-05-21 10:22:21 +02:00
Linus
6d305d416b Added passage about maybe automagically looping 2021-05-21 10:20:38 +02:00
Linus
10ba6bd9d2 Fixed documentation warning 2021-05-21 10:12:51 +02:00
Linus
dd1589ab3a Changed documentation to reflect recent changes 2021-05-21 10:09:07 +02:00
Linus
93134a1b21 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)))))
2021-05-18 20:39:37 +02:00
Linus
7a1137e579 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.
2021-05-18 19:57:02 +02:00
Linus
aa77fef2ad Fix example in readme
forgot parens.
2021-05-18 18:18:17 +02:00
Linus
f6d22792b0 Don't know git. 2021-05-18 18:17:10 +02:00
Linus
c65ab9cb15 Some more changes to readme 2021-05-18 18:15:41 +02:00
Linus
20471c01c2 Added annotations for code highlighting 2021-05-18 18:15:09 +02:00
Linus
2c323be362 Big change: lexical scoping
This introduces lexical scoping of for clauses. See README.md
2021-05-18 18:12:01 +02:00
Linus
769553832b 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.
2021-05-16 20:13:55 +02:00
Linus
cccc324ecd 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...
2021-05-12 12:54:29 +02:00
Linus
5d07594f53 Tagged a release 2021-05-11 13:36:05 +02:00
9 changed files with 770 additions and 563 deletions

8
CHANGELOG Normal file
View file

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

299
README.md
View file

@ -1,46 +1,23 @@
# 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.
```
(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))
```
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:
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.
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)
(:acc acc (summing b))))
;; => 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.
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))
```
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
@ -48,67 +25,70 @@ 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
## Differences from foof-loop
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.
### syntactical
## Features
for-clauses are split into :for and :acc clauses. This is because the addition of subloops means we have to treat accumulators differently.
### Lexical order of clauses
while and until are removed in favour of :break.
``` 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)))))
```
:when and :unless are added to better control when the loop body is executed (and accumulators accumulated)
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.
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.
This can lead to some things things that seem counter-intuitive, like:
### Higher order loop protocol
``` scheme
(loop ((:for a (in-list '(1 2 3)))
(:acc vec (vectoring a (:length 2)))
;; implicit :break (= vec-index 2)
(:acc sum (summing a))))
;; => #(1 2) 1
```
goof supports a higher order looping protocol, based on srfi-158 generators:
It also means that any loop body is executed _after_ values are accumulated.
(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))
### 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.
In the above example true? never ends, but restarts every time the list is exhausted.
``` scheme
(loop ((:for a (up-from 1 5))
(:acc sum (summing a))))
;; => 10
### Regressions compared to foof-loop
(loop ((:for a (up-from 1 5))
(:acc sum (summing a)))
=> (- sum))
;; => -10
```
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)))
### similarities
### Loop naming to make it "fold right"
You can of course still have a larger control of when to loop by naming your loop:
```
(loop loopy-loop ((:for a (up-from 1 (to 11))))
``` scheme
(loop loopy-loop ((:for a (up-from 1 (:to 11))))
=> '()
(if (odd? a)
(cons (* a (- a)) (loopy-loop))
(cons (* a a) (loopy-loop))))
;; => (-1 4 -9 16 -25 36 -49 64 -81 100)
```
Named updates also work.
Replace that cons with stream-cons and you have a lazy construct.
```
;; Shamelessly stolen from Taylor Campbell's foof-loop documentation
### Named updates
``` scheme
;; 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 '()))
@ -120,13 +100,97 @@ Named updates also work.
(continue (=> unsatisfied (cons element unsatisfied))))))
(partition '(1 2 3 4 5) odd?)
;; => (values (1 3 5) (2 4))
;; => (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.
``` scheme
(loop name ((:for elt pair (in-list '(1 2 3))))
=> '()
(if (null? (cdr pair))
(list elt)
(cons* elt ': (name))))
;; => (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 word (in-list '(true false sant falskt wahr falsch)))
(:for true? (in-cycle (in-list '(#t #f)))))
(display word)
(display ": ")
(display true?)
(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)
``` scheme
(loop ((:for elt (in-list '( 1 2 3)))
(:final (= elt 2))
(:for ab (in-list '(a b)))
(: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 marginally less efficient than racket's #:final.
### :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)))
(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))))
;; |> 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 ...), 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)))
(:acc sum (summing val))))
;; => 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.
```
``` scheme
(loop/list ((a (up-from 0 3)))
a)
;; => (0 1 2)
@ -136,12 +200,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)
@ -161,22 +225,37 @@ 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:
```
``` scheme
,expand (loop ((:for a (in-list '(1 2 3 4)))
(:when (even? a))
(:acc acc (listing a))))
$0 = (let ((tmp-kons (@@ (goof) cons)))
(let loop ((cursor-1 '()) (cursor '(1 2 3 4)))
(if ((@@ (goof) not) ((@@ (goof) pair?) cursor))
(let ((acc ((@@ (goof) reverse) cursor-1)))
((@@ (goof) values) acc))
(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)))
=> acc)
$1 = (let loopy-loop ((cursor-1 '()) (cursor '(1 2 3 4)))
(if (pair? cursor)
(let ((a (car cursor)) (succ (cdr cursor)))
(if (even? a)
(loopy-loop (cons a cursor-1) succ)
(loopy-loop cursor-1 succ)))
(reverse cursor-1)))
(:acc acc (listing a))))
$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)))
@ -190,12 +269,13 @@ $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)
(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
@ -215,17 +295,50 @@ $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 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).
## Todo
Tests!
Finish documentation.
add generator support for all provided iterators
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
(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.
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.
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
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.

View file

@ -11,7 +11,8 @@
<li>A looping facility that in almost all cases produces as fast code as a hand-written named let</li>
<li>An extensible looping facility, where new ways of iterating over data can be easily added</li>
</ul>
<p>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.</p>
<p>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</p>
<p>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.</p>
<div id="An example or two"><h3>An example or two</h3><p>So, how does it look? A slightly contrived example, a naive sieve of Erathostenes:</p>
<pre class="code-example">
(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))
</pre><p>Calling <code>(erathostenes 10)</code> returns a list of all primes below 10.</p>
<p>The example above can also be written using “subloops”, but unless you know the expansion it can be somewhat surprising.</p>
<p>The example above can also be written using “subloops”:</p>
<pre class="code-example">
(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))))
=&gt; lst
(:acc lst (listing i))
(:for j (up-from (* 2 i) (:to n) (:by i))))
(vector-set! vec j #f)))
</pre><p>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 =&gt; is the final expression: this is the expression returned after the loop ends.</p>
</div></div><div id="Specification"><h2>Specification</h2><p>The loop grammar is the following:</p>
</pre></div></div><div id="Specification"><h2>Specification</h2><p>The loop grammar is the following:</p>
<pre class="code-example">
(loop [name] (loop-clause ...) [=&gt; 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.
</pre><p>If a <code>name</code> is provided, it will be bound to a macro that allows named update of loop variables:</p>
<pre class="code-example">
(loop lp ((:for a (in 0 (+ a 1)))
@ -60,34 +63,45 @@
(cons a (lp (=&gt; a 8)))
(cons a (lp))))
</pre><p>This rather inane example would return <code>(0 1 2 3 4 8 9)</code>. Read more about this in the part about loop variables.</p>
<div id="Subloops"><h3>Subloops</h3><p>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.</p>
<div id="Subloops"><h3>Subloops</h3><p>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.</p>
<pre class="code-example">
(loop ((:for a (in-list '(1 2 3)))
:subloop
(:for b (up-from 0 (to a)))
(:acc acc (listing (cons a b))))
=&gt; acc)
(:for b (up-from 0 (:to a)))
(:acc acc (listing (cons a b)))))
;; =&gt; ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))
</pre><p>The above <code>:subloop</code> clause is equivalent to <code>:when #t</code> and <code>:unless #f</code>. A <code>:break</code> clause will immediately stop execution of the loop:</p>
<pre class="code-example">
(loop ((:for a (in-list '(1 2 3)))
(:break (= 3 a))
(:for b (up-from 0 (to a)))
(:acc acc (listing (cons a b))))
=&gt; acc)
(:for b (up-from 0 (:to a)))
(:acc acc (listing (cons a b)))))
;; =&gt; ((1 . 0) (2 . 0) (2 . 1))
</pre><p>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:</p>
</pre><p>And a :final guard will let the subsequent subloops execute once.</p>
<pre class="code-example">
(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))))
=&gt; acc)
(:for b (up-from 0 (:to a)))
(:acc acc (listing (cons a b)))))
;; =&gt; ((1 . 0) (2 . 0) (2 . 1) (3 . 0))
</pre></div><div id="Loop variables"><h3>Loop variables</h3><p>Both accumulating clauses and :for clauses have something called loop variables. In the case of <code>(:for elt (in-list lst))</code> the loop variable would be the current pair where <code>elt</code> is the car. Some :acc- or :for-clauses may expose their loop variables so that they can be queried or even updated.</p>
;; =&gt; ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))
</pre><p>The :final clause is actually equivalent to something alike the following:</p>
<pre class="code-example">
(loop ((:for a (in-list '(1 2 3 4)))
;; this works because :acc bindings are promoted &quot;outwards&quot;.
(:break final)
(:acc final (in-value (:initial #f) #t (:if (= 3 a))))
(:acc acc (listing (cons a b)))))
</pre><p>This means that any clause above the final binding will be executed an extra time before the loop exits:</p>
<pre class="code-example">
(loop ((:for a (up-from 1 4))
(:acc lst (listing a))
(:final (= a 2))
(:acc lst2 (listing a))))
;; =&gt; (1 2 3) (1 2)
</pre></div><div id="Loop variables"><h3>Loop variables</h3><p>Both accumulating clauses and :for clauses have something called loop variables. In the case of <code>(:for elt (in-list lst))</code> the loop variable would be the current pair where <code>elt</code> is the car. Some :acc- or :for-clauses may expose their loop variables so that they can be queried or even updated.</p>
<p>In the case of the menioned <code>in-list</code> we can choo se to expose the name of the current pair, as in the following example:</p>
<pre class="code-example">
(define (interpose lst between)
@ -103,13 +117,13 @@
<p>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.</p>
</div><div id="Simple forms"><h3>Simple forms</h3><p>The pure <code>loop</code> 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.</p>
<pre class="code-example">
(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)
</pre><p>The simple forms provided by goof-loop are the following:</p>
<dl><dt><a id="loop/first"><b>Scheme syntax: </b>loop/first</a><dd><code>(loop/first (clauses ...) body ...)</code><br /><p>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.</p>
</dd></dt><dt><a id="loop/last"><b>Scheme syntax: </b>loop/last</a><dd><code>(loop/last (clauses ...) body ...)</code><br /><p>Returns the result of the last body to be evaluated. If no body is evaluated the return value is unspecified.</p>
<dl><dt><a id="loop/first"><b>Scheme syntax: </b>loop/first</a><dd><code>(loop/first [:default #f] (clauses ...) body ...)</code><br /><p>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 <code>:default</code>, which defaults to #f.</p>
</dd></dt><dt><a id="loop/last"><b>Scheme syntax: </b>loop/last</a><dd><code>(loop/last [:default #f] (clauses ...) body ...)</code><br /><p>Returns the result of the last body to be evaluated. If no body is evaluated it returns the value specified by <code>:default</code>, which defaults to #f.</p>
</dd></dt><dt><a id="loop/list"><b>Scheme syntax: </b>loop/list</a><dd><code>(loop/list (clauses ...) body ...)</code><br /><p>Iterates over <code>clauses</code> 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.</p>
<p>The list returned is the same even when used with multi-shot continuations.</p>
<p>If no body is evaluated, the result is the empty list.</p>
@ -152,33 +166,30 @@
</dd></dt><dt><a id="stop-after"><b>Scheme syntax: </b>stop-after</a><dd><code>(:for binding (stop-after iterator pred))</code><br /><p>Binds <code>binding</code> to the values produced by <code>iterator</code> until <code>pred</code> 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.</p>
</dd></dt></dl></div><div id=":acc-clauses"><h3>:acc-clauses</h3><p>Accumulating clauses differ from :for-clauses in 2 significant ways. They have a final value available in the <code>final-expr</code>, 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.</p>
<p>Another small thing is that for some :acc-clauses, the <code>binding</code> may sometimes only be visible to the user in the <code>final-expr</code>, but like :for-clauses they sometimes offer the programmer to name the loop variables.</p>
<p>One general thing about accumulating clauses is that they all support a guarding <code>if</code> form. If such a clause is given, accumulation will only happen if the guard clause returns true. When a <code>:when</code> or <code>:unless</code> clause is given, they also have to return true for any result to be accumulated. The following code returns the empty list:</p>
<pre class="code-example">
(loop ((:for a (up-from 0 10))
(:acc acc (listing a (if (odd? a))))
(:when (even? a)))
=&gt; acc)
</pre><dl><dt><a id="listing"><b>Scheme syntax: </b>listing</a><dd><code>(:acc binding (listing [(initial init)] expr [if guard]))</code><br /><p>Accumulates <code>expr</code> into a list. ´binding<code>is only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. If</code>initial<code>is given that will be used as the tail of the accumulated results. It defaults to</code>()`.</p>
</dd></dt><dt><a id="listing-reverse"><b>Scheme syntax: </b>listing-reverse</a><dd><code>(:acc binding (listing-reverse [(initial init)] expr [if guard]))</code><br /><p>The same as <code>listing</code> 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.</p>
</dd></dt><dt><a id="appending"><b>Scheme syntax: </b>appending</a><dd><code>(:acc binding (appending [(initial init)] expr [if guard]))</code><br /><p><code>expr</code> evaluates to a list that is then appended to the accumulated result.</p>
<p>Many accumulating clauses support an <code>:if</code> form. If such a clause is given, accumulation will only happen if the guard clause returns true.</p>
<dl><dt><a id="listing"><b>Scheme syntax: </b>listing</a><dd><code>(:acc binding (listing [(:initial init)] expr [(:if guard)]))</code><br /><p>Accumulates <code>expr</code> into a list. ´binding<code>is only accesible in the final-expression. The list is in the same order as the loop bodies were evaluated. If</code>initial<code>is given that will be used as the tail of the accumulated results. It defaults to</code>()`.</p>
</dd></dt><dt><a id="listing-reverse"><b>Scheme syntax: </b>listing-reverse</a><dd><code>(:acc binding (listing-reverse [(:initial init)] expr [(:if guard)]))</code><br /><p>The same as <code>listing</code> 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.</p>
</dd></dt><dt><a id="appending"><b>Scheme syntax: </b>appending</a><dd><code>(:acc binding (appending [(:initial init)] expr [(:if guard)]))</code><br /><p><code>expr</code> evaluates to a list that is then appended to the accumulated result.</p>
<pre class="code-example">
(loop ((:for elt (in-list '((1 2) (3 4))))
(:acc acc (appending (initial '(0)) elt)))
(:acc acc (appending (:initial '(0)) elt)))
=&gt; acc)
;; =&gt; (0 1 2 3 4)
</pre></dd></dt><dt><a id="appending-reverse"><b>Scheme syntax: </b>appending-reverse</a><dd><code>(:acc binding (appending-reverse [(initial init)] expr [if guard]))</code><br /><p><code>expr</code> evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is <code>'()</code>.</p>
</pre></dd></dt><dt><a id="appending-reverse"><b>Scheme syntax: </b>appending-reverse</a><dd><code>(:acc binding (appending-reverse [(:initial init)] expr [(:if guard)]))</code><br /><p><code>expr</code> evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is <code>'()</code>.</p>
<pre class="code-example">
(loop ((:for elt (in-list '((1 2) (3 4))))
(:acc acc (appending-reverse (initial '(0)) elt)))
(:acc acc (appending-reverse (:initial '(0)) elt)))
=&gt; acc)
;; =&gt; (4 3 2 1 0)
</pre></dd></dt><dt><a id="summing"><b>Scheme syntax: </b>summing</a><dd><code>(:acc binding (summing [(initial init)] expr [(if guard)]))</code><br /><p>Adds the result of <code>expr</code> together using <code>+</code>. The default initial value is 0.</p>
</dd></dt><dt><a id="multiplying"><b>Scheme syntax: </b>multiplying</a><dd><code>(:acc binding (multiplying [(initial init)] expr [(if guard)]))</code><br /><p>Multiplies the result of <code>expr</code> using <code>*</code>. The default initial value is 1.</p>
</dd></dt><dt><a id="hashing"><b>Scheme syntax: </b>hashing</a><dd><code>(:acc binding (hashing [(initial init)] key value [(if guard)]))</code><br /><p>Adds the mapping <code>(key =&gt; value)</code> to the hashtable <code>binding</code> using equal?-hashing. The initial hash table is an empty hash-table.</p>
</dd></dt><dt><a id="hashving"><b>Scheme syntax: </b>hashving</a><dd><code>(:acc binding (hashving [(initial init)] key value [(if guard)]))</code><br /><p>Adds the mapping <code>(key =&gt; value)</code> to the hashtable <code>binding</code> using eqv?-hashing. The initial hash table is an empty hash-table.</p>
</dd></dt><dt><a id="hashqing"><b>Scheme syntax: </b>hashqing</a><dd><code>(:acc binding (hashqing [(initial init)] key value [(if guard)]))</code><br /><p>Adds the mapping <code>(key =&gt; value)</code> to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.</p>
</dd></dt><dt><a id="vectoring"><b>Scheme syntax: </b>vectoring</a><dd><code>(:acc var [index] (vectoring expr [(:length len) [(:fill fill)]]))</code><br /><p>Accumulates the result of <code>expr</code> into a vector. If <code>len</code> and <code>fill</code> is given the vector will be at most <code>len</code> elements long and any unfilled indexes will contain the element <code>fill</code>. The loop will exit when <code>len</code> elements have been accumulated.</p>
</pre></dd></dt><dt><a id="summing"><b>Scheme syntax: </b>summing</a><dd><code>(:acc binding (summing [(:initial init)] expr [(:if guard)]))</code><br /><p>Adds the result of <code>expr</code> together using <code>+</code>. The default initial value is 0.</p>
</dd></dt><dt><a id="multiplying"><b>Scheme syntax: </b>multiplying</a><dd><code>(:acc binding (multiplying [(:initial init)] expr [(:if guard)]))</code><br /><p>Multiplies the result of <code>expr</code> using <code>*</code>. The default initial value is 1.</p>
</dd></dt><dt><a id="hashing"><b>Scheme syntax: </b>hashing</a><dd><code>(:acc binding (hashing [(:initial init)] key value [(:if guard)]))</code><br /><p>Adds the mapping <code>(key =&gt; value)</code> to the hashtable <code>binding</code> using equal?-hashing. The initial hash table is an empty hash-table. <code>binding</code> is bound to the hash table throughout the loop, and its content can be mutated in the loop body.</p>
</dd></dt><dt><a id="hashving"><b>Scheme syntax: </b>hashving</a><dd><code>(:acc binding (hashving [(:initial init)] key value [(:if guard)]))</code><br /><p>Adds the mapping <code>(key =&gt; value)</code> to the hashtable <code>binding</code> using eqv?-hashing. The initial hash table is an empty hash-table. <code>binding</code> is bound to the hash table throughout the loop, and its content can be mutated in the loop body.</p>
</dd></dt><dt><a id="hashqing"><b>Scheme syntax: </b>hashqing</a><dd><code>(:acc binding (hashqing [(:initial init)] key value [(:if guard)]))</code><br /><p>Adds the mapping <code>(key =&gt; value)</code> to a hashtable using eq?-hashing. The initial hash table is an empty hash-table.<code>binding</code> is bound to the hash table throughout the loop, and its can be mutated in the loop body.</p>
</dd></dt><dt><a id="vectoring"><b>Scheme syntax: </b>vectoring</a><dd><code>(:acc binding [index] (vectoring expr [(:length len) [(:fill fill)]]))</code><br /><p>Accumulates the result of <code>expr</code> into a vector. If <code>len</code> and <code>fill</code> is given the vector will be at most <code>len</code> elements long and any unfilled indexes will contain the element <code>fill</code>. The loop will exit when <code>len</code> elements have been accumulated.</p>
<p>If <code>length</code> is not given, the vector will be expanded as required.</p>
<p>A vectoring clause adds an implicit <code>(:break (= index len))</code> 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.</p>
<p><code>binding</code> is bound to the vector throughout the loop, and its content mutated in the loop body.</p>
</dd></dt></dl></div></div><div id="Loop protocol"><h2>Loop protocol</h2><p>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.</p>
<div id=":for-clauses"><h3>:for-clauses</h3><p>The following example defines the simple :for-driver <code>in-alist</code>:</p>
<pre class="code-example">
@ -206,7 +217,7 @@
</pre><p>In short, the clause (:for key value (in-alist alist-expr)) expands to:</p>
<pre class="code-example">
(in-alist ((key val) (alist-expr)) next-macro . rest)
</pre><p>You almost never have to care about <code>rest</code>. 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 <code>vectoring</code> which (ab)uses this to introduce a :break clause without breaking out a subloop).</p>
</pre><p>You should never have to care about <code>rest</code>. 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.</p>
<p>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.</p>
<p>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.</p>
<p>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.</p>
@ -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) =&gt;
(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)
</pre><p>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.</p>
<p>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.</p>
<p>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.</p>
@ -269,11 +309,10 @@
<p>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.</p>
<p>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 …).</p>
<p>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.</p>
<p>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.</p>
<p>WHEN-EXPR: the user supplied :when or :unless guard expression.</p>
<p>USER-BREAK: user-supplied :break guard.</p>
<p>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.</p>
<p>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 iterations 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.</p>
<p>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.</p>
<p>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 <code>(:bind (one (fst . snd) (values 1 (cons 3 4))))</code>, and it will work as expected.</p>
<p>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.</p>
</div><div id="Porting"><h2>Porting</h2><p>The bulk of goof-loop is written in portable syntax-rules. That code can be found in <code>goof-impl.scm</code> and all files under the <code>goof</code> 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:</p>
<pre class="code-example">

View file

@ -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.
<subsection title="An example or two">
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))
</example>
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":
<example>
(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)))
</example>
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.
</subsection>
</section>
@ -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.
</example>
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.
<subsection title="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.
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.
<example>
(loop ((:for a (in-list '(1 2 3)))
:subloop
(:for b (up-from 0 (to a)))
(:acc acc (listing (cons a b))))
=> acc)
(: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))
</example>
@ -114,24 +117,42 @@
<example>
(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)
(:for b (up-from 0 (:to a)))
(:acc acc (listing (cons a b)))))
;; => ((1 . 0) (2 . 0) (2 . 1))
</example>
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.
<example>
(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)
(:for b (up-from 0 (:to a)))
(:acc acc (listing (cons a b)))))
;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0))
;; => ((1 . 0) (2 . 0) (2 . 1) (3 . 0) (3 . 1) (3 . 2))
</example>
The :final clause is actually equivalent to something alike the following:
<example>
(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)))))
</example>
This means that any clause above the final binding will be executed an extra time before the loop exits:
<example>
(loop ((:for a (up-from 1 4))
(:acc lst (listing a))
(:final (= a 2))
(:acc lst2 (listing a))))
;; => (1 2 3) (1 2)
</example>
</subsection>
<subsection title="Loop variables">
@ -161,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.
<example>
(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)
@ -171,15 +192,15 @@
<spec>
<syntax name="loop/first">
<form>(loop/first (clauses ...) body ...)</form>
<form>(loop/first [:default #f] (clauses ...) body ...)</form>
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.
</syntax>
<syntax name="loop/last">
<form>(loop/last (clauses ...) body ...)</form>
<form>(loop/last [:default #f] (clauses ...) body ...)</form>
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.
</syntax>
<syntax name="loop/list">
@ -367,91 +388,87 @@
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:
<example>
(loop ((:for a (up-from 0 10))
(:acc acc (listing a (if (odd? a))))
(:when (even? a)))
=> acc)
</example>
Many accumulating clauses support an `:if` form. If such a clause is given, accumulation will only happen if the guard clause returns true.
<spec>
<syntax name="listing">
<form>(:acc binding (listing [(initial init)] expr [if guard]))</form>
<form>(:acc binding (listing [(:initial init)] expr [(:if guard)]))</form>
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 `'()`.
</syntax>
<syntax name="listing-reverse">
<form>(:acc binding (listing-reverse [(initial init)] expr [if guard]))</form>
<form>(:acc binding (listing-reverse [(:initial init)] expr [(:if guard)]))</form>
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.
</syntax>
<syntax name="appending">
<form>(:acc binding (appending [(initial init)] expr [if guard]))</form>
<form>(:acc binding (appending [(:initial init)] expr [(:if guard)]))</form>
`expr` evaluates to a list that is then appended to the accumulated result.
<example>
(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)
</example>
</syntax>
<syntax name="appending-reverse">
<form>(:acc binding (appending-reverse [(initial init)] expr [if guard]))</form>
<form>(:acc binding (appending-reverse [(:initial init)] expr [(:if guard)]))</form>
`expr` evaluates to a list that is then consed element by element onto the already accumulated results. The default initial value is `'()`.
<example>
(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)
</example>
</syntax>
<syntax name="summing">
<form>(:acc binding (summing [(initial init)] expr [(if guard)]))</form>
<form>(:acc binding (summing [(:initial init)] expr [(:if guard)]))</form>
Adds the result of `expr` together using `+`. The default initial value is 0.
</syntax>
<syntax name="multiplying">
<form>(:acc binding (multiplying [(initial init)] expr [(if guard)]))</form>
<form>(:acc binding (multiplying [(:initial init)] expr [(:if guard)]))</form>
Multiplies the result of `expr` using `*`. The default initial value is 1.
</syntax>
<syntax name="hashing">
<form>(:acc binding (hashing [(initial init)] key value [(if guard)]))</form>
<form>(:acc binding (hashing [(:initial init)] key value [(:if guard)]))</form>
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.
</syntax>
<syntax name="hashving">
<form>(:acc binding (hashving [(initial init)] key value [(if guard)]))</form>
<form>(:acc binding (hashving [(:initial init)] key value [(:if guard)]))</form>
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.
</syntax>
<syntax name="hashqing">
<form>(:acc binding (hashqing [(initial init)] key value [(if guard)]))</form>
<form>(:acc binding (hashqing [(:initial init)] key value [(:if guard)]))</form>
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.
</syntax>
<syntax name="vectoring">
<form>(:acc var [index] (vectoring expr [(:length len) [(:fill fill)]]))</form>
<form>(:acc binding [index] (vectoring expr [(:length len) [(:fill fill)]]))</form>
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.
</syntax>
</spec>
</subsection>
@ -492,7 +509,7 @@
(in-alist ((key val) (alist-expr)) next-macro . rest)
</example>
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)
</example>
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.
</section>
<section title="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:

View file

@ -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))

View file

@ -47,16 +47,18 @@
loop/or
loop/list/parallel
:when :unless :break :final :let :let* :subloop :for :acc
:when :unless :break :continue :final :bind :subloop :do :for :acc
:initial
:length :fill
:to :by
:default
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
@ -86,15 +88,15 @@
;; 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
;; 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
@ -105,8 +107,8 @@
#'in-cycle
#'in-indexed
#'stop-before
#'stop-after
)))
#'stop-after)))
(define valid-acc-clauses (make-parameter (list #'folding
#'listing
#'listing-reverse
@ -117,8 +119,8 @@
#'hashing
#'hashving
#'hashqing
#'vectoring
)))
#'vectoring)))
(define (add-clause type form)
(cond ((eq? type 'for)
@ -204,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))))

View file

@ -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.
;;
@ -29,54 +29,57 @@
(define-aux-syntaxes
;; Auxiliary syntax for the loop clauses
:when :unless :break :final :let :let* :subloop :for :acc
:when :unless :break :final :continue :bind :do :subloop :for :acc
;; Auxiliary syntax for the iterators.
:gen
;; auxiliary syntax for some accumulators
:initial :if
;; 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.
%acc)
%acc
;; nop. Used by CL
:nop)
(include "goof/iterators.scm")
(include "iterators.scm")
;; This first step saves the original syntax.
(define-syntax loop
(syntax-rules ()
((loop . rest)
(%loop (loop . rest) . rest))))
(define-syntax %loop
(syntax-rules (=>)
((%loop o () => expr body ...)
(%loop o ((:for ensure-once (up-from 0 1))) => expr body ...))
((%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 ((: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))))
;; This ensures that the first subloop has at least ONE for clause. If none is found
;; we add a dummy one!
;; 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 (clauses ...) body ...)
(cl o outer-loop
(()) (()) (()) (()) (()) () ((() ())) (())
(clauses ...) body ... (outer-loop)))
((%loop o name clauses . body)
(cl o name
(()) (()) (()) (()) (()) () ((() ())) (())
clauses . body))))
;; 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)
(cl orig name
(()) (()) (()) (()) (()) () ((() ())) (()) (()) (()) ()
(()) (()) (()) (()) (()) () ((() ())) (())
clauses . body))
;; Ensure that a subloop gets run at least once
@ -103,7 +106,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,61 +116,69 @@
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 :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)
(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)
(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-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))
;; 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)
(syntax-error "Invalid clause in loop" clause orig))
((_ orig name l a v c r f ff user (clause . rest) . body)
(syntax-error "Invalid clause in loop" clause orig))))
))
;; HOLY CODE-DUPLICATION-BATMAN!
@ -185,15 +196,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 ... (: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
@ -203,15 +214,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 ... (: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
@ -221,16 +232,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 ...(: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
@ -245,7 +256,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 +265,37 @@
((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 ...)
(begin body ...))
((_ (lets ...) () () . body)
(let (lets ...)
. body))
((_ () (stars ...) () . body)
(let* (stars ...) . body))
;; User is responsible for all non-acc/non-for clauses.
(define-syntax user
(syntax-rules (:when :bind :break :continue :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)
(ref-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))))
((_ 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 ...
(user f n o rest . 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)))
;; 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))))
;; If there are no subloops, we emit to the simple case
(define-syntax emit
@ -300,29 +315,29 @@
((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 ...)
(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-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 ...
(let ((final-binding final-value) ...)
final-expr))
(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 +350,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 +362,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 +393,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 +403,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 ...)
outer
(us ...)
(let-kw-form name final () (innermost-loop (accvar accstep) ... (var step) ...)
. body)))))))
;; Any intermediate loops
((_ orig
@ -422,10 +421,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 +431,11 @@
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 ...)
outer
(us ...)
(emit-many/rest orig
name
(intermediate-loop accstep ... step ...)
(next-lets ...)
@ -451,46 +445,38 @@
(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))))
(define-syntax forify*
(syntax-rules (:for :acc :when :unless :break :final :subloop :let :let* %acc)
((_ o n done-clauses () . body)
(%loop o n done-clauses . body))
(syntax-rules (:for :acc :when :unless :break :final :subloop :bind :do %acc)
((_ 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))
((_ 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))
(forify o n (s ... :subloop) (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))
(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 ()
@ -517,27 +503,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 ()

View file

@ -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)
@ -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,16 +369,16 @@
()
. 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
(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)
((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)))
()
@ -340,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)
@ -390,24 +448,24 @@
(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 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))
((_ :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
((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!)
@ -455,6 +513,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 until exhaustion.
(define-syntax final
(syntax-rules (:acc)
((_ :acc ((var) (test)) n . rest)
(n ()
((var #f test))
()
()
()
. rest))))
;;; Here starts generator clauses.
(define (generator->list gen)

View file

@ -1,82 +1,5 @@
;; This testrunner is shamelessly stolen from rednosehacker.com
;; and is copyrighted as
;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2019 Jérémy Korwin-Zmijowski <jeremy@korwin-zmijowski.fr>
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;; Thus, this file is under the GPL v.3 or any later version.
(use-modules (srfi srfi-64)
(goof)
(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
@ -114,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))
@ -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")
@ -224,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")