;; TITLE
;;
;; srfi-pms: Poor Man's Streams

;; AUTHOR
;;
;; Anthony Carrico

;; STATUS
;;
;; Half serious.

;; ABSTRACT
;;
;; Srfi-pms: Poor Man's Streams proposes poor man's streams (pms). It
;; depends on:
;;    srfi-34: Exception Handling for Programs
;;    srfi-35: Conditions
;; and recommends
;;    srfi-11: Syntax for receiving multiple values

;; RATIONALE
;;
;; Lazy streams can be challenging to understand, implement and use,
;; and difficult to reason about in terms of time and space complexity
;; (see srfi-40: A Library of Streams, and related discussions).
;;
;; Lazy evaluation may be a hallmark of functional programming, but
;; the cached value in a promise smells imperative. Scheme is
;; primarily a strict language. By embracing Scheme's "values"
;; procedure, srfi-pms presents a simple method for generating a
;; sequence of values without using delay, force, or macros. With
;; srfi-pms, poor Scheme programmers can do stream like things without
;; feeling like they are in a foreign land.

;; SPECIFICATION
;;
;; Srfi-pms defines three values:
;;
;; &pms-end -- a condition type
;; pms-end? -- &pms-end predicate
;; pms-end -- instance of &pms-end
;;
;; and the convention that a pms is a procedure that returns another
;; pms and one or more additional values, or raises "pms-end".

;; IMPLEMENTATION

(define-condition-type &pms-end &condition pms-end?)
(define pms-end (make-condition &pms-end))

;; If a non-error base condition is made standard, it would make sense
;; for "&end" to derive from that, rather than "&condition".

;; EXAMPLES

(define pms-from
  (lambda (start)
    (lambda ()
      (let loop ((x start))
        (values (lambda () (loop (+ x 1))) x)))))

(define pms-from-to
  (lambda (start stop)
    (lambda ()
      (let loop ((x start))
        (if (< x stop)
            (values (lambda () (loop (+ x 1))) x)
            (raise pms-end))))))

(define pms-repeat
  (lambda objs
    (lambda ()
      (let loop ((current objs))
        (if (pair? current)
            (values (lambda () (loop (cdr current))) (car current))
            (loop objs))))))

(define pms-iterate
  (lambda (func obj)
    (lambda ()
      (let loop ((obj obj))
        (values (lambda () (loop (func obj))) obj)))))

;; Pms-for-each covers the case in which each iteration of the pms
;; produces a single extra value.

(define pms-for-each
  (lambda (proc . pmses)
    (guard (condition
            ((pms-end? condition)
             ;; Return the same way as a native for-each
             (for-each (lambda (x) x) '())))
           (let loop ((pmses pmses))
             (let-values
                 (((pmses args)
                   (let recurse ((pmses pmses))
                     (if (pair? pmses)
                         (let*-values (((pms arg) ((car pmses)))
                                       ((pmses args) (recurse (cdr pmses))))
                           (values (cons pms pmses) (cons arg args)))
                         (values '() '())))))
               (apply proc args)
               (loop pmses))))))

(pms-for-each (lambda (x) (display x) (newline)) (pms-from-to 0 10))
;; 0
;; 1
;; 2
;; 3
;; 4
;; 5
;; 6
;; 7
;; 8
;; 9

(pms-for-each
  (lambda (x y) (display y) (newline))
  (pms-from-to 0 5)
  (pms-iterate (lambda (x) (list x)) '()))
;; ()
;; (())
;; ((()))
;; (((())))
;; ((((()))))

;; Pms-map covers the case in which each iteration of the pms produces
;; a single extra value.

(define pms-map
  (lambda (proc . pmses)
    (lambda ()
      (let loop ((pmses pmses))
        (let*-values
            (((pmses args)
              (let recurse ((pmses pmses))
                (if (pair? pmses)
                    (let*-values (((pms arg) ((car pmses)))
                                  ((pmses args) (recurse (cdr pmses))))
                      (values (cons pms pmses) (cons arg args)))
                    (values '() '()))))
             (results (apply proc args)))
          (apply values (lambda () (loop pmses)) results))))))

(pms-for-each
 (lambda (x) (display x) (newline))
 (pms-map (lambda (x) (* x 10)) (pms-from-to 0 10)))
;; 0
;; 10
;; 20
;; 30
;; 40
;; 50
;; 60
;; 70
;; 80
;; 90

;; Pms-for-each* covers the case in which each iteration of the pms
;; produces more than one value.

(define pms-for-each*
  (lambda (proc pms)
    (guard (condition
            ((pms-end? condition)
             ;; Return the same way as a native for-each
             (for-each (lambda (x) x) '())))
           (let loop ((pms pms))
             (let-values (((pms . x) (pms)))
               (apply proc x)
               (loop pms))))))

(define quotient+remainder
  (lambda (n1 n2)
    (values (quotient n1 n2) (remainder n1 n2))))

(pms-for-each* (lambda (q r) (display q) (display " ") (display r) (newline))
               (pms-map quotient+remainder
                        (pms-repeat 20)
                        (pms-from-to 1 5)))
;; 20 0
;; 10 0
;; 6 2
;; 5 0