Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #4 from nixz/nix

actor class
  • Loading branch information...
commit a8d206f1c24ca4b34008b045748eda9dd1944756 2 parents 7e473e3 + 57d5ce7
Naveen Sundar G. authored
Showing with 114 additions and 51 deletions.
  1. +113 −50 actors.lisp
  2. +1 −1  cl-actors.asd
View
163 actors.lisp
@@ -1,63 +1,126 @@
(in-package #:cl-actors)
-; Create a behavior that can be attached to any actor
+;; ----------------------------------------------------------------------------
+(defclass actor()
+ ((name :initarg :name
+ :initform (error ":name must be specified")
+ :accessor name
+ :documentation "Hold the name of actor")
+ (add :initarg :add
+ :initform (error ":add must be specified")
+ :accessor add
+ :documentation "holds handle to add method")
+ (main :initarg :main
+ :initform (error ":main must be specified")
+ :accessor main
+ :documentation "Main Thread")
+ (messages :initarg :messages
+ :initform (error ":messages must be specified")
+ :accessor messages
+ :documentation "Message stream sent to actor")
+ thread))
+
+;; ----------------------------------------------------------------------------
+(defmethod initialize-instance :after((self actor) &key)
+ "Uses the main functiona name to create a thread"
+ (with-slots (name main thread) self
+ (setf thread
+ (bt:make-thread main :name name))))
+
+;; ----------------------------------------------------------------------------
+(defmethod send ((self actor) &rest message)
+ (bt:make-thread #'(lambda () (funcall (get-add self) message)))
+ (values))
+
+;; ----------------------------------------------------------------------------
+;; (defun stop-actor (actor) (destroy-thread (get-thread actor)))
+(defmethod stop-actor ((self actor))
+ "Stops the actor thread"
+ (with-slots (thread) self
+ (destroy-thread thread)))
+
+;; ----------------------------------------------------------------------------
+;; (defun get-thread (actor) (first actor))
+(defmethod get-thread ((self actor))
+ "Returns the handle of a thread"
+ (with-slots (thread) self
+ thread))
+
+;; ----------------------------------------------------------------------------
+;; (defun get-add (actor) (second actor))
+(defmethod get-add ((self actor))
+ "Returns handle to the add function"
+ (with-slots (add) self
+ add))
+
+;; ----------------------------------------------------------------------------
+;; Create a behavior that can be attached to any actor
(defmacro behav (state vars &body body)
`(let ,state
- (labels ((me ,(append vars `(&key self (next #'me next-supplied-p)))
- (setf next (curry next :self self))
- ,@body))
- #'me)))
+ (labels ((me ,(append vars `(&key self (next #'me next-supplied-p)))
+ (setf next (curry next :self self))
+ x ,@body))
+ #'me)))
-; Macro for creating actors with the behavior specified by body
+;; ----------------------------------------------------------------------------
+;; Macro for creating actors with the behavior specified by body
(defmacro defactor (name state vars &body body)
- `(defun ,name (&key (self) ,@state)
- (labels ((me ,(append vars `(&key (next #'me next-supplied-p)))
- (if next-supplied-p
- (setf next (curry next :self self)))
- ,@body))
- (setf self (make-actor #'me ,(string name))) self)))
-
-; The shell of an actor
+ `(defun ,name (&key (self) ,@state)
+ (labels ((me ,(append vars `(&key (next #'me next-supplied-p)))
+ (if next-supplied-p
+ (setf next (curry next :self self)))
+ ,@body))
+ (setf self (make-actor #'me ,(string name))) self)))
+
+;; ----------------------------------------------------------------------------
+;; The shell of an actor
(defun make-actor (behav name)
- (let (self
- (lock (make-lock))
- (messages '())
- (cv (make-condition-variable)))
- (labels ((add (m)
- (with-lock-held (lock)
- (setf messages (nconc messages (list m))))
- (condition-notify cv))
- (run-actor () (loop
- (thread-yield)
- (with-lock-held (lock)
- (if (not (null messages))
- (setf behav (apply behav
- (pop messages)))
- (condition-wait cv lock ))
- (unless behav (return))))))
- (setf self
- (list (make-thread #'run-actor :name (concatenate 'string "Actor: " name))
- #'add
- messages)))))
-
-(defun send (actor &rest message)
- (make-thread #'(lambda () (funcall (get-add actor) message)))
- (values))
+ (let (self
+ (lock (bt:make-lock))
+ (messages '())
+ (cv (bt:make-condition-variable)))
+ (labels ((add (m)
+ (with-lock-held (lock)
+ (setf messages (nconc messages (list m))))
+ (condition-notify cv))
+ (run-actor () (loop
+ (thread-yield)
+ (with-lock-held (lock)
+ (if (not (null messages))
+ (setf behav (apply behav
+ (pop messages)))
+ (condition-wait cv lock ))
+ (unless behav (return))))))
+ (setf self (make-instance 'actor
+ :name (concatenate 'string "Actor: " name)
+ :main #'run-actor
+ :add #'add
+ :messages messages)))))
-(defun stop-actor (actor) (destroy-thread (get-thread actor)))
+;; ----------------------------------------------------------------------------
+(defun if-single (x)
+ (if (eq (length x) 1)
+ (car x)
+ x))
-(defun if-single (x) (if (eq (length x) 1) (car x) x))
-(defun get-thread (actor) (first actor))
-(defun get-add (actor) (second actor))
-(defun sink (&rest args) (declare (ignore args)) #'sink)
+;; ----------------------------------------------------------------------------
+(defun sink (&rest args)
+ (declare (ignore args)) #'sink)
-;Currying.
+;; ----------------------------------------------------------------------------
+;; Currying.
(defun curry (f &rest args)
- (lambda (&rest rem)
- (apply f (append rem args) )))
+ (lambda (&rest rem)
+ (apply f (append rem args) )))
-;Easy priting to repl from threads.
-(defun pr (x) (print x *standard-output*))
+;; ----------------------------------------------------------------------------
+;; Easy priting to repl from threads.
+(defun pr (x)
+ (print x *standard-output*)
+ (format t "~%"))
-;A printing actor
-(defactor printer () (x) (pr x) next)
+;; ----------------------------------------------------------------------------
+;; A printing actor
+(defactor printer ()
+ (x)
+ (pr x) next)
View
2  cl-actors.asd
@@ -5,7 +5,7 @@
;;;; @author Naveen Sundar G. <naveensundarg@gmail.com>
;;;; @date Thu Apr 5 2012
;;;; @brief asdf-install package file for cl-actors
-;;;;===========================================================================
+;;;;===========================================================================
(defpackage #:cl-actors-asd (:use #:asdf #:cl))
(in-package :cl-actors-asd)
Please sign in to comment.
Something went wrong with that request. Please try again.