X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=data-structures.lisp;h=f45de422125d88abf9fb2751880d5d7140ddefb2;hp=3500ba419a002b41b74e28c10bc5fab8c7b3fb19;hb=HEAD;hpb=965b7cc5c174f0e0b82d1589978f734ea257ed78 diff --git a/data-structures.lisp b/data-structures.lisp index 3500ba4..f45de42 100644 --- a/data-structures.lisp +++ b/data-structures.lisp @@ -2,15 +2,13 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: data-structures.lisp -;;;; Purpose: Basic data objects for UMLisp -;;;; Author: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 -;;;; -;;;; $Id: data-structures.lisp,v 1.9 2003/05/06 07:20:31 kevin Exp $ +;;;; Name: data-structures.lisp +;;;; Purpose: Basic data objects for UMLisp +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2011 by Kevin M. Rosenberg, M.D. ;;;; ;;;; UMLisp users are granted the rights to distribute and use this software ;;;; as governed by the terms of the GNU General Public License. @@ -18,46 +16,62 @@ (in-package #:umlisp) -(eval-when (:compile-toplevel) - (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))) - ;;; Paths for files -(defvar *umls-path* - (make-pathname :directory '(:absolute "data" "umls" "2003AA")) +(defparameter *release* "2017AA") + +(defparameter *umls-path* + (make-pathname :directory (list :absolute "srv" "umls" *release* *release*)) "Path for base of UMLS data files") -(defvar *meta-path* - (merge-pathnames - (make-pathname :directory '(:relative "META")) - *umls-path*)) +(defparameter *meta-dir* + (make-pathname :directory '(:relative "META"))) + +(defparameter *lex-dir* + (make-pathname :directory '(:relative "LEX"))) -(defvar *lex-path* - (merge-pathnames - (make-pathname :directory '(:relative "LEX")) - *umls-path*)) +(defparameter *net-dir* + (make-pathname :directory '(:relative "NET"))) -(defvar *net-path* - (merge-pathnames - (make-pathname :directory '(:relative "NET")) - *umls-path*)) +(defparameter *meta-path* + (merge-pathnames *meta-dir* *umls-path*)) -(defun umls-path! (p) - (setq *umls-path* p)) +(defparameter *lex-path* + (merge-pathnames *lex-dir* *umls-path*)) + +(defparameter *net-path* + (merge-pathnames *net-dir* *umls-path*)) + +(defun set-umls-path (p) + (setq *umls-path* (etypecase p + (string (parse-namestring p)) + (pathname p))) + (setq *meta-path* (merge-pathnames *meta-dir* *umls-path*)) + (setq *lex-path* (merge-pathnames *lex-dir* *umls-path*)) + (setq *net-path* (merge-pathnames *net-dir* *umls-path*))) ;;; Structures for parsing UMLS text files - -(defparameter *umls-files* nil + +(defparameter *umls-files* nil "List of umls file structures. Used when parsing text files.") -(defparameter *umls-cols* nil +(defparameter *umls-cols* nil "List of meta column structures. Used when parsing text files.") +;; Special variables + +(defvar *has-fixnum-class* (when (ignore-errors (find-class 'fixnum)) t)) + +(defvar *octet-sql-storage* t + "Used to deciding field lengths. Use nil if using UTF-8 database encoding. But, UTF-8 will cause MySQL to double the bytes used for fixed field sizes.") + ;; Preliminary objects to replace structures (defclass ufile () - ((fil :initarg :fil :accessor fil) + ((subdir :initarg :subdir :accessor subdir) + (dir :initarg :dir :accessor dir) + (fil :initarg :fil :accessor fil) (table :initarg :table :accessor table) (des :initarg :des :accessor des) (fmt :initarg :fmt :accessor fmt) @@ -67,7 +81,7 @@ (fields :initarg :fields :accessor fields) (ucols :initarg :ucols :accessor ucols)) (:default-initargs :fil nil :table nil :des nil :fmt nil :cls nil :rws nil :bts nil - :fields nil :ucols nil) + :fields nil :ucols nil :subdir nil :dir nil) (:documentation "UMLS File")) (defclass ucol () @@ -81,22 +95,19 @@ (sqltype :initarg :sqltype :accessor sqltype) (dty :initarg :dty :accessor dty :documentation "new in 2002: suggested SQL datatype") (parse-fun :initarg :parse-fun :accessor parse-fun) - (quotechar :initarg :quotechar :accessor quotechar) + (quote-str :initarg :quote-str :accessor quote-str) (datatype :initarg :datatype :accessor datatype) (custom-value-fun :initarg :custom-value-fun :accessor custom-value-fun)) (:default-initargs :col nil :des nil :ref nil :min nil :av nil :max nil :fil nil - :sqltype nil :dty nil :parse-fun nil :datatype nil - :custom-value-fun nil) + :sqltype nil :dty nil :parse-fun nil :datatype nil + :custom-value-fun nil) (:documentation "UMLS column")) -(defmethod print-object ((obj ufile) (s stream)) - (print-unreadable-object (obj s :type t :identity t) +(defmethod print-object ((obj ufile) s) + (print-unreadable-object (obj s :type t) (format s "~A" (fil obj)))) -(defmethod print-object ((obj ucol) (s stream)) - (print-unreadable-object (obj s :type t :identity t) +(defmethod print-object ((obj ucol) s) + (print-unreadable-object (obj s :type t) (format s "~A" (col obj)))) - - -