50 lines
1.2 KiB
Common Lisp
50 lines
1.2 KiB
Common Lisp
;;;; cl-scopes/core/message
|
|
|
|
(defpackage :scopes/core/message
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:core :scopes/core))
|
|
(:export #:message #:simple-message
|
|
#:head #:data
|
|
#:as-list))
|
|
|
|
(in-package :scopes/core/message)
|
|
|
|
(defgeneric as-list (obj))
|
|
|
|
;;;; message-head
|
|
|
|
(defclass message-head ()
|
|
((domain)
|
|
(action)
|
|
(class)
|
|
(item)))
|
|
|
|
(defmethod print-object ((head message-head) stream)
|
|
(with-slots (domain action class item) head
|
|
(format stream
|
|
"<message-head (~a ~a ~a ~a)>"
|
|
domain action class item)))
|
|
|
|
(defmethod as-list ((h message-head))
|
|
(with-slots (domain action class item) h
|
|
(list domain action class item)))
|
|
|
|
;;;; message
|
|
|
|
(defclass message ()
|
|
((head :reader head :initarg :head)
|
|
(sender)
|
|
(timestamp)
|
|
(data :accessor data :initform nil)))
|
|
|
|
(defun simple-message (&rest head-vals)
|
|
(let ((h (make-instance 'message-head)))
|
|
(dolist (sl '(domain action class item))
|
|
(setf (slot-value h sl) (pop head-vals)))
|
|
(make-instance 'message :head h)))
|
|
|
|
(defmethod print-object ((msg message) stream)
|
|
(with-slots (domain action class item) (head msg)
|
|
(format stream
|
|
"<message (~a ~a ~a ~a) <data ~s>>"
|
|
domain action class item (data msg))))
|