parse-2002.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          parse-2002.lisp
   6 ;;;; Purpose:       Parsing and SQL insertion routines for UMLisp which may
   7 ;;;;                change from year to year
   8 ;;;; Author:        Kevin M. Rosenberg
   9 ;;;; Date Started:  Apr 2000
  10 ;;;;
  11 ;;;; $Id: parse-2002.lisp,v 1.8 2003/05/06 07:44:07 kevin Exp $
  12 ;;;;
  13 ;;;; This file, part of UMLisp, is
  14 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
  15 ;;;;
  16 ;;;; UMLisp users are granted the rights to distribute and use this software
  17 ;;;; as governed by the terms of the GNU General Public License.
  18 ;;;; *************************************************************************
  19
  20 (in-package #:umlisp)
  21
  22 (eval-when (:compile-toplevel)
  23   (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
  24
  25 ;;; Pre-read data for custom fields into hash tables
  26 (defvar *parse-hash-init?* nil)
  27
  28 (eval-when (:compile-toplevel :load-toplevel :execute)
  29 (let ((pfstr-hash nil)      ;;; Preferred concept strings by CUI
  30       (cui-lrl-hash nil)    ;;; LRL by CUI
  31       (lui-lrl-hash nil)    ;;; LRL by LUI
  32       (cuisui-lrl-hash nil) ;;; LRL by CUISUI
  33       (sab-srl-hash nil))   ;;; SRL by SAB
  34
  35   (defun make-parse-hash-table ()
  36     (if pfstr-hash
  37         (progn
  38           (clrhash pfstr-hash)
  39           (clrhash cui-lrl-hash)
  40           (clrhash lui-lrl-hash)
  41           (clrhash cuisui-lrl-hash)
  42           (clrhash sab-srl-hash))
  43       (setf
  44           pfstr-hash (make-hash-table :size 800000)
  45           cui-lrl-hash (make-hash-table :size 800000)
  46           lui-lrl-hash (make-hash-table :size 1500000)
  47           cuisui-lrl-hash (make-hash-table :size 1800000)
  48           sab-srl-hash (make-hash-table :size 100 :test 'equal))))
  49
  50   (defun binit-hash-table (&optional (force-read nil))
  51     (when (or force-read (not *parse-hash-init?*))
  52       (make-parse-hash-table)
  53       (setq *parse-hash-init?* t))
  54     (with-buffered-umls-file (line "MRCON")
  55       (let ((cui (parse-ui (aref line 0)))
  56             (lui (parse-ui (aref line 3)))
  57             (sui (parse-ui (aref line 5)))
  58             (lrl (parse-integer (aref line 7))))
  59         (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
  60           (if (and (string-equal (aref line 1) "ENG") ; LAT
  61                    (string-equal (aref line 2) "P") ; ts
  62                    (string-equal (aref line 4) "PF")) ; stt
  63               (setf (gethash cui pfstr-hash) (aref line 6))))
  64         (set-lrl-hash cui lrl cui-lrl-hash)
  65         (set-lrl-hash lui lrl lui-lrl-hash)
  66         (set-lrl-hash (make-cuisui cui sui) lrl cuisui-lrl-hash)))
  67     (with-buffered-umls-file (line "MRSO")
  68       (let ((sab (aref line 3)))
  69         (unless (gethash sab sab-srl-hash)  ;; if haven't stored
  70           (setf (gethash sab sab-srl-hash) (aref line 6))))))
  71
  72   (defun init-hash-table (&optional (force-read nil))
  73     (when (or force-read (not *parse-hash-init?*))
  74       (make-parse-hash-table)
  75       (setq *parse-hash-init?* t))
  76     (with-umls-file (line "MRCON")
  77       (let ((cui (parse-ui (nth 0 line)))
  78             (lui (parse-ui (nth 3 line)))
  79             (sui (parse-ui (nth 5 line)))
  80             (lrl (parse-integer (nth 7 line))))
  81         (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
  82           (if (and (string-equal (nth 1 line) "ENG") ; LAT
  83                    (string-equal (nth 2 line) "P") ; ts
  84                    (string-equal (nth 4 line) "PF")) ; stt
  85               (setf (gethash cui pfstr-hash) (nth 6 line))))
  86         (set-lrl-hash cui lrl cui-lrl-hash)
  87         (set-lrl-hash lui lrl lui-lrl-hash)
  88         (set-lrl-hash (make-cuisui cui sui) lrl cuisui-lrl-hash)))
  89     (with-umls-file (line "MRSO")
  90       (let ((sab (nth 3 line)))
  91         (multiple-value-bind (val found) (gethash sab sab-srl-hash)
  92           (declare (ignore val))
  93           (unless found
  94             (setf (gethash sab sab-srl-hash) (parse-integer (nth 6 line))))))))
  95
  96   (defun pfstr-hash (cui)
  97     (gethash cui pfstr-hash))
  98
  99   (defun cui-lrl (cui)
 100     (gethash cui cui-lrl-hash))
 101
 102   (defun lui-lrl (lui)
 103     (gethash lui lui-lrl-hash))
 104
 105   (defun cuisui-lrl (cuisui)
 106     (gethash cuisui cuisui-lrl-hash))
 107
 108   (defun sab-srl (sab)
 109     (kmrcl:aif (gethash sab sab-srl-hash) kmrcl::it 0))
 110 )) ;; closure
 111
 112 (defun set-lrl-hash (key lrl hash)
 113   "Set the least restrictive level in hash table"
 114   (multiple-value-bind (hash-lrl found) (gethash key hash)
 115     (if (or (not found) (< lrl hash-lrl))
 116         (setf (gethash key hash) lrl))))
 117
 118 ;; UMLS file and column structures
 119 ;;; SQL datatypes symbols
 120 ;;; sql-u - Unique identifier
 121 ;;; sql-s - Small integer (16-bit)
 122 ;;; sql-i - Integer (32-bit)
 123 ;;; sql-l - Big integer (64-bit)
 124 ;;; sql-f - Floating point
 125
 126 (defparameter +col-datatypes+
 127     '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
 128       ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
 129       ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-s)
 130       ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
 131       ;;; Custom columns
 132       ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i)
 133       ("KSRL" sql-i) ("KLRL" sql-i)
 134       ;;; LEX columns
 135       ("EUI" sql-u) ("EUI2" sql-u)
 136       ;;; Semantic net columns
 137       ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
 138       ;; New fields for 2002AD
 139       ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
 140       )
 141     "SQL data types for each non-string column")
 142
 143 (defparameter +custom-tables+
 144     nil
 145   #+ignore
 146   '(("MRCONSO" "SELECT m.CUI, m.LAT, m.TS, m.LUI, m.STT, m.SUI, m.STR, m.LRL, s.SAB, s.TTY, s.SCD, s.SRL FROM MRCON m, MRSO s WHERE m.CUI=s.CUI AND m.LUI=s.LUI AND m.SUI=s.SUI")
 147     ("MRCONFULL" "SELECT m.CUI, m.LAT, m.TS, m.LUI, m.STT, m.SUI, m.STR, m.LRL, s.SAB, s.TTY, s.SCD, s.SRL, t.TUI FROM MRCON m, MRSO s, MRSTY t WHERE m.CUI=s.CUI AND m.LUI=s.LUI AND m.SUI=s.SUI AND m.CUI=t.CUI AND s.CUI=t.CUI"))
 148   "Custom tables to create")
 149
 150 (defparameter +custom-cols+
 151     '(("MRCON" "KPFSTR" "TEXT" 1024
 152                (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
 153       ("MRCON" "KCUISUI" "BIGINT" 0
 154        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
 155       ("MRCON" "KCUILUI" "BIGINT" 0
 156        (lambda (x) (format nil "~d" (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x))))))
 157       ("MRCON" "KCUILRL" "INTEGER" 0
 158        (lambda (x) (format nil "~d" (cui-lrl (parse-ui (nth 0 x))))))
 159       ("MRCON" "KLUILRL" "INTEGER" 0
 160        (lambda (x) (format nil "~d" (lui-lrl (parse-ui (nth 3 x))))))
 161       ("MRLO" "KLRL" "INTEGER" 0
 162        (lambda (x) (format nil "~d"
 163                     (if (zerop (length (nth 4 x)))
 164                         (cui-lrl (parse-ui (nth 0 x)))
 165                       (cuisui-lrl (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 4 x))))))))
 166       ("MRSTY" "KLRL" "INTEGER" 0
 167        (lambda (x) (format nil "~d" (cui-lrl (parse-ui (nth 0 x))))))
 168       ("MRCOC" "KLRL" "INTEGER" 0
 169        (lambda (x) (format nil "~d"
 170                     (max (cui-lrl (parse-ui (nth 0 x)))
 171                          (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
 172       ("MRSAT" "KSRL" "INTEGER" 0
 173        (lambda (x) (format nil "~d" (sab-srl (nth 5 x)))))
 174       ("MRREL" "KSRL" "INTEGER" 0
 175        (lambda (x) (format nil "~d" (sab-srl (nth 4 x)))))
 176       ("MRRANK" "KSRL" "INTEGER" 0
 177        (lambda (x) (format nil "~d" (sab-srl (nth 1 x)))))
 178       ("MRDEF" "KSRL" "INTEGER" 0
 179        (lambda (x) (format nil "~d" (sab-srl (nth 1 x)))))
 180       ("MRCXT" "KSRL" "INTEGER" 0
 181        (lambda (x) (format nil "~d" (sab-srl (nth 2 x)))))
 182       ("MRATX" "KSRL" "INTEGER" 0
 183        (lambda (x) (format nil "~d" (sab-srl (nth 1 x)))))
 184       ("MRXW.ENG" "KLRL" "INTEGER" 0
 185        (lambda (x) (format nil "~d" (cuisui-lrl (make-cuisui
 186                                                  (parse-ui (nth 2 x))
 187                                                  (parse-ui (nth 4 x)))))))
 188       ("MRXW.NONENG" "KLRL" "INTEGER" 0
 189        (lambda (x) (format nil "~d" (cuisui-lrl (make-cuisui
 190                                                  (parse-ui (nth 2 x))
 191                                                  (parse-ui (nth 4 x)))))))
 192       ("MRXNW.ENG" "KLRL" "INTEGER" 0
 193        (lambda (x) (format nil "~d" (cuisui-lrl (make-cuisui
 194                                                  (parse-ui (nth 2 x))
 195                                                  (parse-ui (nth 4 x)))))))
 196       ("MRXNS.ENG" "KLRL" "INTEGER" 0
 197        (lambda (x) (format nil "~d" (cuisui-lrl (make-cuisui
 198                                                  (parse-ui (nth 2 x))
 199                                                  (parse-ui (nth 4 x)))))))
 200       ("MRREL" "KPFSTR2" "TEXT" 1024
 201        (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
 202       ("MRCOC" "KPFSTR2" "TEXT" 1024
 203        (lambda (x) (pfstr-hash (parse-ui (nth 1 x)))))
 204       ("MRCXT" "KCUISUI" "BIGINT" 0
 205        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
 206       ("MRSAT" "KCUILUI" "BIGINT" 0
 207        (lambda (x) (format nil "~d" (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
 208       ("MRSAT" "KCUISUI" "BIGINT" 0
 209        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
 210       ("MRSO" "KCUISUI" "BIGINT" 0
 211        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
 212       ("MRXW.ENG" "KCUISUI" "BIGINT" 0
 213        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 214       ("MRXNW.ENG" "KCUISUI" "BIGINT" 0
 215        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 216       ("MRXNS.ENG" "KCUISUI" "BIGINT" 0
 217        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 218       ("MRXW.NONENG" "LAT" "CHAR" 3 (lambda (x) (nth 0 x)))
 219       ("MRXW.NONENG" "WD"  "CHAR" 200  (lambda (x) (nth 1 x)))
 220       ("MRXW.NONENG" "CUI" "INTEGER" 0 (lambda (x) (parse-ui (nth 2 x))))
 221       ("MRXW.NONENG" "LUI" "INTEGER" 0 (lambda (x) (parse-ui (nth 3 x))))
 222       ("MRXW.NONENG" "SUI" "INTEGER" 0 (lambda (x) (parse-ui (nth 4 x))))
 223       ("MRXW.NONENG" "KCUISUI" "BIGINT" 0
 224        (lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
 225   "Custom columns to create.(filename, col, sqltype, value-func).")
 226
 227 (defparameter +index-cols+
 228     '(("CUI" "MRATX") ("CUI1" "MRCOC") ("CUI" "MRCON") ("LUI" "MRCON")
 229       ("LRL" "MRCON")
 230       ("SUI" "MRCON") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO")
 231       ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
 232       ("CUI" "MRSO") ("SAB" "MRSO") ("SRL" "MRSO") ("CUI" "MRSTY")
 233       ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") ("NSTR" "MRXNS_ENG" 10)
 234       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
 235       ("KCUISUI" "MRCON") ("KCUILUI" "MRCON") ("KCUILRL" "MRCON")
 236       ("KLUILRL" "MRCON") ("KCUISUI" "MRCXT")
 237       ("KCUISUI" "MRSO") ("KCUISUI" "MRSAT")  ("KCUILUI" "MRSAT")
 238       ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
 239       ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
 240       ("KSRL" "MRATX") ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK")
 241       ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
 242       ("KLRL" "MRLO") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
 243       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
 244       ;; LEX indices
 245       ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
 246       ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
 247       ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
 248       ("BAS" "LRABR")
 249       ;; Semantic NET indices
 250       ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
 251       ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
 252       ("RL" "SRSTR")
 253       ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
 254       ("VCUI" "MRSAB") ("LAT" "MRSAB"))
 255   "Columns in files to index")
 256
 257 (defparameter +custom-index-cols+
 258   nil
 259   #+ignore
 260   '(("CUI" "MRCONFULL") ("SAB" "MRCONFULL") ("TUI" "MRCONFULL"))
 261   "Indexes to custom tables")
 262
 263 ;; File & Column functions
 264
 265 (defun init-umls (&optional (alwaysclear nil))
 266 "Initialize all UMLS file and column structures if not already initialized"
 267   (when (or alwaysclear (null *umls-files*))
 268     (init-umls-cols)
 269     (init-umls-files)
 270     (init-field-lengths)))
 271
 272 (defun init-umls-cols ()
 273   (setq *umls-cols* (append
 274                      (init-meta-cols)
 275                      (init-custom-cols)
 276                      (init-generic-cols "LRFLD")
 277                      (init-generic-cols "SRFLD"))))
 278
 279 (defun init-meta-cols ()
 280 "Initialize all umls columns"
 281   (let ((cols '()))
 282     (with-umls-file (line "MRCOLS")
 283       (destructuring-bind (col des ref min av max fil dty) line
 284         (let ((c (make-instance 'ucol
 285                   :col col
 286                   :des des
 287                   :ref ref
 288                   :min (parse-integer min)
 289                   :av (read-from-string av)
 290                   :max (parse-integer max)
 291                   :fil fil
 292                   :dty dty  ;; new in 2002 UMLS
 293                   :sqltype "VARCHAR"    ; default data type
 294                   :parse-fun #'add-sql-quotes
 295                   :custom-value-fun nil
 296                   :quotechar "'")))
 297           (add-datatype-to-col c (datatype-for-col col))
 298           (push c cols))))
 299     (nreverse cols)))
 300
 301 (defun init-custom-cols ()
 302 "Initialize umls columns for custom columns"
 303   (let ((cols '()))
 304     (dolist (customcol +custom-cols+)
 305       (let ((c (make-instance 'ucol
 306                               :col (nth 1 customcol) :des "" :ref 0 :min 0 :max (nth 3 customcol)
 307                               :av 0 :dty nil :fil (nth 0 customcol) :sqltype (nth 2 customcol)
 308                               :parse-fun #'add-sql-quotes  :custom-value-fun (nth 4 customcol)
 309                               :quotechar "'")))
 310         (add-datatype-to-col c (datatype-for-col (nth 1 customcol)))
 311         (push c cols)))
 312     (nreverse cols)))
 313
 314 (defun escape-column-name (name)
 315   (substitute #\_ #\/ name))
 316
 317 (defun init-generic-cols (col-filename)
 318 "Initialize for generic (LEX/NET) columns"
 319   (let ((cols '()))
 320     (with-umls-file (line col-filename)
 321       (destructuring-bind (nam des ref fil) line
 322         (setq nam (escape-column-name nam))
 323         (dolist (file (delimited-string-to-list fil #\,))
 324           (let ((c (make-instance 'ucol
 325                   :col nam
 326                   :des des
 327                   :ref ref
 328                   :min nil
 329                   :av nil
 330                   :max nil
 331                   :fil file
 332                   :dty nil
 333                   :sqltype "VARCHAR"    ; default data type
 334                   :parse-fun #'add-sql-quotes
 335                   :custom-value-fun nil
 336                   :quotechar "'")))
 337             (add-datatype-to-col c (datatype-for-col nam))
 338             (push c cols)))))
 339     (nreverse cols)))
 340
 341 (defun init-umls-files ()
 342   (setq *umls-files* (append
 343                       (init-generic-files "MRFILES")
 344                       (init-generic-files "LRFIL")
 345                       (init-generic-files "SRFIL")))
 346   ;; need to separate this since init-custom-files depends on *umls-files*
 347   (setq *umls-files* (append *umls-files* (init-custom-files))))
 348
 349
 350 (defun umls-field-string-to-list (fmt)
 351   "Converts a comma delimited list of fields into a list of field names. Will
 352 append a unique number (starting at 2) onto a column name that is repeated in the list"
 353   (let ((field-list (delimited-string-to-list (escape-column-name fmt) #\,))
 354         (col-count (make-hash-table :test 'equal)))
 355     (dotimes (i (length field-list))
 356       (declare (fixnum i))
 357       (let ((col (nth i field-list)))
 358         (multiple-value-bind (key found) (gethash col col-count)
 359           (if found
 360               (let ((next-id (1+ key)))
 361                 (setf (nth i field-list) (concatenate 'string
 362                                                     col
 363                                                     (format nil "~D" next-id)))
 364                 (setf (gethash col col-count) next-id))
 365             (setf (gethash col col-count) 1)))))
 366     field-list))
 367
 368 (defun init-generic-files (files-filename)
 369 "Initialize all LEX file structures"
 370   (let ((files '()))
 371   (with-umls-file (line files-filename)
 372     (destructuring-bind (fil des fmt cls rws bts) line
 373       (let ((f (make-instance 'ufile
 374                 :fil fil
 375                 :table (substitute #\_ #\. fil)
 376                 :des des
 377                 :fmt (escape-column-name fmt)
 378                 :cls (parse-integer cls)
 379                 :rws (parse-integer rws)
 380                 :bts (parse-integer bts)
 381                 :fields (concatenate 'list
 382                           (umls-field-string-to-list fmt)
 383                           (custom-colnames-for-filename fil)))))
 384         (setf (ucols f) (ucols-for-ufile f))
 385         (push f files))))
 386   (nreverse files)))
 387
 388 (defun init-custom-files ()
 389   (let ((ffile (make-instance 'ufile
 390                      :fil "MRXW.NONENG" :des "Custom NonEnglish Index" :table "MRXW_NONENG"
 391                      :cls 5 :rws 0 :bts 0 :fields (fields (find-ufile "MRXW.ENG")))))
 392     (setf (ucols ffile)
 393       (ucols-for-ufile ffile))
 394     (list ffile)))
 395
 396 (defun datatype-for-col (colname)
 397 "Return datatype for column name"
 398   (car (cdr (find colname +col-datatypes+ :key #'car :test #'string-equal))))
 399
 400 (defun add-datatype-to-col (col datatype)
 401 "Add data type information to column"
 402   (setf (datatype col) datatype)
 403   (case datatype
 404     (sql-u (setf (sqltype col) "INTEGER"
 405                  (parse-fun col) #'parse-ui
 406                  (quotechar col) ""))
 407     (sql-s (setf (sqltype col) "SMALLINT"
 408                  (parse-fun col) #'parse-integer
 409                  (quotechar col) ""))
 410     (sql-l (setf (sqltype col) "BIGINT"
 411                  (parse-fun col) #'parse-integer
 412                  (quotechar col) ""))
 413     (sql-i (setf (sqltype col) "INTEGER"
 414                  (parse-fun col) #'parse-integer
 415                  (quotechar col) ""))
 416     (sql-f (setf (sqltype col) "NUMERIC"
 417                  (parse-fun col) #'read-from-string
 418                  (quotechar col) ""))
 419     (t                       ; Default column type, optimized text storage
 420      (setf (parse-fun col) #'add-sql-quotes
 421            (quotechar col) "'")
 422      (when (and (cmax col) (av col))
 423        (if (> (cmax col) 255)
 424            (setf (sqltype col) "TEXT")
 425          (if (< (- (cmax col) (av col)) 4)
 426              (setf (sqltype col) "CHAR") ; if average bytes wasted < 4
 427            (setf (sqltype col) "VARCHAR")))))))
 428
 429
 430