;;;;
;;;; Name: parse-common.lisp
;;;; Purpose: Common, stable parsing routines for UMLisp
-;;;; Programmer: Kevin M. Rosenberg
+;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: parse-common.lisp,v 1.6 2003/05/06 01:34:57 kevin Exp $
+;;;; $Id: parse-common.lisp,v 1.8 2003/05/06 07:44:07 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(defun file-field-lengths (files)
(let ((lengths '()))
(dolist (file files)
- (setq file (umls-file-fil file))
+ (setq file (fil file))
(let (max-field count-field num-fields (count-lines 0))
(with-umls-file (fields file)
(unless num-fields
Currently, these are the LEX and NET files."
(let ((measure-files '()))
(dolist (file *umls-files*)
- (let ((filename (umls-file-fil file)))
+ (let ((filename (fil file)))
(unless (or (char= #\M (char filename 0))
(char= #\m (char filename 0)))
(push file measure-files))))
(let* ((filename (car length-list))
(max-field (cadr length-list))
(av-field (caddr length-list))
- (file (find-umls-file filename)))
+ (file (find-ufile filename)))
(when file
- (if (/= (length max-field) (length (umls-file-fields file)))
+ (if (/= (length max-field) (length (fields file)))
(format t "Warning: Number of file fields ~A doesn't match length of fields in file structure ~S"
max-field file)
- (dotimes (i (max (length max-field) (length (umls-file-fields file))))
+ (dotimes (i (max (length max-field) (length (fields file))))
(declare (fixnum i))
- (let* ((field (nth i (umls-file-fields file)))
- (col (find-umls-col field filename)))
+ (let* ((field (nth i (fields file)))
+ (col (find-ucol field filename)))
(if col
(progn
- (setf (umls-col-max col) (aref max-field i))
- (setf (umls-col-av col) (aref av-field i))
- (add-datatype-to-col col (datatype-for-col (umls-col-col col))))
+ (setf (cmax col) (aref max-field i))
+ (setf (av col) (aref av-field i))
+ (add-datatype-to-col col (datatype-for-col (col col))))
(error "can't find column ~A" field)))))))))))
(defun find-col-in-columns (colname filename cols)
"Returns list of umls-col structure for a column name and a filename"
(dolist (col cols)
- (when (and (string-equal filename (umls-col-fil col))
- (string-equal colname (umls-col-col col)))
+ (when (and (string-equal filename (fil col))
+ (string-equal colname (col col)))
(return-from find-col-in-columns col)))
nil)
(let ((base-colname (subseq colname 0 (1- (length colname)))))
(setq col (find-col-in-columns base-colname filename cols))
(if col
- (let ((new-col (make-umls-col
+ (let ((new-col (make-instance 'ucol
:col (copy-seq colname)
- :des (copy-seq (umls-col-des col))
- :ref (copy-seq (umls-col-ref col))
- :min (umls-col-min col)
- :max (umls-col-max col)
- :fil (copy-seq (umls-col-fil col))
- :sqltype (copy-seq (umls-col-sqltype col))
- :dty (copy-seq (umls-col-dty col))
- :parsefunc (umls-col-parsefunc col)
- :quotechar (copy-seq (umls-col-quotechar col))
- :datatype (umls-col-datatype col)
- :custom-value-func (umls-col-custom-value-func col))))
+ :des (copy-seq (des col))
+ :ref (copy-seq (ref col))
+ :min (cmin col)
+ :max (cmax col)
+ :fil (copy-seq (fil col))
+ :sqltype (copy-seq (sqltype col))
+ :dty (copy-seq (dty col))
+ :parse-fun (parse-fun col)
+ :quotechar (copy-seq (quotechar col))
+ :datatype (datatype col)
+ :custom-value-fun (custom-value-fun col))))
(push new-col *umls-cols*)
new-col)
(error "Couldn't find a base column for col ~A in file ~A"
colname filename)))
- (let ((new-col (make-umls-col
+ (let ((new-col (make-instance 'ucol
:col (copy-seq colname)
:des "Unknown"
:ref ""
:fil filename
:sqltype "VARCHAR"
:dty nil
- :parsefunc #'add-sql-quotes
+ :parse-fun #'add-sql-quotes
:quotechar "'"
:datatype nil
- :custom-value-func nil)))
+ :custom-value-fun nil)))
(push new-col *umls-cols*)
new-col))))))
-(defun find-umls-col (colname filename)
+(defun find-ucol (colname filename)
"Returns list of umls-col structure for a column name and a filename"
(find-or-make-col-in-columns colname filename *umls-cols*))
-(defun find-umls-file (filename)
+(defun find-ufile (filename)
"Returns umls-file structure for a filename"
- (find-if (lambda (f) (string-equal filename (umls-file-fil f))) *umls-files*))
+ (find-if (lambda (f) (string-equal filename (fil f))) *umls-files*))
-(defun umls-cols-for-umls-file (file)
+(defun ucols-for-ufile (file)
"Returns list of umls-cols for a file structure"
- (let ((filename (umls-file-fil file)))
- (mapcar (lambda (col) (find-umls-col col filename))
- (umls-file-fields file))))
+ (let ((filename (fil file)))
+ (mapcar (lambda (col) (find-ucol col filename))
+ (fields file))))