- Timestamp:
- 05/31/20 02:13:11 (8 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/slib-arraymap/trunk/slib-arraymap.scm
r38719 r38722 36 36 (: array-index-map! (array (#!rest -> *) -> void)) 37 37 (: array:copy! (array array -> void)) 38 38 39 (: array-copy (array -> array)) 40 (: array-fold (procedure * #!rest array -> *)) 39 41 40 42 (include "arraymap") … … 46 48 47 49 (define (array-fold proc seed . ras) 48 (import (only (chicken base) sub1 add1 cut))49 50 (let rafo ((rdims (array-dimensions (car ras))) (inds '())) 50 51 (if (null? (cdr rdims)) … … 52 53 (sdni (reverse (cons #f inds))) 53 54 (lastpair (last-pair sdni)) ) 54 (do ((i 0 ( add1 i)))55 ((> i ( sub1 (car rdims))))55 (do ((i 0 (+ 1 i))) 56 ((> i (+ -1 (car rdims)))) 56 57 (set-car! lastpair i) 57 (set! seed (apply proc seed (map ( cut apply array-ref <> sdni) ras))) ) )58 (set! seed (apply proc seed (map (lambda (x) (apply array-ref x sdni)) ras))) ) ) 58 59 (let ( 59 60 (crdims (cdr rdims)) 60 (ll ( sub1 (car rdims))) )61 (do ((i 0 ( add1 i)))61 (ll (+ -1 (car rdims))) ) 62 (do ((i 0 (+ 1 i))) 62 63 ((> i ll)) 63 64 (rafo crdims (cons i inds)) ) ) ) )
Note: See TracChangeset
for help on using the changeset viewer.