;; -*-theme-d-*-

;; Copyright (C) 2016 Tommi Höynälänmaa
;; Distributed under GNU Lesser General Public License version 3,
;; see file doc/LGPL-3.

(define-body (standard-library stream)


  (define-param-proc stream-next (%type)
		     (((stream (:stream %type)))
		      (:stream %type)
		      pure)
    (match-type-strong stream
      ((<null>) (raise-simple 'stream-next:empty-stream))
      ((stream2 (:nonempty-stream %type))
       (force (cdr stream2)))))


  (define-param-proc stream-value (%type)
		     (((stream (:stream %type)))
		      %type
		      pure)
    (match-type-strong stream
      ((<null>) (raise-simple 'stream-value:empty-stream))
      ((stream2 (:nonempty-stream %type))
       (force (car stream2)))))


  (define-param-proc stream-empty? (%type)
		     (((stream (:stream %type)))
		      <boolean>
		      pure)
    (null? stream))


  (define-param-proc stream->list (%type)
		     (((stream (:stream %type)))
		      (:uniform-list %type)
		      pure)
    (match-type-strong stream
      ((<null>) null)
      ((stream2 (:nonempty-stream %type))
       (cons (force (car stream2))
	     (stream->list (stream-next stream2))))))


  (define-param-proc list->stream (%type)
		     (((l (:uniform-list %type)))
		      (:stream %type)
		      pure)
    (match-type-strong l
      ((<null>) null)
      ((l2 (:nonempty-uniform-list %type))
       (cons (delay (car l2)) (delay (list->stream (cdr l2)))))))


  (define-param-proc nonpure-stream-next (%type)
		     (((stream (:nonpure-stream %type)))
		      (:nonpure-stream %type)
		      nonpure)
    (match-type-strong stream
      ((<null>) (raise-simple 'nonpure-stream-next:empty-stream))
      ((stream2 (:nonempty-nonpure-stream %type))
       (force-nonpure (cdr stream2)))))


  (define-param-proc nonpure-stream-value (%type)
		     (((stream (:nonpure-stream %type)))
		      %type
		      nonpure)
    (match-type-strong stream
      ((<null>) (raise-simple 'nonpure-stream-value:empty-stream))
      ((stream2 (:nonempty-nonpure-stream %type))
       (force-nonpure (car stream2)))))


  (define-param-proc nonpure-stream-empty? (%type)
		     (((stream (:nonpure-stream %type)))
		      <boolean>
		      pure)
    (null? stream))


  (define-param-proc nonpure-stream->list (%type)
		     (((stream (:nonpure-stream %type)))
		      (:uniform-list %type)
		      nonpure)
    (match-type-strong stream
      ((<null>) null)
      ((stream2 (:nonempty-nonpure-stream %type))
       (cons (force-nonpure (car stream2))
	     (nonpure-stream->list
	      (nonpure-stream-next stream2))))))


  (define-param-proc stream-map (%type1 %type2)
		     (((proc (:procedure (%type1) %type2 pure))
		       (stm (:stream %type1)))
		      (:stream %type2)
		      pure)
    (match-type-strong stm
      ((<null>) null)
      ((stm2 (:nonempty-stream %type1))
       (cons (delay (proc (force (car stm2))))
	     (delay (stream-map proc (stream-next stm2)))))))


  (define-param-proc stream-map-nonpure (%type1 %type2)
		     (((proc (:procedure (%type1) %type2 nonpure))
		       (stm (:stream %type1)))
		      (:nonpure-stream %type2)
		      nonpure)
    (match-type-strong stm
      ((<null>) null)
      ((stm2 (:nonempty-stream %type1))
       (cons (delay-nonpure (proc (force (car stm2))))
	     (delay-nonpure 
	      (stream-map-nonpure proc (stream-next stm2)))))))


  (define-param-proc stream-for-each (%type1)
		     (((proc (:procedure (%type1) <none> nonpure))
		       (stm (:stream %type1)))
		      <none>
		      nonpure)
    (match-type-strong stm
      ((<null>) null)
      ((stm2 (:nonempty-stream %type1))
       (proc (stream-value stm2))
       (stream-for-each proc (stream-next stm2)))))


  (define-param-proc nonpure-stream-map (%type1 %type2)
		     (((proc (:procedure (%type1) %type2 nonpure))
		       (stm (:nonpure-stream %type1)))
		      (:nonpure-stream %type2)
		      nonpure)
    (match-type-strong stm
      ((<null>) null)
      ((stm2 (:nonempty-nonpure-stream %type1))
       (cons (delay-nonpure (proc (force-nonpure (car stm2))))
	     (delay-nonpure 
	      (nonpure-stream-map proc (nonpure-stream-next stm2)))))))


  (define-param-proc nonpure-stream-for-each (%type1)
		     (((proc (:procedure (%type1) <none> nonpure))
		       (stm (:nonpure-stream %type1)))
		      <none>
		      nonpure)
    (match-type-strong stm
      ((<null>) null)
      ((stm2 (:nonempty-nonpure-stream %type1))
       (proc (force-nonpure (car stm2)))
       (nonpure-stream-for-each proc (nonpure-stream-next stm2)))))


  (define-simple-proc make-input-expr-stream
      (((ip <input-port>)) (:nonpure-stream <object>) nonpure)
    (if (eof? (peek-character ip))
	null
	(cons (delay-nonpure (read ip))
	      (delay-nonpure (make-input-expr-stream ip))))))
