X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=data-structures.lisp;h=f45de422125d88abf9fb2751880d5d7140ddefb2;hp=a52c97de2968c7d4274d4570f1192b2445f0c86d;hb=HEAD;hpb=f513e7b50135115f3c56b840c2cb0d1c9c8ffa82 diff --git a/data-structures.lisp b/data-structures.lisp index a52c97d..f45de42 100644 --- a/data-structures.lisp +++ b/data-structures.lisp @@ -1,37 +1,113 @@ -;;;; $Id: data-structures.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $ - -(in-package :umlisp) +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; 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-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. +;;;; ************************************************************************* +(in-package #:umlisp) ;;; Paths for files -(defvar *umls-path* - (make-pathname :directory '(:absolute "data" "umls" "2002AC")) +(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"))) + +(defparameter *net-dir* + (make-pathname :directory '(:relative "NET"))) -(defvar *lex-path* - (merge-pathnames - (make-pathname :directory '(:relative "LEX")) - *umls-path*)) +(defparameter *meta-path* + (merge-pathnames *meta-dir* *umls-path*)) -(defvar *net-path* - (merge-pathnames - (make-pathname :directory '(:relative "NET")) - *umls-path*)) +(defparameter *lex-path* + (merge-pathnames *lex-dir* *umls-path*)) -(defun umls-path! (p) - (setq *umls-path* p)) +(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 () + ((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) + (cls :initarg :cls :accessor cls) + (rws :initarg :rws :accessor rws) + (bts :initarg :bts :accessor bts) + (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 :subdir nil :dir nil) + (:documentation "UMLS File")) + +(defclass ucol () + ((col :initarg :col :accessor col) + (des :initarg :des :accessor des) + (ref :initarg :ref :accessor ref) + (min :initarg :min :accessor cmin) + (av :initarg :av :accessor av) + (max :initarg :max :accessor cmax) + (fil :initarg :fil :accessor fil) + (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) + (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) + (:documentation "UMLS column")) + + +(defmethod print-object ((obj ufile) s) + (print-unreadable-object (obj s :type t) + (format s "~A" (fil obj)))) + +(defmethod print-object ((obj ucol) s) + (print-unreadable-object (obj s :type t) + (format s "~A" (col obj))))