diff --git a/README.md b/README.md index 6aac2bd..136f8b1 100644 --- a/README.md +++ b/README.md @@ -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? diff --git a/goof.scm b/goof.scm index a22b875..769677d 100644 --- a/goof.scm +++ b/goof.scm @@ -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)))))) diff --git a/tests.scm b/tests.scm new file mode 100644 index 0000000..8629257 --- /dev/null +++ b/tests.scm @@ -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 +