;;; Timers

(defun start-timer ()
  (get-internal-real-time))

(defun stop-timer (timer)
  (/ (float (- (get-internal-real-time) timer))
     internal-time-units-per-second))

(defmacro timeit (func)
  `(let* ((timer (start-timer))
	  (rslt ,func))
     (format t "~a~%" (stop-timer timer))
     rslt))

;;; Callbacks

(defun source (callback)
  (do ((k 1 (1+ k)))
      ((= 100000 k))
    (funcall callback (/ (* (1+ k) k) 2))))

(defun new-make-pairs (callback)
  (let (buffer)
    (lambda (chunk)
      (if buffer
	  (funcall callback (cons (pop buffer) chunk))
	  (push chunk buffer)))))

(defun split (chunk callback1 callback2)
  (funcall callback1 chunk)
  (funcall callback2 chunk))

(defun multiply (chunk callback)
  (destructuring-bind (x . y) chunk
    (funcall callback (* x y))))

(defun toy-gcd (chunk callback)
  (destructuring-bind (x . y) chunk
    (if (< x y)
	(toy-gcd (cons y x) callback)
	(if (= 0 y) (funcall callback x)
	    (toy-gcd (cons y (mod x y)) callback)))))

(defun new-combine (callback)
  (let (buffer)
    (lambda (chunk)
      (if buffer
	  (funcall callback (cons (pop buffer) chunk))
	  (push chunk buffer)))))

(defun divide (chunk callback)
  (destructuring-bind (x . y) chunk
    (funcall callback (/ x y))))

(defun get-digits (chunk callback)
  (unless (= 0 chunk)
    (get-digits (floor chunk 10) callback)
    (funcall callback (mod chunk 10))))

(defun sink (chunk)
  (declare (ignore chunk)))

(defun pipeline ()
  (let* ((get-digits (lambda (c) (get-digits c #'sink)))
	 (divide (lambda (c) (divide c get-digits)))
	 (combine (new-combine divide))
	 (toy-gcd (lambda (c) (toy-gcd c combine)))
	 (multiply (lambda (c) (multiply c combine)))
	 (split (lambda (c) (split c multiply toy-gcd)))
	 (make-pairs (new-make-pairs split)))
    (source make-pairs)))

(timeit (dotimes (i 100) (pipeline)))