r11478: generate custom columns by dynamically finding position of dependant columns...

[umlisp.git] / parse-common.lisp

diff --git a/parse-common.lisp b/parse-common.lisp
index 96f7b8ddef77cd7a026bb5579a4c8efb3dd516ba..a0c7c2afce6afea1c94dbc0c132041be7d42238d 100644 (file)
--- a/parse-common.lisp
+++ b/parse-common.lisp
@@ -23,12 +23,14 @@
   (handler-case
       (when (or alwaysclear (null *umls-files*))
         (setf *umls-cols* nil *umls-files* nil)
-        (gen-ucols)
         (gen-ufiles)
+        (gen-ucols)
+        (set-ucols-for-ufiles *umls-files*)
         (ensure-field-lengths))
-    (error (e)
-      (setf *umls-cols* nil *umls-files* nil)
-      (error e)))
+      (error (e)
+             (warn "Error reading ucols+ufiles: ~A." e)
+             (setf *umls-cols* nil *umls-files* nil)
+             nil))
   t)
 
 
@@ -123,12 +125,13 @@ Currently, these are the LEX and NET files."
   "Returns a list of FILENAME MAX AV"
   (declare (optimize (speed 3) (safety 0)))
   (let (fields-max fields-av num-fields (count-lines 0))
+    (declare (fixnum count-lines))
     (with-umls-ufile (line ufile)
       (unless num-fields
        (setq num-fields (length line))
        (setq fields-max (make-array num-fields :element-type 'fixnum
                                     :initial-element 0))
-       (setq fields-av (make-array num-fields :element-type 'number
+       (setq fields-av (make-array num-fields :element-type '(or integer float)
                                    :initial-element 0)))
       (dotimes (i num-fields)
        (declare (fixnum i))
@@ -138,6 +141,8 @@ Currently, these are the LEX and NET files."
                             (if *octet-sql-storage*
                                 (ext:convert-string-to-bytes str charset:utf-8)
                               str))))
+          #-(and clisp unicode) (declare (string str))
+          (declare (type (integer 0 10000000) len))
          (incf (aref fields-av i) len)
          (when (> len (aref fields-max i))
            (setf (aref fields-max i) len))))
@@ -223,7 +228,27 @@ Currently, these are the LEX and NET files."
 
 (defun find-ufile (filename)
   "Returns umls-file structure for a filename"
-  (find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*))
+  (find-if #'(lambda (f) (string= filename (fil f))) *umls-files*))
+
+(defvar *position-hash* (make-hash-table :test 'equal))
+
+(defun position-field-file (filename fieldname)
+  "Returns the position of a field in a file"
+  (let ((key (cons filename fieldname)))
+    (multiple-value-bind (pos found) (gethash key *position-hash*)
+      (if found
+          (return-from position-field-file pos)))
+
+    (let ((ufile (find-ufile filename)))
+      (unless ufile
+        (warn "Unable to find ufile for filename ~A." filename)
+        (return-from position-field-file nil))
+      (let ((pos (position fieldname (fields ufile) :test #'string=)))
+        (unless pos
+          (warn "Unable to find field ~A in ufile ~S." fieldname ufile)
+          (return-from position-field-file nil))
+        (setf (gethash key *position-hash*) pos)
+        pos))))
 
 (defun find-ucols-for-ufile (ufile)
   "Returns list of umls-cols for a file structure"
@@ -268,9 +293,12 @@ append a unique number (starting at 2) onto a column name that is repeated in th
                                :des des :cls cls
                                :rws rws :bts bts :fields fields
                                :table (filename-to-tablename file))))
-      (setf (ucols ufile) (find-ucols-for-ufile ufile))
       ufile)))
 
+(defun set-ucols-for-ufiles (ufiles)
+  (dolist (ufile ufiles)
+    (setf (ucols ufile) (find-ucols-for-ufile ufile))))
+
 (defun datatype-for-colname (colname)
 "Return datatype for column name"
   (second (find colname +col-datatypes+ :key #'car :test #'string-equal)))