fork(1) download 
  1. ;; Reconciling srfi-41 and ice-9 streams.
  2.  
  3. (use-modules (srfi srfi-41))
  4.  
  5. ;; srfi-41 does not have ice-9 streams make-stream.
  6.  
  7. (define (make-stream proc init)
  8.   (stream-let loop ((init (proc init)))
  9.     (if (pair? init)
  10.         (stream-cons (car init) (loop (proc (cdr init))))
  11.         stream-null)))
  12.  
  13. ;; ice-9 streams does not have srfi-41 stream-take (not needed here).
  14.  
  15. (define (stream-take n stream)
  16.   (make-stream (lambda (state)
  17.                  (let ((s (car state))
  18.                        (n (cdr state)))
  19.                    (unless (or (stream-null? s)
  20.                                (<= n 0))
  21.                            (cons* (stream-car s) (stream-cdr s) (- n 1)))))
  22.                (cons stream n)))
  23.  
  24. ;; Write cycle and repeat in terms of make-stream.
  25.  
  26. (define (stream-cycle head)
  27.   (make-stream (lambda (rest)
  28.                  (if (null? rest)
  29.                      head
  30.                      rest))
  31.                head))
  32.  
  33. (define* (stream-repeat item #:optional (count -1))
  34.   ;; Negative count is infinite.
  35.   (make-stream (lambda (n)
  36.                  (unless (zero? n)
  37.                          (cons item (- n 1))))
  38.                count))
  39.  
  40. (display (stream->list (stream-take 10 (stream-cycle '(1 2 3)))))
  41. (newline)
  42. (display (stream->list (stream-take 10 (stream-repeat #\X))))
  43. (newline)
  44. (display (stream->list (stream-repeat #\Y 5)))
  45. (newline)
  46.  
  47. ;; With stream-take there isn't much reason to allow stream-repeat
  48. ;; to accept a count; write in terms of stream-cycle.
  49.  
  50. (define (stream-repeat item)
  51.   (stream-cycle (list item)))
  52.  
  53. (display (stream->list (stream-take 10 (stream-cycle '(1 2 3)))))
  54. (newline)
  55. (display (stream->list (stream-take 10 (stream-repeat #\X))))
  56. (newline)
  57. (display (stream->list (stream-take  5 (stream-repeat #\Y))))
  58. (newline)
  59.  
  60. ;; Write stream-cycle in terms of srfi-41 stream-constant.
  61.  
  62. (define (stream-cycle head)
  63.   (apply stream-constant head))
  64.  
  65. (display (stream->list (stream-take 10 (stream-cycle '(1 2 3)))))
  66. (newline)
  67. (display (stream->list (stream-take 10 (stream-repeat #\X))))
  68. (newline)
  69. (display (stream->list (stream-take  5 (stream-repeat #\Y))))
  70. (newline)
  71.  
  72. ;; Alternate stream-cycle using srfi-41 stream-of.
  73.  
  74. (define (stream-cycle head)
  75.   (stream-of x
  76.     (y in (stream-constant head))
  77.     (x in (list->stream y))))
  78.  
  79. (display (stream->list (stream-take 10 (stream-cycle '(1 2 3)))))
  80. (newline)
  81. (display (stream->list (stream-take 10 (stream-repeat #\X))))
  82. (newline)
  83. (display (stream->list (stream-take  5 (stream-repeat #\Y))))
  84. (newline)
Success #stdin #stdout 0.03s 11928KB
comments (?)
stdin 
Standard input is empty
stdout 
(1 2 3 1 2 3 1 2 3 1)
(X X X X X X X X X X)
(Y Y Y Y Y)
(1 2 3 1 2 3 1 2 3 1)
(X X X X X X X X X X)
(Y Y Y Y Y)
(1 2 3 1 2 3 1 2 3 1)
(X X X X X X X X X X)
(Y Y Y Y Y)
(1 2 3 1 2 3 1 2 3 1)
(X X X X X X X X X X)
(Y Y Y Y Y)
https://ideone.com/3No7VD
language:
Scheme (guile 2.2.4)
created:
4 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!