From 2d35c9d6cf504edfc72da1bc5f93a79d17705e89 Mon Sep 17 00:00:00 2001 From: Linus Date: Wed, 16 Dec 2020 19:54:55 +0100 Subject: [PATCH] Polishing the README and iterator protocol. * 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. --- README.md | 152 +++++++++++++++++++++++++++++++++++++++++++++++++- goof.scm | 26 +++++---- iterators.scm | 10 ++-- ref-let.scm | 51 +++++++++++++++++ 4 files changed, 220 insertions(+), 19 deletions(-) create mode 100644 ref-let.scm diff --git a/README.md b/README.md index 13077ad..2ff0521 100644 --- a/README.md +++ b/README.md @@ -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* () + (letrec ((final-function (lambda () )) + (goof-loop (lambda ( ... ...) + (if (or ...) + (begin + ... + (final-function ( ) ...)) + (let (( ... ) ...) + (let (( ... ) ...) + (match-let (( )) + (if (and ...) + (cond + ((or ...) + ... + (final-function ( ) ...)) + (else + + (goof-loop ... ...)) + (goof-loop ... ...)))))))) + (goof-loop ... ...))) +``` + +: 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. + + and : 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 . In case of (listing ...) the accumulated results are reversed before the final function. + + and : 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. is the current state of a :for clause. + +: Checks for :for-clauses. In the case of (in-list ...) this would check for (not (pair? ...)). + +: 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. + +: is any preprocessing done to before passing it on to the final-function. In the case of (listing ...) that would be (reverse ...). + + and : 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. + + and : If a 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. + +: the user supplied :when or :unless guard expression. + +: user-supplied :break guard. + +, , and : 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. is the expression the accumulator clause provided to accumulate a new value. For (:acc acc (listing elem)) that is (cons elem acc). 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. + + and : are ALL accumulator init values, including the ones in subloops. For (listing ...) that is the empty list. is the initial loop vars. + + +In case of subloops, those are placed instead of . They use the same final-function, and instead of quitting when any 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. diff --git a/goof.scm b/goof.scm index 35a0e97..b7c212c 100644 --- a/goof.scm +++ b/goof.scm @@ -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) diff --git a/iterators.scm b/iterators.scm index f2e6e4f..2d76842 100644 --- a/iterators.scm +++ b/iterators.scm @@ -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) diff --git a/ref-let.scm b/ref-let.scm new file mode 100644 index 0000000..a579353 --- /dev/null +++ b/ref-let.scm @@ -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))))