1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Low-level utility functions for UMLisp
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; $Id: utils.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $
12 ;;;; This file, part of UMLisp, is
13 ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
15 ;;;; UMLisp users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the GNU General Public License.
17 ;;;; *************************************************************************
20 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
21 (declaim (inline make-cuisui make-cuilui parse-ui parse-cui))
23 (defmacro def-metaclass-reader (field)
24 "Create function for reading slot of metaclass"
26 (car (slot-value (class-of cl) ',field))))
28 (defmacro def-metaclass-reader-car (field)
29 "Create function for reading slot of metaclass"
31 (car (slot-value (class-of cl) ',field))))
33 ;;; Field transformations
35 (defun parse-ui (s &optional (nullvalue 0))
36 "Return integer value for a UMLS unique identifier."
39 (parse-integer s :start 1)))
41 (defun parse-cui (cui)
43 (let ((ch (aref cui 0)))
49 (defun parse-lui (lui)
51 (let ((ch (aref lui 0)))
57 (defun parse-sui (sui)
59 (let ((ch (aref sui 0)))
65 (defun parse-tui (tui)
67 (let ((ch (aref tui 0)))
73 (defun parse-eui (eui)
75 (let ((ch (aref eui 0)))
81 (defconstant +cuisui-scale+ 10000000)
83 (defun make-cuisui (cui sui)
84 (declare (fixnum cui sui))
85 (the integer (+ (* +cuisui-scale+ cui) sui)))
87 (defun make-cuilui (cui lui)
88 (declare (fixnum cui lui))
89 (the integer (+ (* +cuisui-scale+ cui) lui)))
91 (defun decompose-cuisui (cuisui)
92 (declare (integer cuisui))
93 (let* ((cui (the fixnum (truncate (/ cuisui +cuisui-scale+))))
94 (sui (the fixnum (- cuisui (* cui +cuisui-scale+)))))