Adapt getters to parser local dump location. Implement sym-by-value.
authorGerd Flaig <gefla@rose.pond.sub.org>
Fri, 11 Feb 2011 23:48:26 +0000 (00:48 +0100)
committerGerd Flaig <gefla@rose.pond.sub.org>
Fri, 11 Feb 2011 23:48:26 +0000 (00:48 +0100)
xdump.lisp

index eaa8ce125e9c03a0d4945835ebfb0b947a67733f..3114323a86bd0f40f29b532f89e0ec3ad9499575 100644 (file)
                                  :initial-element nil))
    (has-uid-p :accessor has-uid-p :initarg :has-uid-p)))
 
-(defun get-table (table-name)
-  (let* ((table-index (gethash table-name *index-by-name*))
-        (table (aref *table-by-index* table-index)))
-    table))
-
-(defun get-table-entry (table-name index)
-    (aref (table-entries (get-table table-name)) index))
-
 (defclass xdump-parser ()
   ((line-parser :accessor line-parser :initform nil)
    (entry-buffer :accessor entry-buffer
@@ -52,6 +44,9 @@
    (meta-index :accessor meta-index :initform (make-array 5))
    (meta-meta :accessor meta-meta :initform (make-array 5))))
 
+(defgeneric get-table (xdump-parser table-name))
+(defgeneric get-table-entry (xdump-parser table-name index))
+(defgeneric sym-by-value (xdump-parser table-name value))
 (defgeneric finish-table (xdump-parser number-of-records))
 (defgeneric parse-entry (xdump-parser line))
 (defgeneric parse-meta (xdump-parser name timestamp))
 (defgeneric parse-line (xdump-parser line))
 (defgeneric reset-table-parser (xdump-parser))
 
+(defmethod get-table ((parser xdump-parser) table-name)
+  (with-slots (index-by-name table-by-index) parser
+    (let* ((table-index (gethash table-name index-by-name))
+          (table (aref table-by-index table-index)))
+      table)))
+
+(defmethod get-table-entry ((parser xdump-parser) table-name index)
+    (aref (table-entries (get-table table-name)) index))
+
+(defmethod sym-by-value ((parser xdump-parser) table-name value)
+  (with-slots (table-classes-package) parser
+    (let ((value-slot (find-symbol "VALUE" table-classes-package))
+         (name-slot (find-symbol "NAME" table-classes-package))
+         (meta-type-table (get-table parser table-name)))
+      (loop for entry across (table-entries meta-type-table)
+          if (= (slot-value entry value-slot) value)
+          return (slot-value entry name-slot)))))
+
 (defmethod reset-table-parser ((parser xdump-parser))
   (with-slots (line-parser entry-buffer entry-index finalizer name timestamp)
       parser
                                           slot-list)))))))
 
 (defun entry-from-vector (class meta-table entry-vector table-classes-package)
-  (let ((new-entry (make-instance class)))
+  (let ((new-entry (make-instance class))
+       (i 0))
     (loop
-       for item in entry-vector
        for column across meta-table do
         (let ((slot (find-symbol (string-upcase (meta-name column))
                                  table-classes-package)))
-          (setf (slot-value new-entry slot) item)))
+          (setf (slot-value new-entry slot) (nth i entry-vector))
+          (incf i)))
     new-entry))
 
 (defmethod table-entry-insert-at ((table xdump-table) entry index)