Add the vectoring accumulator.
Currently undocumented and untested.
This commit is contained in:
parent
f492a5278b
commit
7311da2ec2
2 changed files with 53 additions and 0 deletions
6
goof.scm
6
goof.scm
|
@ -36,6 +36,7 @@
|
||||||
#:use-module (goof helpers)
|
#:use-module (goof helpers)
|
||||||
#:use-module (goof ref-let)
|
#:use-module (goof ref-let)
|
||||||
#:use-module ((srfi srfi-1) #:select (circular-list))
|
#: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 (srfi srfi-71)
|
||||||
#:use-module (rnrs io simple)
|
#:use-module (rnrs io simple)
|
||||||
#:use-module (ice-9 futures)
|
#:use-module (ice-9 futures)
|
||||||
|
@ -51,6 +52,7 @@
|
||||||
loop/list/parallel
|
loop/list/parallel
|
||||||
|
|
||||||
:when :unless :break :final :let :let* :subloop :for :acc
|
:when :unless :break :final :let :let* :subloop :for :acc
|
||||||
|
:length :fill
|
||||||
|
|
||||||
in
|
in
|
||||||
in-list
|
in-list
|
||||||
|
@ -74,6 +76,7 @@
|
||||||
summing
|
summing
|
||||||
multiplying
|
multiplying
|
||||||
hashing
|
hashing
|
||||||
|
vectoring
|
||||||
|
|
||||||
in-cycle
|
in-cycle
|
||||||
in-indexed
|
in-indexed
|
||||||
|
@ -84,6 +87,9 @@
|
||||||
:when :unless :break :final :let :let* :subloop :for :acc
|
:when :unless :break :final :let :let* :subloop :for :acc
|
||||||
;; Auxiliary syntax for the iterators.
|
;; Auxiliary syntax for the iterators.
|
||||||
:gen
|
:gen
|
||||||
|
;; auxiliary auxiliary syntax
|
||||||
|
;; for vectoring
|
||||||
|
:length :fill
|
||||||
;; Internal syntax. %acc is turned into :acc by the forify macro
|
;; 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
|
;; it is used make it possible to report an error if :acc is used in
|
||||||
;; one of the simple macros.
|
;; one of the simple macros.
|
||||||
|
|
|
@ -360,7 +360,54 @@
|
||||||
(define-hashing hashving (make-hash-table) hashv-set!)
|
(define-hashing hashving (make-hash-table) hashv-set!)
|
||||||
(define-hashing hashqing (make-hash-table) hashq-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.
|
;;; Here starts generator clauses.
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue