(require-library "synrule.ss")

(define-syntax stream-cons
  (syntax-rules ()
    ((stream-cons x y) (cons x (delay y)))))

(define stream-car
  (lambda (x)
    (car x)))

(define stream-cdr
  (lambda (x)
    (force (cdr x))))

(define stream
  (lambda args
    (letrec
      ((loop
          (lambda (ls)
            (if (null? ls)
              '()
              (stream-cons (car ls) (loop (cdr ls)))))))
      (loop args))))


(define stream-ref
  (lambda (x n)
    (if (= n 0)
      (stream-car x)
      (stream-ref (stream-cdr x) (- n 1)))))

(define stream-append
  (lambda (x y)
    (if (null? x)
      y
      (stream-cons 
        (stream-car x)
        (stream-append (stream-cdr x) y)))))

(define stream-map
  (lambda (proc . args)
    (if (null? (car args))
      '()
      (stream-cons
        (apply proc (map stream-car args))
        (apply stream-map proc (map stream-cdr args))))))

(define stream-apply
  (lambda (proc x)
    (apply proc (stream->list x))))

(define stream-filter
  (lambda (pred x)
    (if (null? x)
      '()
      (let ((y (stream-car x)))
        (if (pred y)
          (stream-cons y (stream-filter pred (stream-cdr x)))
          (stream-filter pred (stream-cdr x)))))))

(define stream->list
  (lambda (x)
    (if (null? x)
      '()
      (cons (stream-car x) (stream->list (stream-cdr x))))))

(define iota
  (lambda ()
    (stream-cons 1 (stream-map add1 (iota)))))

(define fibs
  (lambda ()
    (stream-map 
      + 
      (stream-cons 1 (fibs)) 
      (stream-cons 0 (stream-cons 1 (fibs))))))

(define fib
  (lambda (n)
    (stream-ref (fibs) n)))

(define lattice
  (lambda ()
    (stream-map
      (lambda (u) (stream-map (lambda (v) (stream u v)) (iota)))
      (iota))))