diff --git a/core/message.lisp b/core/message.lisp index 50c5b10..32237ca 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -3,26 +3,22 @@ (defpackage :scopes/core/message (:use :common-lisp) (:local-nicknames (:shape :scopes/shape)) - (:export #:message #:create + (:export #:message-meta #:message #:create #:head #:data #:sender)) (in-package :scopes/core/message) ;;;; message -(defun message-factory () - (make-instance 'shape:record-factory :item-class 'message - :head-fields '(:domain :action :class :item))) +(defun message-meta () + (make-instance 'shape:record-meta :head-fields '(:domain :action :class :item))) (defclass message (shape:record) - ((factory :initform (message-factory)) - (shape:head-fields :initform '(:domain :action :class :item)) + ((shape:meta :initform (message-meta) :allocation :class) (sender :reader sender :initarg :sender :initform nil))) (defun create (head &key data sender) (shape:create 'message :head head :data data :sender sender)) - ;(shape:create-item (message-factory) :head head :data data :sender sender)) - ;(make-instance 'message :head head :data data :sender sender)) (defmethod print-object ((msg message) stream) (shape:print-slots msg stream 'shape:head 'sender 'shape:data)) diff --git a/shape/shape.lisp b/shape/shape.lisp index b1aa669..7c37ed1 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -4,43 +4,36 @@ (:use :common-lisp) (:local-nicknames (:util :scopes/util) (:mop :closer-mop)) - (:export #:factory #:create #:create-item #:record-factory + (:export #:meta #:get-meta #:create #:record-meta #:record #:print-fields #:print-slots #:head-fields #:head #:head-value #:head-plist #:data-fields #:data #:data-value)) (in-package :scopes/shape) -;;;; abstract base item and factory - -(defclass factory () - ((item-class :reader item-class :initarg :item-class))) +;;;; abstract base item (defclass item () - ((factory :reader factory :initarg :factory :allocation :class))) + ((meta :reader meta :initarg :meta :allocation :class))) -(defun create (cls &rest args) - (let* ((ic (find-class cls))) - (mop:ensure-finalized ic) - (apply #'make-instance cls :factory (factory (mop:class-prototype ic)) args))) +(defun get-meta (cls) + (when (symbolp cls) + (setf cls (find-class cls))) + (mop:ensure-finalized cls) + (meta (mop:class-prototype cls))) -(defun create-item (fac &rest args) - (apply #'make-instance (item-class fac) args)) +(defun create (cs &rest args) + (apply #'make-instance cs :meta (get-meta cs) args)) ;;;; record class, factory, utilities -(defclass record-factory (factory) - ((item-class :initform 'record) - (head-fields :reader head-fields :initarg :head-fields +(defclass record-meta () + ((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username)) (data-fields :reader data-fields :initarg :data-fields :initform nil))) (defclass record (item) - ((factory :initform (make-instance 'record-factory)) - (head-fields :reader head-fields :initarg :head-fields - :initform '(:taskid :username) :allocation :class) - (data-fields :reader data-fields :initarg :data-fields - :initform nil :allocation :class) + ((meta :initform (make-instance 'record-meta) :allocation :class) (head :reader head :initarg :head) (data :accessor data :initarg :data :initform nil))) @@ -48,7 +41,10 @@ (setf (slot-value rec 'head) (util:rfill (head-fields rec) head))) (defmethod print-object ((rec record) stream) - (print-fields rec stream 'head 'data)) + (print-slots rec stream 'head 'data)) + +(defmethod head-fields ((rec record)) + (head-fields (get-meta (class-of rec)))) (defun head-value (rec key) (elt (head rec) (position key (head-fields rec)))) diff --git a/storage/msgstore.lisp b/storage/msgstore.lisp index e9994f3..01926d6 100644 --- a/storage/msgstore.lisp +++ b/storage/msgstore.lisp @@ -11,7 +11,7 @@ (in-package :scopes/storage/msgstore) (defclass pmsg (message:message tracking:track) - ((shape:head-fields :initform '(:domain :action :class :item) :allocation :class))) + ((shape:meta :initform (shape:get-meta 'message:message) :allocation :class))) (defun indexes (cont) '((domain action class item) (domain class item))) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index 7e225e3..822bf84 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -22,7 +22,8 @@ (defvar *build-track-data* #'alx:hash-table-plist) (defclass track (shape:record) - ((key-fields :reader key-fields :initarg :key-fields :initform nil :allocation :class) + ((shape:meta :initform (make-instance 'shape:record-meta) :allocation :class) + (key-fields :reader key-fields :initarg :key-fields :initform nil :allocation :class) (trackid :accessor trackid :initform nil) (timestamp :accessor timestamp :initform nil) (container :reader container :initarg :container))) @@ -62,12 +63,9 @@ (make-instance 'container :short-name :trk :storage st)) (defmethod initialize-instance :after ((cont container) &key &allow-other-keys) - (let ((ic (find-class (item-class cont)))) - (setf (gethash (short-name cont) *containers*) cont) - ;(mop:ensure-finalized ic) - ;(setf (item-head-fields cont) - ; (shape:head-fields (mop:class-prototype ic))))) - (setf (item-head-fields cont) (shape:head-fields (make-instance ic))))) + (setf (gethash (short-name cont) *containers*) cont) + (setf (item-head-fields cont) + (shape:head-fields (shape:get-meta (item-class cont))))) (defun make-item (cont &rest head) (make-instance (item-class cont) :head head :container cont))