Changeset 14056 in project


Ignore:
Timestamp:
04/03/09 07:02:21 (11 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/4/srfi-41/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-41/trunk/streams-derived.scm

    r14054 r14056  
    121121
    122122(define-syntax stream-match-pattern
    123   (syntax-rules ()
     123  (syntax-rules (_)
    124124    ((stream-match-pattern STRM () (BINDING ...) BODY)
    125125     (and (stream-null? STRM) (let (BINDING ...) BODY)))
     
    168168
    169169(define-syntax stream-of
    170   (syntax-rules ()
     170  (syntax-rules (is in)
    171171    ((stream-of "aux" EXPR BASE)
    172172     (stream-cons EXPR BASE))
  • release/4/srfi-41/trunk/streams-math.scm

    r14052 r14056  
    1 ;;;; srfi-41-math.scm
    2 ;;;; Kon Lovett, Feb '08
    3 
    4 (use srfi-41 srfi-41-utils)
    5 
    6 (eval-when (compile)
    7   (declare
    8     (not usual-integrations
    9       +
    10       max min )
    11     (inline)
    12     (no-bound-checks)
    13     (no-procedure-checks)
    14     (export
    15       stream-sum
    16       stream-max
    17       stream-min
    18       odd-numbers-stream
    19       even-numbers-stream
    20       natural-numbers-stream
    21       prime-numbers-stream
    22       hamming-sequence-stream ) ) )
     1;;;; streams-math.scm
     2;;;; Kon Lovett, Apr '09
    233
    244; Copyright (C) 2007 by Philip L. Bewig of Saint Louis, Missouri, USA.  All rights
     
    3616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    3717
     18(declare
     19  (not usual-integrations < + * max min)
     20  (inline)
     21  (local)
     22  (no-procedure-checks) )
     23
     24(module streams-math (;export
     25  stream-sum
     26  stream-max
     27  stream-min
     28  odd-numbers-stream
     29  even-numbers-stream
     30  natural-numbers-stream
     31  prime-numbers-stream
     32  hamming-sequence-stream)
     33
     34(import scheme chicken data-structures streams streams-utils)
     35(require-library streams streams-utils)
     36
    3837(define stream-sum (left-section stream-fold + 0))
    3938
    40 (define (stream-max strm)
    41   (stream-fold-one max strm))
     39(define (stream-max strm) (stream-fold-one max strm))
    4240
    43 (define (stream-min strm)
    44   (stream-fold-one min strm))
     41(define (stream-min strm) (stream-fold-one min strm))
    4542
    4643(define odd-numbers-stream (stream-from 1 2))
     
    7774        (stream-map (left-section * 3) hamming-sequence-stream)
    7875        (stream-map (left-section * 5) hamming-sequence-stream)))))
     76
     77) ;module streams-math
  • release/4/srfi-41/trunk/streams-utils.scm

    r14052 r14056  
    1 ;;;; srfi-41-utils.scm
    2 ;;;; Kon Lovett, Feb '08
    3 
    4 (use srfi-41)
    5 
    6 (eval-when (compile)
    7   (declare
    8     (usual-integrations)
    9     (inline)
    10     (fixnum)
    11     (no-bound-checks)
    12     (no-procedure-checks)
    13     (export
    14       stream-intersperse
    15       stream-permutations
    16       file->stream
    17       stream-split
    18       stream-unique
    19       stream-fold-one
    20       stream-member
    21       stream-merge
    22       stream-partition
    23       stream-finds
    24       stream-find
    25       stream-remove
    26       stream-every
    27       stream-any
    28       stream-and
    29       stream-or
    30       stream-fold-right
    31       stream-fold-right-one
    32       stream-assoc
    33       stream-equal?
    34       stream-quick-sort
    35       stream-insertion-sort
    36       stream-merge-sort
    37       stream-maximum
    38       stream-minimum ) ) )
     1;;;; streams-utils.scm
     2;;;; Kon Lovett, Apr '09
    393
    404; Copyright (C) 2007 by Philip L. Bewig of Saint Louis, Missouri, USA.  All rights
     
    5216; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    5317
     18(declare
     19  (usual-integrations)
     20  (fixnum)
     21  (inline)
     22  (local)
     23  (no-procedure-checks) ) 
     24
     25(module streams-utils (;export
     26  stream-intersperse
     27  stream-permutations
     28  file->stream
     29  stream-split
     30  stream-unique
     31  stream-fold-one
     32  stream-member
     33  stream-merge
     34  stream-partition
     35  stream-finds
     36  stream-find
     37  stream-remove
     38  stream-every
     39  stream-any
     40  stream-and
     41  stream-or
     42  stream-fold-right
     43  stream-fold-right-one
     44  stream-assoc
     45  stream-equal?
     46  stream-quick-sort
     47  stream-insertion-sort
     48  stream-merge-sort
     49  stream-maximum
     50  stream-minimum)
     51
     52(import scheme chicken data-structures streams)
     53(require-library streams)
     54
    5455(define-stream (stream-intersperse yy x)
    5556  (stream-match yy
     
    6364
    6465(define-stream (stream-permutations xs)
    65   (if (stream-null? xs)
    66       (stream (stream))
     66  (if (stream-null? xs) (stream (stream))
    6767      (stream-concat
    6868        (stream-map (right-section stream-intersperse (stream-car xs))
     
    7272  (let ((port (open-input-file filename)))
    7373    (stream-let loop ((obj (reader port)))
    74       (if (eof-object? obj)
    75           (begin (close-input-port port) stream-null)
     74      (if (eof-object? obj) (begin (close-input-port port) stream-null)
    7675          (stream-cons obj (loop (reader port)))))))
    7776
    78 (define (stream-split n strm)
    79   (values (stream-take n strm) (stream-drop n strm)))
     77(define (stream-split n strm) (values (stream-take n strm) (stream-drop n strm)))
    8078
    8179(define-stream (stream-unique eql? strm)
    82   (if (stream-null? strm)
    83       stream-null
     80  (if (stream-null? strm) stream-null
    8481      (stream-cons
    8582        (stream-car strm)
     
    105102          (() xx)
    106103          ((y . ys)
    107             (if (lt? y x)
    108                 (stream-cons y (merge xx ys))
     104            (if (lt? y x) (stream-cons y (merge xx ys))
    109105                (stream-cons x (merge xs yy))))))))
    110106  (stream-let loop ((strms strms))
     
    117113  (stream-unfolds
    118114    (lambda (s)
    119       (if (stream-null? s)
    120           (values s '() '())
     115      (if (stream-null? s) (values s '() '())
    121116          (let ((a (stream-car s))
    122117                (d (stream-cdr s)))
    123             (if (pred? a)
    124                 (values d (list a) #f)
     118            (if (pred? a) (values d (list a) #f)
    125119                (values d #f (list a))))))
    126120    strm))
     
    167161(define (stream-fold-right func base strm)
    168162  (let loop ((base base) (strm strm))
    169     (if (stream-null? strm)
    170         base
     163    (if (stream-null? strm) base
    171164        (func (stream-car strm) (loop base (stream-cdr strm))))))
    172165
     
    192185
    193186(define-stream (stream-quick-sort lt? strm)
    194   (let loop ([strm strm])
    195     (if (stream-null? strm)
    196         stream-null
     187  (let loop ((strm strm))
     188    (if (stream-null? strm) stream-null
    197189        (let ((x (stream-car strm))
    198190              (xs (stream-cdr strm)))
     
    208200        (stream x))
    209201      ((y . ys)
    210         (if (lt? y x)
    211             (stream-cons y (insert ys x))
     202        (if (lt? y x) (stream-cons y (insert ys x))
    212203            (stream-cons x strm)))))
    213204  (stream-fold insert stream-null strm))
    214205
    215206(define-stream (stream-merge-sort lt? strm)
    216   (let loop ([strm strm])
     207  (let loop ((strm strm))
    217208    (let ((n (quotient (stream-length strm) 2)))
    218       (if (zero? n)
    219           strm
     209      (if (zero? n) strm
    220210          (stream-merge lt? (loop (stream-take n strm)) (loop (stream-drop n strm)))))))
    221211
     
    225215(define (stream-minimum lt? strm)
    226216  (stream-fold-one (lambda (x y) (if (lt? x y) x y)) strm))
     217
     218) ;module streams-utils
Note: See TracChangeset for help on using the changeset viewer.