X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=parse-common.lisp;h=a0c7c2afce6afea1c94dbc0c132041be7d42238d;hb=88be55a3921b3078570bb737da197c671117a719;hp=c9adcf740cd7d856a383723af8a99f55922cbf42;hpb=08af5459d3ba7d229a8339d242ef742cfe846861;p=umlisp.git

diff --git a/parse-common.lisp b/parse-common.lisp
index c9adcf7..a0c7c2a 100644
--- 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,15 +293,24 @@ 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)))
 
 (defun canonicalize-column-type (type)
   (cond
+   ((string-equal type "TINYINT")
+    (case *umls-sql-type*
+      (:mysql "TINYINT")
+      ((:postgresql :postgresql-socket) "INT1")
+      (:oracle "NUMBER(3,0)")
+      (t "INTEGER")))
    ((string-equal type "SMALLINT")
     (case *umls-sql-type*
       (:mysql "SMALLINT")
@@ -332,6 +366,9 @@ append a unique number (starting at 2) onto a column name that is repeated in th
     (sql-i (setf (sqltype col)  (canonicalize-column-type "INTEGER")
 		 (parse-fun col) #'parse-integer
 		 (quote-str col) ""))
+    (sql-t (setf (sqltype col)  (canonicalize-column-type "TINYINT")
+		 (parse-fun col) #'parse-integer
+		 (quote-str col) ""))
     (sql-f (setf (sqltype col)  (canonicalize-column-type "NUMERIC")
 		 (parse-fun col) #'read-from-string
 		 (quote-str col) ""))