Added dir-streams
This commit is contained in:
Martin Gasbichler
parent
08b7071076
commit
651b737ef7
|
|
@ -0,0 +1,68 @@
|
|||
;;; predicates for directory streams
|
||||
|
||||
;;; This file is part of the Scheme Untergrund Library.
|
||||
|
||||
;;; Copyright (c) 2002-2003 by Martin Gasbichler.
|
||||
;;; Copyright (c) 2002 by Eric Knauel.
|
||||
;;; Copyright (c) 2002 by Matthias Neubauer.
|
||||
;;; For copyright information, see the file COPYING which comes with
|
||||
;;; the distribution.
|
||||
|
||||
(define (dir-stream-display ds)
|
||||
(dir-stream-for-each ds display display))
|
||||
|
||||
(define (fs-object-size-less-then? fs-object size)
|
||||
(< (file-info:size (fs-object-info fs-object)) size))
|
||||
|
||||
(define (fs-object-size-greater-then? fs-object size)
|
||||
(> (file-info:size (fs-object-info fs-object)) size))
|
||||
|
||||
(define (minutes->seconds minutes)
|
||||
(* 60 minutes))
|
||||
|
||||
(define (hours->seconds hours)
|
||||
(* hours (minutes->seconds 60)))
|
||||
|
||||
(define (days->seconds days)
|
||||
(* days (hours->seconds 24)))
|
||||
|
||||
(define (in-time-interval? point left right)
|
||||
(and (>= point left) (<= point right)))
|
||||
|
||||
;;; functions to get atime, ctime, mtime from a fs-object
|
||||
(define (fs-object-atime fs-object)
|
||||
(file-info:atime (fs-object-info fs-object)))
|
||||
|
||||
(define (fs-object-ctime fs-object)
|
||||
(file-info:ctime (fs-object-info fs-object)))
|
||||
|
||||
(define (fs-object-mtime fs-object)
|
||||
(file-info:mtime (fs-object-info fs-object)))
|
||||
|
||||
(define (fs-object-last-modified-in? fs-object pair)
|
||||
(in-time-interval? (fs-object-mtime fs-object) (car pair) (cdr pair)))
|
||||
|
||||
(define (fs-object-last-accessed-in? fs-object pair)
|
||||
(in-time-interval? (fs-object-atime fs-object) (car pair) (cdr pair)))
|
||||
|
||||
(define (fs-object-created-in? fs-object pair)
|
||||
(in-time-interval? (fs-object-ctime fs-object) (car pair) (cdr pair)))
|
||||
|
||||
(define (fs-object-name-matches? fso regexp)
|
||||
(regexp-search? regexp (fs-object-name fso)))
|
||||
|
||||
(define (ds-object-filename-matches? fso regexp)
|
||||
(regexp-search? regexp (fs-object-filename fso)))
|
||||
|
||||
;;; test stuff
|
||||
|
||||
;(dir-stream-display
|
||||
; (dir-stream-filter (dir-stream-from-dirname "/Users/eric/tmp")
|
||||
; (lambda (fs-object)
|
||||
; (display (fs-object-mtime fs-object))
|
||||
; (newline)
|
||||
; (let ((one-week (days->seconds 7)))
|
||||
; (fs-object-created-in? fs-object
|
||||
; (cons (- (time) one-week)
|
||||
; (time)))))
|
||||
; (lambda (fs-object) #t)))
|
||||
|
|
@ -0,0 +1,193 @@
|
|||
;;; directories represented as streams
|
||||
|
||||
;;; This file is part of the Scheme Untergrund Library.
|
||||
|
||||
;;; Copyright (c) 2002-2003 by Martin Gasbichler.
|
||||
;;; Copyright (c) 2002 by Eric Knauel
|
||||
;;; Copyright (c) 2002 by Matthias Neubauer
|
||||
;;; For copyright information, see the file COPYING which comes with
|
||||
;;; the distribution.
|
||||
|
||||
;; dir-stream ===
|
||||
;; (make-dir-stream file-info (stream of file-info) (stream of dir-stream)
|
||||
|
||||
(define-record-type dir-stream :dir-stream
|
||||
(make-dir-stream dir-info files-stream subdir-stream)
|
||||
dir-stream?
|
||||
(dir-info dir-stream-info)
|
||||
(files-stream dir-stream-files-stream)
|
||||
(subdir-stream dir-stream-subdir-stream))
|
||||
|
||||
(define-record-type fs-object :fs-object
|
||||
(really-make-fs-object parent name info)
|
||||
fs-object?
|
||||
(parent fs-object-parent)
|
||||
(name fs-object-name)
|
||||
(info fs-object-info))
|
||||
|
||||
(define-record-discloser :fs-object
|
||||
(lambda (r)
|
||||
`(fs-object ,(fs-object-name r) ,(fs-object-parent r))))
|
||||
|
||||
(define (make-fs-object parent name chase?)
|
||||
(really-make-fs-object
|
||||
parent
|
||||
name
|
||||
(file-info (combine-path parent name) chase?)))
|
||||
|
||||
(define (combine-path parent name)
|
||||
(if (string=? parent "")
|
||||
name
|
||||
(string-append parent
|
||||
"/"
|
||||
name)))
|
||||
|
||||
(define (fs-object-filename fs-object)
|
||||
(combine-path (fs-object-parent fs-object)
|
||||
(fs-object-name fs-object)))
|
||||
|
||||
|
||||
(define (dir-stream-from-dirname dirname . args)
|
||||
;; skip file in case of an error during file-info
|
||||
(define (next-info ds parent dirname chase?)
|
||||
(let ((file (read-directory-stream ds)))
|
||||
(if file
|
||||
(call-with-current-continuation
|
||||
(lambda (k)
|
||||
(with-handler
|
||||
(lambda (cond more)
|
||||
(k (next-info ds parent dirname chase?)))
|
||||
(lambda ()
|
||||
(cons (make-fs-object (combine-path parent dirname)
|
||||
file
|
||||
chase?)
|
||||
ds)))))
|
||||
(begin (close-directory-stream ds) #f))))
|
||||
(let-optionals args ((chase? #t) (parent ""))
|
||||
(let ((info-stream (stream-unfold
|
||||
(lambda (ds)
|
||||
(next-info ds parent dirname chase?))
|
||||
(call-with-current-continuation
|
||||
(lambda (k)
|
||||
(with-handler
|
||||
(lambda (cond more)
|
||||
(make-empty-stream))
|
||||
(lambda ()
|
||||
(open-directory-stream (combine-path parent dirname)))))))))
|
||||
(make-dir-stream
|
||||
(make-fs-object parent dirname chase?)
|
||||
(stream-filter-map
|
||||
(lambda (fso) (and (not (file-info-dir? (fs-object-info fso)))
|
||||
fso))
|
||||
info-stream)
|
||||
(stream-filter-map
|
||||
(lambda (fso)
|
||||
(and (file-info-dir? (fs-object-info fso))
|
||||
(dir-stream-from-dirname
|
||||
(fs-object-name fso) chase? (fs-object-parent fso))))
|
||||
info-stream)))))
|
||||
|
||||
(define (dir-stream-filter ds file-pred dir-pred)
|
||||
(make-dir-stream (dir-stream-info ds)
|
||||
(stream-filter file-pred
|
||||
(dir-stream-files-stream ds))
|
||||
(stream-filter-map
|
||||
(lambda (subdir)
|
||||
(and (dir-pred (dir-stream-info subdir))
|
||||
(dir-stream-filter subdir file-pred dir-pred)))
|
||||
(dir-stream-subdir-stream ds))))
|
||||
|
||||
;; dir-stream a b = make-dir-tream a (stream of b) (stream of (dir-stream a b))
|
||||
;; dir-stream-fold-right: dir-stream a b -> (a -> c -> d -> e) ->
|
||||
;; (b -> c -> c) -> c ->
|
||||
;; (e -> d -> d) -> d -> e
|
||||
;; Krass Sach!!!
|
||||
|
||||
(define (dir-stream-fold-right ds make-dir-stream
|
||||
files-make-stream files-stream-empty
|
||||
subdirs-make-stream subdirs-empty)
|
||||
(make-dir-stream
|
||||
(dir-stream-info ds)
|
||||
(stream-fold-right files-make-stream files-stream-empty (dir-stream-files-stream ds))
|
||||
(stream-fold-right (lambda (subdir accu)
|
||||
(subdirs-make-stream
|
||||
(dir-stream-fold-right subdir make-dir-stream files-make-stream
|
||||
files-stream-empty subdirs-make-stream subdirs-empty)
|
||||
accu))
|
||||
subdirs-empty
|
||||
(dir-stream-subdir-stream ds))))
|
||||
|
||||
; Example:
|
||||
; (define (disc-usage ds)
|
||||
; (dir-stream-fold-right ds (lambda (fso sum subdirs) (list (fs-object-filename fso)
|
||||
; (apply + sum (map cadr subdirs))
|
||||
; subdirs))
|
||||
; (lambda (fso accu)
|
||||
; (+ accu (file-info:size (fs-object-info fso))))
|
||||
; 0
|
||||
; cons
|
||||
; '()))
|
||||
|
||||
(define (apply-to-dir-stream stream-f)
|
||||
(define (f ds file-f dir-f)
|
||||
(make-dir-stream
|
||||
(dir-f (dir-stream-info ds))
|
||||
(stream-f file-f (dir-stream-files-stream ds))
|
||||
(stream-f (lambda (sub-ds)
|
||||
(f sub-ds file-f dir-f))
|
||||
(dir-stream-subdir-stream ds))))
|
||||
f)
|
||||
|
||||
(define dir-stream-map (apply-to-dir-stream stream-map))
|
||||
(define dir-stream-filter-map (apply-to-dir-stream stream-filter-map))
|
||||
|
||||
(define (dir-stream-for-each ds file-f dir-f)
|
||||
(dir-f (dir-stream-info ds))
|
||||
(stream-for-each file-f (dir-stream-files-stream ds))
|
||||
(stream-for-each
|
||||
(lambda (sub-ds)
|
||||
(dir-stream-for-each sub-ds file-f dir-f))
|
||||
(dir-stream-subdir-stream ds)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (file-info-dir? fi)
|
||||
(eq? (file-info:type fi) 'directory))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;;(filter x file? dir?) -> x
|
||||
|
||||
;(define (filter p l)
|
||||
; (fold-right (lambda (e a)
|
||||
; (if (p e)
|
||||
; (cons e a)
|
||||
; a))
|
||||
; '()
|
||||
; l))
|
||||
;(define-structure dir :dir
|
||||
; (make-dir info files))
|
||||
|
||||
;; dir = (make-dir dir-info (stream of (union file-info dir)))
|
||||
|
||||
;(define (dir-filter dir file-pred dir-pred) ; dir -> p1 -> p2 -> dir
|
||||
; (make-dir
|
||||
; (dir-info dir)
|
||||
; (let lp ((stream (dir-files dir))) ; stream -> steam
|
||||
; (if (stream-empty? stream)
|
||||
; (make-empty-stream)
|
||||
; (let ((head (stream-head dir)))
|
||||
; (cond ((file? head)
|
||||
; (if (file-pred head)
|
||||
; (make-stream
|
||||
; (lambda () head)
|
||||
; (lambda () (lp (stream-tail stream))))
|
||||
; (lp (stream-tail stream))))
|
||||
; (else (if (dir-pred (dir-info head))
|
||||
; (make-steam
|
||||
; (lambda () (dir-filter head file-pred dir-pred))
|
||||
; (lambda () (lp (steam-tail stream))))
|
||||
; (lp (stream-tail stream))))))))))
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
(define-interface dir-streams-interface
|
||||
(export dir-stream-from-dirname
|
||||
dir-stream-for-each
|
||||
dir-stream-map
|
||||
dir-stream-filter
|
||||
dir-stream-filter-map
|
||||
fs-object-parent
|
||||
fs-object-name
|
||||
fs-object-info
|
||||
fs-object-filename))
|
||||
|
||||
(define-interface dir-stream-predicates-interfaces
|
||||
(export fs-object-size-less-then?
|
||||
fs-object-size-greater-then?
|
||||
days->seconds
|
||||
hours->seconds
|
||||
minutes->seconds
|
||||
fs-object-last-modified-in?
|
||||
fs-object-last-accessed-in?
|
||||
fs-object-created-in?
|
||||
fs-object-name-matches?
|
||||
ds-object-filename-matches?))
|
||||
|
||||
(define-interface streams-interface
|
||||
(export the-empty-stream
|
||||
make-empty-stream
|
||||
make-stream
|
||||
make-stream-lazily
|
||||
(stream :syntax)
|
||||
stream-empty?
|
||||
stream-head
|
||||
stream-tail
|
||||
stream-map
|
||||
stream-zip-with
|
||||
stream-for-each
|
||||
stream-filter
|
||||
stream-filter-map
|
||||
stream-unfold
|
||||
stream-transform
|
||||
stream-take
|
||||
stream-drop
|
||||
stream-fold-right
|
||||
stream-fold-right-lazily
|
||||
stream-prepend
|
||||
list->stream
|
||||
stream-from
|
||||
stream-from-to
|
||||
stream-from-then
|
||||
stream-from-then-to
|
||||
stream-ref
|
||||
stream-iterate
|
||||
stream-cycle
|
||||
stream-take-while
|
||||
stream-drop-while))
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
(define-structure dir-streams dir-streams-interface
|
||||
(open scheme-with-scsh
|
||||
handle
|
||||
conditions
|
||||
define-record-types
|
||||
let-opt
|
||||
records
|
||||
streams)
|
||||
(files dir-stream))
|
||||
|
||||
(define-structure dir-stream-predicates dir-stream-predicates-interfaces
|
||||
(open
|
||||
scheme-with-scsh
|
||||
dir-streams)
|
||||
(files dir-stream-predicates))
|
||||
|
||||
(define-structure streams
|
||||
streams-interface
|
||||
(open scheme
|
||||
signals)
|
||||
(files stream))
|
||||
|
|
@ -0,0 +1,308 @@
|
|||
;;; stream library
|
||||
|
||||
;;; This file is part of the Scheme Untergrund Library.
|
||||
|
||||
;;; Copyright (c) 2002-2003 by Martin Gasbichler.
|
||||
;;; Copyright (c) 2002 by Eric Knauel
|
||||
;;; Copyright (c) 2002 by Matthias Neubauer
|
||||
;;; For copyright information, see the file COPYING which comes with
|
||||
;;; the distribution.
|
||||
|
||||
;;;; constructors
|
||||
|
||||
(define the-empty-stream
|
||||
(delay '()))
|
||||
|
||||
;; -> stream
|
||||
(define (make-empty-stream)
|
||||
the-empty-stream)
|
||||
|
||||
;; a stream(a) -> stream(a)
|
||||
(define (make-stream head tail-stream)
|
||||
(delay
|
||||
(cons head
|
||||
tail-stream)))
|
||||
|
||||
;; (() -> a) stream(a) -> stream(a)
|
||||
(define (make-stream-lazily head-thunk tail-stream)
|
||||
(delay
|
||||
(cons (head-thunk)
|
||||
tail-stream)))
|
||||
|
||||
(define-syntax stream
|
||||
(syntax-rules ()
|
||||
((stream ?h ?t) (make-stream-lazily (lambda () ?h) ?t))))
|
||||
|
||||
;;;; predicates
|
||||
|
||||
;; stream -> bool
|
||||
(define (stream-empty? s)
|
||||
(null? (force s)))
|
||||
|
||||
;;;; destructors
|
||||
|
||||
;; stream -> a
|
||||
(define (stream-head stream)
|
||||
(car (force stream)))
|
||||
|
||||
;; stream -> stream
|
||||
(define (stream-tail stream)
|
||||
(cdr (force stream)))
|
||||
|
||||
;;;; the usual suspects
|
||||
|
||||
;; CHANGED
|
||||
;; (a -> b) stream(a) -> stream(b)
|
||||
(define (stream-map proc stream)
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(cond
|
||||
((null? stream_) stream_)
|
||||
(else
|
||||
(cons (proc (car stream_))
|
||||
(stream-map proc (cdr stream_))))))))
|
||||
|
||||
;; NEW
|
||||
;; (a -> b) . list(stream(a)) -> stream(b)
|
||||
(define (stream-zip-with proc . streams)
|
||||
(delay
|
||||
(let* ((streams_ (map force streams))
|
||||
(finished?
|
||||
(or (null? streams_)
|
||||
(let loop ((streams_ streams_))
|
||||
(and (not (null? streams_))
|
||||
(or (null? (car streams_))
|
||||
(loop (cdr streams_))))))))
|
||||
(if finished?
|
||||
'()
|
||||
(cons (apply proc (map car streams_))
|
||||
(apply stream-zip-with proc (map cdr streams_)))))))
|
||||
|
||||
;; CHANGED
|
||||
;; (a ->* ) -> stream(a) ->*
|
||||
(define (stream-for-each proc stream)
|
||||
(if (not (stream-empty? stream))
|
||||
(begin
|
||||
(proc (stream-head stream))
|
||||
(stream-for-each proc (stream-tail stream)))))
|
||||
|
||||
;; stream-filter : (a -> bool) stream(a) -> stream(a)
|
||||
(define (stream-filter pred? stream)
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(cond
|
||||
((null? stream_) stream_)
|
||||
(else
|
||||
(let ((head (car stream_)))
|
||||
(if (pred? head)
|
||||
(cons head
|
||||
(stream-filter pred? (cdr stream_)))
|
||||
(force (stream-filter pred? (cdr stream_))))))))))
|
||||
|
||||
;; stream-filter-map : (a -> (union b #f)) -> stream(a) -> stream(b)
|
||||
(define (stream-filter-map proc stream)
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(cond
|
||||
((null? stream_) stream_)
|
||||
(else
|
||||
(let ((head (proc (car stream_))))
|
||||
(if head
|
||||
(cons head
|
||||
(stream-filter-map proc (cdr stream_)))
|
||||
(force (stream-filter-map proc (cdr stream_))))))))))
|
||||
|
||||
;; CHANGED
|
||||
;; stream-unfold : (b -> (union (cons a b) #f)) b -> stream(a)
|
||||
(define (stream-unfold gen-fun start)
|
||||
(delay
|
||||
(let ((res (gen-fun start)))
|
||||
(if res
|
||||
(cons (car res)
|
||||
(stream-unfold gen-fun (cdr res)))
|
||||
'()))))
|
||||
|
||||
;; NEW
|
||||
;;
|
||||
;; this is Richard Bird and Jeremy Gibbon's "stream" from AFP4
|
||||
;; transforms a stream by alternating between producer and consumer
|
||||
;;
|
||||
;; stream-transform : (b -> (cons list(a) b)) ->
|
||||
;; (b c -> b)
|
||||
;; b
|
||||
;; stream(c) ->
|
||||
;; stream(a)
|
||||
;;
|
||||
(define (stream-transform producer consumer state stream)
|
||||
(delay
|
||||
(let* ((ys&state1 (producer state))
|
||||
(ys (car ys&state1))
|
||||
(state1 (cdr ys&state1))
|
||||
(stream_ (force stream))
|
||||
(as1
|
||||
(cond
|
||||
((null? stream_) (delay stream_))
|
||||
(else
|
||||
(stream-transform producer
|
||||
consumer
|
||||
(consumer state1 (car stream_))
|
||||
(cdr stream_))))))
|
||||
(force (stream-prepend ys as1)))))
|
||||
|
||||
;; stream-take : integer stream(a) -> list(a)
|
||||
(define (stream-take n stream)
|
||||
(if (zero? n) '()
|
||||
(let ((stream_ (force stream)))
|
||||
(if (null? stream_) stream_
|
||||
(cons (car stream_)
|
||||
(stream-take (- n 1)
|
||||
(cdr stream_)))))))
|
||||
|
||||
;; NEW
|
||||
;; stream-drop : integer stream(a) -> stream(a)
|
||||
(define (stream-drop n stream)
|
||||
(if (zero? n) stream
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(if (null? stream_) stream_
|
||||
(if (> n 0)
|
||||
(force (stream-drop (- n 1) (cdr stream_)))
|
||||
(error "stream-drop: negative argument")))))))
|
||||
|
||||
;; stream-fold-right : (a b -> b) b stream(a) -> b
|
||||
(define (stream-fold-right kons knil stream)
|
||||
(let loop ((stream stream))
|
||||
(if (stream-empty? stream)
|
||||
knil
|
||||
(kons (stream-head stream)
|
||||
(loop (stream-tail stream))))))
|
||||
|
||||
;; CHANGED
|
||||
;; stream-foldr-lazily : (a (promise b) -> (promise b))
|
||||
;; (promise b)
|
||||
;; stream(a) ->
|
||||
;; (promise b)
|
||||
(define (stream-fold-right-lazily kons knil stream)
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(cond
|
||||
((null? stream_) (force knil))
|
||||
(else
|
||||
(force (kons (car stream_)
|
||||
(stream-fold-right-lazily kons knil (cdr stream)))))))))
|
||||
|
||||
;; NEW
|
||||
;; stream-prepend : list(a) stream(a) -> stream(a)
|
||||
(define (stream-prepend l s)
|
||||
(if (null? l)
|
||||
s
|
||||
(delay
|
||||
(cons (car l)
|
||||
(stream-prepend (cdr l) s)))))
|
||||
|
||||
;; CHANGED
|
||||
;; list->stream : list(a) -> stream(a)
|
||||
(define (list->stream l)
|
||||
(stream-unfold (lambda (l)
|
||||
(and (not (null? l))
|
||||
l))
|
||||
l))
|
||||
|
||||
;; CHANGED
|
||||
;; stream-from : integer -> stream(integer)
|
||||
(define (stream-from n)
|
||||
(stream-unfold (lambda (s) (cons s (+ s 1))) n))
|
||||
|
||||
;; NEW
|
||||
;; stream-from-to : integer integer -> stream(integer)
|
||||
(define (stream-from-to n m)
|
||||
(stream-unfold
|
||||
(lambda (s)
|
||||
(and (<= s m)
|
||||
(cons s (+ s 1))))
|
||||
n))
|
||||
|
||||
;; NEW
|
||||
;; stream-from-then : integer integer -> stream(integer)
|
||||
(define (stream-from-then n n1)
|
||||
(stream-unfold (lambda (s) (cons s (+ s (- n1 n)))) n))
|
||||
|
||||
;; NEW
|
||||
;; stream-from-to : integer integer integer -> stream(integer)
|
||||
(define (stream-from-then-to n n1 m)
|
||||
(stream-unfold
|
||||
(lambda (s)
|
||||
(and (<= s m)
|
||||
(cons s (+ s (- n1 n)))))
|
||||
n))
|
||||
|
||||
;; NEW
|
||||
;; stream-ref : stream(a) integer -> a
|
||||
(define (stream-ref s n)
|
||||
(if (zero? n)
|
||||
(stream-head s)
|
||||
(if (> n 0)
|
||||
(stream-ref (stream-tail s) (- n 1))
|
||||
(error "stream-ref: invalid reference"))))
|
||||
|
||||
;; stream-iterate : (a -> a) -> a -> stream(a)
|
||||
(define (stream-iterate f a)
|
||||
(stream-unfold (lambda (s) (cons s (f s))) a))
|
||||
|
||||
;; NEW
|
||||
;; stream-repeat : a -> stream(a)
|
||||
(define (stream-repeat a)
|
||||
(letrec ((s (delay (cons a s))))
|
||||
s))
|
||||
|
||||
;; NEW
|
||||
;; stream-cycle : list(a) -> stream(a)
|
||||
(define (stream-cycle l)
|
||||
(letrec ((s (stream-prepend l s)))
|
||||
s))
|
||||
|
||||
;; NEW
|
||||
;; stream-take-while : (a -> boolean) stream(a) -> stream(a)
|
||||
(define (stream-take-while p stream)
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(cond
|
||||
((null? stream_) stream_)
|
||||
(else
|
||||
(let ((head (car stream_)))
|
||||
(if (p head)
|
||||
(cons head (stream-take-while p (cdr stream_)))
|
||||
'())))))))
|
||||
|
||||
;; NEW
|
||||
;; stream-drop-while : (a -> boolean) stream(a) -> stream(a)
|
||||
(define (stream-drop-while p stream)
|
||||
(delay
|
||||
(let ((stream_ (force stream)))
|
||||
(cond
|
||||
((null? stream_) stream_)
|
||||
(else
|
||||
(let ((head (car stream_)))
|
||||
(if (p head)
|
||||
(force (stream-drop-while p (cdr stream_)))
|
||||
stream_)))))))
|
||||
|
||||
;; some tests
|
||||
|
||||
;(define test-stream-zip-with
|
||||
; (stream-zip-with
|
||||
; +
|
||||
; (stream-from-to 1 10)
|
||||
; (stream-from 42)
|
||||
; (stream-from 100)))
|
||||
|
||||
;(define test-stream-transform
|
||||
; (stream-transform
|
||||
; (lambda (state)
|
||||
; (cons (list state (* state state))
|
||||
; (+ state 1)))
|
||||
; (lambda (state1 c)
|
||||
; (* state1 c))
|
||||
; 13
|
||||
; (stream-from 1)))
|
||||
|
||||
Loading…
Reference in New Issue