rename factory to meta, with slight functionality change; work in progress: use in storage ...

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))

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))))

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)))

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))