X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=data-structures.lisp;h=c7e3f683f8a30b0fa939923317f0e9fa659b17e1;hb=c01a3503e58ba9d4e7fadb42f3f0f69c38496e10;hp=dfa28458383cb94597026ca5ea72e857093d49d4;hpb=3199369942d2e5ab4f5b060c2c6b655caf505944;p=umlisp.git diff --git a/data-structures.lisp b/data-structures.lisp index dfa2845..c7e3f68 100644 --- a/data-structures.lisp +++ b/data-structures.lisp @@ -2,15 +2,15 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: data-structures.lisp -;;;; Purpose: Basic data objects for UMLisp -;;;; Author: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 +;;;; Name: data-structures.lisp +;;;; Purpose: Basic data objects for UMLisp +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; -;;;; $Id: data-structures.lisp,v 1.10 2003/05/07 21:57:06 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2006 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 +18,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* "2006AD") + +(defparameter *umls-path* + (make-pathname :directory (list :absolute "srv" "umls" *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"))) + +(defparameter *meta-path* + (merge-pathnames *meta-dir* *umls-path*)) -(defvar *lex-path* - (merge-pathnames - (make-pathname :directory '(:relative "LEX")) - *umls-path*)) +(defparameter *lex-path* + (merge-pathnames *lex-dir* *umls-path*)) -(defvar *net-path* - (merge-pathnames - (make-pathname :directory '(:relative "NET")) - *umls-path*)) +(defparameter *net-path* + (merge-pathnames *net-dir* *umls-path*)) (defun umls-path! (p) - (setq *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 +83,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 () @@ -91,12 +107,11 @@ (defmethod print-object ((obj ufile) (s stream)) - (print-unreadable-object (obj s :type t :identity t) + (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) + (print-unreadable-object (obj s :type t) (format s "~A" (col obj)))) -