diff --git a/goof.scm b/goof.scm index 6bf608e..63fbc17 100644 --- a/goof.scm +++ b/goof.scm @@ -36,6 +36,7 @@ #: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) @@ -51,6 +52,7 @@ loop/list/parallel :when :unless :break :final :let :let* :subloop :for :acc + :length :fill in in-list @@ -74,6 +76,7 @@ summing multiplying hashing + vectoring in-cycle in-indexed @@ -84,6 +87,9 @@ :when :unless :break :final :let :let* :subloop :for :acc ;; Auxiliary syntax for the iterators. :gen + ;; auxiliary auxiliary syntax + ;; for vectoring + :length :fill ;; Internal syntax. %acc is turned into :acc by the forify macro ;; it is used make it possible to report an error if :acc is used in ;; one of the simple macros. diff --git a/goof/iterators.scm b/goof/iterators.scm index 84e3a32..eb76863 100644 --- a/goof/iterators.scm +++ b/goof/iterators.scm @@ -360,7 +360,54 @@ (define-hashing hashving (make-hash-table) hashv-set!) (define-hashing hashqing (make-hash-table) hashq-set!) +(define (vector-grow v factor len) + (define newlen (* len factor)) + (define new (make-vector newlen)) + (vector-copy! new 0 v 0 len) + new) +(define (vector-set!? vec index value) + (cond ((= index (vector-length vec)) + (let ((newvec (vector-grow vec 2 (vector-length vec)))) + (vector-set! newvec index value) + newvec)) + (else + (vector-set! vec index value) + vec))) + +(define (vector-shrink? vec index) + (if (= index (vector-length vec)) + vec + (vector-copy vec 0 index))) + +(define-syntax vectoring + (syntax-rules (:acc :length :fill) + ((_ :acc ((var) expr) n . rest) + (vectoring :acc ((var index) expr) n . rest)) + ((_ :acc ((var index) (expr)) n . rest) + (n () + ((index 0 (+ index 1)) (var (make-vector 32) (vector-set!? var index expr))) + () + () + () + ((var (vector-shrink? var index))) + . rest)) + ((_ :acc ((var index) (expr (:length len))) n . rest) + (vectoring :acc ((var index) (expr (:length len) (:fill (if #f #f)))) n . rest)) + + ;; I am truly sorry. Currently this relies on pushing a :break clause WITHOUT + ;; the :when #t to ensure a subloop. It is the solution I would have used + ;; otherwise as well, but I would have wished for it to be more elegant. + ((_ :acc ((var index) (expr (:length len) (:fill f))) next + o n l a v c r fi ff ul uw ((ub ...) . ub-rest) uf . rest) + (next ((var (make-vector len f))) + ((index 0 (begin (vector-set! var index expr) (+ index 1)))) + () + () + () + ((var var)) + o n l a v c r fi ff ul uw ((ub ... (= index len)) . ub-rest) uf + . rest)))) ;;; Here starts generator clauses.