classes.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          classes.lisp
   6 ;;;; Purpose:       Class defintions for UMLisp
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: classes.lisp,v 1.7 2002/10/16 17:37:18 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of UMLisp, is
  13 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
  14 ;;;;
  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 ;;;; *************************************************************************
  18
  19 (in-package :umlisp)
  20 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
  21
  22 (defclass umlsclass ()
  23   ()
  24   (:metaclass kmrcl:ml-class)
  25   (:documentation "Parent class of all UMLS objects. It is based on the KMRCL:ML-CLASS metaclass that provides object printing functions."))
  26
  27
  28 (defmethod print-object ((obj umlsclass) (s stream))
  29   (print-unreadable-object (obj s :type t :identity t)
  30     (let ((fmt (make-instance 'kmrcl::textformat)))
  31       (apply #'format
  32              s (funcall (kmrcl::obj-data-fmtstr fmt) obj)
  33              (multiple-value-list
  34               (funcall (funcall (kmrcl::obj-data-value-func fmt) obj) obj))))))
  35
  36
  37 (defclass usrl (umlsclass)
  38   ((sab :type string :initarg :sab :reader sab)
  39    (srl :type integer :initarg :srl :reader srl))
  40   (:metaclass kmrcl:ml-class)
  41   (:default-initargs :sab nil :srl nil)
  42   (:title "Source Restriction Level")
  43   (:fields (sab :string) (srl :fixnum))
  44   (:documentation "Custom Table: Source Restriction Level"))
  45
  46
  47 (defclass urank (umlsclass)
  48   ((rank :type fixnum :initarg :rank :reader rank)
  49    (sab :type string :initarg :sab :reader sab)
  50    (tty :type string :initarg :tty :reader tty)
  51    (supres :type string :initarg :supres :reader supres))
  52   (:metaclass kmrcl:ml-class)
  53   (:default-initargs :rank nil :sab nil :tty nil :supres nil)
  54   (:title "Rank")
  55   (:fields (rank :fixnum) (sab :string) (tty :string) (supres :string)))
  56
  57 (defclass udef (umlsclass)
  58   ((def :type string :initarg :def :reader def)
  59    (sab :type string :initarg :sab :reader sab))
  60   (:metaclass kmrcl:ml-class)
  61   (:default-initargs :def nil :sab nil)
  62   (:title "Definition")
  63   (:ref-fields (sab find-bsab-sab))
  64   (:fields (sab :string) (def :cdata)))
  65
  66 (defclass usat (umlsclass)
  67   ((sab :type string :initarg :sab :reader sab)
  68    (code :type string :initarg :code :reader code)
  69    (atn :type string :initarg :atn :reader atn)
  70    (atv :type string :initarg :atv :reader atv))
  71   (:metaclass kmrcl:ml-class)
  72   (:default-initargs :sab nil :code nil :atn nil :atv nil)
  73   (:title "Simple Attribute")
  74   (:ref-fields (sab find-bsab-sab))
  75   (:fields (sab :string) (code :string) (atn :string) (atv :cdata)))
  76
  77 (defclass uso (umlsclass)
  78   ((sab :type string :initarg :sab :reader sab)
  79    (code :type string :initarg :code :reader code)
  80    (tty :type string :initarg :tty :reader tty)
  81    (srl :type fixnum :initarg :srl :reader srl))
  82   (:metaclass kmrcl:ml-class)
  83   (:default-initargs :sab nil :code nil :tty nil :srl nil)
  84   (:title "Source")
  85   (:ref-fields (sab find-bsab-sab) (tty find-btty-tty))
  86   (:fields (sab :string) (code :string) (tty :string) (srl :fixnum)))
  87
  88 (defclass ucxt (umlsclass)
  89   ((sab :type string :initarg :sab :reader sab)
  90    (code :type string :initarg :code :reader code)
  91    (rnk :type fixnum :initarg :rnk :reader rnk)
  92    (cxn :type fixnum :initarg :cxn :reader cxn)
  93    (cxl :type string :initarg :cxl :reader cxl)
  94    (cxs :type string :initarg :cxs :reader cxs)
  95    (cui2 :type fixnum :initarg :cui2 :reader cui2)
  96    (hcd :type string :initarg :hcd :reader hcd)
  97    (rela :type string :initarg :rela :reader rela)
  98    (xc :type string  :initarg :xc :reader xc))
  99   (:metaclass kmrcl:ml-class)
 100   (:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
 101                      :cui2 nil :hcd nil :rela nil :xc nil)
 102   (:title "Context")
 103   (:ref-fields (sab find-bsab-sab) (cui2 find-ucon-cui))
 104   (:fields
 105    (sab :string) (code :string) (rnk :fixnum) (cxn :fixnum) (cxl :string)
 106    (hcd :string) (rela :string) (xc :string) (cui2 :string fmt-cui)
 107    (cxs :cdata)))
 108
 109 (defclass ustr (umlsclass)
 110   ((sui :type fixnum :initarg :sui :reader sui)
 111    (cui :type fixnum :initarg :cui :reader cui)
 112    (lui :type fixnum :initarg :lui :reader lui)
 113    (cuisui :type integer :initarg :cuisui :reader cuisui )
 114    (str :type string :initarg :str :reader str)
 115    (lrl :type fixnum :initarg :lrl :reader lrl)
 116    (stt :type string :initarg :stt :reader stt)
 117    (s#sat :reader s#sat)
 118    (s#so :reader s#so)
 119    (s#cxt :reader s#cxt))
 120   (:metaclass kmrcl:ml-class)
 121   (:default-initargs
 122    :sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
 123   (:title "String")
 124   (:subobjects-lists (s#sat usat) (s#so uso) (s#cxt ucxt))
 125   (:fields (sui :string fmt-sui) (stt :string) (lrl :fixnum) (str :cdata))
 126   (:ref-fields (sui find-ustr-sui)))
 127
 128 (defclass ulo (umlsclass)
 129   ((isn :type string :initarg :isn :reader isn)
 130    (fr :type fixnum :initarg :fr :reader fr)
 131    (un :type string :initarg :un :reader un)
 132    (sui :type fixnum :initarg :sui :reader sui)
 133    (sna :type string :initarg :sna :reader sna)
 134    (soui :type string :initarg :soui :reader soui))
 135   (:metaclass kmrcl:ml-class)
 136   (:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
 137   (:title "Locator")
 138   (:fields (isn :string) (fr :fixnum) (un :string) (sna :string)
 139            (soui :string) (sui :string fmt-sui) (suistr :string)))
 140
 141 (defclass uterm (umlsclass)
 142   ((lui :type fixnum :initarg :lui :reader lui)
 143    (cui :type fixnum :initarg :cui :reader cui)
 144    (lat :type string :initarg :lat :reader lat)
 145    (ts :type string  :initarg :ts :reader ts)
 146    (lrl :type fixnum :initarg :lrl :reader lrl)
 147    (s#str :reader s#str)
 148    (s#sat :reader s#sat))
 149   (:metaclass kmrcl:ml-class)
 150   (:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil)
 151   (:title "Term")
 152   (:subobjects-lists (s#sat usat) (s#str ustr))
 153   (:fields (lui :string fmt-lui) (lat :string) (ts :string) (lrl :fixnum))
 154   (:ref-fields (lui find-uterm-lui)))
 155
 156 (defclass usty (umlsclass)
 157   ((tui :type fixnum :initarg :tui :reader tui)
 158    (sty :type string :initarg :sty :reader sty))
 159   (:metaclass kmrcl:ml-class)
 160   (:default-initargs :tui nil :sty nil)
 161   (:title "Semantic Type")
 162   (:ref-fields (tui find-ucon-tui (("subobjects" "no"))))
 163   (:fields (tui :string fmt-tui) (sty :string)))
 164
 165 (defclass urel (umlsclass)
 166   ((rel :type string :initarg :rel :reader rel)
 167    (cui1 :type fixnum :initarg :cui1 :reader cui1)
 168    (cui2 :type fixnum :initarg :cui2 :reader cui2)
 169    (pfstr2 :type string :initarg :pfstr2 :reader pfstr2)
 170    (rela :type string :initarg :rela :reader rela)
 171    (sab :type string :initarg :sab :reader sab)
 172    (sl :type string  :initarg :sl :reader sl)
 173    (mg :type string  :initarg :mg :reader mg))
 174   (:metaclass kmrcl:ml-class)
 175   (:default-initargs
 176    :rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
 177   (:title "Relationship")
 178   (:ref-fields (rel find-brel-rel) (sab find-bsab-sab) (cui2 find-ucon-cui))
 179   (:fields (rel :string) (rela :string) (sab :string) (sl :string)
 180            (mg :string) (cui2 :string fmt-cui) (pfstr2 :cdata)))
 181
 182 (defclass ucoc (umlsclass)
 183   ((cui1 :type fixnum :initarg :cui1 :reader cui1)
 184    (cui2 :type fixnum :initarg :cui2 :reader cui2)
 185    (pfstr2 :type string :initarg :pfstr2 :reader pfstr2)
 186    (soc :type string :initarg :soc :reader soc)
 187    (cot :type string :initarg :cot :reader cot)
 188    (cof :type fixnum :initarg :cof :reader cof)
 189    (coa :type string :initarg :coa :reader coa))
 190   (:metaclass kmrcl:ml-class)
 191   (:default-initargs
 192    :cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
 193   (:title "Co-occuring Concept")
 194   (:ref-fields (cui2 find-ucon-cui))
 195   (:fields (soc :string) (cot :string) (cof :fixnum) (coa :cdata)
 196            (cui2 :string fmt-cui) (pfstr2 :cdata)))
 197
 198
 199 (defclass uatx (umlsclass)
 200   ((sab :type string :initarg :sab :reader sab)
 201    (rel :type string :initarg :rel :reader rel)
 202    (atx :type string :initarg :atx :reader atx))
 203   (:metaclass kmrcl:ml-class)
 204   (:default-initargs :sab nil :rel nil :atx nil)
 205   (:title "Associated Expression")
 206   (:fields (sab :string) (rel :string) (atx :cdata)))
 207
 208 (defclass ucon (umlsclass)
 209   ((cui :type fixnum :initarg :cui :reader cui )
 210    (pfstr :initarg :pfstr :reader pfstr)
 211    (lrl :initarg :lrl :reader lrl)
 212    (s#term :reader s#term)
 213    (s#def :reader s#def)
 214    (s#lo :reader s#lo)
 215    (s#rel :reader s#rel)
 216    (s#coc :reader s#coc)
 217    (s#sat :reader s#sat)
 218    (s#atx :reader s#atx)
 219    (s#sty :reader s#sty))
 220   (:metaclass kmrcl:ml-class)
 221   (:default-initargs :cui nil :pfstr nil :lrl nil)
 222   (:title "Concept")
 223   (:subobjects-lists
 224    (s#def udef) (s#sty usty) (s#lo ulo) (s#atx uatx) (s#sat usat) (s#rel urel)
 225    (s#coc ucoc) (s#term uterm))
 226   (:fields (cui :string fmt-cui) (lrl :fixum) (pfstr :cdata))
 227   (:ref-fields (cui find-ucon-cui)))
 228
 229 (defclass uxw (umlsclass)
 230   ((wd :type string :initarg :wd :reader wd)
 231    (cui :type fixnum :initform nil :initarg :cui :reader cui)
 232    (lui :type fixnum :initform nil :initarg :lui :reader lui)
 233    (sui :type fixnum :initform nil :initarg :sui :reader sui))
 234   (:metaclass kmrcl:ml-class)
 235   (:default-initargs :wd nil :cui nil :lui nil :sui nil)
 236   (:title "XW Index")
 237   (:fields (wd :string) (cui :string fmt-cui) (lui :string fmt-lui)
 238            (sui :string fmt-sui)))
 239
 240 (defclass uxnw (umlsclass)
 241   ((lat :type string :initarg :lat :reader lat)
 242    (nwd :type string :initarg :nwd :reader nwd)
 243   (cuilist :type list :initarg :cuilist :reader uxnw-cuilist))
 244   (:metaclass kmrcl:ml-class)
 245   (:default-initargs :lat nil :nwd nil :cuilist nil)
 246   (:title "XNW Index")
 247   (:fields (lat :string) (nwd :string) (cuilist :string)))
 248
 249 (defclass uxns (umlsclass)
 250   ((lat :type string :initarg :lat :reader lat)
 251    (nstr :type string :initarg :nstr :reader nstr)
 252    (cuilist :type list :initarg :cuilist :reader cuilist))
 253   (:metaclass kmrcl:ml-class)
 254   (:default-initargs :lat nil :nstr nil :cuilist nil)
 255   (:title "XNS Index")
 256   (:fields (lat :string) (nstr :string) (cuilist :string)))
 257
 258
 259 ;;; LEX objects
 260
 261 (defclass lexterm (umlsclass)
 262   ((eui :type fixnum :initarg :eui :reader eui)
 263    (wrd :type string :initarg :wrd :reader wrd)
 264    (s#abr :reader s#abr)
 265    (s#agr :reader s#agr)
 266    (s#cmp :reader s#cmp)
 267    (s#mod :reader s#mod)
 268    (s#nom :reader s#nom)
 269    (s#prn :reader s#prn)
 270    (s#prp :reader s#prp)
 271    (s#spl :reader s#spl)
 272    (s#trm :reader s#trm)
 273    (s#typ :reader s#typ))
 274   (:metaclass kmrcl:ml-class)
 275   (:default-initargs :eui nil :wrd nil)
 276   (:title "Lexical Term")
 277   (:subobjects-lists
 278    (s#abr labr) (s#agr lagr) (s#cmp lcmp) (s#mod lmod) (s#nom unom)
 279    (s#prn lprn) (s#prp lprp) (s#spl lspl) (s#trm ltrm) (s#typ ltyp))
 280   (:fields (eui :string fmt-eui) (wrd :string))
 281   (:ref-fields (eui find-lexterm-eui)))
 282
 283
 284 (defclass labr  (umlsclass)
 285   ((eui :type integer :initarg :eui :reader eui)
 286    (bas :type string :initarg :bas :reader bas)
 287    (abr :type string :initarg :abr :reader abr)
 288    (eui2 :type integer :initarg :eui2 :reader eui2)
 289    (bas2 :type string :initarg :bas2 :reader bas2))
 290   (:metaclass kmrcl:ml-class)
 291   (:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
 292   (:title "Abbreviations and Acronyms")
 293   (:fields (eui :string fmt-eui) (bas :string) (abr :string)
 294            (eui2 :string fmt-eui) (bas2 :string )))
 295
 296 (defclass lagr  (umlsclass)
 297   ((eui :type integer :initarg :eui :reader eui)
 298    (str :type string :initarg :str :reader str)
 299    (sca :type string :initarg :sca :reader sca)
 300    (agr :type string :initarg :agr :reader agr)
 301    (cit :type string :initarg :cit :reader cit)
 302    (bas :type string :initarg :bas :reader bas))
 303   (:metaclass kmrcl:ml-class)
 304   (:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil)
 305   (:title "Agreement and Inflection")
 306   (:fields (eui :string fmt-eui) (str :string) (sca :string) (agr :string)
 307            (cit :string) (bas :string)))
 308
 309 (defclass lcmp  (umlsclass)
 310   ((eui :type integer :initarg :eui :reader eui)
 311    (bas :type string :initarg :bas :reader bas)
 312    (sca :type string :initarg :sca :reader sca)
 313    (com :type string :initarg :com :reader com))
 314   (:metaclass kmrcl:ml-class)
 315   (:default-initargs :eui nil :bas nil :sca nil :com nil)
 316   (:title "Complementation")
 317   (:fields (eui :string fmt-eui) (bas :string) (sca :string) (com :string)))
 318
 319 (defclass lmod  (umlsclass)
 320   ((eui :type integer :initarg :eui :reader eui)
 321    (bas :type string :initarg :bas :reader bas)
 322    (sca :type string :initarg :sca :reader sca)
 323    (psnmod :type string :initarg :psnmod :reader psnmod)
 324    (fea :type string :initarg :fea :reader fea))
 325   (:metaclass kmrcl:ml-class)
 326   (:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
 327   (:title "Modifiers")
 328   (:fields (eui :string fmt-eui) (bas :string) (sca :string) (psnmod :string)
 329            (fea :string)))
 330
 331 (defclass lnom  (umlsclass)
 332   ((eui :type integer :initarg :eui :reader eui)
 333    (bas :type string :initarg :bas :reader bas)
 334    (sca :type string :initarg :sca :reader sca)
 335    (eui2 :type integer :initarg :eui2 :reader eui2)
 336    (bas2 :type string :initarg :bas2 :reader bas2)
 337    (sca2 :type string :initarg :sca2 :reader sca2))
 338   (:metaclass kmrcl:ml-class)
 339   (:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
 340   (:title "Nominalizations")
 341   (:fields (eui :string fmt-eui) (bas :string) (sca :string)
 342            (eui2 :string fmt-eui) (bas2 :string) (sca2 :string)))
 343
 344 (defclass lprn  (umlsclass)
 345   ((eui :type integer :initarg :eui :reader eui)
 346    (bas :type string :initarg :bas :reader bas)
 347    (num :type string :initarg :num :reader num)
 348    (gnd :type string :initarg :gnd :reader gnd)
 349    (cas :type string :initarg :cas :reader cas)
 350    (pos :type string :initarg :pos :reader pos)
 351    (qnt :type string :initarg :qnt :reader qnt)
 352    (fea :type string :initarg :fea :reader fea))
 353   (:metaclass kmrcl:ml-class)
 354   (:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil
 355                      :pos nil :qnt nil :fea nil)
 356   (:title "Pronouns")
 357   (:fields (eui :string fmt-eui) (bas :string) (num :string) (gnd :string)
 358            (cas :string) (pos :string) (qnt :string) (fea :string)))
 359
 360 (defclass lprp  (umlsclass)
 361   ((eui :type integer :initarg :eui :reader eui)
 362    (bas :type string :initarg :bas :reader bas)
 363    (str :type string :initarg :str :reader str)
 364    (sca :type string :initarg :sca :reader sca)
 365    (fea :type string :initarg :fea :reader fea))
 366   (:metaclass kmrcl:ml-class)
 367   (:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil)
 368   (:title "Properties")
 369   (:fields (eui :string fmt-eui) (bas :string) (str :string) (sca :string)
 370            (fea :string)))
 371
 372
 373 (defclass lspl  (umlsclass)
 374   ((eui :type integer :initarg :eui :reader eui)
 375    (spv :type string :initarg :spv :reader spv)
 376    (bas :type string :initarg :bas :reader bas))
 377   (:metaclass kmrcl:ml-class)
 378   (:default-initargs :eui nil :spv nil :bas nil)
 379   (:title "Spelling Variants")
 380   (:fields (eui :string fmt-eui) (spv :string) (bas :string)))
 381
 382
 383
 384 (defclass ltrm  (umlsclass)
 385   ((eui :type integer :initarg :eui :reader eui)
 386    (bas :type string :initarg :bas :reader bas)
 387    (gen :type string :initarg :gen :reader gen))
 388   (:metaclass kmrcl:ml-class)
 389   (:default-initargs :eui nil :bas nil :gen nil)
 390   (:title "Trade Marks")
 391   (:fields (eui :string fmt-eui) (bas :string) (gen :string)))
 392
 393 (defclass ltyp  (umlsclass)
 394   ((eui :type integer :initarg :eui :reader eui)
 395    (bas :type string :initarg :bas :reader bas)
 396    (sca :type string :initarg :sca :reader sca)
 397    (typ :type string :initarg :typ :reader typ))
 398   (:metaclass kmrcl:ml-class)
 399   (:default-initargs :eui nil :bas nil :sca nil :typ nil)
 400   (:title "Inflection Type")
 401   (:fields (eui :string fmt-eui) (bas :string) (sca :string) (typ :string)))
 402
 403 (defclass lwd (umlsclass)
 404   ((wrd :type string :initarg :wrd :reader wrd)
 405    (euilist :type list :initarg :euilist :reader euilist))
 406   (:metaclass kmrcl:ml-class)
 407   (:default-initargs :wrd nil :euilist nil)
 408   (:title "Lexical Word Index")
 409   (:fields (wrd :string) (euilist :string)))
 410
 411 ;;; Semantic NET objects
 412
 413 (defclass sdef (umlsclass)
 414   ((rt :type string :initarg :rt :reader rt)
 415    (ui :type integer :initarg :ui :reader ui)
 416    (styrl :type string :initarg :styrl :reader styrl)
 417    (stnrtn :type string :initarg :stnrtn :reader stnrtn)
 418    (def :type string :initarg :def :reader def)
 419    (ex :type string :initarg :ex :reader ex)
 420    (un :type string :initarg :un :reader un)
 421    (rh :type string :initarg :rh :reader rh)
 422    (abr :type string :initarg :abr :reader abr)
 423    (rin :type string :initarg :rin :reader rin))
 424   (:metaclass kmrcl:ml-class)
 425   (:default-initargs
 426    :rt nil :ui nil :styrl nil :stnrtn nil :def nil :ex nil :un nil :rh nil
 427    :abr nil :rin nil)
 428   (:title "Basic information about Semantic Types and Relations")
 429   (:fields
 430    (rt :string) (ui :string fmt-tui) (styrl :string) (stnrtn :string-tui)
 431    (def :string) (ex :string) (un :string) (rh :string) (abr :string)
 432    (rin :string)))
 433
 434 (defclass sstr (umlsclass)
 435   ((styrl :type string :initarg :styrl :reader styrl)
 436    (rl :type string :initarg :rl :reader rl)
 437    (styrl2 :type string :initarg :styrl2 :reader styrl2)
 438    (ls :type string :initarg :ls :reader ls))
 439   (:metaclass kmrcl:ml-class)
 440   (:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
 441   (:title "Structure of the Network")
 442   (:fields (styrl :string) (rl :string) (styrl2 :string) (ls :string)))
 443
 444 (defclass sstre1 (umlsclass)
 445   ((ui :type integer :initarg :ui :reader ui)
 446    (ui2 :type integer :initarg :ui2 :reader ui2)
 447    (ui3 :type integer :initarg :ui3 :reader ui3))
 448   (:metaclass kmrcl:ml-class)
 449   (:default-initargs :ui nil :ui2 nil :ui3 nil)
 450   (:title "Fully Inherited Set of Releatons (TUI's)")
 451   (:fields (ui :string fmt-tui) (ui2 :string fmt-tui) (ui3 :string fmt-tui)))
 452
 453 (defclass sstre2 (umlsclass)
 454   ((sty :type string :initarg :ui :reader sty)
 455    (rl :type string :initarg :ui2 :reader rl)
 456    (sty2 :type string :initarg :ui3 :reader sty2))
 457   (:metaclass kmrcl:ml-class)
 458   (:default-initargs :sty nil :rl nil :sty2 nil)
 459   (:title "Fully Inherited Set of Releatons (strings)")
 460   (:fields (sty :string) (rl :string) (sty2 :string)))
 461
 462 ;;; Formatting routines
 463
 464 (defgeneric fmt-cui (c))
 465 (defmethod fmt-cui ((c ucon))
 466   (format nil "C~7,'0d" (cui c)))
 467
 468 (defmethod fmt-cui ((c fixnum))
 469   (format nil "C~7,'0d" c))
 470
 471 (defmethod fmt-cui ((c string))
 472   (if (eql (aref c 0) #\C)
 473       c
 474     (format nil "C~7,'0d" (parse-integer c))))
 475
 476 (defmethod fmt-cui ((c null))
 477   (format nil "nil"))
 478
 479 (defgeneric fmt-lui (c))
 480 (defmethod fmt-lui ((l uterm))
 481   (format nil "L~7,'0d" (lui l)))
 482
 483 (defmethod fmt-lui ((l fixnum))
 484   (format nil "L~7,'0d" l))
 485
 486 (defmethod fmt-lui ((l string))
 487   (if (eql (aref l 0) #\L)
 488       l
 489   (format nil "L~7,'0d" (parse-integer l))))
 490
 491 (defgeneric fmt-sui (s))
 492 (defmethod fmt-sui ((s ustr))
 493   (format nil "S~7,'0d" (sui s)))
 494
 495 (defmethod fmt-sui ((s fixnum))
 496   (format nil "S~7,'0d" s))
 497
 498 (defmethod fmt-sui ((s string))
 499   (if (eql (aref s 0) #\S)
 500       s
 501   (format nil "S~7,'0d" (parse-integer s))))
 502
 503 (defgeneric fmt-tui (t))
 504 (defmethod fmt-tui ((s fixnum))
 505   (format nil "T~3,'0d" s))
 506
 507 (defmethod fmt-tui ((s string))
 508   (if (eql (aref s 0) #\T)
 509       s
 510   (format nil "T~3,'0d" (parse-integer s))))
 511
 512 (defgeneric fmt-eui (e))
 513 (defmethod fmt-eui ((e fixnum))
 514   (format nil "E~7,'0d" e))
 515
 516 (defmethod fmt-eui ((e string))
 517   (if (eql (aref e 0) #\E)
 518       e
 519     (format nil "E~7,'0d" (parse-integer e))))
 520
 521 (defmethod fmt-eui ((e null))
 522   (format nil "nil"))
 523
 524 ;;; Generic display functions
 525
 526 (eval-when (:compile-toplevel :load-toplevel :execute)
 527 (defun english-term-p (obj)
 528   "Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
 529   (if (eq (kmrcl::ml-class-name (kmrcl::ml-class-of obj)) 'uterm)
 530       (values (string-equal (lat obj) "ENG") t)
 531     (values nil nil))))
 532
 533 (defun display-umls-obj
 534   (obj &key (os *standard-output*) (format :text) (label nil)
 535        (file-wrapper t) (english-only nil) (subobjects nil)
 536        (refvars nil))
 537   (display-ml-class
 538    obj :os os :format format :label label :subobjects subobjects
 539    :file-wrapper file-wrapper
 540    :english-only-function (if english-only #'english-term-p nil)
 541    :refvars refvars))
 542
 543 (defmacro defludisp-ml-class (newfuncname lookup-func)
 544   "Defines functions for looking up and displaying objects"
 545   `(defun ,newfuncname
 546      (keyval &key (os *standard-output*) (format :text) (label nil)
 547              (file-wrapper t) (english-only nil) (subobjects nil))
 548      (let ((obj (funcall ,lookup-func keyval)))
 549        (display-umls-obj obj :os os :format format :label label
 550                          :file-wrapper file-wrapper :english-only english-only
 551                          :subobjects subobjects))))
 552
 553 (defludisp-ml-class disp-con #'find-ucon-cui)
 554 (defludisp-ml-class disp-term #'find-uterm-lui)
 555 (defludisp-ml-class disp-str #'find-ustr-sui)
 556
 557 #+cmu
 558 (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 ))
 559   (let ((cl (pcl:find-class c)))
 560     (pcl:finalize-inheritance cl)))
 561
 562
 563