r9507: rrf updates

[umlisp.git] / parse-common.lisp

diff --git a/parse-common.lisp b/parse-common.lisp
index 98d0c018be432e33f74db79a67a78eeede645fe3..c6032363b39749f0f758613c8c6549731fc55359 100644 (file)
--- a/parse-common.lisp
+++ b/parse-common.lisp
@@ -19,8 +19,10 @@
 (in-package #:umlisp)
 
 (defun ensure-ucols+ufiles (&optional (alwaysclear nil))
-"Initialize all UMLS file and column structures if not already initialized"
+  "Initialize all UMLS file and column structures if not already initialized"
   (when (or alwaysclear (null *umls-files*))
+    (setq *umls-cols* nil)
+    (setq *umls-files* nil)
     (gen-ucols)
     (gen-ufiles)
     (ensure-field-lengths)))
@@ -35,6 +37,16 @@
   (setq *umls-files* (append (mklist ufiles) *umls-files*))
   ufiles)
 
+(defun ufile-pathname (ufile &optional (extension ""))
+  "Return pathname for a umls filename with an optional extension"
+  (assert (typep ufile 'ufile))
+  (let ((dirs (append (list (dir ufile)) 
+                     (awhen (subdir ufile) (list it)))))
+     (merge-pathnames 
+      (make-pathname :name (concatenate 'string (fil ufile) extension)
+                    :directory (cons :relative dirs))
+      *umls-path*)))
+
 (defun umls-pathname (filename &optional (extension ""))
 "Return pathname for a umls filename with an optional extension"
   (etypecase filename
@@ -51,14 +63,8 @@
        (t
         *umls-path*))))
     (pathname
-      filename)))
+     filename)))
 
-(defun read-umls-line (strm &optional (eof 'eof))
-  "Read a line from a UMLS stream, split into fields"
-  (let ((line (read-line strm nil eof)))
-    (if (eq line eof)
-       eof
-       (delimited-string-to-list line #\| t))))
 
 ;;; Find field lengths for LEX and NET files
 
@@ -89,18 +95,18 @@ Currently, these are the LEX and NET files."
   (loop for ufile in *umls-files*
        unless (or (char= #\M (schar (fil ufile) 0))
                   (char= #\m (schar (fil ufile) 0)))
-       collect ufile))
+      collect ufile))
     
   
 (defun ufiles-field-lengths (ufiles)
   "Returns a list of lists of containing (FILE MAX AV)"
-  (loop for ufile in ufiles collect (file-field-lengths (fil ufile))))
+  (loop for ufile in ufiles collect (file-field-lengths ufile)))
 
-(defun file-field-lengths (filename)
+(defun file-field-lengths (ufile)
   "Returns a list of FILENAME MAX AV"
   (declare (optimize (speed 3) (safety 0)))
   (let (fields-max fields-av num-fields (count-lines 0))
-    (with-umls-file (line filename)
+    (with-umls-ufile (line ufile)
       (unless num-fields
        (setq num-fields (length line))
        (setq fields-max (make-array num-fields :element-type 'fixnum 
@@ -116,7 +122,7 @@ Currently, these are the LEX and NET files."
       (incf count-lines))
     (dotimes (i num-fields)
       (setf (aref fields-av i) (float (/ (aref fields-av i) count-lines))))
-    (list filename fields-max fields-av)))
+    (list (fil ufile) fields-max fields-av)))
 
 ;;; UMLS column/file functions
 
@@ -177,7 +183,9 @@ Currently, these are the LEX and NET files."
               :col col :des des :ref ref :min min :av av 
               :max (if (eql max 0) 1 max) ;; ensure at least one char wide
               :fil fil
-              :dty dty :sqltype sqltype :quote-str quote-str
+              :dty dty
+              :sqltype sqltype 
+              :quote-str quote-str
               :parse-fun (ensure-compiled-fun parse-fun)
               :custom-value-fun (ensure-compiled-fun custom-value-fun))))
     (ensure-ucol-datatype ucol (datatype-for-colname col))
@@ -215,11 +223,28 @@ append a unique number (starting at 2) onto a column name that is repeated in th
               (setf (gethash colname col-counts) 1)
               colname))))))
 
-(defun make-ufile (fil des table cls rws bts fields)
-  (let ((ufile (make-instance 'ufile :fil fil :des des :table table :cls cls
-                             :rws rws :bts bts :fields fields)))
-    (setf (ucols ufile) (find-ucols-for-ufile ufile))
-    ufile))
+(defun decompose-fil (fil)
+  (if fil
+      (let ((pos (position #\/ fil)))
+       (if pos
+           (values (subseq fil (1+ pos)) (subseq fil 0 pos))
+         (values fil nil)))
+    (values nil nil)))
+
+(defun filename-to-tablename (file)
+  (let ((pos (search ".RRF" file)))
+    (when pos
+      (setf file (subseq file 0 pos))))
+  (substitute #\_ #\. file))
+
+(defun make-ufile (dir fil des cls rws bts fields)
+  (multiple-value-bind (file subdir) (decompose-fil fil)
+    (let ((ufile (make-instance 'ufile :dir dir :fil file :subdir subdir
+                               :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 datatype-for-colname (colname)
 "Return datatype for column name"