Intermediate loops

goof.scm
  * Changed cl-next to properly push all intermediate loops
  * Changed emit-many/rest to emit intermediate loops
  * Added loop/list as a shorthand for just accumulating lists.

tests.scm
  * Collected some things I wanted ta have to track regressions.

README.md
  * Reflect above changes
This commit is contained in:
Linus 2020-11-04 23:15:32 +01:00
parent f2496604d5
commit be9ac1a55d
3 changed files with 108 additions and 54 deletions

View file

@ -26,7 +26,19 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes
=> acc)
```
This will sum all the sublists of lst and produce the result 21. Any :when, :unless, or :break clause will break out a subloop if any subsequent for clauses are found.
This will sum all the sublists of lst and produce the result 21. Any :when, :unless, :break, 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))
```
## Differences from foof-loop
@ -42,11 +54,13 @@ with-clauses are removed in favour of (:for var (in init [step [stop]]))
accumulators are no longer for-clauses, but should be prepended with :acc.
### Regressions
### Regressions compared to foof-loop
only :acc clauses are visible in the final-expression. This is due to for-clauses not being promoted through to outer loops (since they should not keep their state).
:for clauses cannot finalize, due to the above thing. The reason for distinguishing between :for and :acc is to be able to promote accumulators outwards and finalizers inwards. This is not implemented.
:for clauses cannot finalize, due to the above thing. The reason for distinguishing between :for and :acc is to be able to promote accumulators outwards and finalizers inwards. This is not implemented yet, however.
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
@ -54,8 +68,6 @@ only :acc clauses are visible in the final-expression. This is due to for-clause
(with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var)))
Positional updates of variables is not supported, due to goof-loop reordering the loop-vars - which there are reasons for.
### similarities
You can of course still have a larger control of your loops:
@ -90,11 +102,6 @@ Named updates also work.
## Todo
Currently, there is a bug if you have subloops more than 2 loops deep where all accumulators are reset. This should be an easy fix.
Regarding the above: fixing that bug does nothing! I can only output loops of at most 2.
Should we add finalizers for :for-clauses? I can't see the need outside of a potential (in-file ...), which can't be properly supported anyway since I won't do any dynamic-wind stuff.
Is (:for var (in init step stop)) and (:acc var (in init update)) good syntax? the :with clause of foof-loop is nice, but what should it be called for accumulators? Should we go back to calling both :acc and :for just ":for" and re-add :with and an accumulating counterpart? What should that accumulating counterpart be called? :acc?

110
goof.scm
View file

@ -54,20 +54,6 @@
(include "iterators.scm")
;; TODO: Add intermediate subloops. Make sure that accumulators are properly propagated.
;; DONE: fix let-kw-form. Don't use mutation. This should be tested:
;; (define (partition predicate list)
;; (loop continue ((:for element (in-list list))
;; (:acc satisfied (in '()))
;; (:acc unsatisfied (in '())))
;; => (values (reverse satisfied)
;; (reverse unsatisfied))
;; (if (predicate element)
;; (continue (=> satisfied (cons element satisfied)))
;; (continue (=> unsatisfied (cons element unsatisfied))))))
(define-aux-syntaxes :for :when :unless :break :final :let :let* :acc :subloop)
(define-syntax loop
@ -166,24 +152,10 @@
))
;; cl-next integrates the results
;; THIS WILL NEED TO BE UPDATED TO PROPERLY PUSH (accvar accinit accvar) ... down to the first accumulator. currently it
;; will be re-initialized for every previous loop except the innermost one.
;; THIS needs to work:
;; (loop ((:for a (in-list '((1 2) (3 4) (5 6))))
;; (:when #t)
;; (:for b (in-list a))
;; (:for acc (listing b)))
;; => acc)
;; as well as this:
;; (loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
;; (:when #t)
;; (:for b (in-list a))
;; (:when :t)
;; (:for c (in-list b))
;; (:for acc (listing c)))
;; => acc)
;; HOLY CODE-DUPLICATION-BATMAN!
;; cl-next integrates any bindings introduced by a :for or :acc clause. The complexity comes from pushing :acc-clauses
;; into the outer loops. Since accumulators need to be available in the (final-fun ...), they need to be visible also
;; in the outer loops if the loop exits there.
(define-syntax cl-next
(syntax-rules ()
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
@ -202,18 +174,36 @@
((refs ... new-refs ...))
(finals ... new-finals ...)
ul uw ub clauses . body))
;; We have a subloop!
;; We have ONE subloop!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name
((lets ...) . lets-rest)
((accs ...) ((oldacc oldinit oldupdate) ...) ...)
((accs ...) ((oldacc oldinit oldupdate) ...))
((vars ...) . vars-rest)
((checks ...) . checks-rest)
((refs ...) . refs-rest)
(finals ...) ul uw ub clauses . body)
(cl orig name
((lets ... new-lets ...) . lets-rest)
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...) ...)
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest)
((checks ... new-checks ...) . checks-rest)
((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...)
ul uw ub clauses . body))
;; We have several subloops!
((_ (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) ...))
((vars ...) . vars-rest)
((checks ...) . checks-rest)
((refs ...) . refs-rest)
(finals ...) ul uw ub clauses . body)
(cl orig name
((lets ... new-lets ...) . lets-rest)
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest)
((checks ... new-checks ...) . checks-rest)
((refs ... new-refs ...) . refs-rest)
@ -327,7 +317,7 @@
;; match innermost loop
((_ orig
name
next
outer
((lets ...))
(((accvar accinit accstep) ...))
(((var init step) ...))
@ -338,11 +328,11 @@
((user-whens ...))
((user-breaks ...))
. body)
(let innermost-loop ((accvar accinit) ...
(var init) ...)
(let* (lets ...)
(let* (lets ...)
(let innermost-loop ((accvar accinit) ...
(var init) ...)
(if (or checks ...)
next
outer
(let (refs ...)
(user-let () () (user-lets ...)
(if (and user-whens ...)
@ -356,10 +346,10 @@
;; Any intermediate loops
((_ orig
name
next
outer
(next-lets ... (lets ...))
(next-accs ... ((accvar accinit accupdate) ...))
(next-vars ... ((var init update) ...))
(next-accs ... ((accvar accinit accstep) ...))
(next-vars ... ((var init step) ...))
(next-checks ... (checks ...))
(next-refs ... (refs ...))
final
@ -367,7 +357,32 @@
(uw-next ... (user-whens ...))
(ub-next ... (user-breaks ...))
. body)
(display "not implemented"))))
(let* (lets ...)
(let intermediate-loop ((accvar accinit) ...
(var init) ...)
(if (or checks ...)
outer
(let (refs ...)
(user-let () () (user-lets ...)
(if (and user-whens ...)
(if (or user-breaks ...)
final
(emit-many/rest
orig
name
(intermediate-loop accstep ... step ...)
(next-lets ...)
(next-accs ...)
(next-vars ...)
(next-checks ...)
(next-refs ...)
final
(ul-next ...)
(uw-next ...)
(ub-next ...)
. body))
(intermediate-loop accvar ... step ...))))))))))
;; Helper procedures for let-kw-form
@ -404,3 +419,10 @@
. body))))
(define-syntax loop/list
(syntax-rules ()
((_ (clauses ...) body ...)
(loop loop-name (clauses ...)
=> '()
(cons (let () body ...) (loop-name))))))

25
tests.scm Normal file
View file

@ -0,0 +1,25 @@
;; This is just a file with things that should be written as a test. Dump file.
(loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
(:when #t)
(:for b (in-list a))
(:when #t)
(:for c (in-list b))
(:for acc (listing c)))
=> acc)
(loop ((:for a (in-list '((1 2) (3 4) (5 6))))
(:when #t)
(:for b (in-list a))
(:for acc (listing b)))
=> acc)
(loop ((:for a (in-list '(1 2 3)))
(:acc oa (summing a))
:subloop
(:for b (up-from a (to (+ a 2))))
(:acc ob (listing b)))
=> (values oa ob))
;; Should return 6 and (1 2 2 3 3 4