-;;; $Id: classes.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
-;;;
-;;; UMLS object defintions and printing routines
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: classes.lisp
+;;;; Purpose: Class defintions for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: classes.lisp,v 1.14 2002/11/23 22:15:13 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 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 (optimize (speed 3) (safety 1)))
+(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
-(defclass umlsclass ()
+(defclass umlsclass (hyperobject)
()
- (:metaclass ml-class)
- (:documentation "Parent class of all UMLS objects"))
-
-
-(defmethod print-object ((obj umlsclass) (s stream))
- (print-unreadable-object (obj s :type t :identity t)
- (let ((fmt (make-instance 'gu.ml::textformat)))
- (apply #'format
- s (funcall (gu.ml::obj-data-fmtstr fmt) obj)
- (multiple-value-list
- (funcall (funcall (gu.ml::obj-data-value-func fmt) obj) obj))))))
+ (:metaclass hyperobject-class)
+ (:documentation "Parent class of all UMLS objects. It is based on the HYPEROBJECT-CLASS metaclass that provides object printing functions."))
+(defclass usrl (umlsclass)
+ ((sab :type string :initarg :sab :reader sab)
+ (srl :type fixnum :initarg :srl :reader srl))
+ (:metaclass hyperobject-class)
+ (:default-initargs :sab nil :srl nil)
+ (:title "Source Restriction Level")
+ (:print-slots sab srl)
+ (:documentation "Custom Table: Source Restriction Level"))
(defclass urank (umlsclass)
(sab :type string :initarg :sab :reader sab)
(tty :type string :initarg :tty :reader tty)
(supres :type string :initarg :supres :reader supres))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :rank nil :sab nil :tty nil :supres nil)
(:title "Rank")
- (:fields (rank :fixnum) (sab :string) (tty :string) (supres :string)))
+ (:print-slots rank sab tty supres))
(defclass udef (umlsclass)
- ((def :type string :initarg :def :reader def)
- (sab :type string :initarg :sab :reader sab))
- (:metaclass ml-class)
+ ((def :type cdata :initarg :def :reader def)
+ (sab :type string :initarg :sab :reader sab :reference find-usab-rsab))
+ (:metaclass hyperobject-class)
(:default-initargs :def nil :sab nil)
(:title "Definition")
- (:ref-fields (sab find-bsab-sab))
- (:fields (sab :string) (def :cdata)))
+ (:print-slots sab def))
(defclass usat (umlsclass)
- ((sab :type string :initarg :sab :reader sab)
+ ((sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
(code :type string :initarg :code :reader code)
(atn :type string :initarg :atn :reader atn)
- (atv :type string :initarg :atv :reader atv))
- (:metaclass ml-class)
+ (atv :type cdata :initarg :atv :reader atv))
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :atn nil :atv nil)
(:title "Simple Attribute")
- (:ref-fields (sab find-bsab-sab))
- (:fields (sab :string) (code :string) (atn :string) (atv :cdata)))
+ (:print-slots sab code atn atv))
+
+(defclass usab (umlsclass)
+ ((vcui :type fixnum :initarg :vcui :reader vcui :print-formatter fmt-cui)
+ (rcui :type fixnum :initarg :rcui :reader rcui :print-formatter fmt-cui)
+ (vsab :type string :initarg :vsab :reader vsab)
+ (rsab :type string :initarg :rsab :reader rsab :reference find-ucan-sab)
+ (son :type string :initarg :son :reader son)
+ (sf :type string :initarg :sf :reader sf)
+ (sver :type string :initarg :sver :reader sver)
+ (mstart :type string :initarg :mstart :reader mstart)
+ (mend :type string :initarg :mend :reader mend)
+ (imeta :type string :initarg :imeta :reader imeta)
+ (rmeta :type string :initarg :rmeta :reader rmeta)
+ (slc :type cdata :initarg :slc :reader slc)
+ (scc :type cdata :initarg :scc :reader scc)
+ (srl :type fixnum :initarg :srl :reader srl)
+ (tfr :type fixnum :initarg :tfr :reader tfr :print-formatter ho:comma-integer)
+ (cfr :type fixnum :initarg :cfr :reader cfr :print-formatter ho:comma-integer)
+ (cxty :type string :initarg :cxty :reader cxty)
+ (ttyl :type string :initarg :ttyl :reader ttyl)
+ (atnl :type string :initarg :atnl :reader atnl)
+ (lat :type string :initarg :lat :reader lat)
+ (cenc :type string :initarg :cenc :reader cenc)
+ (curver :type string :initarg :curver :reader curver)
+ (sabin :type string :initarg :sabin :reader sabin))
+ (:metaclass hyperobject-class)
+ (:default-initargs :vcui nil :rcui nil :vsab nil :rsab nil :son nil :sf nil
+ :sver nil :mstart nil :mend nil :imeta nil :rmeta nil
+ :slc nil :scc nil :srl nil :tfr nil :cfr nil :cxty nil
+ :ttyl nil :atnl nil :lat nil :cenc nil :curver nil
+ :sabin nil)
+ (:title "Source Abbreviation")
+ (:print-slots vcui rcui vsab rsab san sf sver mstart mend imeta
+ rmeta slc scc srl tfr csr cxty ttyl atnl lat cenc
+ curver sabin))
(defclass uso (umlsclass)
- ((sab :type string :initarg :sab :reader sab)
+ ((sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
(code :type string :initarg :code :reader code)
- (tty :type string :initarg :tty :reader tty)
+ (tty :type string :initarg :tty :reader tty :reference find-btty-tty)
(srl :type fixnum :initarg :srl :reader srl))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :tty nil :srl nil)
(:title "Source")
- (:ref-fields (sab find-bsab-sab) (tty find-btty-tty))
- (:fields (sab :string) (code :string) (tty :string) (srl :fixnum)))
+ (:print-slots sab code tty srl))
(defclass ucxt (umlsclass)
- ((sab :type string :initarg :sab :reader sab)
+ ((sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
(code :type string :initarg :code :reader code)
(rnk :type fixnum :initarg :rnk :reader rnk)
(cxn :type fixnum :initarg :cxn :reader cxn)
(cxl :type string :initarg :cxl :reader cxl)
- (cxs :type string :initarg :cxs :reader cxs)
- (cui2 :type fixnum :initarg :cui2 :reader cui2)
+ (cxs :type cdata :initarg :cxs :reader cxs)
+ (cui2 :type fixnum :initarg :cui2 :reader cui2 :reference find-ucon-cui
+ :print-formatter fmt-cui)
(hcd :type string :initarg :hcd :reader hcd)
(rela :type string :initarg :rela :reader rela)
(xc :type string :initarg :xc :reader xc))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
:cui2 nil :hcd nil :rela nil :xc nil)
(:title "Context")
- (:ref-fields (sab find-bsab-sab) (cui2 find-ucon-cui))
- (:fields
- (sab :string) (code :string) (rnk :fixnum) (cxn :fixnum) (cxl :string)
- (hcd :string) (rela :string) (xc :string) (cui2 :string fmt-cui)
- (cxs :cdata)))
+ (:print-slots sab code rnk cnx cxl hcd rela xc cui2 cxs))
(defclass ustr (umlsclass)
- ((sui :type fixnum :initarg :sui :reader sui)
- (cui :type fixnum :initarg :cui :reader cui)
- (lui :type fixnum :initarg :lui :reader lui)
+ ((sui :type fixnum :initarg :sui :reader sui :print-formatter fmt-sui
+ :reference find-ustr-sui)
+ (cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui)
+ (lui :type fixnum :initarg :lui :reader lui :print-formatter fmt-lui
+ :reference find-uterm-lui)
(cuisui :type integer :initarg :cuisui :reader cuisui )
- (str :type string :initarg :str :reader str)
+ (str :type cdata :initarg :str :reader str)
(lrl :type fixnum :initarg :lrl :reader lrl)
(stt :type string :initarg :stt :reader stt)
- (s#sat :reader s#sat)
- (s#so :reader s#so)
- (s#cxt :reader s#cxt))
- (:metaclass ml-class)
+ (s#sat :reader s#sat :subobject t)
+ (s#so :reader s#so :subobject t)
+ (s#cxt :reader s#cxt :subobject t))
+ (:metaclass hyperobject-class)
(:default-initargs
:sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
(:title "String")
- (:subobjects-lists (s#sat usat) (s#so uso) (s#cxt ucxt))
- (:fields (sui :string fmt-sui) (stt :string) (lrl :fixnum) (str :cdata))
- (:ref-fields (sui find-ustr-sui)))
+ (:print-slots sui stt lrl str))
(defclass ulo (umlsclass)
((isn :type string :initarg :isn :reader isn)
(fr :type fixnum :initarg :fr :reader fr)
(un :type string :initarg :un :reader un)
- (sui :type fixnum :initarg :sui :reader sui)
+ (sui :type fixnum :initarg :sui :reader sui :print-formatter fmt-sui)
(sna :type string :initarg :sna :reader sna)
(soui :type string :initarg :soui :reader soui))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
(:title "Locator")
- (:fields (isn :string) (fr :fixnum) (un :string) (sna :string)
- (soui :string) (sui :string fmt-sui) (suistr :string)))
+ (:print-slots isn fr un sna soui sui suistr))
(defclass uterm (umlsclass)
- ((lui :type fixnum :initarg :lui :reader lui)
+ ((lui :type fixnum :initarg :lui :reader lui :reference find-uterm-lui)
(cui :type fixnum :initarg :cui :reader cui)
(lat :type string :initarg :lat :reader lat)
(ts :type string :initarg :ts :reader ts)
(lrl :type fixnum :initarg :lrl :reader lrl)
- (s#str :reader s#str)
- (s#sat :reader s#sat))
- (:metaclass ml-class)
+ (s#str :reader s#str :subobject t)
+ (s#sat :reader s#sat :subobject t))
+ (:metaclass hyperobject-class)
(:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil)
(:title "Term")
- (:subobjects-lists (s#sat usat) (s#str ustr))
- (:fields (lui :string fmt-lui) (lat :string) (ts :string) (lrl :fixnum))
- (:ref-fields (lui find-uterm-lui)))
+ (:print-slots lui lat ts lrl))
(defclass usty (umlsclass)
- ((tui :type fixnum :initarg :tui :reader tui)
+ ((tui :type fixnum :initarg :tui :reader tui :print-formatter fmt-tui
+ :reference (find-ucon-tui ("subobjects" "no")))
(sty :type string :initarg :sty :reader sty))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :tui nil :sty nil)
(:title "Semantic Type")
- (:ref-fields (tui find-ucon-tui (("subobjects" "no"))))
- (:fields (tui :string fmt-tui) (sty :string)))
+ (:print-slots tui sty))
(defclass urel (umlsclass)
- ((rel :type string :initarg :rel :reader rel)
- (cui1 :type fixnum :initarg :cui1 :reader cui1)
- (cui2 :type fixnum :initarg :cui2 :reader cui2)
- (pfstr2 :type string :initarg :pfstr2 :reader pfstr2)
+ ((rel :type string :initarg :rel :reader rel :reference find-brel-rel)
+ (cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
+ (cui2 :type fixnum :initarg :cui2 :reader cui2 :reference find-ucon-sui
+ :print-formatter fmt-cui)
+ (pfstr2 :type cdata :initarg :pfstr2 :reader pfstr2)
(rela :type string :initarg :rela :reader rela)
- (sab :type string :initarg :sab :reader sab)
+ (sab :type string :initarg :sab :reader sab :reference find-usab-rsab)
(sl :type string :initarg :sl :reader sl)
(mg :type string :initarg :mg :reader mg))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs
:rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
(:title "Relationship")
- (:ref-fields (rel find-brel-rel) (sab find-bsab-sab) (cui2 find-ucon-cui))
- (:fields (rel :string) (rela :string) (sab :string) (sl :string)
- (mg :string) (cui2 :string fmt-cui) (pfstr2 :cdata)))
+ (:print-slots rel rela sab sl mg cui2 pfstr2))
(defclass ucoc (umlsclass)
- ((cui1 :type fixnum :initarg :cui1 :reader cui1)
- (cui2 :type fixnum :initarg :cui2 :reader cui2)
- (pfstr2 :type string :initarg :pfstr2 :reader pfstr2)
+ ((cui1 :type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui)
+ (cui2 :type fixnum :initarg :cui2 :reader cui2 :print-formatter fmt-cui
+ :reference find-ucon-cui)
+ (pfstr2 :type cdata :initarg :pfstr2 :reader pfstr2)
(soc :type string :initarg :soc :reader soc)
(cot :type string :initarg :cot :reader cot)
(cof :type fixnum :initarg :cof :reader cof)
- (coa :type string :initarg :coa :reader coa))
- (:metaclass ml-class)
+ (coa :type cdata :initarg :coa :reader coa))
+ (:metaclass hyperobject-class)
(:default-initargs
:cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
(:title "Co-occuring Concept")
- (:ref-fields (cui2 find-ucon-cui))
- (:fields (soc :string) (cot :string) (cof :fixnum) (coa :cdata)
- (cui2 :string fmt-cui) (pfstr2 :cdata)))
+ (:print-slots soc cot cof coa cui2 pfstr2))
(defclass uatx (umlsclass)
((sab :type string :initarg :sab :reader sab)
(rel :type string :initarg :rel :reader rel)
- (atx :type string :initarg :atx :reader atx))
- (:metaclass ml-class)
+ (atx :type cdata :initarg :atx :reader atx))
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :rel nil :atx nil)
(:title "Associated Expression")
- (:fields (sab :string) (rel :string) (atx :cdata)))
+ (:print-slots sab rel atx))
(defclass ucon (umlsclass)
- ((cui :type fixnum :initarg :cui :reader cui )
- (pfstr :initarg :pfstr :reader pfstr)
- (lrl :initarg :lrl :reader lrl)
- (s#term :reader s#term)
- (s#def :reader s#def)
- (s#lo :reader s#lo)
- (s#rel :reader s#rel)
- (s#coc :reader s#coc)
- (s#sat :reader s#sat)
- (s#atx :reader s#atx)
- (s#sty :reader s#sty))
- (:metaclass ml-class)
+ ((cui :type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
+ :reference find-ucon-cui)
+ (pfstr :type cdata :initarg :pfstr :reader pfstr)
+ (lrl :type fixnum :initarg :lrl :reader lrl)
+ (s#term :reader s#term :subobject t)
+ (s#def :reader s#def :subobject t)
+ (s#lo :reader s#lo :subobject t)
+ (s#rel :reader s#rel :subobject t)
+ (s#coc :reader s#coc :subobject t)
+ (s#sat :reader s#sat :subobject t)
+ (s#atx :reader s#atx :subobject t)
+ (s#sty :reader s#sty :subobject t))
+ (:metaclass hyperobject-class)
(:default-initargs :cui nil :pfstr nil :lrl nil)
(:title "Concept")
- (:subobjects-lists
- (s#def udef) (s#sty usty) (s#lo ulo) (s#atx uatx) (s#sat usat) (s#rel urel)
- (s#coc ucoc) (s#term uterm))
- (:fields (cui :string fmt-cui) (lrl :fixum) (pfstr :cdata))
- (:ref-fields (cui find-ucon-cui)))
+ (:print-slots cui lrl pfstr))
(defclass uxw (umlsclass)
((wd :type string :initarg :wd :reader wd)
- (cui :type fixnum :initform nil :initarg :cui :reader cui)
- (lui :type fixnum :initform nil :initarg :lui :reader lui)
- (sui :type fixnum :initform nil :initarg :sui :reader sui))
- (:metaclass ml-class)
+ (cui :type fixnum :initform nil :initarg :cui :reader cui :print-formatter fmt-cui)
+ (lui :type fixnum :initform nil :initarg :lui :reader lui :print-formatter fmt-lui)
+ (sui :type fixnum :initform nil :initarg :sui :reader sui :print-formatter fmt-sui))
+ (:metaclass hyperobject-class)
(:default-initargs :wd nil :cui nil :lui nil :sui nil)
(:title "XW Index")
- (:fields (wd :string) (cui :string fmt-cui) (lui :string fmt-lui)
- (sui :string fmt-sui)))
+ (:print-slots wd cui lui sui))
(defclass uxnw (umlsclass)
((lat :type string :initarg :lat :reader lat)
(nwd :type string :initarg :nwd :reader nwd)
- (cuilist :type list :initarg :cuilist :reader uxnw-cuilist))
- (:metaclass ml-class)
+ (cuilist :type list :initarg :cuilist :reader uxnw-cuilist))
+ (:metaclass hyperobject-class)
(:default-initargs :lat nil :nwd nil :cuilist nil)
(:title "XNW Index")
- (:fields (lat :string) (nwd :string) (cuilist :string)))
+ (:print-slots lat nwd cuilist))
(defclass uxns (umlsclass)
((lat :type string :initarg :lat :reader lat)
(nstr :type string :initarg :nstr :reader nstr)
(cuilist :type list :initarg :cuilist :reader cuilist))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :lat nil :nstr nil :cuilist nil)
(:title "XNS Index")
- (:fields (lat :string) (nstr :string) (cuilist :string)))
+ (:print-slots lat nstr cuilist))
;;; LEX objects
(defclass lexterm (umlsclass)
- ((eui :type fixnum :initarg :eui :reader eui)
+ ((eui :type fixnum :initarg :eui :reader eui :print-formatter fmt-eui
+ :reference find-lexterm-eui)
(wrd :type string :initarg :wrd :reader wrd)
- (s#abr :reader s#abr)
- (s#agr :reader s#agr)
- (s#cmp :reader s#cmp)
- (s#mod :reader s#mod)
- (s#nom :reader s#nom)
- (s#prn :reader s#prn)
- (s#prp :reader s#prp)
- (s#spl :reader s#spl)
- (s#trm :reader s#trm)
- (s#typ :reader s#typ))
- (:metaclass ml-class)
+ (s#abr :reader s#abr :subobject t)
+ (s#agr :reader s#agr :subobject t)
+ (s#cmp :reader s#cmp :subobject t)
+ (s#mod :reader s#mod :subobject t)
+ (s#nom :reader s#nom :subobject t)
+ (s#prn :reader s#prn :subobject t)
+ (s#prp :reader s#prp :subobject t)
+ (s#spl :reader s#spl :subobject t)
+ (s#trm :reader s#trm :subobject t)
+ (s#typ :reader s#typ :subobject t))
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :wrd nil)
(:title "Lexical Term")
- (:subobjects-lists
- (s#abr labr) (s#agr lagr) (s#cmp lcmp) (s#mod lmod) (s#nom unom)
- (s#prn lprn) (s#prp lprp) (s#spl lspl) (s#trm ltrm) (s#typ ltyp))
- (:fields (eui :string fmt-eui) (wrd :string))
- (:ref-fields (eui find-lexterm-eui)))
+ (:print-slots eui wrd))
(defclass labr (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(abr :type string :initarg :abr :reader abr)
- (eui2 :type integer :initarg :eui2 :reader eui2)
+ (eui2 :type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui)
(bas2 :type string :initarg :bas2 :reader bas2))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
(:title "Abbreviations and Acronyms")
- (:fields (eui :string fmt-eui) (bas :string) (abr :string)
- (eui2 :string fmt-eui) (bas2 :string )))
+ (:print-slots eui bas absr eui2 bas3))
(defclass lagr (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(str :type string :initarg :str :reader str)
(sca :type string :initarg :sca :reader sca)
(agr :type string :initarg :agr :reader agr)
(cit :type string :initarg :cit :reader cit)
(bas :type string :initarg :bas :reader bas))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil)
(:title "Agreement and Inflection")
- (:fields (eui :string fmt-eui) (str :string) (sca :string) (agr :string)
- (cit :string) (bas :string)))
+ (:print-slots eui str sca agr cit bas))
(defclass lcmp (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(com :type string :initarg :com :reader com))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :com nil)
(:title "Complementation")
- (:fields (eui :string fmt-eui) (bas :string) (sca :string) (com :string)))
+ (:print-slots eui bas sca cam))
(defclass lmod (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(psnmod :type string :initarg :psnmod :reader psnmod)
(fea :type string :initarg :fea :reader fea))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
(:title "Modifiers")
- (:fields (eui :string fmt-eui) (bas :string) (sca :string) (psnmod :string)
- (fea :string)))
+ (:print-slots eui bas scan psnmod fea))
(defclass lnom (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
- (eui2 :type integer :initarg :eui2 :reader eui2)
+ (eui2 :type integer :initarg :eui2 :reader eui2 :print-formatter fmt-eui)
(bas2 :type string :initarg :bas2 :reader bas2)
(sca2 :type string :initarg :sca2 :reader sca2))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
(:title "Nominalizations")
- (:fields (eui :string fmt-eui) (bas :string) (sca :string)
- (eui2 :string fmt-eui) (bas2 :string) (sca2 :string)))
+ (:print-slots eui bas eui2 bas2 sca2))
(defclass lprn (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(num :type string :initarg :num :reader num)
(gnd :type string :initarg :gnd :reader gnd)
(pos :type string :initarg :pos :reader pos)
(qnt :type string :initarg :qnt :reader qnt)
(fea :type string :initarg :fea :reader fea))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil
:pos nil :qnt nil :fea nil)
(:title "Pronouns")
- (:fields (eui :string fmt-eui) (bas :string) (num :string) (gnd :string)
- (cas :string) (pos :string) (qnt :string) (fea :string)))
+ (:print-slots eui bas num gnd cas pos qnt fea))
(defclass lprp (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(str :type string :initarg :str :reader str)
(sca :type string :initarg :sca :reader sca)
(fea :type string :initarg :fea :reader fea))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil)
(:title "Properties")
- (:fields (eui :string fmt-eui) (bas :string) (str :string) (sca :string)
- (fea :string)))
+ (:print-slots eui bas str sca fea))
(defclass lspl (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(spv :type string :initarg :spv :reader spv)
(bas :type string :initarg :bas :reader bas))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :spv nil :bas nil)
(:title "Spelling Variants")
- (:fields (eui :string fmt-eui) (spv :string) (bas :string)))
-
+ (:print-slots eui spv bas))
(defclass ltrm (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(gen :type string :initarg :gen :reader gen))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :gen nil)
(:title "Trade Marks")
- (:fields (eui :string fmt-eui) (bas :string) (gen :string)))
+ (:print-slots eui bas gen))
(defclass ltyp (umlsclass)
- ((eui :type integer :initarg :eui :reader eui)
+ ((eui :type integer :initarg :eui :reader eui :print-formatter fmt-eui)
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(typ :type string :initarg :typ :reader typ))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :bas nil :sca nil :typ nil)
(:title "Inflection Type")
- (:fields (eui :string fmt-eui) (bas :string) (sca :string) (typ :string)))
+ (:print-slots eui bas sca typ))
(defclass lwd (umlsclass)
((wrd :type string :initarg :wrd :reader wrd)
(euilist :type list :initarg :euilist :reader euilist))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :wrd nil :euilist nil)
(:title "Lexical Word Index")
- (:fields (wrd :string) (euilist :string)))
+ (:print-slots wrd euilist))
;;; Semantic NET objects
(defclass sdef (umlsclass)
((rt :type string :initarg :rt :reader rt)
- (ui :type integer :initarg :ui :reader ui)
+ (ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)
(styrl :type string :initarg :styrl :reader styrl)
(stnrtn :type string :initarg :stnrtn :reader stnrtn)
(def :type string :initarg :def :reader def)
(rh :type string :initarg :rh :reader rh)
(abr :type string :initarg :abr :reader abr)
(rin :type string :initarg :rin :reader rin))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs
:rt nil :ui nil :styrl nil :stnrtn nil :def nil :ex nil :un nil :rh nil
:abr nil :rin nil)
(:title "Basic information about Semantic Types and Relations")
- (:fields
- (rt :string) (ui :string fmt-tui) (styrl :string) (stnrtn :string-tui)
- (def :string) (ex :string) (un :string) (rh :string) (abr :string)
- (rin :string)))
+ (:print-slots rt ui styrl stnrtn def ex un rh abr rin))
(defclass sstr (umlsclass)
((styrl :type string :initarg :styrl :reader styrl)
(rl :type string :initarg :rl :reader rl)
(styrl2 :type string :initarg :styrl2 :reader styrl2)
(ls :type string :initarg :ls :reader ls))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
(:title "Structure of the Network")
- (:fields (styrl :string) (rl :string) (styrl2 :string) (ls :string)))
+ (:print-slots styrl rl styl2 ls))
(defclass sstre1 (umlsclass)
- ((ui :type integer :initarg :ui :reader ui)
- (ui2 :type integer :initarg :ui2 :reader ui2)
- (ui3 :type integer :initarg :ui3 :reader ui3))
- (:metaclass ml-class)
+ ((ui :type integer :initarg :ui :reader ui :print-formatter fmt-tui)
+ (ui2 :type integer :initarg :ui2 :reader ui2 :print-formatter fmt-tui)
+ (ui3 :type integer :initarg :ui3 :reader ui3 :print-formatter fmt-tui))
+ (:metaclass hyperobject-class)
(:default-initargs :ui nil :ui2 nil :ui3 nil)
(:title "Fully Inherited Set of Releatons (TUI's)")
- (:fields (ui :string fmt-tui) (ui2 :string fmt-tui) (ui3 :string fmt-tui)))
+ (:print-slots ui ui2 ui3))
(defclass sstre2 (umlsclass)
((sty :type string :initarg :ui :reader sty)
(rl :type string :initarg :ui2 :reader rl)
(sty2 :type string :initarg :ui3 :reader sty2))
- (:metaclass ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :sty nil :rl nil :sty2 nil)
(:title "Fully Inherited Set of Releatons (strings)")
- (:fields (sty :string) (rl :string) (sty2 :string)))
+ (:print-slots sty rl sty2))
;;; Formatting routines
+(defgeneric fmt-cui (c))
(defmethod fmt-cui ((c ucon))
(format nil "C~7,'0d" (cui c)))
(defmethod fmt-cui ((c null))
(format nil "nil"))
+(defgeneric fmt-lui (c))
(defmethod fmt-lui ((l uterm))
(format nil "L~7,'0d" (lui l)))
l
(format nil "L~7,'0d" (parse-integer l))))
+(defgeneric fmt-sui (s))
(defmethod fmt-sui ((s ustr))
(format nil "S~7,'0d" (sui s)))
s
(format nil "S~7,'0d" (parse-integer s))))
+(defgeneric fmt-tui (t))
(defmethod fmt-tui ((s fixnum))
(format nil "T~3,'0d" s))
s
(format nil "T~3,'0d" (parse-integer s))))
+(defgeneric fmt-eui (e))
(defmethod fmt-eui ((e fixnum))
(format nil "E~7,'0d" e))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun english-term-p (obj)
- (and (eq (class-name (class-of obj)) 'uterm)
- (string-equal (lat obj) "ENG"))))
-
-(defun display-umls-obj
- (obj &key (os *standard-output*) (format :text) (label nil)
- (file-wrapper t) (english-only nil) (subobjects nil)
- (refvars nil))
- (display-ml-class
- obj :os os :format format :label label :subobjects subobjects
- :file-wrapper file-wrapper
- :english-only-function (if english-only #'english-term-p nil)
- :refvars refvars))
-
-(defmacro defludisp-ml-class (newfuncname lookup-func)
- "Defines functions for looking up and displaying objects"
- `(defun ,newfuncname
- (keyval &key (os *standard-output*) (format :text) (label nil)
- (file-wrapper t) (english-only nil) (subobjects nil))
- (let ((obj (funcall ,lookup-func keyval)))
- (display-umls-obj obj :os os :format format :label label
- :file-wrapper file-wrapper :english-only english-only
- :subobjects subobjects))))
+ "Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
+ (if (eq (hyperobject::portable-class-name (hyperobject::portable-class-of obj)) 'uterm)
+ (values (string-equal (lat obj) "ENG") t)
+ (values nil nil))))
-(defludisp-ml-class disp-con #'find-ucon-cui)
-(defludisp-ml-class disp-term #'find-uterm-lui)
-(defludisp-ml-class disp-str #'find-ustr-sui)
+(defgeneric print-umlsclass (obj &key os format label file-wrapper english-only subobjects refvars)
+ )
+
+(defmethod print-umlsclass ((obj umlsclass) &key (os *standard-output*) (format :text)
+ (label nil) (file-wrapper t) (english-only nil) (subobjects nil)
+ (refvars nil))
+ (print-hyperobject obj :os os :format format :label label :subobjects subobjects
+ :file-wrapper file-wrapper
+ :english-only-function (if english-only #'english-term-p nil)
+ :refvars refvars))
+
+
+(defmacro define-lookup-display (newfuncname lookup-func)
+ "Defines functions for looking up and displaying objects"
+ `(defun ,newfuncname (keyval &key (os *standard-output*) (format :text) (label nil)
+ (file-wrapper t) (english-only nil) (subobjects nil))
+ (let ((obj (funcall ,lookup-func keyval)))
+ (print-umlsclass obj :os os :format format :label label
+ :file-wrapper file-wrapper :english-only english-only
+ :subobjects subobjects)
+ obj)))
+
+(define-lookup-display display-con #'find-ucon-cui)
+(define-lookup-display display-term #'find-uterm-lui)
+(define-lookup-display display-str #'find-ustr-sui)
+
+#+(or scl cmu)
+(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 usrl))
+ #+cmu
+ (let ((cl (pcl:find-class c)))
+ (pcl:finalize-inheritance cl))
+ #+scl
+ (let ((cl (find-class c)))
+ (clos:finalize-inheritance cl)))
projects / umlisp.git / blobdiff