1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: utils.lisp
;;;; Purpose: Low-level utility functions for UMLisp
;;;; Author: Kevin M. Rosenberg
;;;; Created: Apr 2000
;;;;
;;;; $Id$
;;;;
;;;; This file, part of UMLisp, is
;;;; 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.
;;;; *************************************************************************
(in-package #:umlisp)
(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."
(declare (simple-string s)
(optimize (speed 3) (safety 0)))
(if (< (length s) 2)
nullvalue
(nth-value 0 (parse-integer s :start 1))))
(defun parse-cui (cui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp cui)
(let ((ch (schar cui 0)))
(if (char-equal ch #\C)
(parse-ui cui)
(nth-value 0 (parse-integer cui))))
cui))
(defun parse-lui (lui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp lui)
(let ((ch (schar lui 0)))
(if (char-equal ch #\L)
(parse-ui lui)
(nth-value 0 (parse-integer lui))))
lui))
(defun parse-sui (sui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp sui)
(let ((ch (schar sui 0)))
(if (char-equal ch #\S)
(parse-ui sui)
(nth-value 0 (parse-integer sui))))
sui))
(defun parse-tui (tui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp tui)
(let ((ch (schar tui 0)))
(if (char-equal ch #\T)
(parse-ui tui)
(nth-value 0 (parse-integer tui))))
tui))
(defun parse-aui (aui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp aui)
(let ((ch (schar aui 0)))
(if (char-equal ch #\A)
(parse-ui aui)
(nth-value 0 (parse-integer aui))))
aui))
(defun parse-rui (rui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp rui)
(let ((ch (schar rui 0)))
(if (char-equal ch #\R)
(parse-ui rui)
(nth-value 0 (parse-integer rui))))
rui))
(defun parse-eui (eui)
(declare (optimize (speed 3) (safety 0)))
(if (stringp eui)
(let ((ch (schar eui 0)))
(if (char-equal ch #\E)
(parse-ui eui)
(nth-value 0 (parse-integer eui))))
eui))
(defconstant +cuisui-scale+ 10000000)
(declaim (type (integer 0 10000000) +cuisui-scale+))
#+(or 64bit x86-64)
(defun make-cuisui (cui sui)
(declare (type (integer 0 10000000) cui sui)
(optimize (speed 3) (safety 0) (space 0)))
(the fixnum
(+ (the fixnum (* +cuisui-scale+ cui)) sui)))
#-(or 64bit x86-64)
(defun make-cuisui (cui sui)
(when (and cui sui)
(locally (declare (fixnum cui sui)
(optimize (speed 3) (safety 0) (space 0)))
(+ (* +cuisui-scale+ cui) sui))))
#+(or 64bit x86-64)
(defun make-cuilui (cui lui)
(declare (type (integer 0 10000000) cui lui)
(optimize (speed 3) (safety 0) (space 0)))
(the fixnum
(+ (the fixnum (* +cuisui-scale+ cui)) lui)))
#-(or 64bit x86-64)
(defun make-cuilui (cui lui)
(declare (fixnum cui lui)
(optimize (speed 3) (safety 0) (space 0)))
(+ (* +cuisui-scale+ cui) lui))
(defun decompose-cuisui (cuisui)
"Returns the CUI and SUI of a cuisui number"
#-(or 64bit x86-64) (declare (integer cuisui))
#+(or 64bit x86-64) (declare (fixnum cuisui))
(floor cuisui +cuisui-scale+))
;;; Lookup functions for uterms,ustr in ucons
(defun find-uterm-in-ucon (ucon lui)
(find lui (s#term ucon) :key #'lui :test 'equal))
(defun find-ustr-in-uterm (uterm sui)
(find sui (s#str uterm) :key #'sui :test 'equal))
(defun find-ustr-in-ucon (ucon sui)
(dolist (uterm (s#term ucon))
(dolist (ustr (s#str uterm))
(when (string-equal sui (sui ustr))
(return-from find-ustr-in-ucon ustr)))))
|
