bjoli/goof-loop
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Polishing the README and iterator protocol.

Browse source 
* README.md: added some small documentation and loop expansion.
 * goof.scm: Changed the iterator protocol to not use unnecessary :acc and :fors.
 * iterators.scm: see above.
 * ref-let.scm: a new macro to allow multiple values and pattern matching to co-exist for body-bindings.
This commit is contained in:
Linus 2020-12-16 19:54:55 +01:00
parent aab9fcabb0
commit 2d35c9d6cf
4 changed files with 220 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

152
README.md
View file

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

26
goof.scm
View file

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

10
iterators.scm
View file

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

51
ref-let.scm Normal file
View file

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