Changeset 37133 in project


Ignore:
Timestamp:
01/27/19 01:14:04 (7 months ago)
Author:
Ivan Raikov
Message:

yasos collections: added lseq-map and lseq->list

Location:
release/5/yasos
Files:
1 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/5/yasos/tags/1.11/collections.scm

    r37129 r37133  
    77   reduce-items* sort! sort make-vector-generator list->generator
    88   vector->generator string->generator hash-table->generator g-map
    9    g-reduce g-find g-filter g-zip generator->lseq lseq-first lseq-rest )
     9   g-reduce g-find g-filter g-zip
     10   generator->lseq lseq-first lseq-rest lseq-map lseq-map-generator
     11   lseq->list)
    1012 
    1113 (import scheme (chicken base) (chicken format) srfi-69
     
    612614        (cdr lseq)))
    613615
     616  ;; Helper returns #t if any element of list is null or #f if none
     617  (define (any-null? list)
     618    (cond
     619     ((null? list) #f)
     620     ((null? (car list)) #t)
     621     (else (any-null? (cdr list)))))
     622
     623  ;; Safe version of lseq-rest that returns () if the argument is ()
     624  (define (safe-lseq-rest obj)
     625    (if (null? obj)
     626        obj
     627        (lseq-rest obj)))
     628
     629  (define (lseq-map proc . lseqs)
     630    (generator->lseq
     631     (apply lseq-map-generator (cons proc lseqs))))
     632
     633  (define (lseq-map-generator proc . lseqs)
     634    (let ((lseqsp (make-parameter lseqs)))
     635      (lambda ()
     636        (let ((lseqsv (lseqsp)))
     637          (if (any-null? lseqsv)
     638              (eof-object)
     639              (let ((result (apply proc (map lseq-first lseqsv))))
     640                (lseqsp (map safe-lseq-rest lseqsv))
     641                result))))
     642      ))
     643 
     644  (define (lseq->list lseq)
     645    (let recur ((lseq lseq) (ax '()))
     646      (if (null? lseq)
     647          (reverse ax)
     648          (recur (lseq-rest lseq) (cons (lseq-first lseq) ax)))
     649      ))
     650
     651
    614652 )
  • release/5/yasos/trunk/collections.scm

    r37129 r37133  
    77   reduce-items* sort! sort make-vector-generator list->generator
    88   vector->generator string->generator hash-table->generator g-map
    9    g-reduce g-find g-filter g-zip generator->lseq lseq-first lseq-rest )
     9   g-reduce g-find g-filter g-zip
     10   generator->lseq lseq-first lseq-rest lseq-map lseq-map-generator
     11   lseq->list)
    1012 
    1113 (import scheme (chicken base) (chicken format) srfi-69
     
    612614        (cdr lseq)))
    613615
     616  ;; Helper returns #t if any element of list is null or #f if none
     617  (define (any-null? list)
     618    (cond
     619     ((null? list) #f)
     620     ((null? (car list)) #t)
     621     (else (any-null? (cdr list)))))
     622
     623  ;; Safe version of lseq-rest that returns () if the argument is ()
     624  (define (safe-lseq-rest obj)
     625    (if (null? obj)
     626        obj
     627        (lseq-rest obj)))
     628
     629  (define (lseq-map proc . lseqs)
     630    (generator->lseq
     631     (apply lseq-map-generator (cons proc lseqs))))
     632
     633  (define (lseq-map-generator proc . lseqs)
     634    (let ((lseqsp (make-parameter lseqs)))
     635      (lambda ()
     636        (let ((lseqsv (lseqsp)))
     637          (if (any-null? lseqsv)
     638              (eof-object)
     639              (let ((result (apply proc (map lseq-first lseqsv))))
     640                (lseqsp (map safe-lseq-rest lseqsv))
     641                result))))
     642      ))
     643 
     644  (define (lseq->list lseq)
     645    (let recur ((lseq lseq) (ax '()))
     646      (if (null? lseq)
     647          (reverse ax)
     648          (recur (lseq-rest lseq) (cons (lseq-first lseq) ax)))
     649      ))
     650
     651
    614652 )
Note: See TracChangeset for help on using the changeset viewer.