;; goof loop - a bastardisation of chibi loop. ;; ;; Copyright 2020, 2021 Linus Björnstam ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions ;; are met: ;; 1. Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; 2. Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. ;; 3. The name of the author(s) may not be used to endorse or promote products ;; derived from this software without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;; This is a looping construct obviously based on (chibi loop) (aka: ;; foof-loop) by Alex Shinn. The name goof-loop is a play on that ;; name, and the fact that I goofed in the chibi issue tracker when ;; trying to understand the iterator protocol. (define-module (goof) #:use-module (goof helpers) #:use-module (goof ref-let) #:use-module ((srfi srfi-1) #:select (circular-list)) #:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!)) #:use-module (srfi srfi-71) #:use-module (rnrs io simple) #:use-module (ice-9 futures) #:export (loop loop/list loop/sum loop/product loop/first loop/last loop/and loop/or loop/list/parallel :when :unless :break :final :let :let* :subloop :for :acc :length :fill in in-list in-lists in-vector in-reverse-vector in-string in-reverse-string in-hash in-port in-file in-generator up-from down-from accumulating folding listing listing-reverse appending appending-reverse summing multiplying hashing vectoring in-cycle in-indexed )) ;; This contains the portable parts of goof-loop. (include "goof-impl.scm") ;; Helper procedures for let-kw-form (define (syntax= s1 s2) (equal? (syntax->datum s1) (syntax->datum s2))) (define (update-name params name val) (cond ((null? params) (error "unknown loop variable name " name (list '=> name val))) ((syntax= name (caar params)) (cons (list (caar params) val) (cdr params))) (else (cons (car params) (update-name (cdr params) name val))))) (define-syntax inner-recur (syntax-rules () ((_ loop-name final-fun () ((v s) ...)) (loop-name s ...)) ((_ loop-name final-fun (user-finals ...) ((v s) ...)) (let ((v s) ...) (if (or user-finals ...) final-fun (loop-name v ...)))))) (define (syntax->list stx) (syntax-case stx () ((a ...) #'(a ...)))) (define-syntax let-kw-form (syntax-rules () ((_ macro-name final-fun (user-finals ...) (loop-name (var step) ...) . body) (let-syntax ((macro-name (lambda (stx) (with-ellipsis ::: (let loop ((lst (cdr (syntax->list stx))) (params (list #'(var step) ...))) (if (null? lst) (with-syntax ((((v s) :::) params)) #'(inner-recur loop-name final-fun (user-finals ...) ((v s) :::))) (syntax-case (car lst) (=>) ((=> name val) (loop (cdr lst) (update-name params #'name #'val))) (_ (error "Malformed looping clause in macro"))))))))) . body)))) (define-syntax loop/list/parallel (syntax-rules () ((n (clauses ...) body ...) (forify (n (clauses ...) body ...) parallel-list-loop () (clauses ... (%acc futures (listing-reverse (future (let () body ...))))) => (loop ((:for future (in-list futures)) (:acc futures2 (listing-reverse (touch future)))) => futures2) (parallel-list-loop)))))