Changeset 36387 in project


Ignore:
Timestamp:
08/25/18 02:56:06 (4 weeks ago)
Author:
iraikov
Message:

yasos: a separate reduce-items operation in collections

Location:
release/5/yasos/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/yasos/trunk/collections.scm

    r36370 r36387  
    66              map-elts map-keys map-items
    77              for-each-key for-each-elt elt-ref elt-set! elt-take elt-drop
    8               reduce reduce* any-elt? every-elt? zip-elts sort! sort
     8              reduce reduce* reduce-items reduce-items* any-elt? every-elt? zip-elts sort! sort
    99              make-vec-gen-elts list-gen-elts vector-gen-elts
    1010              string-gen-elts hash-table-gen-elts
     
    292292 (define (reduce <proc> <seed> . <collections>)
    293293   (let ( (max+1 (size (car <collections>)))
     294          (elt-generators (map gen-elts <collections>))
     295          (ax (make-parameter <seed>))
     296          )
     297     (let loop ( (count 0) )
     298       (cond
     299        ((< count max+1)
     300         (ax (apply <proc> (ax) (map (lambda (g) (g)) elt-generators)))
     301         (loop (add1 count))
     302         )
     303        (else (ax))
     304        ) )
     305     )  )
     306 
     307
     308 (define (reduce-items <proc> <seed> . <collections>)
     309   (let ( (max+1 (size (car <collections>)))
    294310          (key-generators (map gen-keys <collections>))
    295311          (elt-generators (map gen-elts <collections>))
     
    310326
    311327 (define (reduce* <proc> . <collections>)
     328   (let* ( (max+1 (size (car <collections>)))
     329           (elt-generators (map gen-elts <collections>))
     330           (ax (make-parameter (map (lambda (g) (g)) elt-generators)))
     331           )
     332     (let loop ( (count 0) )
     333       (cond
     334        ((< count max+1)
     335         (ax (apply <proc> (ax) (map (lambda (g) (g)) elt-generators)))
     336         (loop (add1 count))
     337         )
     338        (else (ax))
     339        ) )
     340     )  )
     341
     342 (define (reduce-items* <proc> . <collections>)
    312343   (let* ( (max+1 (size (car <collections>)))
    313344           (key-generators (map gen-keys <collections>))
     
    540571          (b (make-vector n)))
    541572     (do-items (lambda (item) (vector-set! a (car item) (cadr item))) x)
    542       (let recur ((m 1))
    543         (if (< m n)
    544             (let inner-recur ((p 0))
    545               (if (< p (- n m))
    546                   (let ((q (+ p m))
    547                         (r (min (+ p (* 2 m)) n)))
    548                     (vector-merge! elt< a p q r b p)
    549                     (vector-blit! b p r a p)
    550                     (inner-recur (+ p (* 2 m)))
    551                     )
    552                   (recur (* m 2))))
    553             b))
    554       ))
     573     (let recur ((m 1))
     574       (if (< m n)
     575           (let inner-recur ((p 0))
     576             (if (< p (- n m))
     577                 (let ((q (+ p m))
     578                       (r (min (+ p (* 2 m)) n)))
     579                   (vector-merge! elt< a p q r b p)
     580                   (vector-blit! b p r a p)
     581                   (inner-recur (+ p (* 2 m)))
     582                   )
     583                 (recur (* m 2))))
     584           b))
     585     ))
    555586           
    556587
  • release/5/yasos/trunk/tests/run.scm

    r36370 r36387  
    331331    (test "map-keys" #(b a) (map-keys identity t))
    332332    (test "map-elts" #(2 1) (map-elts identity t))
    333     (test "reduce" 3 (reduce (lambda (ax item)
    334                                (+ (cadr item) ax)) 0 t))
     333    (test "reduce" 3 (reduce + 0 t))
     334    (test "reduce-items" 3 (reduce-items (lambda (ax item)
     335                                           (+ (cadr item) ax)) 0 t))
    335336    (test "sort!" #(1 2 3 4 5) (sort! (lambda (i vi j vj) (< vi vj))
    336337                                      #( 5 2 4 3 1)))
Note: See TracChangeset for help on using the changeset viewer.