Created
February 15, 2010 21:42
-
-
Save dharmatech/305027 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
#| | |
* accessing | |
(first seq) | |
(last seq) | |
* combinators | |
(for-each seq proc) | |
(for-each-with-index seq proc) | |
(fold-left seq val proc) | |
(fold-right seq val proc) | |
(map seq proc) | |
(map! seq proc) | |
(partition seq proc) | |
(filter seq proc) | |
(for-all seq proc) | |
(exists seq proc) | |
(count seq proc) | |
* appending | |
(append2 seq seq) | |
(appendn ...) | |
* subsequences | |
(subseq seq start end) | |
(take seq n) | |
(drop seq n) | |
(cut seq i) | |
* searching | |
(index seq proc) | |
(find seq proc) | |
|# | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(import (dharmalab records define-record-type)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
#| | |
iterable protocol | |
(iterator obj) | |
(empty? iter) | |
(next iter) | |
(rest iter) | |
(new-from-list list) | |
|# | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define-record-type++ iterable-protocol | |
(fields iterator empty? next rest new-from-list)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-first protocol) | |
(import-iterable-protocol protocol) | |
(define (first col) | |
(next (iterator col))) | |
first) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-last protocol) | |
(import-iterable-protocol protocol) | |
(define (last col) | |
(let ((iter (iterator col))) | |
(let ((item (next iter))) | |
(let loop ((iter (rest iter)) (item item)) | |
(if (empty? iter) | |
item | |
(let ((item (next iter))) | |
(loop (rest iter) item))))))) | |
last) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-for-each protocol) | |
(import-iterable-protocol protocol) | |
(define (for-each col f) | |
(let loop ((iter (iterator col))) | |
(when (not (empty? iter)) | |
(f (next iter)) | |
(loop (rest iter))))) | |
for-each) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-for-each-with-index protocol) | |
(import-iterable-protocol protocol) | |
(define (for-each-with-index col proc) | |
(let loop ((iter (iterator col)) (i 0)) | |
(when (not (empty? iter)) | |
(proc i (next iter)) | |
(loop (rest iter) (+ i 1))))) | |
for-each-with-index) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; (define (make-iterable-reduce protocol) | |
;; (import-iterable-protocol protocol) | |
;; (define (reduce col initial proc) | |
;; (let loop ((iter (iterator col)) (val initial)) | |
;; (if (empty? iter) | |
;; val | |
;; (loop (rest iter) (proc val (next iter)))))) | |
;; reduce) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-fold-left protocol) | |
(import-iterable-protocol protocol) | |
(define (fold-left col initial proc) | |
(let loop ((iter (iterator col)) (val initial)) | |
(if (empty? iter) | |
val | |
(loop (rest iter) (proc val (next iter)))))) | |
fold-left) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-fold-right protocol) | |
(import-iterable-protocol protocol) | |
(define (fold-right col initial proc) | |
(let loop ((iter (iterator col))) | |
(if (empty? iter) | |
initial | |
(proc (next iter) | |
(loop (rest iter)))))) | |
fold-right) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-map-into-reversed-list protocol) | |
(import-iterable-protocol protocol) | |
(define (map-into-reversed-list col f) | |
(let loop ((iter (iterator col)) (items '())) | |
(if (empty? iter) | |
items | |
(loop (rest iter) | |
(cons (f (next iter)) | |
items))))) | |
map-into-reversed-list) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-map-into-list protocol) | |
(import-iterable-protocol protocol) | |
(let ((map-into-reversed-list (make-iterable-map-into-reversed-list protocol))) | |
(define (map-into-list col f) | |
(reverse (map-into-reversed-list col f))) | |
map-into-list)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-partition-into-reversed-lists protocol) | |
(import-iterable-protocol protocol) | |
(define (partition-into-reversed-lists col proc) | |
(let loop ((iter (iterator col)) (a '()) (b '())) | |
(if (empty? iter) | |
(values a b) | |
(let ((elt (next iter))) | |
(if (proc elt) | |
(loop (rest iter) (cons elt a) b) | |
(loop (rest iter) a (cons elt b))))))) | |
partition-into-reversed-lists) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-partition-into-lists protocol) | |
(import-iterable-protocol protocol) | |
(let ((partition-into-reversed-lists | |
(make-iterable-partition-into-reversed-lists protocol))) | |
(define (partition-into-lists col proc) | |
(call-with-values (partition-into-reversed-lists col proc) | |
(lambda (a b) | |
(values (reverse a) | |
(reverse b))))) | |
partition-into-lists)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-take-into-reversed-list protocol) | |
(import-iterable-protocol protocol) | |
(define (take-into-reversed-list col n) | |
(let loop ((iter (iterator col)) (n n) (accum '())) | |
(if (= n 0) | |
accum | |
(loop (rest iter) (- n 1) (cons (next iter) accum))))) | |
take-into-reversed-list) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-iterable-drop protocol) | |
(import-iterable-protocol protocol) | |
(define (drop col n) | |
(let loop ((iter (iterator col)) (n n)) | |
(if (= n 0) | |
iter | |
(loop (rest iter) (- n 1))))) | |
drop) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; list | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define iterable-protocol/list | |
(make-iterable-protocol (lambda (x) x) | |
null? | |
car | |
cdr | |
(lambda (x) x))) | |
(define list-for-each (make-iterable-for-each iterable-protocol/list)) | |
(define list-last (make-iterable-last iterable-protocol/list)) | |
(define list-fold-left (make-iterable-fold-left iterable-protocol/list)) | |
(define list-fold-right (make-iterable-fold-right iterable-protocol/list)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; input-port | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define iterable-protocol/input-port | |
(make-iterable-protocol (lambda (x) x) | |
(lambda (p) | |
(eof-object? | |
(lookahead-char p))) | |
lookahead-char | |
(lambda (p) | |
(get-char p) | |
p) | |
#f)) | |
(define input-port-for-each (make-iterable-for-each iterable-protocol/input-port)) | |
(define input-port-map-into-reversed-list | |
(make-iterable-map-into-reversed-list iterable-protocol/input-port)) | |
(define input-port-last (make-iterable-last iterable-protocol/input-port)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
#| | |
mutable-indexable protocol | |
(new-of-length n) | |
(size seq) | |
(ref seq i) | |
(put seq i val) | |
(copy seq i seq) | |
|# | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define-record-type++ mutable-indexable-protocol | |
(fields new-of-length size ref put copy)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; mutable-indexable functors | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-append2 protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (append2 a b) | |
(let ((new (new-of-length | |
(+ (size a) | |
(size b))))) | |
(copy new 0 a) | |
(copy new (size a) b) | |
new)) | |
append2) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-appendn protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (appendn . cols) | |
(let ((new (new-of-length (list-fold-left cols | |
0 | |
(lambda (n col) | |
(+ n (size col))))))) | |
(list-fold-left cols | |
0 | |
(lambda (i col) | |
(copy new i col) | |
(+ i (size col)))) | |
new)) | |
appendn) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-subseq protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (subseq seq start end) | |
(let ((n (- end start))) | |
(let ((new (new-of-length (- end start)))) | |
(let loop ((i 0)) | |
(when (< i n) | |
(put new i (ref seq (+ start i))) | |
(loop (+ i 1)))) | |
new))) | |
subseq) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-last protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (last seq) | |
(ref seq (- (size seq) 1))) | |
last) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-take protocol) | |
(let ((subseq (make-mutable-indexable-subseq protocol))) | |
(define (take seq n) | |
(subseq seq 0 n)) | |
take)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-drop protocol) | |
(let ((subseq (make-mutable-indexable-subseq protocol))) | |
(define (drop seq n) | |
(subseq seq n (size seq))) | |
drop)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; (define (make-mutable-indexable-cut protocol) | |
;; (define (cut seq n) | |
;; (values (take seq n) | |
;; (drop seq n)))) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-fold-left protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (fold-left seq initial proc) | |
(let ((n (size seq))) | |
(let loop ((i 0) (val initial)) | |
(if (< i n) | |
(loop (+ i 1) (proc val (ref seq i))) | |
val)))) | |
fold-left) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-fold-left-with-index protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (fold-left-with-index seq initial proc) | |
(let ((n (size seq))) | |
(let loop ((i 0) (val initial)) | |
(if (< i n) | |
(loop (+ i 1) (proc val (ref seq i))) | |
val)))) | |
fold-left) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-for-each protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (for-each seq proc) | |
(let ((n (size seq))) | |
(let loop ((i 0)) | |
(when (< i n) | |
(proc (ref seq i)) | |
(loop (+ i 1)))))) | |
for-each) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-for-each-with-index protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (for-each-with-index seq proc) | |
(let ((n (size seq))) | |
(let loop ((i 0)) | |
(when (< i n) | |
(proc i (ref seq i)) | |
(loop (+ i 1)))))) | |
for-each) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; (define (make-mutable-indexable-reduce protocol) | |
;; (import-mutable-indexable-protocol protocol) | |
;; (define (reduce seq initial proc) | |
;; (let ((n (size seq))) | |
;; (let ((i 0) (elt initial)) | |
;; (when (< i n) | |
;; (loop (+ i 1) (proc elt (ref seq i))))))) | |
;; reduce) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-map protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (map seq proc) | |
(let ((n (size seq))) | |
(let ((new (new-of-length n))) | |
(let loop ((i 0)) | |
(when (< i n) | |
(put new i (proc (ref seq i))) | |
(loop (+ i 1))))))) | |
map) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-map! protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (map! seq proc) | |
(let ((n (size seq))) | |
(let loop ((i 0)) | |
(when (< i n) | |
(put seq i (proc (ref seq i))) | |
(loop (+ i 1)))))) | |
map!) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-partition-into-lists protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (partition seq proc) | |
(let ((n (size seq))) | |
(let loop ((i 0) (a '()) (b '())) | |
(if (>= i n) | |
(values a b) | |
(let ((elt (ref seq i))) | |
(if (proc elt) | |
(loop (+ i 1) (cons elt a) b) | |
(loop (+ i 1) a (cons elt b)))))))) | |
partition) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-filter-to-list protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (filter seq proc) | |
(let ((n (size seq))) | |
(let loop ((i 0) (items '())) | |
(if (>= i n) | |
items | |
(let ((elt (ref seq i))) | |
(if (proc elt) | |
(loop (+ i 1) (cons elt items)) | |
(loop (+ i 1) items))))))) | |
partition) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-filter protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (filter seq proc) | |
(let ((n (size seq))) | |
(let ((new (new-of-length n))) | |
(let loop ((i 0) (j 0)) | |
(if (>= i n) | |
(copy (new-of-length j) 0 new) | |
(let ((elt (ref seq i))) | |
(if (proc elt) | |
(begin (put new j elt) | |
(loop (+ i 1) (+ j 1))) | |
(loop (+ i 1) j)))))))) | |
filter) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; (define (make-mutable-indexable-find-and-index protocol) | |
;; (import-mutable-indexable-protocol protocol) | |
;; (define (find seq proc) | |
;; (let ((n (size seq))) | |
;; (let loop ((i 0)) | |
;; (if (>= i n) | |
;; (values #f #f) | |
;; (let ((elt (ref seq i))) | |
;; (if (proc elt) | |
;; (values elt i) | |
;; (loop (+ i 1)))))))) | |
;; find) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-index protocol) | |
(import-mutable-indexable-protocol protocol) | |
(define (index seq proc) | |
(let ((n (size seq))) | |
(let loop ((i 0)) | |
(if (>= i n) | |
#f | |
(let ((elt (ref seq i))) | |
(if (proc elt) | |
i | |
(loop (+ i 1)))))))) | |
index) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-mutable-indexable-find protocol) | |
(import-mutable-indexable-protocol protocol) | |
(let ((index (make-mutable-indexable-index protocol))) | |
(define (find seq proc) | |
(let ((i (index seq proc))) | |
(if i | |
(ref seq i) | |
#f))) | |
find)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; copy-into! functor | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define (make-copy-into! size ref put!) | |
(define (copy-into! a start b) | |
(let ((n (size b))) | |
(let loop ((i 0)) | |
(when (< i n) | |
(put! a (+ start i) (ref b i)) | |
(loop (+ i 1)))))) | |
copy-into!) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; vector | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define vector-copy-into! (make-copy-into! vector-length vector-ref vector-set!)) | |
(define mutable-indexable-protocol/vector | |
(make-mutable-indexable-protocol make-vector | |
vector-length | |
vector-ref | |
vector-set! | |
vector-copy-into! | |
)) | |
(define vector-append2 | |
(make-mutable-indexable-append2 mutable-indexable-protocol/vector)) | |
(define vector-appendn | |
(make-mutable-indexable-appendn mutable-indexable-protocol/vector)) | |
(define vector-subseq | |
(make-mutable-indexable-subseq mutable-indexable-protocol/vector)) | |
(define vector-take | |
(make-mutable-indexable-take mutable-indexable-protocol/vector)) | |
(define vector-drop | |
(make-mutable-indexable-drop mutable-indexable-protocol/vector)) | |
(define vector-last | |
(make-mutable-indexable-last mutable-indexable-protocol/vector)) | |
(define vector-fold-left | |
(make-mutable-indexable-fold-left mutable-indexable-protocol/vector)) | |
(define vector-for-each | |
(make-mutable-indexable-for-each mutable-indexable-protocol/vector)) | |
(define vector-map! | |
(make-mutable-indexable-map! mutable-indexable-protocol/vector)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; string | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define string-copy-into! (make-copy-into! string-length string-ref string-set!)) | |
(define mutable-indexable-protocol/string | |
(make-mutable-indexable-protocol make-string | |
string-length | |
string-ref | |
string-set! | |
string-copy-into! | |
)) | |
(define string-for-each | |
(make-mutable-indexable-for-each mutable-indexable-protocol/string)) | |
(define string-map! | |
(make-mutable-indexable-map! mutable-indexable-protocol/string)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; bytevector | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define bytevector-copy-into! | |
(make-copy-into! bytevector-length bytevector-u8-ref bytevector-u8-set!)) | |
(define mutable-indexable-protocol/bytevector | |
(make-mutable-indexable-protocol make-bytevector | |
bytevector-length | |
bytevector-u8-ref | |
bytevector-u8-set! | |
bytevector-copy-into!)) | |
(define bytevector-for-each | |
(make-mutable-indexable-for-each mutable-indexable-protocol/bytevector)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;; range | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
(define-record-type++ range | |
(fields start end step)) | |
(define create-range | |
(case-lambda | |
((end) (make-range 0 end 1)) | |
((start end) (make-range start end 1)) | |
((start end step) (make-range start end step)))) | |
(define (range-ref r i) | |
(is-range r) | |
(+ r.start (* i r.step))) | |
(define (range-size r) | |
(is-range r) | |
(/ (- (+ r.end r.step) r.start) r.step)) | |
(define mutable-indexable-protocol/range | |
(make-mutable-indexable-protocol #f | |
range-size | |
range-ref | |
#f | |
#f)) | |
(define range-fold-left | |
(make-mutable-indexable-fold-left mutable-indexable-protocol/range)) | |
(define range-for-each | |
(make-mutable-indexable-for-each mutable-indexable-protocol/range)) | |
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment