Changeset 38722 in project


Ignore:
Timestamp:
05/31/20 02:13:11 (6 weeks ago)
Author:
Kon Lovett
Message:

add types for -copy & -fold

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/slib-arraymap/trunk/slib-arraymap.scm

    r38719 r38722  
    3636(: array-index-map! (array (#!rest -> *) -> void))
    3737(: array:copy! (array array -> void))
     38
    3839(: array-copy (array -> array))
     40(: array-fold (procedure * #!rest array -> *))
    3941
    4042(include "arraymap")
     
    4648
    4749(define (array-fold proc seed . ras)
    48   (import (only (chicken base) sub1 add1 cut))
    4950  (let rafo ((rdims (array-dimensions (car ras))) (inds '()))
    5051    (if (null? (cdr rdims))
     
    5253        (sdni (reverse (cons #f inds)))
    5354        (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))))
    5657          (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))) ) )
    5859      (let (
    5960        (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)))
    6263            ((> i ll))
    6364          (rafo crdims (cons i inds)) ) ) ) )
Note: See TracChangeset for help on using the changeset viewer.