Hi, I'm trying to figure out how to design a chat-server using Cells. This doesn't work, but this is what I've come up with:
(defpackage CellsChat (:use :cl :cells)) (in-package :CellsChat)
(defparameter *newline* (princ-to-string #\Newline))
(defmodel CellsChat () ((username :cell nil :accessor username-of :initarg :username :initform (error "CellsChat needs a `username'."))
(text-box :accessor text-box-of :allocation :class :initform (c-in ""))
(participants :cell nil :accessor participants-of :allocation :class :initform nil)))
(defmethod initialize-instance :after ((chat CellsChat) &key) ;; New user joins the conversation. (push chat (participants-of chat)) ;; New user wants to see what's been going on recently. (updateTextBox chat))
(defmethod updateTextBox ((chat CellsChat)) ;; Show conversation till now. (format t "(text-box-of ~A): '~A'~%" (username-of chat) (text-box-of chat)))
(defobserver text-box ((chat CellsChat)) ;; Update interface of each participant whenever ;; `text-box' changes (for whatever reason). (dolist (participant (participants-of chat)) (updateTextBox participant)))
(defmethod say ((chat CellsChat) (what string)) (setf (text-box-of chat) (concatenate 'string (text-box-of chat) (username-of chat) ": " what *newline*)))
(defmethod part ((chat CellsChat)) ;; User leaves the conversation. (setf (participants-of chat) (delete chat (participants-of chat))))
ok, after some mailing with Kenny - this works:
(defpackage CellsChat (:use :cl :cells)) (in-package :CellsChat)
(defparameter *newline* (princ-to-string #\Newline))
(defmodel Participant () ((chat :cell nil :accessor chat-of :initarg :chat :initform (error "Participants need something for its `chat'-slot."))
(username :cell nil :accessor username-of :initarg :username :initform (error "CellsChat needs a `username'."))
(speech :cell :ephemeral :accessor speech-of :initarg :speech :initform (c-in nil))))
(defmethod initialize-instance :after ((participant Participant) &key) (push participant (participants-of (chat-of participant))))
(defobserver speech ((participant Participant)) ;; `new-value' always refers to the slot `speech' ;; since that is what we're observing (when new-value (dolist (participant (participants-of (chat-of participant))) (format t "Update interface for '~A', appending: ~A~%" (username-of participant) new-value))))
(defmethod say ((participant Participant) (what string)) (setf (speech-of participant) (concatenate 'string (username-of participant) ": " what *newline*)))
(defmodel Chat () ((text-box :accessor text-box-of :initform (c? (concatenate 'string ;; conversation till now.. (or .cache "") ;; well, ok then - this is neat O_o (some 'speech-of (participants-of self)))))
(participants :accessor participants-of :initform (c-in nil))))
(defun testChat () (let* ((chat (make-instance 'Chat)) (user1 (make-instance 'Participant :username "user1" :chat chat)) (user2 (make-instance 'Participant :username "user2" :chat chat))) (say user1 "Hello, anyone here?") (say user2 "Well hello there - I'm here :)") (say user1 "Cool .. what's up?") (say user2 "Just doing some Lisp-hacking -- you?") (say user1 "Naaaw .. nothing; I'm kind of tired, so I'm just sitting in the sun here listening to some music")))
..pretty darn cool :)
On 6/12/06, Lars Rune Nøstdal larsnostdal@gmail.com wrote:
ok, after some mailing with Kenny - this works:
(defpackage CellsChat (:use :cl :cells)) (in-package :CellsChat)
(defparameter *newline* (princ-to-string #\Newline))
(defmodel Participant () ((chat :cell nil :accessor chat-of :initarg :chat :initform (error "Participants need something for its `chat'-slot."))
(username :cell nil :accessor username-of :initarg :username :initform (error "CellsChat needs a `username'."))
(speech :cell :ephemeral :accessor speech-of :initarg :speech :initform (c-in nil))))
(defmethod initialize-instance :after ((participant Participant) &key) (push participant (participants-of (chat-of participant))))
(defobserver speech ((participant Participant)) ;; `new-value' always refers to the slot `speech' ;; since that is what we're observing (when new-value (dolist (participant (participants-of (chat-of participant))) (format t "Update interface for '~A', appending: ~A~%" (username-of participant) new-value))))
(defmethod say ((participant Participant) (what string)) (setf (speech-of participant) (concatenate 'string (username-of participant) ": " what *newline*)))
(defmodel Chat () ((text-box :accessor text-box-of :initform (c? (concatenate 'string ;; conversation till now.. (or .cache "") ;; well, ok then - this is neat O_o (some 'speech-of (participants-of self)))))
(participants :accessor participants-of :initform (c-in nil))))
(defun testChat () (let* ((chat (make-instance 'Chat)) (user1 (make-instance 'Participant :username "user1" :chat chat)) (user2 (make-instance 'Participant :username "user2" :chat chat))) (say user1 "Hello, anyone here?") (say user2 "Well hello there - I'm here :)") (say user1 "Cool .. what's up?") (say user2 "Just doing some Lisp-hacking -- you?") (say user1 "Naaaw .. nothing; I'm kind of tired, so I'm just sitting in the sun here listening to some music")))
..pretty darn cool :)
yes, indeed, except for the bug I tricked Lars into copying. It was a new one on me, to tell you the truth. I am working on a write-up. Almost done, then I will post it here. The bug can be seen by printing out the contents of the text-box (supposedly a full log) at the end of the chat:
user1: Hello, anyone here? user2: Well hello there - I'm here :) user2: Just doing some Lisp-hacking -- you?
In brief, SOME and ephemerals do not play well together.
New instances get pushed onto participants (the slot), so user appears before user1 in the list. Once user2 gets picked up by SOME, there is no dependency on user1 speech, so only user2 gets recorded. Recall that dependencies reflect only the most recent evaluation (uhhh--I think synapses are an exception, but I have started to wonder why <g>. Anyway....).
Deets to follow. Interestingly, I think this is the first case where the Lisp one might naturally write does not Just Work. This bothers me quite a bit -- it may be a Bad Sign. After I post the writeup I will be interested in what others think.
kt
OK, here is the promised write-up, with a scary proposed fix. What do you all think?
the code, btw, ships in broken form: the text-box will not have a complete record. Move the featuring around in the text-box rule to make an awkward fix tantamount to the fix I have in mind to for the Cells engine.
I will follow up separately with a discussion of the proposed fix.
kenny
(defpackage #:tu-some-ephemeral-uhoh (:use :cl :utils-kt :cells :tu-cells)) (in-package #:tu-some-ephemeral-uhoh)
#|
SOME over a list of ephemerals will not establish useful dependencies. Actually, I think there is just a larger problem with the current implementation of ephemerals. More below. The short-term fix is to force iteration over all ephemerals, then return the first found. This is because ephemerals do not change to NIL visibly to propagation -- it is a silent reset done by internals. Details follow:
Normally Cells and SOME get along fine. The spirit of SOME is to find just the first non-nil result in a list, returned by its predicate argument. To stay current with such an expression after non-nil value V is returned by some instance F (the first instance in the list to return a non-nil value), the rule should run if:
an instance appearing earlier in the list would now return a non-nil value the predicate would return a different value V2 if applied to the same instance F in the special case where the new value returned by F would be nil, we want a new search down the list until (possibly) some other instance F2 returns a value.
Well, as I said, normally that works fines, assuming the predicate's return value is affected only by Cells. (This, btw, is a good example of why it is hard to be "a little bit Cells".) Dependencies will exist on the population of the list of instances, and, for all instances up to F, dependencies will exist on all Cells going into the predicate's derivation of a value.
If you stare at the three cases above, you will see that they all work. Note also that they work even though no dependencies exist from applying the predicate to instances /after/ F. That is because they do not matter until F decides to return NIL, and but that change will trigger the rule to run again and sail past F to (possibly) some new F2, establishing dependencies all along the way.
And now the problem. Suppose the predicate simply reads and ephemeral slot. Some instance F takes on a value V for that slot and the rule runs. The value V gets returned, so the rule is not dependent on any instance after F. Fine. But when this propagation completes, because the slot is ephemeral, it reverts to nil without propagating, which is exactly when above the rule ran again, sailed past F and established dependencies of instances farther down the list, ready for someone to turn non-nil.
When some F2 farther down the line /does/ change to return a non-nil, or even if it was ready to return a non-nil when F did so it never got asked (SOME just wants the first), the rule having no dependency past F will not run.
The solution? Do not use SOME in conjunction with ephemerals. Iterate over the whole list to establish dependencies and then take the first result found. if this is to inefficient, have an observer on the ephemeral propagate state change via deferred SETF.
Meanwhile, i will be looking for a fix that makes ephemerals more transparent. The only thing that springs to mind (this is a preview) is re-running the rule after resetting the ephemeral just to establish the dependencies. Which is sick because the code will branch differently -- but that is the idea!
Like I said, sick. :)
|# (defparameter *newline* (princ-to-string #\Newline))
(defmodel cells-chat (family) ;; kids slot can be partcipants ((text-box :initarg :text-box :accessor text-box :initform (let (last-chatters) (c? (let ((latest-speech ;; broken... (some (lambda (p) (when (speech p) ;(print (speech p)) (cons p (speech p)))) ;; no dependencies after this (^kids)) ;; fixed (always hit all speeches to estab dependencies) #+(or) (loop with result for p in (^kids) when (and (speech p) (not result)) ;; this order or same bug do (setf result (cons p (speech p))) finally (return result))
) (new-chatters (set-difference (^kids) last-chatters)) (lost-chatters (set-difference last-chatters (^kids)))) (prog1 (cond (latest-speech (destructuring-bind (p . s) latest-speech (concatenate 'string (or .cache "") (username p) ": " s *newline*))) (lost-chatters (concatenate 'string (or .cache "") (format nil "~a has/have left the chat~a" (mapcar 'username lost-chatters) *newline*))) (new-chatters (concatenate 'string (or .cache "") (format nil "~a has/have joined the chat~a" (mapcar 'username new-chatters) *newline*))) (t .cache)) (setf last-chatters (^kids)))))))))
(defmodel chatter (model) ((username :cell nil :accessor username :initarg :username :initform (error "chatter needs a `username'.")) (speech :cell :ephemeral :initform (c-in nil) :initarg :speech :accessor speech)))
(defobserver text-box ((chat cells-chat) new-value old-value) #+confusingoutput (when new-value (format t "~&--------------(text-box-of ~A)------------------:~&'~A'~%" chat new-value)))
(defun tu-cells::tu-some-ephemeral-uhoh () (cells-reset) (let* ((chat (make-instance 'cells-chat)) (lars (make-instance 'chatter :fm-parent chat :username "Lars"))) (push lars (kids chat)) (setf (speech lars) "Cells are different.") (push (make-instance 'chatter :fm-parent chat :username "Kenny") (kids chat)) (setf (speech lars) "Hi, kenny") ; ; this next state change causes the text-box to lose its dependency on (speech lars)... ; (setf (speech (car (kids chat))) "Hi, Lars. That's for sure. Takes a while to adjust.") ; ; this next state change will not be propagated... ; (setf (speech lars) "OK, I'll keep plugging") (depart-chat lars) (print (text-box chat))))
(defun depart-chat (chatter) (print `(departing ,chatter)) (setf (kids (fm-parent chatter)) (remove chatter (kids (fm-parent chatter)))))
-
Ken Tilton -
Lars Rune Nøstdal