;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: utils.lisp ;;;; Purpose: Low-level utility functions for UMLisp ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; ;;;; $Id: utils.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 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) (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) (declaim (inline make-cuisui make-cuilui parse-ui parse-cui)) (defmacro def-metaclass-reader (field) "Create function for reading slot of metaclass" `(defun ,field (cl) (car (slot-value (class-of cl) ',field)))) (defmacro def-metaclass-reader-car (field) "Create function for reading slot of metaclass" `(defun ,field (cl) (car (slot-value (class-of cl) ',field)))) ;;; Field transformations (defun parse-ui (s &optional (nullvalue 0)) "Return integer value for a UMLS unique identifier." (if (< (length s) 2) nullvalue (parse-integer s :start 1))) (defun parse-cui (cui) (if (stringp cui) (let ((ch (aref cui 0))) (if (eql ch #\C) (parse-ui cui) (parse-integer cui))) cui)) (defun parse-lui (lui) (if (stringp lui) (let ((ch (aref lui 0))) (if (eql ch #\L) (parse-ui lui) (parse-integer lui))) lui)) (defun parse-sui (sui) (if (stringp sui) (let ((ch (aref sui 0))) (if (eql ch #\S) (parse-ui sui) (parse-integer sui))) sui)) (defun parse-tui (tui) (if (stringp tui) (let ((ch (aref tui 0))) (if (eql ch #\T) (parse-ui tui) (parse-integer tui))) tui)) (defun parse-eui (eui) (if (stringp eui) (let ((ch (aref eui 0))) (if (eql ch #\E) (parse-ui eui) (parse-integer eui))) eui)) (defconstant +cuisui-scale+ 10000000) (defun make-cuisui (cui sui) (declare (fixnum cui sui)) (the integer (+ (* +cuisui-scale+ cui) sui))) (defun make-cuilui (cui lui) (declare (fixnum cui lui)) (the integer (+ (* +cuisui-scale+ cui) lui))) (defun decompose-cuisui (cuisui) (declare (integer cuisui)) (let* ((cui (the fixnum (truncate (/ cuisui +cuisui-scale+)))) (sui (the fixnum (- cuisui (* cui +cuisui-scale+))))) (values cui sui)))