X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=utils.lisp;h=20f91c4fe9d2ddea62b8c81030cf138d35eaa351;hb=8dc001f5e7cf851c06006e489473a85611d348be;hp=ba75eea82c7fb4074c3500a30e9f7523e1088e72;hpb=3958c05ae02edac75fe6f3413020b62f1993b22b;p=umlisp.git diff --git a/utils.lisp b/utils.lisp index ba75eea..20f91c4 100644 --- a/utils.lisp +++ b/utils.lisp @@ -7,10 +7,8 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Created: Apr 2000 ;;;; -;;;; $Id$ -;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2010 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. @@ -35,62 +33,62 @@ (defun parse-ui (s &optional (nullvalue 0)) "Return integer value for a UMLS unique identifier." (declare (simple-string s) - (optimize (speed 3) (safety 0))) + (optimize (speed 3) (safety 0))) (if (< (length s) 2) nullvalue - (nth-value 0 (parse-integer s :start 1)))) + (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)))) + (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)))) + (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)))) + (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)))) + (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)))) + (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) + (if (char-equal ch #\R) + (parse-ui rui) (nth-value 0 (parse-integer rui)))) rui)) @@ -98,30 +96,31 @@ (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)))) + (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+)) +(defconstant +cuisui-scale+ 100000000) +(declaim (type (integer 0 100000000) +cuisui-scale+)) #+(or 64bit x86-64) (defun make-cuisui (cui sui) - (declare (type (integer 0 10000000) cui sui) + (declare (type (integer 0 100000000) 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) - (declare (fixnum cui sui) - (optimize (speed 3) (safety 0) (space 0))) - (+ (* +cuisui-scale+ 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) + (declare (type (integer 0 100000000) cui lui) (optimize (speed 3) (safety 0) (space 0))) (the fixnum (+ (the fixnum (* +cuisui-scale+ cui)) lui))) @@ -129,7 +128,7 @@ #-(or 64bit x86-64) (defun make-cuilui (cui lui) (declare (fixnum cui lui) - (optimize (speed 3) (safety 0) (space 0))) + (optimize (speed 3) (safety 0) (space 0))) (+ (* +cuisui-scale+ cui) lui)) (defun decompose-cuisui (cuisui) @@ -150,4 +149,4 @@ (dolist (uterm (s#term ucon)) (dolist (ustr (s#str uterm)) (when (string-equal sui (sui ustr)) - (return-from find-ustr-in-ucon ustr))))) + (return-from find-ustr-in-ucon ustr)))))