1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Low-level utility functions for UMLisp
7 ;;;; Author: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; $Id: utils.lisp,v 1.10 2003/07/19 20:32:48 kevin Exp $
12 ;;;; This file, part of UMLisp, is
13 ;;;; Copyright (c) 2000-2003 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 ;;;; *************************************************************************
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 (nth-value 0 (parse-integer s :start 1))))
41 (defun parse-cui (cui)
43 (let ((ch (schar cui 0)))
44 (if (char-equal ch #\C)
46 (nth-value 0 (parse-integer cui))))
49 (defun parse-lui (lui)
51 (let ((ch (schar lui 0)))
52 (if (char-equal ch #\L)
54 (nth-value 0 (parse-integer lui))))
57 (defun parse-sui (sui)
59 (let ((ch (schar sui 0)))
60 (if (char-equal ch #\S)
62 (nth-value 0 (parse-integer sui))))
65 (defun parse-tui (tui)
67 (let ((ch (schar tui 0)))
68 (if (char-equal ch #\T)
70 (nth-value 0 (parse-integer tui))))
73 (defun parse-eui (eui)
75 (let ((ch (schar eui 0)))
76 (if (char-equal ch #\E)
78 (nth-value 0 (parse-integer eui))))
81 (defconstant +cuisui-scale+ 10000000)
82 (declaim (type fixnum +cuisui-scale+))
84 (defun make-cuisui (cui sui)
85 (declare (fixnum cui sui)
86 (optimize (speed 3) (safety 0) (space 0)))
87 (+ (* +cuisui-scale+ cui) sui))
89 (defun make-cuilui (cui lui)
90 (declare (fixnum cui lui)
91 (optimize (speed 3) (safety 0) (space 0)))
92 (+ (* +cuisui-scale+ cui) lui))
94 (defun decompose-cuisui (cuisui)
95 "Returns the CUI and SUI of a cuisui number"
96 (floor cuisui +cuisui-scale+))
98 ;;; Lookup functions for uterms,ustr in ucons
100 (defun find-uterm-in-ucon (ucon lui)
101 (find lui (s#term ucon) :key #'lui :test 'equal))
103 (defun find-ustr-in-uterm (uterm sui)
104 (find sui (s#str uterm) :key #'sui :test 'equal))
106 (defun find-ustr-in-ucon (ucon sui)
107 (dolist (uterm (s#term ucon))
108 (dolist (ustr (s#str uterm))
109 (when (string-equal sui (sui ustr))
110 (return-from find-ustr-in-ucon ustr)))))