(import scheme (chicken base) srfi-1 srfi-4 srfi-42 srfi-4-comprehensions test) (define n 20) (define xlst (list-tabulate n (lambda (x) x))) (define (to-4-dp f) (/ (round (* f 10000)) 10000)) (define (=4 n1 n2) (= (to-4-dp n1) (to-4-dp n2))) (test-group "SRFI-4 vector comprehension" (test (list->f64vector xlst) (f64vector-ec (: i 0 n) i) ) (test (list->f32vector xlst) (f32vector-ec (: i 0 n) i) ) ; (test (list->s64vector xlst) (s64vector-ec (: i 0 n) i) ) (test (list->u64vector xlst) (u64vector-ec (: i 0 n) i) ) (test (list->s32vector xlst) (s32vector-ec (: i 0 n) i) ) (test (list->u32vector xlst) (u32vector-ec (: i 0 n) i) ) (test (list->s16vector xlst) (s16vector-ec (: i 0 n) i) ) (test (list->u16vector xlst) (u16vector-ec (: i 0 n) i) ) (test (list->s8vector xlst) (s8vector-ec (: i 0 n) i) ) (test (list->u8vector xlst) (u8vector-ec (: i 0 n) i) ) ) (test-group "SRFI-4 vector fold comprehension" (let ((v (f64vector-ec (: i 0. n) (* 0.5 i)))) (test-assert (=4 617.5 (fold-ec 0. (:f64vector x (index i) v) x (lambda (x ax) (+ ax (* x x))))))) (let ((v (f32vector-ec (: i 0. n) (* 0.5 i)))) (test-assert (=4 617.5 (fold-ec 0. (:f32vector x (index i) v) x (lambda (x ax) (+ ax (* x x)))))) ))