;;; future.el --- Futures, a concurrency primitive   -*- lexical-binding: t; -*-

;; Copyright (C) 2020  Dmitry Gutov

;; Author: Dmitry Gutov <dgutov@yandex.ru>
;; Keywords: lisp

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(require 'cl-lib)

(cl-defstruct (future
               (:conc-name future--)
               (:constructor future-make (&key force-fn
                                               cancel-fn)))
  "This structure represents a \"future\" value."
  value
  error
  (status 'pending)
  (force-fn #'future-force--apo)
  (cancel-fn #'ignore)
  callback
  errback)

(defun future-force (f)
  (funcall (future--force-fn f)))

(defun future-force--apo (f)
  (while (eq (future--status f) 'pending)
    (accept-process-output nil 0.05)))

(defun future-cancel (f)
  (when (eq (future--status f) 'pending)
    (setf (future--status f) 'canceled)
    (funcall (future--cancel-fn f))))

(defun future-set (f v)
  ;; FIXME: Probably shouldn't error on 'canceled'.
  (cl-assert (eq (future--status f) 'pending))
  (setf (future--value f) v
        (future--status f) 'success)
  (when (future--callback f)
    (funcall (future--callback f) v)))

(defun future-error (f e)
  ;; FIXME: Probably shouldn't error on 'canceled'.
  (cl-assert (eq (future--status f) 'pending))
  (setf (future--error f) e
        (future--status f) 'error)
  (when (future--errback f)
    (funcall (future--errback f) e)))

;; Or we can make these both lists of functions...
(defun future-set-callback (f c)
  (cl-assert (null (future--callback f)))
  (setf (future--callback f) c)
  (when (eq (future--status f) 'success)
    (funcall c (future--value f))))

;; ...and rename to -add-callback/-add-errback.
(defun future-set-errback (f c)
  (cl-assert (null (future--errback f)))
  (setf (future--errback f) c)
  (when (eq (future--status f) 'error)
    (funcall c (future--error f))))

(provide 'future)
;;; future.el ends here