Permalink
Browse files

Merge pull request #2 from naryl/master

A set of nice features from naryl.
  • Loading branch information...
2 parents c2f81fa + 9a0d02c commit 248704a9dfabf2c5258470256669da4d43afec24 Naveen Sundar G committed May 26, 2011
Showing with 6 additions and 5 deletions.
  1. +6 −5 actors.lisp
View
@@ -15,27 +15,28 @@
(if next-supplied-p
(setf next (curry next :self self)))
,@body))
- (setf self (make-actor #'me)) self)))
+ (setf self (make-actor #'me ,(string name))) self)))
; The shell of an actor
-(defun make-actor (behav)
+(defun make-actor (behav name)
(let (self
(lock (make-lock))
(messages '())
(cv (make-condition-variable)))
(labels ((add (m)
(with-lock-held (lock)
- (push m messages))
+ (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 ))))))
+ (condition-wait cv lock ))
+ (unless behav (return))))))
(setf self
- (list (make-thread #'run-actor)
+ (list (make-thread #'run-actor :name (concatenate 'string "Actor: " name))
#'add
messages)))))

0 comments on commit 248704a

Please sign in to comment.