From: Gerd Flaig <gefla@rose.pond.sub.org>
Date: Fri, 11 Feb 2011 23:48:26 +0000 (+0100)
Subject: Adapt getters to parser local dump location. Implement sym-by-value.
X-Git-Url: http://git.pond.sub.org/?p=eow;a=commitdiff_plain;h=702b7b803394d5db770b4137bd1d3698d632b227

Adapt getters to parser local dump location. Implement sym-by-value.
---

diff --git a/xdump.lisp b/xdump.lisp
index eaa8ce1..3114323 100644
--- a/xdump.lisp
+++ b/xdump.lisp
@@ -21,14 +21,6 @@
 				  :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))
@@ -60,6 +55,24 @@
 (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
@@ -142,13 +155,14 @@
 					   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)