;;; 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))

;;; Generators

(require "cl-cont")
(require "alexandria")
(use-package :cl-cont)
(use-package :alexandria)

(define-condition stop-iteration (error) ())

(defmacro defstream (name args &body body)
  (with-gensyms (cont cc)
    `(defun ,name ,args
       (macrolet ((yield (var)
		    `(let/cc ,',cc
		       (setq ,',cont ,',cc)
		       ,var)))
	 (let (,cont)
	   (with-call/cc
	     (flet ((,name ()
			,@body
			(error 'stop-iteration)))
	       (setq ,cont (lambda () (,name)))))
	   (lambda () (funcall ,cont)))))))


(defmacro dostream ((var stream) &body body)
  (with-gensyms (cont start)
    `(let ((,cont ,stream)
	   (,var nil))
       (handler-case
	   (block nil
	     (tagbody
		,start
		(setq ,var (funcall ,cont))
		,@body
		(go ,start)))
	 (stop-iteration ())))))

(defstream source ()
  (do ((k 1 (1+ k)))
      ((= 100000 k))
    (yield (/ (* (1+ k) k) 2))))

(defstream  make-pairs (src)
  (let (buffer)
    (dostream (chunk src)
      (if buffer
	  (yield (cons (pop buffer) chunk))
	  (push chunk buffer)))))

(defstream split (src)
  (dostream (chunk src)
    (yield chunk)
    (yield chunk)))

(defstream multiply (src)
  (dostream (chunk src)
    (destructuring-bind (x . y) chunk
      (yield (* x y)))))

(defstream toy-gcd (src)
  (labels ((helper (x y)
	     (if (< x y)
		 (helper y x)
		 (if (= 0 y) (yield x)
		     (helper y (mod x y))))))
    (dostream (chunk src)
      (destructuring-bind (x . y) chunk
	(helper x y)))))

(defstream combine (src1 src2)
  (dostream (x src1)
    (yield (cons x (funcall src2)))))

(defstream divide (src)
  (dostream (chunk src)
    (destructuring-bind (x . y) chunk
      (yield (/ x y)))))

(defstream get-digits (src)
  (labels ((helper (x)
	     (unless (= 0 x)
	       (helper (floor x 10))
	       (yield (mod x 10)))))
    (dostream (x src)
      (helper x))))

(defun sink (src)
  (dostream (chunk src)))

(defun pipeline ()
  (let ((split (split (make-pairs (source)))))
    (sink (get-digits (divide (combine (multiply split) (toy-gcd split)))))))

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