experiments/stream-fusion.scm
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 166 116b68c008a6
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
166
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
(define-struct stream (stepper0 state0))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     2
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     3
(define (stream-stepper stream-or-list)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
  (if (or (null? stream-or-list)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
	  (pair? stream-or-list))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     6
      list-stream-stepper
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     7
      (stream-stepper0 stream-or-list)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
(define (stream-state stream-or-list)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    10
  (if (or (null? stream-or-list)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
	  (pair? stream-or-list))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
      stream-or-list
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    13
      (stream-state0 stream-or-list)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    14
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
(define (stream-maker stepper)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
  (lambda (state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    17
    (make-stream stepper state)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    19
(define (list-stream-stepper l done skip yield)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    20
  (if (null? l)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    21
      (done)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    22
      (yield (car l) (cdr l))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    23
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    24
(define list->stream (stream-maker list-stream-stepper))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    25
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    26
(define (stream->list stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    27
  (sfoldr cons '() stream))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    28
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    29
(define (smap f stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    30
  (let ((stepper (stream-stepper stream)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    31
    (make-stream (lambda (state done skip yield)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    32
		   (stepper state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    33
			    done
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    34
			    skip
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    35
			    (lambda (elt new-state) (yield (f elt) new-state))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    36
		 (stream-state stream))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    37
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    38
(define (sfilter pred stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    39
  (let ((stepper (stream-stepper stream)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    40
    (make-stream (lambda (state done skip yield)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    41
		   (stepper state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    42
			    done
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    43
			    skip
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    44
			    (lambda (elt new-state) (if (pred elt)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    45
							(yield elt new-state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    46
							(skip new-state)))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    47
		 (stream-state stream))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    48
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    49
(define (sfoldr kons knil stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    50
  (let ((stepper (stream-stepper stream)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    51
    (let loop ((state (stream-state stream)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    52
      (stepper state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    53
	       (lambda () knil)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    54
	       (lambda (new-state) (loop new-state))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    55
	       (lambda (elt new-state) (kons elt (loop new-state)))))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    56
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    57
(define (sfoldl kons knil stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    58
  (let ((stepper (stream-stepper stream)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    59
    (let loop ((knil knil)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    60
	       (state (stream-state stream)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    61
      (stepper state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    62
	       (lambda () knil)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    63
	       (lambda (new-state) (loop new-state))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    64
	       (lambda (elt new-state) (loop (kons elt knil) new-state))))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    65
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    66
(define-struct szip-state (cell left right))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    67
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    68
(define (szip left right)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    69
  (let ((left-stepper (stream-stepper left))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    70
	(right-stepper (stream-stepper right)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    71
    (make-stream (lambda (state done skip yield)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    72
		   (let ((cell (szip-state-cell state)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    73
		     (cond
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    74
		      ((null? cell)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    75
		       (right-stepper
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    76
			(szip-state-right state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    77
			done
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    78
			(lambda (new-right)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    79
			  (skip (make-szip-state '() (szip-state-left state) new-right)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    80
			(lambda (elt new-right)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    81
			  (skip (make-szip-state (list elt) (szip-state-left state) new-right)))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    82
		      (else
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    83
		       (left-stepper
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    84
			(szip-state-left state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    85
			done
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    86
			(lambda (new-left)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    87
			  (skip (make-szip-state cell new-left (szip-state-right state))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    88
			(lambda (elt new-left)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    89
			  (yield (cons elt cell)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    90
				 (make-szip-state '() new-left (szip-state-right state)))))))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    91
		 (make-szip-state '() (stream-state left) (stream-state right)))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    92
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    93
(define-struct sconcatmap-state (first-stepper first-state remaining-streams))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    94
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    95
(define (sconcatmap f streams)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    96
  (let ((remaining-streams-stepper (stream-stepper streams)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    97
    (make-stream (lambda (state done skip yield)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    98
		   (let ((first-stepper (sconcatmap-state-first-stepper state)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    99
		     (if first-stepper
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   100
			 (first-stepper (sconcatmap-state-first-state state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   101
					(lambda ()
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   102
					  (skip (make-sconcatmap-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   103
						 #f #f
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   104
						 (sconcatmap-state-remaining-streams state))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   105
					(lambda (new-first-state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   106
					  (skip (make-sconcatmap-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   107
						 first-stepper new-first-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   108
						 (sconcatmap-state-remaining-streams state))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   109
					(lambda (elt new-first-state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   110
					  (yield elt
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   111
						 (make-sconcatmap-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   112
						  first-stepper new-first-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   113
						  (sconcatmap-state-remaining-streams state)))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   114
			 (remaining-streams-stepper (sconcatmap-state-remaining-streams state)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   115
						    done
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   116
						    (lambda (new-remaining-streams)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   117
						      (skip (make-sconcatmap-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   118
							     #f #f
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   119
							     new-remaining-streams)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   120
						    (lambda (first new-remaining-streams)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   121
						      (let ((first-stream (f first)))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   122
							(skip (make-sconcatmap-state
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   123
							       (stream-stepper first-stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   124
							       (stream-state first-stream)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   125
							       new-remaining-streams))))))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   126
		 (make-sconcatmap-state #f #f (stream-state streams)))))
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   127
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   128
(define (sconcatenate streams)
116b68c008a6 Stream fusion experiments.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   129
  (sconcatmap (lambda (stream) stream) streams))