;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(eval-when (:compile-toplevel)
(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
(eval-when (:compile-toplevel)
(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
"Initialize all UMLS file and column structures if not already initialized"
(when (or alwaysclear (null *umls-files*))
(gen-ucols)
"Initialize all UMLS file and column structures if not already initialized"
(when (or alwaysclear (null *umls-files*))
(gen-ucols)
:datatype (datatype ucol) :custom-value-fun (custom-value-fun ucol))
(make-empty-ucol colname filename)))
:datatype (datatype ucol) :custom-value-fun (custom-value-fun ucol))
(make-empty-ucol colname filename)))
(defun make-ucol (col des ref min av max fil dty
&key (sqltype "VARCHAR") (parse-fun #'add-sql-quotes)
(quote-str "'") (custom-value-fun))
(let ((ucol (make-instance
'ucol
:col col :des des :ref ref :min min :av av :max max :fil fil
(defun make-ucol (col des ref min av max fil dty
&key (sqltype "VARCHAR") (parse-fun #'add-sql-quotes)
(quote-str "'") (custom-value-fun))
(let ((ucol (make-instance
'ucol
:col col :des des :ref ref :min min :av av :max max :fil fil
- :dty dty :sqltype sqltype :parse-fun parse-fun
- :quote-str quote-str :custom-value-fun custom-value-fun)))
+ :dty dty :sqltype sqltype :quote-str quote-str
+ :parse-fun (ensure-compiled-fun parse-fun)
+ :custom-value-fun (ensure-compiled-fun custom-value-fun))))
(make-ucol (copy-seq colname) "Unknown" "" nil nil nil filename nil))
(defun find-ucol (colname filename)
(make-ucol (copy-seq colname) "Unknown" "" nil nil nil filename nil))
(defun find-ucol (colname filename)
"Returns umls-file structure for a filename"
(find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*))
"Returns umls-file structure for a filename"
(find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*))
(defun umls-field-string-to-list (fmt)
"Converts a comma delimited list of fields into a list of field names. Will
(defun umls-field-string-to-list (fmt)
"Converts a comma delimited list of fields into a list of field names. Will
(let ((col-counts (make-hash-table :test 'equal)))
(loop for colname in (delimited-string-to-list (escape-column-name fmt) #\,)
collect
(let ((col-counts (make-hash-table :test 'equal)))
(loop for colname in (delimited-string-to-list (escape-column-name fmt) #\,)
collect
- (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-filename fil))
+ (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))