;;;; cl-scopes/core/actor - basic actor definitions

(defpackage :scopes/core/actor
  (:use :common-lisp)
  (:local-nicknames (:async :scopes/util/async)
                    (:util :scopes/util))
  (:export #:actor #:bg-actor #:fg-actor #:make-actor #:start #:stop
           #:become #:create #:send
           #:message #:content #:customer
           #:*logger* #:*root*
           #:echo #:inc #:lgi
           #:calculator #:plus #:minus #:show #:send-value))

(in-package :scopes/core/actor)

;;;; basic message and actor implementations

(defclass message ()
  ((content :reader content :initarg :content :initform nil)
   (customer :reader customer :initarg :customer :initform nil)))

(defun message (content &optional customer)
  (make-instance 'message :content content :customer customer))

(defclass actor ()
  ((behavior :accessor behavior :initarg :behavior :initform #'no-op)))

(defclass bg-actor (actor)
  ((task :accessor task :initform nil)))

(defclass fg-actor (bg-actor) ())

(defgeneric start (ac)
  (:method ((ac actor)))
  (:method ((ac bg-actor))
    (setf (task ac) (make-task ac))
    (async:start (task ac)))
  (:method ((ac fg-actor))
    (setf (task ac) (make-task ac 'async:fg-task))
    (async:start (task ac))))

(defgeneric stop (ac)
  (:method ((ac actor)))
  (:method ((ac bg-actor)) 
    (async:stop (task ac))))

(defun make-actor (bhv &optional (cls 'actor) &rest args &key &allow-other-keys)
  (apply #'make-instance cls :behavior bhv args))

(defun make-task (ac &optional (cls 'async:bg-task))
  (async:make-task :cls cls
                   :handle-message 
                      #'(lambda (ax msg) (funcall (behavior ac) ac msg))))

;;;; the core (classical, i.e. Hewitt) actor API

(defun become (ac bhv)
  (setf (behavior ac) bhv))

(defun create (bhv &optional (cls 'actor) &rest args &key &allow-other-keys)
  (let ((ac (apply #'make-actor bhv cls args)))
    (start ac)
    ac))

(defgeneric send (addr content &key &allow-other-keys)
  (:method ((addr t) (content t) &key customer &allow-other-keys)
    (let ((ac addr) (msg (message content customer))) 
      (send ac msg)))
  (:method ((ac actor) (msg message) &key &allow-other-keys) 
    (funcall (behavior ac) ac msg))
  (:method ((ac bg-actor) (msg message) &key &allow-other-keys)
    (async:send (task ac) msg)))

;;;; predefined behaviors

(defun no-op (ac msg))

(defun lgi (ac msg)
  (util:lgi (content msg)))

(defun echo (ac msg)
  (send (customer msg) msg))

;;;; predefined global actors

(defvar *logger* (create #'lgi))
 
(defclass root (actor) ())

(defun root-bhv (ac msg)
  (send *logger* msg))

(defvar *root* (create #'root-bhv 'root))

 ;;;; example behavior: calculator

(defun calculator (&optional (val 0))
  #'(lambda (ac msg)
      (destructuring-bind (fn &optional param) (content msg)
        (funcall fn ac msg val param))))

(defun plus (ac msg val param)
  (become ac (calculator (+ val param)))) 
(defun minus (ac msg val param)
  (become ac (calculator (- val param)))) 
(defun show (ac msg val param)
  (send (or (customer msg) *logger*) val))
(defun send-value (ac msg val param)
  (send (customer msg) val))