Big, buggy commit
:for clauses now have finalizers! This means (in-file "path") now works. This meant I had to do some restructuring of many nasty pieces of code, but I believe it works. cl-next was broken up into cl-next/acc and cl-next/for. Accumulators have to pass :acc to (cl-next/acc ...). I plan for :for clauses to do the same. I fixed tests.scm and README.md to reflect the de-racketification of the for loops.
This commit is contained in:
Linus
parent
1a826f86e2
commit
0c110dd080
4 changed files with 175 additions and 126 deletions
46
README.md
46
README.md
|
|
@ -5,10 +5,10 @@ WARNING: CURRENTLY PRE-ALPHA. The examples in this document are not consistent w
|
|||
goof-loops aims to be an amalgamation of the racket for loops and Alex Shinn's (chibi-loop). We are many that found racket's for loops a breeze of fresh air, but in the end their most general forms (for/fold and for/foldr) are kinda odd to work with. If you choose not to use those general for loops, you cannot express arbitrary transformations, like say a fibonacci sequence, since for clauses cannot reference eachother. goof-loop tries to fix this:
|
||||
|
||||
```
|
||||
(loop ((a (in 0 b))
|
||||
(b (in 1 (+ a b)))
|
||||
(loop ((:for a (in 0 b))
|
||||
(:for b (in 1 (+ a b)))
|
||||
(count (up-from 0 (to 1000)))
|
||||
(acc (listing b)))
|
||||
(:acc acc (listing b)))
|
||||
=> acc
|
||||
(display b) (newline))
|
||||
```
|
||||
|
|
@ -19,23 +19,23 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes
|
|||
|
||||
```
|
||||
(define lst '((1 2) dud (3 4) (5 6)))
|
||||
(loop ((a (in-list lst))
|
||||
(loop ((:for a (in-list lst))
|
||||
:when (pair? a)
|
||||
(b (in-list a))
|
||||
(acc (summing b)))
|
||||
(:for b (in-list a))
|
||||
(:acc acc (summing b)))
|
||||
=> acc)
|
||||
```
|
||||
|
||||
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.
|
||||
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 ((a (in-list '(1 2 3)))
|
||||
(aa (summing a))
|
||||
(loop ((:for a (in-list '(1 2 3)))
|
||||
(:acc aa (summing a))
|
||||
:subloop
|
||||
(b (up-from a (to (+ a 2))))
|
||||
(ab (listing b)))
|
||||
(:for b (up-from a (to (+ a 2))))
|
||||
(:acc ab (listing b)))
|
||||
=> (values aa ab))
|
||||
;; => (values 6 (1 2 2 3 3 4))
|
||||
```
|
||||
|
|
@ -44,34 +44,32 @@ Accumulators can be in any of the loop's stages:
|
|||
|
||||
### syntactical
|
||||
|
||||
No more (for ...). Every clause is now a for-clause. This is because the addition of subloops and accumulators removed the usefulness of having a simple case that acts just as named let.
|
||||
for-clauses are split into :for and :let 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 (var (in init [step [stop]])) or (var (folding init [step])) in case of accumulators.
|
||||
with-clauses are removed in favour of (:forvar (in init [step [stop]])) or (:acc var (folding init [step])) in case of accumulators.
|
||||
|
||||
### Regressions compared to foof-loop
|
||||
|
||||
only accumulating clauses are visible in the final-expression. This is due to sequence clauses not being promoted through to outer loops (since they should not keep their state).
|
||||
|
||||
sequence clauses cannot finalize, due to the above thing. The reason for distinguishing between sequences and accumulators 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
|
||||
|
||||
(with var [init [step [guard]]]) => (var (in init [step [stop-expr]])). guard was a procedure, but now it is an expression.
|
||||
(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?) => (var (in 10 (- var 10) (negative? var)))
|
||||
(with var 10 (- var 1) negative?) => (:for var (in 10 (- var 10) (negative? var)))
|
||||
|
||||
### similarities
|
||||
|
||||
You can of course still have a larger control of your loops:
|
||||
|
||||
```
|
||||
(loop loopy-loop ((a (up-from 1 (to 11))))
|
||||
(loop loopy-loop ((:for a (up-from 1 (to 11))))
|
||||
=> '()
|
||||
(if (odd? a)
|
||||
(cons (* a (- a)) (loopy-loop))
|
||||
|
|
@ -85,9 +83,9 @@ Named updates also work.
|
|||
```
|
||||
;; Shamelessly stolen from Taylor Campbell's foof-loop documentation
|
||||
(define (partition list predicate)
|
||||
(loop continue ((element (in-list list))
|
||||
(satisfied (folding '()))
|
||||
(unsatisfied (folding '())))
|
||||
(loop continue ((:for element (in-list list))
|
||||
(:acc satisfied (folding '()))
|
||||
(:acc unsatisfied (folding '())))
|
||||
=> (values (reverse satisfied)
|
||||
(reverse unsatisfied))
|
||||
(if (predicate element)
|
||||
|
|
@ -100,11 +98,9 @@ Named updates also work.
|
|||
|
||||
|
||||
## Todo
|
||||
Should we add finalizers for sequence-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.
|
||||
Tests and documentation.
|
||||
|
||||
Add racket #:final clauses.
|
||||
|
||||
Add simple versions of loop. loop/list (done), loop/sum, loop/last, loop/first, and so on.
|
||||
Fix the inlining behavious of some of the :for iterators.
|
||||
|
||||
## foof, what a guy
|
||||
|
||||
|
|
|
|||
169
goof.scm
169
goof.scm
|
|
@ -63,19 +63,20 @@
|
|||
((loop (clauses ...) body ...)
|
||||
(cl (loop (clauses ...) body ...)
|
||||
loop-name
|
||||
(()) (()) (()) (()) (()) () (()) (()) (()) ()
|
||||
(()) (()) (()) (()) (()) () ((() ())) (()) (()) (()) ()
|
||||
(clauses ...)
|
||||
body ... (loop-name)))
|
||||
((loop name (clauses ...) . body)
|
||||
(cl (loop name (clauses ...) . body)
|
||||
name
|
||||
(()) (()) (()) (()) (()) () (()) (()) (()) ()
|
||||
(()) (()) (()) (()) (()) () ((() ())) (()) (()) (()) ()
|
||||
(clauses ...)
|
||||
. body))))
|
||||
|
||||
(define-syntax push-new-subloop
|
||||
(syntax-rules ()
|
||||
((_ orig name (lets ...) (accs ...) (vars ...) (checks ...) (refs ...) f (ul ...) (uw ...) (ub ...) uf clauses . body)
|
||||
((_ orig name (lets ...) (accs ...) (vars ...) (checks ...) (refs ...) f (((ff-cur ...) (ff-above ...)) . ff-rest)
|
||||
(ul ...) (uw ...) (ub ...) uf clauses . body)
|
||||
(cl orig name
|
||||
(() lets ...)
|
||||
(() accs ...)
|
||||
|
|
@ -83,6 +84,8 @@
|
|||
(() checks ...)
|
||||
(() refs ...)
|
||||
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 ...)
|
||||
|
|
@ -93,70 +96,73 @@
|
|||
;; Clauses 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 ul uw ub uf () => expr . body)
|
||||
(emit orig name l a v c r f ul uw ub uf expr . body))
|
||||
((_ orig name l a v c r f ul uw ub uf () . body)
|
||||
(emit orig name l a v c r f ul uw ub uf (if #f #f) . body))
|
||||
((_ 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))
|
||||
|
||||
;; USER LETS
|
||||
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub uf (:let (id id* ... expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub uf (clauses ...) . body))
|
||||
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub uf (:let* (id id* ... expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ((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))
|
||||
((_ 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 ul ((cur-uw ...) . uw-rest) ub uf (:when test clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... test) . uw-rest) ub uf (clauses ...) . body))
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub uf (:unless test clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... (not test)) . uw-rest) ub uf (clauses ...) . body))
|
||||
((_ 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))
|
||||
;; 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 ul ((cur-uw ...) . uw-rest) ((cur-ub ...) . ub-rest) uf (:break expr clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ((cur-ub ... expr) . ub-rest) uf (clauses ...) . body))
|
||||
((_ 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))
|
||||
;; 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 ul ((cur-uw ...) . uw-rest) ub (cur-uf ...) (:final expr clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ub (cur-uf ... expr) (clauses ...) . body))
|
||||
((_ 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))
|
||||
|
||||
;; Explicit subloop. Shorthand for (:when #t)
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub uf (:subloop clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ub uf (clauses ...) . body))
|
||||
((_ 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))
|
||||
;; :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 ul ((uw uw* ...) . uw-rest) ub uf ((:for for-rest ...) clauses ...) . body)
|
||||
(push-new-subloop orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub uf ((:for for-rest ...) clauses ...) . body))
|
||||
((_ 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))
|
||||
|
||||
;; For clause with a sequence creator.
|
||||
((_ orig name l a v c r f ul uw ub uf ((:for id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(iterator ((id ids ...) (source ...)) cl-next orig name l a v c r f ul uw ub uf (clauses ...) . body))
|
||||
((_ orig name l a v c r f ff ul uw ub uf ((:for id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(iterator ((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 ul uw ub uf ((:acc id ids ... (accumulator source ...)) clauses ...) . body)
|
||||
(accumulator :acc ((id ids ...) (source ...)) cl-next orig name l a v c r f ul uw ub uf (clauses ...) . body))
|
||||
;; accumulator clause
|
||||
((_ orig name l a v c r f ff ul uw ub uf ((:acc id ids ... (accumulator source ...)) clauses ...) . body)
|
||||
(accumulator :acc ((id ids ...) (source ...)) cl-next/acc orig name l a v c r f ff ul uw ub uf (clauses ...) . body))
|
||||
|
||||
;; no :acc or :for: imlplicit for!
|
||||
((_ orig name l a v c r f ul uw ub uf ((id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(cl orig name l a v c r f ul uw ub uf ((:for id ids ... (iterator source ...)) clauses ...) . body))
|
||||
((_ orig name l a v c r f ff ul uw ub uf ((id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ul uw ub uf ((:for id ids ... (iterator source ...)) clauses ...) . body))
|
||||
|
||||
;; ERROR HANDLING?
|
||||
((_ orig name l a v c r f ul uw ub uf (clause . rest) . body)
|
||||
(syntax-error "Invalid clause in loop" clause orig))
|
||||
((_ orig name l a v c r f ff ul uw ub uf (clause . rest) . body)
|
||||
'(syntax-error "Invalid clause in loop" clause orig))
|
||||
|
||||
))
|
||||
|
||||
|
||||
;; HOLY CODE-DUPLICATION-BATMAN!
|
||||
;; cl-next integrates any bindings introduced by a :for or :acc clause. The complexity comes from pushing :acc-clauses
|
||||
;; cl-next/acc integrates all the bindings by an :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 (:for :acc)
|
||||
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
|
||||
(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 ...)
|
||||
orig name
|
||||
((lets ...))
|
||||
((accs ...))
|
||||
((vars ...))
|
||||
((checks ...))
|
||||
((refs ...))
|
||||
(finals ...) ul uw ub uf clauses . body)
|
||||
(finals ...)
|
||||
ff ul uw ub uf clauses . body)
|
||||
(cl orig name
|
||||
((lets ... new-lets ...))
|
||||
((accs ... (accvar accinit accupdate) ...))
|
||||
|
|
@ -164,16 +170,17 @@
|
|||
((checks ... new-checks ...))
|
||||
((refs ... new-refs ...))
|
||||
(finals ... new-finals ...)
|
||||
ul uw ub uf clauses . body))
|
||||
ff ul uw ub uf clauses . body))
|
||||
;; We have ONE subloop!
|
||||
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
|
||||
((_ :acc (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
|
||||
orig name
|
||||
((lets ...) . lets-rest)
|
||||
((accs ...) ((oldacc oldinit oldupdate) ...))
|
||||
((vars ...) . vars-rest)
|
||||
((checks ...) . checks-rest)
|
||||
((refs ...) . refs-rest)
|
||||
(finals ...) ul uw ub uf clauses . body)
|
||||
(finals ...)
|
||||
ff ul uw ub uf clauses . body)
|
||||
(cl orig name
|
||||
((lets ... new-lets ...) . lets-rest)
|
||||
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
|
||||
|
|
@ -181,16 +188,17 @@
|
|||
((checks ... new-checks ...) . checks-rest)
|
||||
((refs ... new-refs ...) . refs-rest)
|
||||
(finals ... new-finals ...)
|
||||
ul uw ub uf clauses . body))
|
||||
ff ul uw ub uf clauses . body))
|
||||
;; We have several subloops!
|
||||
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
|
||||
((_ :acc (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 uf clauses . body)
|
||||
(finals ...)
|
||||
ff ul uw ub uf clauses . body)
|
||||
(cl orig name
|
||||
((lets ... new-lets ...) . lets-rest)
|
||||
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
|
||||
|
|
@ -199,8 +207,33 @@
|
|||
((checks ... new-checks ...) . checks-rest)
|
||||
((refs ... new-refs ...) . refs-rest)
|
||||
(finals ... new-finals ...)
|
||||
ff ul uw ub uf 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
|
||||
(define-syntax cl-next/for
|
||||
(syntax-rules ()
|
||||
((_ (new-lets ...) () (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...)
|
||||
orig name
|
||||
((lets ...) . lets-rest)
|
||||
accs
|
||||
((vars ...) . vars-rest)
|
||||
((checks ...) . checks-rest)
|
||||
((refs ...) . refs-rest)
|
||||
finals
|
||||
(((ff-cur ...) (ff-above ...)) . ff-rest)
|
||||
ul uw ub uf clauses . body)
|
||||
(cl orig name
|
||||
((lets ... new-lets ...) . lets-rest)
|
||||
accs
|
||||
((vars ... new-vars ...) . vars-rest)
|
||||
((checks ... new-checks ...) . checks-rest)
|
||||
((refs ... new-refs ...) . refs-rest)
|
||||
finals
|
||||
(((ff-cur ... new-for-finals ...) (ff-above ...)) . ff-rest)
|
||||
ul uw ub uf clauses . body))
|
||||
))
|
||||
((cl err ...)
|
||||
'(cl err ...))))
|
||||
|
||||
(define-syntax user-let
|
||||
(syntax-rules (:let :let*)
|
||||
|
|
@ -243,6 +276,7 @@
|
|||
((checks ...))
|
||||
((refs ...))
|
||||
((final-binding final-value) ...)
|
||||
(((ff-cur ...) (ff-above ...)))
|
||||
((user-lets ...)) ((user-whens ...)) ((user-breaks ...)) uf
|
||||
final-expr . body)
|
||||
(let* (lets ...)
|
||||
|
|
@ -250,7 +284,9 @@
|
|||
final-expr)
|
||||
(define (loopy-loop accvar ... var ...)
|
||||
(if (or checks ...)
|
||||
(final-fun final-value ...)
|
||||
(begin
|
||||
ff-cur ...
|
||||
(final-fun final-value ...))
|
||||
(let (refs ...)
|
||||
(user-let () () (user-lets ...)
|
||||
(if (and user-whens ...)
|
||||
|
|
@ -258,9 +294,12 @@
|
|||
(final-fun final-value ...)
|
||||
uf
|
||||
(loopy-loop (accvar accstep) ... (var step) ...)
|
||||
(if (or user-breaks ...)
|
||||
(final-fun final-value ...)
|
||||
(let () (if #f #f) . body)))
|
||||
(cond
|
||||
((or user-breaks ...)
|
||||
ff-above ... ff-cur ...
|
||||
(final-fun final-value ...))
|
||||
(else
|
||||
(let () (if #f #f) . body))))
|
||||
(loopy-loop accvar ... step ...))))))
|
||||
(loopy-loop accinit ... init ...)))))
|
||||
|
||||
|
|
@ -274,6 +313,7 @@
|
|||
(checks-next ... (checks ...))
|
||||
(refs-next ... (refs ...))
|
||||
((final-binding final-value) ...)
|
||||
(ff-next ... ((ff-cur ...) ()))
|
||||
(ul-next ... (user-lets ...))
|
||||
(uw-next ... (user-whens ...))
|
||||
(ub-next ... (user-breaks ...))
|
||||
|
|
@ -285,12 +325,16 @@
|
|||
(let outer-loop ((accvar accinit) ...
|
||||
(var init) ...)
|
||||
(if (or checks ...)
|
||||
(final-fun final-value ...)
|
||||
(begin
|
||||
ff-cur ...
|
||||
(final-fun final-value ...))
|
||||
(let (refs ...)
|
||||
(user-let () () (user-lets ...)
|
||||
(if (and user-whens ...)
|
||||
(cond
|
||||
((or user-breaks ...) (final-fun final-value ...))
|
||||
((or user-breaks ...)
|
||||
ff-cur ...
|
||||
(final-fun final-value ...))
|
||||
(else (emit-many/rest orig
|
||||
name
|
||||
(outer-loop accstep ... step ...)
|
||||
|
|
@ -301,6 +345,7 @@
|
|||
(refs-next ...)
|
||||
;; THIS IS NOW A COMPLETE call to final
|
||||
(final-fun final-value ...)
|
||||
(ff-next ...)
|
||||
(ul-next ...)
|
||||
(uw-next ...)
|
||||
(ub-next ...)
|
||||
|
|
@ -320,6 +365,7 @@
|
|||
((checks ...))
|
||||
((refs ...))
|
||||
final
|
||||
(((ff-cur ...) (ff-above ...)))
|
||||
((user-lets ...))
|
||||
((user-whens ...))
|
||||
((user-breaks ...))
|
||||
|
|
@ -329,12 +375,16 @@
|
|||
(let innermost-loop ((accvar accinit) ...
|
||||
(var init) ...)
|
||||
(if (or checks ...)
|
||||
outer
|
||||
(begin
|
||||
ff-cur ...
|
||||
outer)
|
||||
(let (refs ...)
|
||||
(user-let () () (user-lets ...)
|
||||
(if (and user-whens ...)
|
||||
(cond
|
||||
((or user-breaks ...) final)
|
||||
((or user-breaks ...)
|
||||
ff-above ... ff-cur ...
|
||||
final)
|
||||
(else
|
||||
(let-kw-form name final uf (innermost-loop (accvar accstep) ... (var step) ...)
|
||||
. body)))
|
||||
|
|
@ -350,6 +400,7 @@
|
|||
(next-checks ... (checks ...))
|
||||
(next-refs ... (refs ...))
|
||||
final
|
||||
(next-ff ... ((ff-cur ...) (ff-above ...)))
|
||||
(ul-next ... (user-lets ...))
|
||||
(uw-next ... (user-whens ...))
|
||||
(ub-next ... (user-breaks ...))
|
||||
|
|
@ -359,14 +410,17 @@
|
|||
(let intermediate-loop ((accvar accinit) ...
|
||||
(var init) ...)
|
||||
(if (or checks ...)
|
||||
outer
|
||||
(begin
|
||||
ff-cur ...
|
||||
outer)
|
||||
(let (refs ...)
|
||||
(user-let () () (user-lets ...)
|
||||
(if (and user-whens ...)
|
||||
(if (or user-breaks ...)
|
||||
final
|
||||
(emit-many/rest
|
||||
orig
|
||||
(cond
|
||||
((or user-breaks ...)
|
||||
ff-above ... ff-cur ...
|
||||
final)
|
||||
(else (emit-many/rest orig
|
||||
name
|
||||
(intermediate-loop accstep ... step ...)
|
||||
(next-lets ...)
|
||||
|
|
@ -375,11 +429,12 @@
|
|||
(next-checks ...)
|
||||
(next-refs ...)
|
||||
final
|
||||
(next-ff ...)
|
||||
(ul-next ...)
|
||||
(uw-next ...)
|
||||
(ub-next ...)
|
||||
uf
|
||||
. body))
|
||||
. body)))
|
||||
(intermediate-loop accvar ... step ...))))))))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -177,23 +177,21 @@
|
|||
|
||||
;; ;;> \macro{(for ch (in-file [input-port [reader [eof?]]]))}
|
||||
|
||||
;; (define-syntax in-file
|
||||
;; (syntax-rules ()
|
||||
;; ((in-file ((var) source) next . rest)
|
||||
;; (in-file ((var p) source) next . rest))
|
||||
;; ((in-file ((var p) (file)) next . rest)
|
||||
;; (in-file ((var p) (file read-char)) next . rest))
|
||||
;; ((in-file ((var p) (file reader)) next . rest)
|
||||
;; (in-file ((var p) (file reader eof-object?)) next . rest))
|
||||
;; ((in-file ((var p) (file reader eof?)) next . rest)
|
||||
;; (next ((p (open-input-file file)) (r reader) (e? eof?))
|
||||
;; ()
|
||||
;; ((var (r p) (r p)))
|
||||
;; ((e? var))
|
||||
;; ()
|
||||
;; ((dummy (clo
|
||||
;; se-input-port p)))
|
||||
;; . rest))))
|
||||
(define-syntax in-file
|
||||
(syntax-rules ()
|
||||
((in-file ((var) source) next . rest)
|
||||
(in-file ((var p) source) next . rest))
|
||||
((in-file ((var p) (file)) next . rest)
|
||||
(in-file ((var p) (file read-char)) next . rest))
|
||||
((in-file ((var p) (file reader)) next . rest)
|
||||
(in-file ((var p) (file reader eof-object?)) next . rest))
|
||||
((in-file ((var p) (file reader eof?)) next . rest)
|
||||
(next ((p (open-input-file file)) (r reader) (e? eof?))
|
||||
()
|
||||
((var (r p) (r p)))
|
||||
((e? var))
|
||||
()
|
||||
((close-input-port p)) . rest))))
|
||||
|
||||
|
||||
(define-syntax in-generator
|
||||
|
|
@ -267,7 +265,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 ((tmp-kons kons))
|
||||
(n :acc ((tmp-kons kons))
|
||||
((cursor init (if check (tmp-kons expr cursor) cursor)))
|
||||
()
|
||||
()
|
||||
|
|
@ -275,7 +273,7 @@
|
|||
((var (final cursor)))
|
||||
. rest))
|
||||
((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest)
|
||||
(n ((tmp-kons kons))
|
||||
(n :acc ((tmp-kons kons))
|
||||
((cursor init (tmp-kons expr cursor)))
|
||||
()
|
||||
()
|
||||
|
|
|
|||
22
tests.scm
22
tests.scm
|
|
@ -1,25 +1,25 @@
|
|||
;; This is just a file with things that should be written as a test. Dump file.
|
||||
|
||||
(loop ((a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
|
||||
(loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
|
||||
:when #t
|
||||
(b (in-list a))
|
||||
(:for b (in-list a))
|
||||
:subloop
|
||||
(c (in-list b))
|
||||
(acc (listing c)))
|
||||
(:for c (in-list b))
|
||||
(:acc acc (listing c)))
|
||||
=> acc)
|
||||
|
||||
|
||||
(loop ((a (in-list '((1 2) (3 4) (5 6))))
|
||||
(loop ((:for a (in-list '((1 2) (3 4) (5 6))))
|
||||
:subloop
|
||||
(b (in-list a))
|
||||
(acc (listing b)))
|
||||
(:for b (in-list a))
|
||||
(:acc acc (listing b)))
|
||||
=> acc)
|
||||
|
||||
(loop ((a (in-list '(1 2 3)))
|
||||
(oa (summing a))
|
||||
(loop ((:for a (in-list '(1 2 3)))
|
||||
(:acc oa (summing a))
|
||||
:subloop
|
||||
(b (up-from a (to (+ a 2))))
|
||||
(ob (listing b)))
|
||||
(: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)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue