Changeset 37736 in project


Ignore:
Timestamp:
06/24/19 15:26:08 (4 months ago)
Author:
Ivan Raikov
Message:

yasos: removed lseq procedures "borrowed" from srfi-127 and added srfi-127 dependency

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

Legend:

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

    r37214 r37736  
    88   vector->generator string->generator hash-table->generator
    99   generator->list g-map g-reduce g-find g-filter g-zip
    10    generator->lseq lseq-first lseq-rest lseq-map lseq-map-generator
    11    lseq-filter lseq->list)
     10   lseq->list)
    1211 
    13  (import scheme (chicken base) (chicken format) srfi-69
     12 (import scheme (chicken base) (chicken format) srfi-69 srfi-127
    1413         (except yasos object object-with-ancestors))
    1514
     
    586585      ))
    587586
    588 ;;;; SRFI 127 lazy sequences
    589 ;;; Convert a generator (procedure with no arguments) to an lseq
    590 ;;; This is the basic constructor for lseqs, since every proper list
    591 ;;; is already an lseq and so list->lseq is not needed
    592 
    593   (define (generator->lseq gen)
    594     (let ((value (gen)))
    595       ;; See what starts off the generator:
    596       ;; if it's already exhausted, the lseq is empty,
    597       ;; otherwise, return an improper list with one value and the generator
    598       ;; in the tail, which is how we represent unrealized lseqs
    599       (if (eof-object? value)
    600           '()
    601           (cons value gen))))
    602 
    603 
    604   (define (lseq-first lseq) (car lseq))
    605 
    606 ;;; Lseq-cdr expands the generator if it's there, or falls back to regular cdr
    607   (define (lseq-rest lseq)
    608     ;; We assume lseq is a pair, because it is an error if it isn't
    609     ;; If it's a procedure, we assume it's a generator and invoke it
    610     (if (procedure? (cdr lseq))
    611         (let ((obj ((cdr lseq))))
    612           (cond
    613            ;; If the generator is exhausted, replace with () and return ()
    614            ((eof-object? obj)
    615             (set-cdr! lseq '())
    616             '())
    617            ;; Otherwise, make a new pair of the value and the generator
    618            ;; and patch it in to the cdr
    619            (else (let ((result (cons obj (cdr lseq))))
    620                    (set-cdr! lseq result)
    621                    result))))
    622         ;; If there is no procedure, return the ordinary cdr
    623         (cdr lseq)))
    624 
    625   ;; Helper returns #t if any element of list is null or #f if none
    626   (define (any-null? list)
    627     (cond
    628      ((null? list) #f)
    629      ((null? (car list)) #t)
    630      (else (any-null? (cdr list)))))
    631 
    632   ;; Safe version of lseq-rest that returns () if the argument is ()
    633   (define (safe-lseq-rest obj)
    634     (if (null? obj)
    635         obj
    636         (lseq-rest obj)))
    637 
    638   (define (lseq-map proc . lseqs)
    639     (generator->lseq
    640      (apply lseq-map-generator (cons proc lseqs))))
    641 
    642   (define (lseq-map-generator proc . lseqs)
    643     (let ((lseqsp (make-parameter lseqs)))
    644       (lambda ()
    645         (let ((lseqsv (lseqsp)))
    646           (if (any-null? lseqsv)
    647               (eof-object)
    648               (let ((result (apply proc (map lseq-first lseqsv))))
    649                 (lseqsp (map safe-lseq-rest lseqsv))
    650                 result))))
    651       ))
    652 
    653   ;; Filter an lseq lazily to include only elements that satisfy pred
    654   (define (lseq-filter pred lseq)
    655     (let ((lseqp (make-parameter lseq)))
    656       (generator->lseq
    657        (lambda ()
    658          (let loop ((lseq1 (lseqp)))
    659            (if (null? lseq1)
    660                (eof-object)
    661                (let ((result (lseq-first lseq1)))
    662                  (cond
    663                   ((pred result)
    664                    (lseqp (lseq-rest lseq1))
    665                    result)
    666                   (else
    667                    (loop (lseq-rest lseq1)))))))))))
    668  
     587
    669588  (define (lseq->list lseq)
    670589    (let recur ((lseq lseq) (ax '()))
  • release/5/yasos/trunk/tests/run.scm

    r36586 r37736  
    22(import scheme (chicken base) (chicken format) (chicken port)
    33        yasos (prefix yasos-stacks stack.) (prefix yasos-queues queue.)
    4         yasos-points yasos-collections test)
     4        yasos-points yasos-collections srfi-127 test)
    55
    66 ;;;-----------------------
  • release/5/yasos/trunk/yasos.egg

    r36370 r37736  
    55 (category oop)
    66 (author "Kenneth Dickey")
    7  (dependencies srfi-69)
     7 (dependencies srfi-69 srfi-127)
    88 (test-dependencies test)
    99 (components (extension yasos)
Note: See TracChangeset for help on using the changeset viewer.