;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: classes.lisp,v 1.8 2002/10/18 07:28:57 kevin Exp $
+;;;; $Id: classes.lisp,v 1.9 2002/11/04 18:02:13 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(defclass umlsclass ()
()
- (:metaclass kmrcl:ml-class)
- (:documentation "Parent class of all UMLS objects. It is based on the KMRCL:ML-CLASS metaclass that provides object printing functions."))
+ (:metaclass hyperobject-class)
+ (:documentation "Parent class of all UMLS objects. It is based on the HYPEROBJECT-CLASS metaclass that provides object printing functions."))
(defmethod print-object ((obj umlsclass) (s stream))
(defclass usrl (umlsclass)
((sab :type string :initarg :sab :reader sab)
(srl :type integer :initarg :srl :reader srl))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :srl nil)
(:title "Source Restriction Level")
(:fields (sab :string) (srl :fixnum))
(sab :type string :initarg :sab :reader sab)
(tty :type string :initarg :tty :reader tty)
(supres :type string :initarg :supres :reader supres))
- (:metaclass kmrcl: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)))
(defclass udef (umlsclass)
((def :type string :initarg :def :reader def)
(sab :type string :initarg :sab :reader sab))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :def nil :sab nil)
(:title "Definition")
(:ref-fields (sab find-bsab-sab))
(code :type string :initarg :code :reader code)
(atn :type string :initarg :atn :reader atn)
(atv :type string :initarg :atv :reader atv))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :code nil :atn nil :atv nil)
(:title "Simple Attribute")
(:ref-fields (sab find-bsab-sab))
(code :type string :initarg :code :reader code)
(tty :type string :initarg :tty :reader tty)
(srl :type fixnum :initarg :srl :reader srl))
- (:metaclass kmrcl: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))
(hcd :type string :initarg :hcd :reader hcd)
(rela :type string :initarg :rela :reader rela)
(xc :type string :initarg :xc :reader xc))
- (:metaclass kmrcl: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")
(s#sat :reader s#sat)
(s#so :reader s#so)
(s#cxt :reader s#cxt))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs
:sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
(:title "String")
(sui :type fixnum :initarg :sui :reader sui)
(sna :type string :initarg :sna :reader sna)
(soui :type string :initarg :soui :reader soui))
- (:metaclass kmrcl: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)
(lrl :type fixnum :initarg :lrl :reader lrl)
(s#str :reader s#str)
(s#sat :reader s#sat))
- (:metaclass kmrcl:ml-class)
+ (: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))
(defclass usty (umlsclass)
((tui :type fixnum :initarg :tui :reader tui)
(sty :type string :initarg :sty :reader sty))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :tui nil :sty nil)
(:title "Semantic Type")
(:ref-fields (tui find-ucon-tui (("subobjects" "no"))))
(sab :type string :initarg :sab :reader sab)
(sl :type string :initarg :sl :reader sl)
(mg :type string :initarg :mg :reader mg))
- (:metaclass kmrcl: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")
(cot :type string :initarg :cot :reader cot)
(cof :type fixnum :initarg :cof :reader cof)
(coa :type string :initarg :coa :reader coa))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs
:cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
(:title "Co-occuring Concept")
((sab :type string :initarg :sab :reader sab)
(rel :type string :initarg :rel :reader rel)
(atx :type string :initarg :atx :reader atx))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :sab nil :rel nil :atx nil)
(:title "Associated Expression")
(:fields (sab :string) (rel :string) (atx :cdata)))
(s#sat :reader s#sat)
(s#atx :reader s#atx)
(s#sty :reader s#sty))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :cui nil :pfstr nil :lrl nil)
(:title "Concept")
(:subobjects-lists
(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 kmrcl:ml-class)
+ (: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)
((lat :type string :initarg :lat :reader lat)
(nwd :type string :initarg :nwd :reader nwd)
(cuilist :type list :initarg :cuilist :reader uxnw-cuilist))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :lat nil :nwd nil :cuilist nil)
(:title "XNW Index")
(:fields (lat :string) (nwd :string) (cuilist :string)))
((lat :type string :initarg :lat :reader lat)
(nstr :type string :initarg :nstr :reader nstr)
(cuilist :type list :initarg :cuilist :reader cuilist))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :lat nil :nstr nil :cuilist nil)
(:title "XNS Index")
(:fields (lat :string) (nstr :string) (cuilist :string)))
(s#spl :reader s#spl)
(s#trm :reader s#trm)
(s#typ :reader s#typ))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :eui nil :wrd nil)
(:title "Lexical Term")
(:subobjects-lists
(abr :type string :initarg :abr :reader abr)
(eui2 :type integer :initarg :eui2 :reader eui2)
(bas2 :type string :initarg :bas2 :reader bas2))
- (:metaclass kmrcl: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)
(agr :type string :initarg :agr :reader agr)
(cit :type string :initarg :cit :reader cit)
(bas :type string :initarg :bas :reader bas))
- (:metaclass kmrcl: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)
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(com :type string :initarg :com :reader com))
- (:metaclass kmrcl: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)))
(sca :type string :initarg :sca :reader sca)
(psnmod :type string :initarg :psnmod :reader psnmod)
(fea :type string :initarg :fea :reader fea))
- (:metaclass kmrcl: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)
(eui2 :type integer :initarg :eui2 :reader eui2)
(bas2 :type string :initarg :bas2 :reader bas2)
(sca2 :type string :initarg :sca2 :reader sca2))
- (:metaclass kmrcl: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)
(pos :type string :initarg :pos :reader pos)
(qnt :type string :initarg :qnt :reader qnt)
(fea :type string :initarg :fea :reader fea))
- (:metaclass kmrcl: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")
(str :type string :initarg :str :reader str)
(sca :type string :initarg :sca :reader sca)
(fea :type string :initarg :fea :reader fea))
- (:metaclass kmrcl: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)
((eui :type integer :initarg :eui :reader eui)
(spv :type string :initarg :spv :reader spv)
(bas :type string :initarg :bas :reader bas))
- (:metaclass kmrcl: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)))
((eui :type integer :initarg :eui :reader eui)
(bas :type string :initarg :bas :reader bas)
(gen :type string :initarg :gen :reader gen))
- (:metaclass kmrcl: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)))
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(typ :type string :initarg :typ :reader typ))
- (:metaclass kmrcl: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)))
(defclass lwd (umlsclass)
((wrd :type string :initarg :wrd :reader wrd)
(euilist :type list :initarg :euilist :reader euilist))
- (:metaclass kmrcl:ml-class)
+ (:metaclass hyperobject-class)
(:default-initargs :wrd nil :euilist nil)
(:title "Lexical Word Index")
(:fields (wrd :string) (euilist :string)))
(rh :type string :initarg :rh :reader rh)
(abr :type string :initarg :abr :reader abr)
(rin :type string :initarg :rin :reader rin))
- (:metaclass kmrcl: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)
(rl :type string :initarg :rl :reader rl)
(styrl2 :type string :initarg :styrl2 :reader styrl2)
(ls :type string :initarg :ls :reader ls))
- (:metaclass kmrcl: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)))
((ui :type integer :initarg :ui :reader ui)
(ui2 :type integer :initarg :ui2 :reader ui2)
(ui3 :type integer :initarg :ui3 :reader ui3))
- (:metaclass kmrcl:ml-class)
+ (: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)))
((sty :type string :initarg :ui :reader sty)
(rl :type string :initarg :ui2 :reader rl)
(sty2 :type string :initarg :ui3 :reader sty2))
- (:metaclass kmrcl: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)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun english-term-p (obj)
"Returns two values: T/NIL if term is english and T/NIL if obj is a TERM"
- (if (eq (kmrcl::ml-class-name (kmrcl::ml-class-of obj)) 'uterm)
+ (if (eq (kmrcl::hyperobject-class-name (kmrcl::hyperobject-class-of obj)) 'uterm)
(values (string-equal (lat obj) "ENG") t)
(values nil nil))))
-(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)
+
+(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))
+ `(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))))
+ (print-umlsclass obj :os os :format format :label label
+ :file-wrapper file-wrapper :english-only english-only
+ :subobjects subobjects)
+ obj)))
-(defludisp-ml-class disp-con #'find-ucon-cui)
-(defludisp-ml-class disp-term #'find-uterm-lui)
-(defludisp-ml-class disp-str #'find-ustr-sui)
+(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))
#+scl
(let ((cl (find-class c)))
(clos:finalize-inheritance cl)))
-
-
-
projects / umlisp.git / commitdiff