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

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

(in-package :scopes/core/actor-ng)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (async:init))

;;;; basic message implementation

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

;;;; actor loop (listener)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (when (not (boundp '+quit-message+)) 
    (defconstant +quit-message+ (gensym "QUIT"))))

(defun start (mb bhv &key foreground)
  (if foreground
    (ac-loop mb bhv)
    (let ((ch (lp:make-channel)))
      (lp:submit-task ch (lambda () (ac-loop mb bhv)))
      ch)))

(defun stop (mb)
  (send mb (message +quit-message+)))

(defun ac-loop (mb bhv)
  (let ((msg (lpq:pop-queue mb)))
    (unless (eq (content msg) +quit-message+)
      (ac-loop mb (or (funcall bhv msg) bhv)))))

;;;; the core (classical, i.e. Hewitt) actor API
;;;  there is no `become` operation: the behavior just returns the new behavior

(defun create (bhv)
  (let ((mb (lpq:make-queue))) 
    (values mb (start mb bhv))))

(defun send (mb msg)
  (lpq:push-queue msg mb))

;;;; predefined behaviors

(defun no-op (msg))

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

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

;;;; predefined global actors

(defvar *logger* (create #'lgi))
 
(defun root-bhv (ac msg)
  (send *logger* msg))

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

;;;; example behavior: calculator

(defun calculator (&optional (val 0))
  (lambda (msg)
    (format t "calc ~a ~a~%" val (content msg))
    (destructuring-bind (fn &optional param) (content msg)
      (funcall fn msg val param))))

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