[isidorus-cvs] r185 - branches/new-datamodel/src/model

Lukas Giessmann lgiessmann at common-lisp.net
Sat Feb 13 13:07:20 UTC 2010


Author: lgiessmann
Date: Sat Feb 13 08:07:13 2010
New Revision: 185

Log:
new-datamodel: added some functionality to the new existing classes -> identifiers, indetifier-associations, reifiable-construct

Modified:
   branches/new-datamodel/src/model/datamodel.lisp

Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Sat Feb 13 08:07:13 2010
@@ -9,10 +9,75 @@
 
 (defpackage :datamodel
   (:use :cl :elephant :constants)
-  (:nicknames :d))
+  (:nicknames :d)
+  (:export ;;classes
+           :PersistenIdC
+	   :ItemIdentifierC
+	   :SubjectLocatorC
+	   :TopicIdentificationC
+	   :TopicC
+
+	   ;;methods and functions
+	   :xtm-id
+	   :uri
+	   :identifieid-construct
+	   :all-identified-constructs
+	   :item-identifiers
+	   :reifier
+	   :add-item-identifier
+	   :add-reifier
+	   :find-item-by-revision
+
+	   ;;globals
+	   :*TM-REVISION*))
 
 (in-package :datamodel)
 
+
+
+;;TODO: implement all-reified-constructs (:with-deleted t) -> TopicC
+;;      the method should return all reifed-constructs of the given topic
+;;TODO: implement make-construct -> symbol
+;;      replace the latest make-construct-method
+;;TODO: implement merge-construct -> ReifiableConstructC -> ...
+;;      the method should merge two constructs that are inherited from
+;;      ReifiableConstructC
+;;TODO: implement find-item-by-revision for all classes that don't have their
+;;      one revision-infos
+
+
+;;; hacks -> just some temporary hacks to avoid compiler-errors ;;;;;;;;;;;;;;;;
+(defpclass TopicC (TopicMapConstructC)
+  ()
+  (:documentation "A temporary emtpy class to avoid compiler-errors."))
+
+(defgeneric merge-constructs(construc-1 construct-2 &key revision)
+  (:method ((construct-1 TopicMapConstructC) (construct-2 TopicMapconstructC)
+	    &key (revision *TM-REVISION*))
+    (or construct-1 construct-2 revision)))
+
+
+(defgeneric all-reified-constructs(topic &key with-deleted)
+  (:method ((topic TopicC) &key (with-deleted t))
+    (or topic with-deleted)))
+
+
+(defgeneric make-construct (class-symbol &key start-revision &allow-other-keys)
+  (:method ((class-symbol symbol) &key (start-revision *TM-REVISION*))
+    (or class-symbol start-revision)))
+;;; end hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+
+
+
+
+
+
+
+
+
 ;;; globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar *TM-REVISION* 0)
 
@@ -45,6 +110,29 @@
   (drop-instance construct))
 
 
+(defun filter-slot-value-by-revision (construct slot-symbol
+				      &key (start-revision
+					    0 start-revision-provided-p))
+  (declare (symbol slot-symbol) (integer start-revision))
+  (let ((revision
+	 (cond (start-revision-provided-p
+		start-revision)
+	       ((boundp '*TM-REVISION*)
+		*TM-REVISION*)
+	       (t 0)))
+	(properties (slot-p construct slot-symbol)))
+    (cond ((not properties)
+	   nil) ;no properties were found -> nil
+	  ((= 0 revision)
+	   (remove-if #'null
+		      (map 'list #'find-most-recent-revision properties)))
+	  (t
+	   (remove-if #'null
+		      (map 'list #'(lambda(prop)
+				     (find-item-by-revision prop revision))
+			   properties))))))
+
+
 ;;; VersionInfoC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defpclass VersionInfoC()
   ((start-revision :initarg :start-revision
@@ -75,13 +163,6 @@
   (delete-1-n-association version-info 'versioned-construct))
 
 
-(defgeneric versioned-construct-p (version-info)
-  (:documentation "Returns t if the passed object is already bound to a
-                   VersionedObjectC.")
-  (:method ((version-info VersionInfoC))
-    (slot-p version-info 'versioned-construct)))
-
-
 ;;; VersionedConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defpclass VersionedConstructC()
   ((versions :initarg :versions
@@ -114,6 +195,30 @@
 	    (first sorted-list)))))) ;latest version-info of marked-as-deleted constructs -> highest integer
 
 
+(defgeneric find-most-recent-revision (construct)
+  (:documentation "Returns the latest version-info-object of the passed
+                   construct.")
+  (:method ((construct VersionedConstructC))
+    (when (find 0 (versions construct) :key #'end-revision)
+      construct)))
+
+
+(defgeneric find-item-by-revision (construct revision)
+  (:documentation "Returns the given object if it exists in the passed
+                   version otherwise nil.")
+  (:method ((construct VersionedConstructC) (revision integer))
+    (cond ((= revision 0)
+	   (find-most-recent-revision construct))
+	  (t
+	   (when (find-if
+		  #'(lambda(vi)
+		      (and (>= revision (start-revision vi))
+			   (or (< revision (end-revision vi))
+			       (= 0 (end-revision vi)))))
+		  (versions construct))
+	     construct)))))
+
+
 (defgeneric add-to-version-history (construct &key start-revision end-revision)
   (:documentation "Adds version history to a versioned construct"))
 
@@ -170,11 +275,13 @@
 (defpclass ReifierAssociationC(VersionedAssociationC)
   ((reifiable-construct :initarg :reifiable-construct
 			:accessor reifiable-construct
+			:initform (error "From ReifierAssociation(): reifiable-construct must be set")
 			:associate ReifiableConstructC
 			:documentation "The actual construct which is reified
                                       by a topic.")
    (reifier-topic :initarg :reifier-topic
 		  :accessor reifier-topic
+		  :initform (error "From ReifierAssociationC(): reifier-topic must be set")
 		  :associate TopicC
 		  :documentation "The reifier-topic that reifies the
                                   reifiable-construct."))
@@ -196,6 +303,7 @@
 (defpclass SubjectLocatorAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
+		     :initform (error "From SubjectLocatorAssociationC(): parent-construct must be set")
 		     :associate TopicC
 		     :documentation "The actual topic which is associated
                                      with the subject-locator."))
@@ -211,6 +319,7 @@
 (defpclass PersistentIdAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
+		     :initform (error "From PersistentIdAssociationC(): parent-construct must be set")
 		     :associate TopicC
 		     :documentation "The actual topic which is associated
                                      with the subject-identifier/psi."))
@@ -226,6 +335,7 @@
 (defpclass TopicIdAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
+		     :initform (error "From TopicIdAssociationC(): parent-construct must be set")
 		     :associate TopicC
 		     :documentation "The actual topic which is associated
                                      with the topic-identifier."))
@@ -241,6 +351,7 @@
 (defpclass ItemIdAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
+		     :initform (error "From ItemIDAssociationC(): parent-construct must be set")
 		     :associate ReifiableConstructC
 		     :documentation "The actual parent which is associated
                                      with the item-identifier."))
@@ -256,6 +367,7 @@
 (defpclass PointerAssociationC (VersionedAssociationC)
   ((identifier :initarg :identifier
 	       :accessor identifier
+	       :initform (error "From VersionedAssociationC(): identifier must be set")
 	       :associate PointerC
 	       :documentation "The actual data that is associated with
                                the pointer-association's parent."))
@@ -342,12 +454,12 @@
   (:documentation "Returns the identified-construct -> ReifiableConstructC or
                    TopicC that corresponds with the passed revision.")
   (:method ((construct PointerC) &key (revision *TM-REVISION*))
-    (let ((results
+    (let ((assocs
 	   (map 'list #'parent-construct
 		(filter-slot-value-by-revision construct 'identified-construct
 					       :start-revision revision))))
-      (when results ;result must be nil or a list with one item
-	(first results)))))
+      (when assocs ;result must be nil or a list with one item
+	(first assocs)))))
 
 
 (defgeneric all-identified-constructs (construct &key with-deleted)
@@ -406,7 +518,9 @@
 (defgeneric add-item-identifier (construct item-identifier &key revision)
   (:documentation "Adds the passed item-identifier to the passed construct.
                    If the item-identifier is already related with the passed
-                   construct a new revision is added.")
+                   construct a new revision is added.
+                   If the passed identifer already identifies another object
+                   the identified-constructs are merged.")
   (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC)
 	    &key (revision *TM-REVISION*))
     (let ((all-constructs
@@ -417,1696 +531,52 @@
 		    (loop for ii-assoc in (slot-p construct 'item-identifiers)
 			 when (eql (identifier ii-assoc) item-identifier)
 			 return ii-assoc)))
-	       (add-to-version-history ii-assoc :start-revision revision)))
+	       (add-to-version-history ii-assoc :start-revision revision)
+	       construct))
 	    (all-constructs
-	     (merge-constructs (first all-constructs) (second all-constructs)))
+	     (merge-constructs (first all-constructs) construct))
 	    (t
 	     (make-construct 'ItemIdAssociationC
 			     :start-revision revision
 			     :parent-construct construct
-			     :identifier item-identifier))))
-    item-identifier))
+			     :identifier item-identifier)
+	     construct)))))
+
 
+(defgeneric add-reifier (construct reifier-topic &key revision)
+  (:documentation "Adds the passed reifier-topic as reifier of the construct.
+                   If the construct is already reified by the given topic
+                   there only is added a new version-info.
+                   If the reifier-topic reifies already another construct
+                   the reified-constructs are merged.")
+  (:method ((construct ReifiableConstructC) (reifier-topic TopicC)
+	    &key (revision *TM-REVISION*))
+    (let ((merged-reifier-topic
+	   (when (reifier construct)
+	     (merge-constructs (reifier construct) reifier-topic))))
+      (let ((all-constructs
+	     (all-reified-constructs merged-reifier-topic :with-deleted nil)))
+	(cond ((find construct all-constructs)
+	       (let ((reifier-assoc
+		      (loop for reifier-assoc in
+			   (slot-p merged-reifier-topic 'reified-construct)
+			 when (eql (reifiable-construct reifier-assoc)
+				   construct)
+			 return reifier-assoc)))
+		 (add-to-version-history reifier-assoc :start-revision revision)
+		 construct))
+	      (all-constructs
+	       (merge-constructs (first all-constructs) construct))
+	      (t
+	       (make-construct 'ReifierAssociationC
+			       :start-revision revision
+			       :reifiable-construct construct
+			       :reifier-topic merged-reifier-topic)
+	       construct))))))
 
-;;TODO: implement add-reifier (version)
-;;TODO: implement make-construct (symbol)
-;;TODO: implement merge-construct
 
 ;;; TopicMapConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defpclass TopicMapConstructC()
   ()
   (:documentation "An abstract base class for all classes that describes
                    Topic Maps data."))
-
-
-
-
-
-
-
-
-
-
-;;  (:import-from :exceptions
-;;                missing-reference-error
-;;                no-identifier-error
-;;                duplicate-identifier-error
-;;                object-not-found-error)
-;;  (:export :AssociationC ;; types
-;;           :CharacteristicC
-;;           :FragmentC
-;;           :IdentifierC
-;;           :IdentityC 
-;;           :ItemIdentifierC
-;;           :NameC
-;;           :OccurrenceC
-;;           :PersistentIdC
-;;           :ReifiableConstructC
-;;           :RoleC
-;;           :ScopableC
-;;           :SubjectLocatorC
-;;           :TopicC
-;;           :TopicIdentificationC
-;;           :TopicMapC
-;;	   :TopicMapConstructC 
-;;	   :TypableC
-;;	   :VariantC
-;;
-;;           ;; functions and slot accessors
-;;           :in-topicmaps
-;;           :add-to-topicmap
-;;           :add-source-locator
-;;           :associations
-;;           :changed-p
-;;           :charvalue
-;;           :check-for-duplicate-identifiers
-;;           :datatype
-;;           :equivalent-constructs
-;;           :find-item-by-revision
-;;           :find-most-recent-revision
-;;           :get-all-revisions
-;;           :get-all-revisions-for-tm
-;;           :get-fragment
-;;           :get-fragments
-;;           :get-revision
-;;           :get-item-by-content
-;;           :get-item-by-id
-;;           :get-item-by-item-identifier
-;;           :get-item-by-psi
-;;           :identified-construct
-;;           :identified-construct-p
-;;           :in-topicmap
-;;           :internal-id
-;;           :instance-of
-;;           :instance-of-p
-;;           :item-identifiers
-;;           :item-identifiers-p
-;;           :list-instanceOf
-;;	   :list-super-types
-;;           :locators
-;;           :locators-p
-;;           :make-construct
-;;           :mark-as-deleted
-;;           :names
-;;           :namevalue
-;;           :occurrences
-;;	   :name
-;;           :parent
-;;           :player
-;;           :player-in-roles
-;;           :players
-;;           :psis
-;;           :psis-p
-;;           :referenced-topics
-;;           :revision
-;;           :RoleC-p
-;;           :roleid
-;;           :roles
-;;           :themes
-;;           :xtm-id
-;;           :xtm-id-p
-;;           :topic
-;;           :topicid
-;;           :topic-identifiers
-;;           :topics
-;;           :unique-id
-;;	   :uri 
-;;	   :uri-p
-;;	   :used-as-type
-;;	   :used-as-theme
-;;	   :variants
-;;	   :xor
-;;           :create-latest-fragment-of-topic
-;;	   :reified
-;;	   :reifier
-;;	   :add-reifier
-;;	   :remove-reifier
-;;
-;;           :*current-xtm* ;; special variables
-;;           :*TM-REVISION*
-;;
-;;           :with-revision ;;macros
-;;
-;;	   :string-starts-with ;;helpers
-;;           ))
-;;
-;;(declaim (optimize (debug 3) (safety 3) (speed 0) (space 0)))
-;;(in-package :datamodel)
-;;
-;;(defparameter *current-xtm* nil "Represents the currently active TM")
-;;
-;;(defmacro find-max-elem (candidate-list &key (relop #'> relop-p) (key #'identity key-p))
-;;  "Given a non-empty list, return the maximum element in the list.
-;;   If provided, then relop must be a relational operator that determines the ordering;
-;;   else #'> is used. The keyword parameter key may name a function that is used to extract
-;;   the sort key; otherwise the elements themselves are the sort keys."
-;;  (let
-;;      ((candidate-list-value-name (gensym))
-;;       (relop-value-name (gensym))
-;;       (key-value-name (gensym))
-;;       (best-seen-cand-name (gensym))
-;;       (max-key-name (gensym))
-;;       (inspected-cand-name (gensym))
-;;       (inspected-key-name (gensym)))
-;;    (let
-;;        ((max-key-init (if key-p
-;;                           `(funcall ,key-value-name ,best-seen-cand-name)
-;;                           best-seen-cand-name))
-;;         (inspected-key-init (if key-p
-;;                                 `(funcall ,key-value-name ,inspected-cand-name)
-;;                                 inspected-cand-name))
-;;         (relexp (if relop-p
-;;                     `(funcall ,relop-value-name ,inspected-key-name ,max-key-name)
-;;                     `(> ,inspected-key-name ,max-key-name))))
-;;      (let
-;;          ((initializers `((,candidate-list-value-name ,candidate-list)
-;;                           (,best-seen-cand-name (first ,candidate-list-value-name))
-;;                           (,max-key-name ,max-key-init))))
-;;        (when relop-p
-;;          (push `(,relop-value-name ,relop) initializers))
-;;        (when key-p
-;;          (push `(,key-value-name ,key) initializers))
-;;        `(let*
-;;          ,initializers
-;;          (dolist (,inspected-cand-name (rest ,candidate-list-value-name))
-;;            (let
-;;                ((,inspected-key-name ,inspected-key-init))
-;;              (when ,relexp
-;;                (setf ,best-seen-cand-name ,inspected-cand-name)
-;;                (setf ,max-key-name ,inspected-key-name))))
-;;          ,best-seen-cand-name)))))
-;;
-;;(defvar *TM-REVISION* 0)
-;;
-;;(defmacro with-revision (revision &rest body)
-;;  `(let
-;;    ((*TM-REVISION* ,revision))
-;;                                        ;(format t "*TM-REVISION* is ~a~&" *TM-REVISION*)
-;;    , at body))
-;;    
-;;
-;;(defmacro slot-predicate (instance slot)
-;;  (let
-;;      ((inst-name (gensym))
-;;       (slot-name (gensym)))
-;;    `(let
-;;      ((,inst-name ,instance)
-;;       (,slot-name ,slot))
-;;      (and (slot-boundp ,inst-name ,slot-name)
-;;       (slot-value ,inst-name ,slot-name)))))
-;;
-;;(defmacro delete-1-n-association (instance slot)
-;;  (let
-;;      ((inst-name (gensym))
-;;       (slot-name (gensym)))
-;;    `(let
-;;      ((,inst-name ,instance)
-;;       (,slot-name ,slot))
-;;      (when (slot-predicate ,inst-name ,slot-name)
-;;        (elephant:remove-association ,inst-name ,slot-name (slot-value ,inst-name ,slot-name))))))
-;;
-;;(defun xor (a1 a2)
-;;  (and (or a1 a2) (not (and a1 a2)))
-;;  )
-;;
-;;(defun remove-nil-values (plist)
-;;  (let
-;;      ((result nil))
-;;    (do* ((rest plist (cddr rest))
-;;          (key (first rest) (first rest))
-;;          (val (second rest) (second rest)))
-;;         ((null rest))
-;;      (when val
-;;        (pushnew val result)
-;;        (pushnew key result)))
-;;    result))
-;;
-;;(defun get-revision ()
-;;  "TODO: replace by something that does not suffer from a 1 second resolution."
-;;  (get-universal-time))
-;;
-;;(defgeneric delete-construct (construct)
-;;  (:documentation "drops recursively construct and all its dependent objects from the elephant store"))
-;;
-;;(defmethod delete-construct ((construct elephant:persistent))
-;;  nil)
-;;
-;;(defmethod delete-construct :after ((construct elephant:persistent))
-;;  (elephant:drop-instance construct))
-;;
-;;(defgeneric find-all-equivalent (construct)
-;;  (:method ((construct t)) nil)
-;;  (:documentation "searches an existing object that is equivalent (but not identical) to construct"))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; VersionInfoC
-;;
-;;
-;;(elephant:defpclass VersionInfoC ()
-;;  ((start-revision :accessor start-revision
-;;                   :initarg :start-revision
-;;                   :type integer
-;;                   :initform 0          ;TODO: for now
-;;                   :documentation "The first revison this AssociationC instance is associated with.")
-;;   (end-revision :accessor end-revision
-;;                 :initarg :end-revision
-;;                 :type integer
-;;                 :initform 0            ;TODO: for now
-;;                 :documentation "The first revison this AssociationC instance is no longer associated with.")
-;;   (versioned-construct :associate TopicMapConstructC
-;;                        :accessor versioned-construct
-;;                        :initarg :versioned-construct
-;;                        :documentation "reifiable construct that is described by this info"))
-;;  (:documentation "Version Info for individual revisions"))
-;;
-;;(defgeneric versioned-construct-p (vi)
-;;  (:documentation "t if this version info is already bound to a TM construct")
-;;  (:method ((vi VersionInfoC)) (slot-predicate vi 'versioned-construct)))
-;;
-;;(defmethod delete-construct :before ((vi VersionInfoC))
-;;  (delete-1-n-association vi 'versioned-construct))
-;;
-;;(defgeneric get-most-recent-version-info (construct))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; ItemIdentifierC
-;;
-;;(elephant:defpclass ItemIdentifierC (IdentifierC) 
-;;  ()
-;;  (:index t)
-;;  (:documentation "Represents an item identifier"))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; SubjectLocator
-;;
-;;(elephant:defpclass SubjectLocatorC (IdentifierC)
-;;  ((identified-construct :accessor identified-construct
-;;                         :initarg :identified-construct
-;;                         :associate TopicC))
-;;  (:index t)
-;;  (:documentation "Represents a subject locator"))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; IdentifierC
-;;
-;;(elephant:defpclass IdentifierC (PointerC)
-;;  ()
-;;  (:documentation "Abstract base class for ItemIdentifierC and
-;;  PersistentIdC, primarily in view of the equality rules"))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; PointerC
-;;
-;;(elephant:defpclass PointerC (TopicMapConstructC)
-;;  ((uri :accessor uri
-;;        :initarg :uri
-;;        :type string
-;;        :initform (error "The uri must be set for a pointer")
-;;        :index t)
-;;   (identified-construct :accessor identified-construct
-;;                         :initarg :identified-construct
-;;                         :associate ReifiableConstructC))
-;;  (:documentation "Abstract base class for all types of pointers and identifiers"))
-;;
-;;(defmethod delete-construct :before ((construct PointerC))
-;;  (delete-1-n-association construct 'identified-construct))
-;;
-;;(defmethod find-all-equivalent ((construct PointerC))
-;;  (delete construct
-;;          (elephant:get-instances-by-value (class-of construct)
-;;                                           'uri
-;;                                           (uri construct))
-;;          :key #'internal-id))
-;;(defgeneric uri-p (construct)
-;;  (:documentation "Check if the slot uri is bound in an identifier and not nil")
-;;  (:method ((identifier PointerC)) (slot-predicate identifier 'uri)))
-;;
-;;(defgeneric identified-construct-p (construct)
-;;  (:documentation "Check if the slot identified-construct is bound in an identifier and not nil")
-;;  (:method ((identifier PointerC)) (slot-predicate identifier 'identified-construct)))
-;;
-;;(defmethod print-object ((identifier PointerC) stream)
-;;  (format stream 
-;;          "~a(href: ~a; Construct: ~a)"
-;;          (class-name (class-of identifier))
-;;          (if (uri-p identifier)
-;;              (uri identifier)
-;;              "URI UNDEFINED")
-;;          (if (identified-construct-p identifier)
-;;              (identified-construct identifier) 
-;;              "SLOT UNBOUND")))
-;;
-;;(defmethod equivalent-constructs ((identifier1 PointerC) (identifier2 PointerC))
-;;  (string= (uri identifier1) (uri identifier2)))
-;;
-;;(defmethod initialize-instance :around ((identifier PointerC) &key
-;;                                        (start-revision (error "Start revision must be present") )
-;;                                        (end-revision 0))
-;;  (call-next-method)
-;;  (add-to-version-history identifier
-;;                          :start-revision start-revision
-;;                          :end-revision end-revision)
-;;  identifier)
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; TopicMapConstrucC
-;;
-;;
-;;(elephant:defpclass TopicMapConstructC ()
-;;  ((versions :associate (VersionInfoC versioned-construct)
-;;             :accessor versions
-;;             :initarg :versions
-;;             :documentation "version infos for former versions of this reifiable construct")))
-;;
-;;                                        ;TODO: if, one day, we allow merges of already existing constructs, we'll need
-;;                                        ;a tree of predecessors rather then just a list of versions. A case in point
-;;                                        ;may be if a newly imported topic carries the PSIs of two existing topics,
-;;                                        ;thereby forcing a merge post factum"
-;;
-;;(defmethod delete-construct :before ((construct TopicMapConstructC))
-;;  (dolist (versioninfo (versions construct))
-;;    (delete-construct versioninfo)))
-;;
-;;
-;;(defgeneric add-to-version-history (construct &key start-revision end-revision)
-;;  (:documentation "Add version history to a topic map construct"))
-;;
-;;(defmethod add-to-version-history ((construct TopicMapConstructC) 
-;;                                   &key 
-;;                                   (start-revision (error "Start revision must be present") )
-;;                                   (end-revision 0))
-;;  "Adds relevant information to a construct's version info"
-;;  (let
-;;      ((current-version-info
-;;        (get-most-recent-version-info construct)))
-;;    (cond
-;;      ((and current-version-info 
-;;           (= (end-revision current-version-info) start-revision)) ;the item was just marked as deleted
-;;       (setf (end-revision current-version-info) 0) ;just revitalize it, do not create a new version
-;;       current-version-info)  ;TODO: this is not quite correct, the topic
-;;                              ;might be recreated with new item
-;;                              ;identifiers. Consider adding a new parameter
-;;                              ;"revitalize"
-;;      ((and 
-;;        current-version-info 
-;;        (= (end-revision current-version-info) 0))
-;;       (setf (end-revision current-version-info) start-revision)
-;;       (make-instance 
-;;        'VersionInfoC 
-;;        :start-revision start-revision
-;;        :end-revision end-revision
-;;        :versioned-construct construct))
-;;      (t
-;;       (make-instance 
-;;        'VersionInfoC 
-;;        :start-revision start-revision
-;;        :end-revision end-revision
-;;        :versioned-construct construct)))))
-;;
-;;(defgeneric revision (constr)
-;;  (:documentation "Essentially a convenience method for start-revision"))
-;;
-;;(defmethod revision ((constr TopicMapConstructC))
-;;  (start-revision constr))
-;;
-;;(defmethod (setf revision) ((constr TopicMapConstructC) (revision integer))
-;;  (setf (start-revision constr) revision))
-;;
-;;
-;;(defgeneric find-item-by-revision (constr revision)
-;;  (:documentation "Get a given version of a construct (if any, nil if none can be found)"))
-;;
-;;(defmethod find-item-by-revision ((constr TopicMapConstructC) (revision integer))
-;;  (cond
-;;    ((= revision 0)
-;;     (find-most-recent-revision constr))
-;;    (t
-;;     (when (find-if
-;;            (lambda(version) 
-;;              (and (>= revision (start-revision version))
-;;                   (or
-;;		    (< revision (end-revision version))
-;;		    (= 0 (end-revision version)))))
-;;            (versions constr))
-;;       constr))))
-;;
-;;(defgeneric find-most-recent-revision (construct)
-;;  (:documentation "Get the most recent version of a construct (nil if
-;;the construct doesn't have versions yet or not anymore)"))
-;;
-;;(defmethod find-most-recent-revision ((construct TopicMapConstructC))
-;;  (when (find 0 (versions construct) :key #'end-revision)
-;;    construct))
-;;
-;;(defmethod delete-construct :before ((construct TopicMapConstructC))
-;;  (dolist (versionInfo (versions construct))
-;;    (delete-construct versionInfo)))
-;;
-;;
-;;(defgeneric check-for-duplicate-identifiers (top)
-;;  (:documentation "Check for possibly duplicate identifiers and signal an
-;;  duplicate-identifier-error is such duplicates are found"))
-;;
-;;(defmethod check-for-duplicate-identifiers ((construct TopicMapConstructC))
-;;  (declare (ignore construct))
-;;                                        ;do nothing
-;;  )
-;;
-;;(defgeneric filter-slot-value-by-revision (construct slot-name &key start-revision)
-;;  (:documentation "filter slot values by a given revision that is
-;;  either provided directly through the keyword argument start-revision
-;;  or through a bound variable named '*TM-REVISION*'"))
-;;
-;;(defmethod filter-slot-value-by-revision ((construct TopicMapConstructC) (slot-name symbol) &key (start-revision 0 start-revision-provided-p))
-;;  (let
-;;      ((revision            ;avoids warnings about undefined variables
-;;        (cond
-;;          (start-revision-provided-p
-;;           start-revision)
-;;          ((boundp '*TM-REVISION*)
-;;           (symbol-value '*TM-REVISION*))
-;;          (t 0)))
-;;       (properties (slot-value construct slot-name)))
-;;       ;(format t "revision in filter-slot-value-by-revision is ~a~&" revision)
-;;    (cond
-;;      ((not properties) 
-;;       nil)   ;if we don't have any properties, we don't have to worry
-;;              ;about revisions
-;;      ((= 0 revision)
-;;       (remove 
-;;        nil
-;;        (map 'list #'find-most-recent-revision
-;;             properties)))
-;;      (t
-;;       (remove nil
-;;               (map 'list 
-;;                    (lambda (constr)
-;;                      (find-item-by-revision constr revision))
-;;                    properties))))))
-;;
-;;(defgeneric make-construct (classsymbol &key start-revision &allow-other-keys)
-;;  (:documentation "create a new topic map construct if necessary or
-;;retrieve an equivalent one if available and update the revision
-;;history accordingly. Return the object in question. Methods use
-;;specific keyword arguments for their purpose"))
-;;
-;;(defmethod make-construct ((classsymbol symbol) &rest args
-;;                           &key start-revision)
-;;  (let*
-;;      ((cleaned-args (remove-nil-values args))
-;;       (new-construct (apply #'make-instance classsymbol cleaned-args))
-;;       (existing-construct (first (find-all-equivalent new-construct))))
-;;    (if existing-construct
-;;        (progn
-;;                                        ;change over new item identifiers to the old construct
-;;          (when  (copy-item-identifiers
-;;                  new-construct existing-construct)
-;;                 ;an existing construct other than a topic (which is handled
-;;                 ;separatedly below) has changed only if it has received a new
-;;                 ;item identifier
-;;            (add-to-version-history existing-construct :start-revision start-revision))
-;;          (delete-construct new-construct)
-;;          existing-construct)
-;;        (progn
-;;          (add-to-version-history new-construct :start-revision start-revision)
-;;          (check-for-duplicate-identifiers new-construct)
-;;          new-construct))))
-;;    
-;;(defmethod get-most-recent-version-info ((construct TopicMapConstructC))
-;;  (let ((result (find 0 (versions construct) :key #'end-revision)))
-;;    (if result
-;;	result ;current version-info -> end-revision = 0
-;;	(let ((sorted-list (sort (versions construct)
-;;				 #'(lambda(x y)
-;;				     (> (end-revision x) (end-revision y))))))
-;;	  (when sorted-list
-;;	    (first sorted-list)))))) ;latest version-info of marked-as-deleted constructs -> highest integer
-;;
-;;(defgeneric equivalent-constructs (construct1 construct2)
-;;  (:documentation "checks if two topic map constructs are equal according to the TMDM equality rules"))
-;;
-;;(defgeneric strictly-equivalent-constructs (construct1 construct2)
-;;  (:documentation "checks if two topic map constructs are not identical but equal according to the TMDM equality rules")
-;;  (:method ((construct1 TopicMapConstructC) (construct2 TopicMapConstructC))
-;;    (and (equivalent-constructs construct1 construct2)
-;;         (not (eq construct1 construct2)))))
-;;
-;;(defgeneric internal-id (construct)
-;;  (:documentation "returns the internal id that uniquely identifies a
-;;  construct (currently simply its OID)"))
-;;
-;;(defmethod internal-id ((construct TopicMapConstructC))
-;;  (slot-value construct (find-symbol "OID" 'elephant)))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; TopicIdentificationC
-;;
-;;(elephant:defpclass TopicIdentificationC (PointerC) 
-;;  ((xtm-id 
-;;    :accessor xtm-id
-;;    :type string
-;;    :initarg :xtm-id
-;;    :index t
-;;    :documentation "ID of the TM this identification came from"))
-;;  (:documentation "Identify topic items through generalized
-;;  topicids. A topic may have many original topicids, the class
-;;  representing one of them") )
-;;
-;;(defmethod find-all-equivalent ((construct TopicIdentificationC))
-;;  (delete (xtm-id construct) (call-next-method) :key #'xtm-id :test #'string=))
-;;
-;;(defun init-topic-identification (top id xtm-id &key (revision *TM-REVISION*))
-;;  "create a TopicIdentification object (if necessary) and initialize it with the
-;;  combination of the current topicid and the ID of the current XTM id"
-;;                                        ;(declare (TopicC top))
-;;  (declare (string id))
-;;
-;;  (flet    ;prevent unnecessary copies of TopicIdentificationC objects
-;;      ((has-topic-identifier (top uri xtm-id)
-;;         (remove-if-not
-;;          (lambda (ident)
-;;            (and (string= (uri ident) uri)
-;;                 (string= (xtm-id ident) xtm-id)))
-;;          (topic-identifiers top))))
-;;    (unless (has-topic-identifier top id xtm-id)
-;;      (let
-;;          ((ti
-;;            (make-instance 
-;;             'TopicIdentificationC
-;;             :uri id
-;;             :xtm-id xtm-id
-;;             :identified-construct top
-;;             :start-revision revision)))
-;;           ;(add-to-version-history ti :start-revision revision)
-;;           ti))))
-;;
-;;(defun xtm-id-p (xtm-id)
-;;  "checks if a xtm-id has been used before"
-;;  (elephant:get-instance-by-value 'TopicIdentificationC
-;;                                  'xtm-id xtm-id))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; PSI
-;;
-;;(elephant:defpclass PersistentIdC (IdentifierC) 
-;;  ((identified-construct :accessor identified-construct
-;;                         :initarg :identified-construct
-;;                         :associate TopicC))
-;;  (:index t)
-;;  (:documentation "Represents a PSI"))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; ReifiableConstructC
-;;
-;;(elephant:defpclass ReifiableConstructC (TopicMapConstructC)
-;;  ((item-identifiers 
-;;    :associate (ItemIdentifierC identified-construct)
-;;    :inherit t
-;;    :documentation "Slot that realizes a 1 to N
-;;                     relation between reifiable constructs and their
-;;                     identifiers; pseudo-initarg is :item-identifiers. Is inherited by all reifiable constructs")
-;;   (reifier
-;;    :associate TopicC
-;;    :inherit t
-;;    :documentation "Represents a reifier association to a topic, i.e.
-;;                   it stands for a 1:1 association between this class and TopicC"))
-;;  (:documentation "Reifiable constructs as per TMDM"))
-;;
-;;
-;;(defgeneric reifier (construct &key revision)
-;;  (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
-;;    (when (slot-boundp construct 'reifier)
-;;      (slot-value construct 'reifier))))
-;;
-;;(defgeneric (setf reifier) (topic TopicC)
-;;  (:method (topic (construct ReifiableConstructC))
-;;    (setf (slot-value construct 'reifier) topic)))
-;;;    (setf (reified topic) construct)))
-;;
-;;(defgeneric item-identifiers (construct &key revision)
-;;  (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision construct 'item-identifiers :start-revision revision)))
-;;
-;;(defmethod initialize-instance :around ((instance ReifiableConstructC) &key (item-identifiers nil) (reifier nil))
-;;  "adds associations to these ids after the instance was initialized."
-;;  (declare (list item-identifiers))
-;;  (call-next-method)
-;;  (dolist (id item-identifiers)
-;;    (declare (ItemIdentifierC id))
-;;    (setf (identified-construct id) instance))
-;;  (when reifier
-;;    (add-reifier instance reifier))
-;;    ;(setf (reifier instance) reifier))
-;;  instance)
-;;
-;;(defmethod delete-construct :before ((construct ReifiableConstructC))
-;;  (dolist (id (item-identifiers construct))
-;;    (delete-construct id))
-;;  (when (reifier construct)
-;;    (let ((reifier-topic (reifier construct)))
-;;      (remove-reifier construct)
-;;      (delete-construct reifier-topic))))
-;;
-;;(defgeneric item-identifiers-p (constr)
-;;  (:documentation "Test for the existence of item identifiers")
-;;  (:method ((construct ReifiableConstructC)) (slot-predicate construct 'item-identifiers)))
-;;
-;;(defgeneric topicid (construct &optional xtm-id)
-;;  (:documentation "Return the ID of a construct"))
-;;
-;;(defmethod revision ((constr ReifiableConstructC))
-;;  (start-revision constr))
-;;
-;;(defgeneric (setf revision) (revision construct)
-;;  (:documentation "The corresponding setter method"))
-;;
-;;(defmethod (setf revision) ((revision integer) (constr ReifiableConstructC))
-;;  (setf (start-revision constr) revision))
-;;
-;;(defgeneric get-all-identifiers-of-construct (construct)
-;;  (:documentation "Get all identifiers that a given construct has"))
-;;
-;;(defmethod get-all-identifiers-of-construct ((construct ReifiableConstructC))
-;;  (item-identifiers construct))
-;;
-;;(defmethod check-for-duplicate-identifiers ((construct ReifiableConstructC))
-;;  (dolist (id (get-all-identifiers-of-construct construct))
-;;    (when (> (length 
-;;              (union 
-;;               (elephant:get-instances-by-value 'ItemIdentifierC 'uri (uri id))
-;;               (union 
-;;                (elephant:get-instances-by-value 'PersistentIdC 'uri (uri id))
-;;                (elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id)))))
-;;             1)
-;;      (error 
-;;       (make-condition 'duplicate-identifier-error 
-;;                       :message (format nil "Duplicate Identifier ~a has been found" (uri id))
-;;                       :uri (uri id))))))
-;;
-;;(defmethod copy-item-identifiers ((from-construct ReifiableConstructC)
-;;                                  (to-construct ReifiableConstructC))
-;;  "Internal method to copy over item idenfiers from a construct to
-;;another on. Returns the set of new identifiers"
-;;  (mapc
-;;   (lambda (identifier)
-;;     (setf (identified-construct identifier) 
-;;           to-construct))
-;;   (set-difference (item-identifiers from-construct)
-;;                   (item-identifiers to-construct)
-;;                   :key #'uri :test #'string=)))
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; ScopableC
-;;
-;;(elephant:defpclass ScopableC ()
-;;  ((themes :accessor themes
-;;           :associate (TopicC used-as-theme)
-;;           :inherit t
-;;           :many-to-many t
-;;           :documentation "list of this scope's themes; pseudo-initarg is :themes")))
-;;
-;;(defmethod initialize-instance :around ((instance ScopableC) &key (themes nil))
-;;  (declare (list themes))
-;;  (call-next-method)
-;;  (dolist (theme themes)
-;;    (elephant:add-association instance 'themes theme))
-;;  instance)
-;;
-;;(defmethod delete-construct :before ((construct ScopableC))
-;;  (dolist (theme (themes construct))
-;;    (elephant:remove-association construct 'themes theme)))
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; TypableC
-;;
-;;(elephant:defpclass TypableC ()
-;;  ((instance-of :accessor instance-of
-;;                :initarg :instance-of
-;;                :associate TopicC
-;;                :inherit t
-;;                :documentation "topic that this construct is an instance of")))
-;;
-;;(defmethod delete-construct :before ((construct TypableC))
-;;  (when (instance-of-p construct)
-;;    (elephant:remove-association construct 'instance-of (instance-of construct))))
-;;
-;;(defgeneric instance-of-p (construct)
-;;  (:documentation "is the instance-of slot bound and not nil")
-;;  (:method ((construct TypableC)) (slot-predicate construct 'instance-of)))
-;;
-;;
-;;;; (defmethod equivalent-constructs ((scope1 ScopeC) (scope2 ScopeC))
-;;;;   "scopes are equal if their themes are equal"
-;;;;   (let
-;;;;       ((themes1 
-;;;;  (map 'list #'internal-id (themes scope1)))
-;;;;        (themes2
-;;;;  (map 'list #'internal-id (themes scope2))))
-;;;;     (not (set-exclusive-or themes1 themes2 :key #'internal-id))))
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; CharacteristicC
-;;       
-;;
-;;(elephant:defpclass CharacteristicC (ReifiableConstructC ScopableC TypableC)
-;;  ((topic :accessor topic
-;;          :initarg :topic
-;;          :associate TopicC
-;;          :documentation "The topic that this characteristic belongs to")
-;;   (charvalue :accessor charvalue
-;;              :type string
-;;              :initarg :charvalue
-;;              :index t
-;;              :documentation "the value of the characteristic in the given scope"))
-;;  (:documentation "Scoped characteristic of a topic (meant to be used
-;;  as an abstract class)"))
-;;
-;;(defgeneric CharacteristicC-p (object)
-;;  (:documentation "test if object is a of type CharacteristicC")
-;;  (:method ((object t)) nil)
-;;  (:method ((object CharacteristicC)) object))
-;;
-;;(defmethod delete-construct :before ((construct CharacteristicC))
-;;  (delete-1-n-association construct 'topic))
-;;
-;;(defun get-item-by-content (content &key (revision *TM-REVISION*))
-;;  "Find characteristis by their (atomic) content"
-;;  (flet
-;;      ((get-existing-instances (classname)
-;;         (delete-if-not #'(lambda (constr)
-;;                            (find-item-by-revision constr revision))
-;;                        (elephant:get-instances-by-value classname 'charvalue content))))
-;;    (nconc (get-existing-instances 'OccurenceC)
-;;           (get-existing-instances 'NameC))))
-;;
-;;
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; VariantC
-;;
-;;(elephant:defpclass VariantC (CharacteristicC)
-;;  ((datatype :accessor datatype
-;;             :initarg :datatype
-;;             :initform nil
-;;             :documentation "The XML Schema datatype of the occurrencevalue (optional, always IRI for resourceRef)")
-;;   (name :accessor name
-;;	  :initarg :name
-;;	  :associate NameC
-;;	  :documentation "references the NameC instance which is the owner of this element")))
-;;
-;;
-;;(defgeneric VariantC-p (object)
-;;  (:documentation "test if object is a of type VariantC")
-;;  (:method ((object t)) nil)
-;;  (:method ((object VariantC)) object))
-;;
-;;
-;;(defmethod delete-construct :before ((construct VariantC))
-;;  (delete-1-n-association construct 'name))
-;;
-;;
-;;(defmethod find-all-equivalent ((construct VariantC))
-;;  (let ((parent (and (slot-boundp construct 'name)
-;;                     (name construct))))
-;;    (when parent
-;;      (delete-if-not #'(lambda(x)(strictly-equivalent-constructs construct x))
-;;                     (slot-value parent 'variants)))))
-;;
-;;
-;;(defmethod equivalent-constructs ((variant1 VariantC) (variant2 VariantC))
-;;  "variant items are (TMDM(5.5)-)equal if the values of their
-;;   [value], [datatype], [scope], and [parent] properties are equal"
-;;  (and (string= (charvalue variant1) (charvalue variant2))
-;;       (or (and (not (slot-boundp variant1 'datatype)) (not (slot-boundp variant2 'datatype)))
-;;           (and (slot-boundp variant1 'datatype) (slot-boundp variant2 'datatype)
-;;                (string= (datatype variant1) (datatype variant2))))
-;;       (not (set-exclusive-or (themes variant1) (themes variant2) :key #'internal-id))))
-;;
-;;                        
-;;
-;;         
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; NameC
-;;
-;;(elephant:defpclass NameC (CharacteristicC)
-;;  ((variants ;:accessor variants
-;;	     :associate (VariantC name)))
-;;  (:documentation "Scoped name of a topic"))
-;;
-;;
-;;(defgeneric variants (name &key revision)
-;;  (:method ((name NameC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision name 'variants :start-revision revision)))
-;;
-;;
-;;(defgeneric NameC-p (object)
-;;  (:documentation "test if object is a of type NameC")
-;;  (:method ((object t)) nil)
-;;  (:method ((object NameC)) object))
-;;
-;;
-;;(defmethod find-all-equivalent ((construct NameC))
-;;  (let
-;;      ((parent (and (slot-boundp construct 'topic)
-;;                    (topic construct))))
-;;    (when parent
-;;      (delete-if-not 
-;;       #'(lambda (cand) (strictly-equivalent-constructs construct cand))
-;;       (slot-value parent 'names)))))
-;;
-;;
-;;(defmethod delete-construct :before ((construct NameC))
-;;  (dolist (variant (variants construct))
-;;    (delete-construct variant)))
-;;
-;;
-;;(defmethod equivalent-constructs ((name1 NameC) (name2 NameC))
-;;  "check for the equlity of two names by the TMDM's equality
-;;rules (5.4)"
-;;  (and
-;;   (string= (charvalue name1) (charvalue name2))
-;;   (or (and (instance-of-p name1)
-;;            (instance-of-p name2)
-;;            (= (internal-id (instance-of name1)) 
-;;               (internal-id (instance-of name2))))
-;;       (and (not (instance-of-p name1)) (not (instance-of-p name2))))
-;;   (not (set-exclusive-or (themes name1) (themes name2) :key #'internal-id))))
-;;           
-;;
-;;
-;;
-;;;;;;;;;;;;;;;;
-;;;;
-;;;; OccurrenceC
-;;
-;;(elephant:defpclass OccurrenceC (CharacteristicC)
-;;  ((datatype :accessor datatype
-;;             :initarg :datatype
-;;             :initform nil
-;;             :documentation "The XML Schema datatype of the occurrencevalue (optional, always IRI for resourceRef)")))
-;;
-;;
-;;(defgeneric OccurrenceC-p (object)
-;;  (:documentation "test if object is a of type OccurrenceC")
-;;  (:method ((object t)) nil)
-;;  (:method ((object OccurrenceC)) object))
-;;
-;;(defmethod find-all-equivalent ((construct OccurrenceC))
-;;  (let
-;;      ((parent (and (slot-boundp construct 'topic)
-;;                    (topic construct))))
-;;    (when parent
-;;      (delete-if-not  #'(lambda (cand) (strictly-equivalent-constructs construct cand))
-;;                      (slot-value parent 'occurrences)))))
-;;
-;;(defmethod equivalent-constructs ((occ1 OccurrenceC) (occ2 OccurrenceC))
-;;  "Occurrence items are equal if the values of their [value], [datatype], [scope], [type], and [parent] properties are equal (TMDM 5.6)"
-;;  (and
-;;   (string= (charvalue occ1) (charvalue occ2))
-;;   (not (set-exclusive-or (themes occ1) (themes occ2) :key #'internal-id))
-;;   (= (internal-id (topic occ1)) (internal-id (topic occ2)))
-;;   (or 
-;;    (and (instance-of-p occ1) (instance-of-p occ2)
-;;         (= 
-;;          (internal-id (instance-of occ1))
-;;          (internal-id (instance-of occ2))))
-;;    (and (not (instance-of-p occ1)) (not (instance-of-p occ2))))))
-;;
-;;
-;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; TopicC
-;;
-;;(elephant:defpclass TopicC (ReifiableConstructC)
-;;  ((topic-identifiers
-;;    :accessor topic-identifiers
-;;    :associate (TopicIdentificationC identified-construct))
-;;   (psis                                ;accessor written below
-;;    :associate (PersistentIdC identified-construct)
-;;    :documentation "list of PSI objects associated with this
-;;         topic")
-;;   (locators
-;;                                        ;accessor written below
-;;    :associate (SubjectLocatorC identified-construct)
-;;    :documentation "an optional URL that (if given) means that this topic is a subject locator")
-;;   (names                               ;accessor written below
-;;    :associate (NameC topic)
-;;    :documentation "list of topic names (as TopicC objects)") 
-;;   (occurrences         ;accessor occurrences explicitly written below
-;;    :associate (OccurrenceC topic)
-;;    :documentation "list of occurrences (as OccurrenceC objects)")
-;;   (player-in-roles            ;accessor player-in-roles written below
-;;    :associate (RoleC player)
-;;    :documentation "the list of all role instances where this topic is a player in")
-;;   (used-as-type                  ;accessor used-as-type written below
-;;    :associate (TypableC instance-of)
-;;    :documentation "list of all constructs that have this topic as their type")
-;;   (used-as-theme                ;accessor used-as-theme written below
-;;    :associate (ScopableC themes)
-;;    :many-to-many t
-;;    :documentation "list of all scopable objects this topic is a theme in")
-;;   (in-topicmaps
-;;    :associate (TopicMapC topics)
-;;    :many-to-many t
-;;    :documentation "list of all topic maps this topic is part of")
-;;   (reified
-;;    :associate ReifiableConstructC
-;;    :documentation "contains a reified object, represented as 1:1 association"))
-;;  (:documentation "Topic in a Topic Map"))
-;;
-;;
-;;(defgeneric reified (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (when (slot-boundp topic 'reified)
-;;      (slot-value topic 'reified))))
-;;
-;;(defgeneric (setf reified) (reifiable ReifiableConstructC)
-;;  (:method (reifiable (topic TopicC))
-;;    (setf (slot-value topic 'reified) reifiable)))
-;;;    (setf (reifier reifiable) topic)))
-;;
-;;(defgeneric occurrences (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision topic 'occurrences :start-revision revision)))
-;;
-;;(defgeneric names (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision topic 'names :start-revision revision)))
-;;
-;;(defgeneric psis (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision 
-;;     topic 'psis :start-revision revision)))
-;;
-;;(defgeneric locators (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision 
-;;     topic 'locators :start-revision revision)))
-;;
-;;(defgeneric player-in-roles (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision 
-;;     topic 'player-in-roles :start-revision revision)))
-;;
-;;(defgeneric used-as-type (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision topic 'used-as-type :start-revision revision)))
-;;
-;;(defgeneric used-as-theme (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision topic 'used-as-theme :start-revision revision)))
-;;
-;;(defgeneric in-topicmaps (topic &key revision)
-;;  (:method ((topic TopicC) &key (revision *TM-REVISION*))
-;;    (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision)))
-;;
-;;(defun move-identifiers(destination-topic source-topic &key (what 'item-identifiers))
-;;  "Moves all identifiers from the source-topic to the destination topic."
-;;  (declare (TopicC destination-topic source-topic))
-;;  (let ((all-source-identifiers
-;;	 (cond
-;;	   ((eql what 'item-identifiers)
-;;	    (item-identifiers source-topic))
-;;	   ((eql what 'locators)
-;;	    (locators source-topic))
-;;	   (t
-;;	    (psis source-topic))))
-;;	(all-destination-identifiers
-;;	 (cond
-;;	   ((eql what 'item-identifiers)
-;;	    (item-identifiers destination-topic))
-;;	   ((eql what 'locators)
-;;	    (locators destination-topic))
-;;	   ((eql what 'psis)
-;;	    (psis destination-topic))
-;;	   ((eql what 'topic-identifiers)
-;;	    (topic-identifiers destination-topic)))))
-;;    (let ((identifiers-to-move
-;;	   (loop for id in all-source-identifiers
-;;	      when (not (find-if #'(lambda(x)
-;;				     (if (eql what 'topic-identifiers)
-;;					 (string= (xtm-id x) (xtm-id id))
-;;					 (string= (uri x) (uri id))))
-;;				 all-destination-identifiers))
-;;	      collect id)))
-;;      (dolist (item identifiers-to-move)
-;;	(remove-association source-topic what item)
-;;	(add-association destination-topic what item)))))
-;;
-;;(defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil) (reified nil))
-;;  "implement the pseudo-initargs :topic-ids, :persistent-ids, and :subject-locators"
-;;  (declare (list psis))
-;;  (declare (list locators))
-;;  (call-next-method)
-;;  ;item-identifiers are handled in the around-method for ReifiableConstructs,
-;;  ;TopicIdentificationCs are handled in make-construct of TopicC
-;;  (dolist (persistent-id psis)
-;;    (declare (PersistentIdC persistent-id))
-;;    (setf (identified-construct persistent-id) instance))
-;;  (dolist (subject-locator locators)
-;;    (declare (SubjectLocatorC subject-locator))
-;;    (setf (identified-construct subject-locator) instance))
-;;  (when reified
-;;    (setf (reified instance) reified)))
-;;
-;;
-;;(defmethod delete-construct :before ((construct TopicC))
-;;  (dolist (dependent (append (topic-identifiers construct)
-;;                             (psis construct)
-;;                             (locators construct)
-;;                             (names construct)
-;;                             (occurrences construct)
-;;                             (player-in-roles construct)
-;;                             (used-as-type construct)))
-;;    (delete-construct dependent))
-;;  (dolist (theme (used-as-theme construct))
-;;    (elephant:remove-association construct 'used-as-theme theme))
-;;  (dolist (tm (in-topicmaps construct))
-;;    (elephant:remove-association construct 'in-topicmaps tm))
-;;  (when (reified construct)
-;;    (slot-makunbound (reified construct) 'reifier)))
-;;  
-;;(defun get-all-constructs-by-uri (uri)
-;;  (delete 
-;;   nil
-;;   (mapcar 
-;;    (lambda (identifier)
-;;      (and
-;;       (slot-boundp identifier 'identified-construct)
-;;       (identified-construct identifier)))
-;;    (union
-;;     (union
-;;      (elephant:get-instances-by-value 'ItemIdentifierC 'uri uri)
-;;      (elephant:get-instances-by-value 'PersistentIdC 'uri uri))
-;;     (elephant:get-instances-by-value 'SubjectLocatorC 'uri uri)))))
-;;
-;;
-;;(defun find-existing-topic (item-identifiers locators psis)
-;;  (let
-;;      ((uris 
-;;        (mapcar #'uri 
-;;               (union (union item-identifiers locators) psis)))
-;;       (existing-topics nil))
-;;    (dolist (uri uris)
-;;      (setf existing-topics
-;;            (nunion existing-topics
-;;                    (get-all-constructs-by-uri uri)
-;;                    :key #'internal-id)))
-;;    (assert (<= (length existing-topics) 1))
-;;    (first existing-topics)))
-;;
-;;
-;;(defmethod make-construct ((class-symbol (eql 'TopicC)) &rest args
-;;                           &key start-revision item-identifiers locators psis topicid xtm-id)
-;;  (let
-;;      ((existing-topic 
-;;        (find-existing-topic item-identifiers locators psis)))
-;;    (if existing-topic
-;;        (progn
-;;          ;our problem with topics is that we know only after the
-;;          ;addition of all the identifiers and characteristics if
-;;          ;anything has changed. We can't decide that here, so we must
-;;          ;add all revisions (real or imaginary) to version history
-;;          ;and decide the rest in changed-p. Maybe somebody can think
-;;          ;of a better way?
-;;          (add-to-version-history existing-topic
-;;                                  :start-revision start-revision)
-;;          (init-topic-identification existing-topic topicid xtm-id
-;;                                     :revision start-revision)
-;;          (let*                 ;add new identifiers to existing topics
-;;              ((all-new-identifiers 
-;;                (union (union item-identifiers locators) psis))
-;;               (all-existing-identifiers 
-;;                (get-all-identifiers-of-construct existing-topic)))
-;;            (mapc
-;;             (lambda (identifier)
-;;               (setf (identified-construct identifier) existing-topic))
-;;             (set-difference all-new-identifiers all-existing-identifiers
-;;                             :key #'uri :test #'string=))
-;;            (mapc #'delete-construct 
-;;                  (delete-if
-;;                   (lambda (identifier) 
-;;                     (slot-boundp identifier 'identified-construct))
-;;                   all-new-identifiers)))
-;;          (check-for-duplicate-identifiers existing-topic)
-;;          existing-topic)
-;;        (progn
-;;          (let*
-;;              ((cleaned-args (remove-nil-values args))
-;;               (new-topic 
-;;                (apply #'make-instance 'TopicC cleaned-args)))
-;;            
-;;            (init-topic-identification new-topic topicid xtm-id 
-;;                                       :revision start-revision)
-;;            (check-for-duplicate-identifiers new-topic)
-;;            (add-to-version-history new-topic
-;;                                    :start-revision start-revision)
-;;            new-topic)))))
-;;
-;;(defmethod make-construct :around ((class-symbol (eql 'TopicC))
-;;                                   &key start-revision &allow-other-keys)
-;;  (declare (ignorable start-revision))
-;;  (call-next-method))
-;;
-;;    
-;;(defmethod equivalent-constructs ((topic1 TopicC) (topic2 TopicC))
-;;  "TMDM, 5.3.5: Equality rule: Two topic items are equal if they have:
-;;
-;;* at least one equal string in their [subject identifiers] properties,
-;;
-;;* at least one equal string in their [item identifiers] properties,
-;;
-;;* at least one equal string in their [subject locators] properties,
-;;
-;;* an equal string in the [subject identifiers] property of the one
-;;topic item and the [item identifiers] property of the other, or the
-;;same information item in their [reified] properties (TODO: this rule
-;;is currently ignored)" 
-;;  ;(declare (optimize (debug 3)))
-;;  (let
-;;      ((psi-uris1
-;;        (map 'list #'uri (psis topic1)))
-;;       (psi-uris2
-;;        (map 'list #'uri (psis topic2)))
-;;       (ii-uris1
-;;        (map 'list #'uri (item-identifiers topic1)))
-;;       (ii-uris2
-;;        (map 'list #'uri (item-identifiers topic2)))
-;;       (locators1
-;;        (map 'list #'uri (locators topic1)))
-;;       (locators2
-;;        (map 'list #'uri (locators topic2))))
-;;    (let
-;;        ((all-uris1
-;;          (union psi-uris1 (union ii-uris1 locators1) :test #'string=))
-;;         (all-uris2
-;;          (union psi-uris2 (union ii-uris2 locators2) :test #'string=)))
-;;      ;;TODO: consider what we should do about this. If the topic at a
-;;      ;;given revision doesn't exist yet, it correctly has no uris
-;;      ;;(for that version)
-;;      ;; (when (= 0 (length all-uris1))
-;;;;         (error (make-condition 'no-identifier-error :message "Topic1 has no identifier" :internal-id (internal-id topic1))))
-;;;;       (when (= 0 (length all-uris2))
-;;;;         (error (make-condition 'no-identifier-error :message "Topic2 has no identifier" :internal-id (internal-id topic2))))
-;;      (intersection
-;;       all-uris1 all-uris2
-;;       :test #'string=))))
-;;    
-;;(defmethod get-all-identifiers-of-construct ((top TopicC))
-;;  (append (psis top)
-;;          (locators top)
-;;          (item-identifiers top)))
-;;
-;;  
-;;(defmethod topicid ((top TopicC) &optional (xtm-id nil))
-;;  "Return the primary id of this item (= essentially the OID). If
-;;xtm-id is explicitly given, return one of the topicids in that
-;;TM (which must then exist)"
-;;  (if xtm-id
-;;      (let 
-;;          ((possible-identifications
-;;            (remove-if-not
-;;             (lambda (top-id)
-;;               (string= (xtm-id top-id) xtm-id))
-;;             (elephant:get-instances-by-value 
-;;              'TopicIdentificationC
-;;              'identified-construct
-;;              top))))
-;;        (unless possible-identifications
-;;          (error (make-condition 
-;;                  'object-not-found-error
-;;                  :message 
-;;                  (format nil "Could not find an object ~a in xtm-id ~a" top xtm-id))))
-;;        (uri (first possible-identifications)))
-;;      (format nil "t~a"
-;;              (internal-id top))))
-;;  
-;;
-;;(defgeneric psis-p (top)
-;;  (:documentation "Test for the existence of PSIs")
-;;  (:method ((top TopicC)) (slot-predicate top 'psis)))
-;;
-;;(defgeneric list-instanceOf (topic &key tm)
-;; (:documentation "Generate a list of all topics that this topic is an
-;;  instance of, optionally filtered by a topic map"))
-;;
-;;(defmethod list-instanceOf ((topic TopicC)  &key (tm nil))
-;;  (remove-if 
-;;   #'null
-;;   (map 'list #'(lambda(x)
-;;                  (when (loop for psi in (psis (instance-of x))
-;;                           when (string= (uri psi) "http://psi.topicmaps.org/iso13250/model/instance")
-;;                           return t)
-;;                    (loop for role in (roles (parent x))
-;;                       when (not (eq role x))
-;;                       return (player role))))
-;;        (if tm
-;;            (remove-if-not 
-;;             (lambda (role)
-;;               ;(format t "player: ~a" (player role))
-;;               ;(format t "parent: ~a" (parent role))
-;;               ;(format t "topic: ~a~&" topic)
-;;               (in-topicmap tm (parent role)))
-;;             (player-in-roles topic))
-;;            (player-in-roles topic)))))
-;;
-;;
-;;(defgeneric list-super-types (topic &key tm)
-;; (:documentation "Generate a list of all topics that this topic is an
-;;  subclass of, optionally filtered by a topic map"))
-;;
-;;
-;;(defmethod list-super-types ((topic TopicC)  &key (tm nil))
-;;  (remove-if 
-;;   #'null
-;;   (map 'list #'(lambda(x)
-;;                  (when (loop for psi in (psis (instance-of x))
-;;                           when (string= (uri psi) *subtype-psi*)
-;;                           return t)
-;;                    (loop for role in (roles (parent x))
-;;                       when (not (eq role x))
-;;                       return (player role))))
-;;        (if tm
-;;            (remove-if-not 
-;;             (lambda (role)
-;;               (format t "player: ~a" (player role))
-;;               (format t "parent: ~a" (parent role))
-;;               (format t "topic: ~a~&" topic)
-;;               (in-topicmap tm (parent role)))
-;;             (player-in-roles topic))
-;;            (player-in-roles topic)))))
-;;
-;;
-;;(defun string-starts-with (str prefix)
-;;  "Checks if string str starts with a given prefix"
-;;  (declare (string str prefix))
-;;  (string= str prefix :start1 0 :end1
-;;           (min (length prefix)
-;;                (length str))))
-;;
-;;
-;;(defun get-item-by-item-identifier (uri &key revision)
-;;  "get a construct by its item identifier. Returns nil if the item does not exist in a
-;;particular revision"
-;;  (declare (string uri))
-;;  (declare (integer revision))
-;;  (let
-;;      ((ii-obj 
-;;        (elephant:get-instance-by-value 'ItemIdentifierC
-;;                                        'uri uri)))
-;;    (when ii-obj
-;;      (find-item-by-revision 
-;;       (identified-construct ii-obj) revision))))
-;;
-;;
-;;(defun get-item-by-psi (psi &key (revision 0))
-;;  "get a topic by its PSI. Returns nil if the item does not exist in a
-;;particular revision"
-;;  (declare (string psi))
-;;  (declare (integer revision))
-;;  (let
-;;      ((psi-obj 
-;;        (elephant:get-instance-by-value 'PersistentIdC
-;;                                        'uri psi)))
-;;    (when psi-obj
-;;      (find-item-by-revision 
-;;       (identified-construct psi-obj) revision))))
-;;
-;;(defun get-item-by-id (topicid &key (xtm-id *current-xtm*) (revision 0) (error-if-nil nil))
-;;  "get a topic by its id, assuming a xtm-id. If xtm-id is empty, the current TM
-;;is chosen. If xtm-id is nil, choose the global TM with its internal ID, if
-;;applicable in the correct revision. If revison is provided, then the code checks
-;;if the topic already existed in this revision and returns nil otherwise.
-;;If no item meeting the constraints was found, then the return value is either
-;;NIL or an error is thrown, depending on error-if-nil."
-;;  (declare (integer revision))
-;;  (let
-;;      ((result 
-;;        (if xtm-id
-;;            (let
-;;                ((possible-items
-;;                  (delete-if-not
-;;                   (lambda (top-id)
-;;                     (and
-;;                      (string= (xtm-id top-id) xtm-id)
-;;                      (string= (uri top-id) topicid))) ;fixes a bug in
-;;                                                       ;get-instances-by-value
-;;                                                       ;that does a
-;;                                                       ;case-insensitive
-;;                                                       ;comparision
-;;                   (elephant:get-instances-by-value 
-;;                    'TopicIdentificationC
-;;                    'uri
-;;                    topicid))))
-;;              (when (and possible-items
-;;                         (identified-construct-p (first possible-items)))
-;;                (unless (= (length possible-items) 1)
-;;                  (error (make-condition 'duplicate-identifier-error 
-;;                                         :message 
-;;                                         (format nil "(length possible-items ~a) for id ~a und xtm-id ~a > 1" possible-items topicid xtm-id)
-;;                                         :uri topicid)))
-;;                (let
-;;                    ((found-topic 
-;;                      (identified-construct (first possible-items))))
-;;                  (if (= revision 0)
-;;                      found-topic 
-;;                      (find-item-by-revision found-topic revision)))))
-;;            (make-instance 'TopicC :from-oid (subseq topicid 1)))))
-;;    (if (and error-if-nil (not result))
-;;        (error (format nil "no such item (id: ~a, tm: ~a, rev: ~a)" topicid xtm-id revision))
-;;        result)))
-;;
-;;      
-;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; RoleC
-;;
-;;(elephant:defpclass RoleC (ReifiableConstructC TypableC)
-;;  ((parent :accessor parent
-;;           :initarg :parent
-;;           :associate AssociationC
-;;           :documentation "Association that this role belongs to")
-;;   (player :accessor player
-;;           :initarg :player
-;;           :associate TopicC
-;;           :documentation "references the topic that is the player in this role"))
-;;  (:documentation "The role that this topic plays in an association (formerly member)"))
-;;
-;;
-;;
-;;(defgeneric RoleC-p (object)
-;;  (:documentation "test if object is a of type RoleC")
-;;  (:method ((object t)) nil)
-;;  (:method ((object RoleC)) object))
-;;
-;;
-;;(defgeneric parent-p (vi)
-;;  (:documentation "t if this construct has a parent construct")
-;;  (:method ((constr RoleC)) (slot-predicate constr 'parent)))
-;;
-;;
-;;(defmethod delete-construct :before ((construct RoleC))
-;;                                        ;the way we use roles, we cannot just delete the parent association
-;;                                        ;(at least the second role won't have one left then and will
-;;                                        ;complain)
-;;  (delete-1-n-association construct 'parent)
-;;  (delete-1-n-association construct 'player))
-;;
-;;(defmethod find-all-equivalent ((construct RoleC))
-;;  (let
-;;      ((parent (and (slot-boundp construct 'parent)
-;;                    (parent construct))))
-;;    (when parent
-;;      (delete-if-not #'(lambda (cand) (strictly-equivalent-constructs construct cand))
-;;                     (slot-value parent 'roles)))))
-;;
-;;
-;;(defmethod equivalent-constructs ((role1 RoleC) (role2 RoleC))
-;;  "Association role items are equal if the values of their [type], [player], and [parent] properties are equal (TMDM 5.8)"
-;;                                        ;for the purposes for which we use this method (namely the
-;;                                        ;construction of associations), roles will initially always be
-;;                                        ;unequal regarding their parent properties
-;;  (and
-;;   (= (internal-id (instance-of role1)) (internal-id (instance-of role2)))
-;;   (= (internal-id (player role1)) (internal-id (player role2)))))
-;;
-;;
-;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; AssociationC
-;;
-;;(elephant:defpclass AssociationC (ReifiableConstructC ScopableC TypableC)
-;;  ((roles :accessor roles
-;;          :associate (RoleC parent)
-;;          :documentation "(non-empty) list of this association's roles")
-;;   (in-topicmaps
-;;    :associate (TopicMapC associations)
-;;    :many-to-many t
-;;    :documentation "list of all topic maps this association is part of"))
-;;  (:documentation "Association in a Topic Map")
-;;  (:index t))
-;;
-;;
-;;(defmethod in-topicmaps ((association AssociationC) &key (revision *TM-REVISION*))
-;;  (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision))
-;;
-;;
-;;(defgeneric AssociationC-p (object)
-;;  (:documentation "test if object is a of type AssociationC")
-;;  (:method ((object t)) nil)
-;;  (:method ((object AssociationC)) object))
-;;
-;;
-;;(defmethod initialize-instance :around ((instance AssociationC) 
-;;                                        &key 
-;;                                        (roles nil))
-;;  "implements the pseudo-initarg :roles"
-;;  (declare (list roles))
-;;  (let
-;;      ((association (call-next-method)))  
-;;    (dolist (role-data roles)
-;;      (make-instance 
-;;       'RoleC 
-;;       :instance-of (getf role-data :instance-of)
-;;       :player (getf role-data :player)
-;;       :item-identifiers (getf role-data :item-identifiers)
-;;       :reifier (getf role-data :reifier)
-;;       :parent association))))
-;;
-;;(defmethod make-construct :around ((class-symbol (eql 'AssociationC))
-;;                                   &key 
-;;                                   start-revision 
-;;                                   &allow-other-keys)
-;;  (declare (ignorable start-revision))
-;;  (let
-;;      ((association
-;;        (call-next-method)))
-;;    (declare (AssociationC association))
-;;    (dolist (role (slot-value association 'roles))
-;;      (unless (versions role)
-;;        (add-to-version-history role
-;;                                :start-revision start-revision)))
-;;    association))
-;;
-;;(defmethod copy-item-identifiers :around
-;;    ((from-construct AssociationC)
-;;     (to-construct AssociationC))
-;;  "Internal method to copy over item idenfiers from one association
-;;with its roles to another one. Role identifiers are also
-;;copied. Returns nil if neither association nor role identifiers had to be copied"
-;;  (let
-;;      ((item-identifiers-copied-p nil)) ;rather brutal solution. find a better one
-;;    (when (call-next-method)
-;;      (setf item-identifiers-copied-p t))
-;;    (do ((from-roles (roles from-construct) (rest from-roles))
-;;         (to-roles (roles to-construct) (rest to-roles)))
-;;        ((null from-roles) 'finished)
-;;      (let
-;;          ((from-role (first from-roles))
-;;           (to-role (first to-roles)))
-;;        (when
-;;            (mapc
-;;             (lambda (identifier)
-;;               (setf (identified-construct identifier) 
-;;                     to-role))
-;;             (set-difference (item-identifiers from-role)
-;;                             (item-identifiers to-role)
-;;                             :key #'uri :test #'string=))
-;;          (setf item-identifiers-copied-p t))))
-;;  item-identifiers-copied-p))
-;;
-;;(defmethod delete-construct :before ((construct AssociationC))
-;;  (dolist (role (roles construct))
-;;    (delete-construct role))
-;;  (dolist (tm (in-topicmaps construct))
-;;    (elephant:remove-association construct 'in-topicmaps tm)))
-;;
-;;(defmethod find-all-equivalent ((construct AssociationC))
-;;  (let
-;;      ((some-player (player (or
-;;                             (second (roles construct))
-;;                             (first (roles construct)))))) ;; dirty, dirty... but brings a tenfold speedup!
-;;    (delete-if-not  
-;;     #'(lambda (cand) 
-;;         (unless (eq construct cand)
-;;           (equivalent-constructs construct cand)))
-;;                                        ;here we need to use the "internal" API and access the players
-;;                                        ;with slot-value (otherwise we won't be able to merge with
-;;                                        ;'deleted' associations)
-;;     (mapcar #'parent (slot-value some-player 'player-in-roles)))))
-;;
-;;
-;;(defmethod equivalent-constructs ((assoc1 AssociationC) (assoc2 AssociationC))
-;;  "Association items are equal if the values of their [scope], [type], and [roles] properties are equal (TMDM 5.7)"
-;;  (and
-;;   (= (internal-id (instance-of assoc1)) (internal-id (instance-of assoc2)))
-;;   (not (set-exclusive-or (themes assoc1) (themes assoc2) 
-;;                          :key #'internal-id))
-;;   (not (set-exclusive-or
-;;         (roles assoc1)
-;;         (roles assoc2)
-;;         :test  #'equivalent-constructs))))
-;;
-;;
-;;(elephant:defpclass TopicMapC (ReifiableConstructC)
-;;  ((topics :accessor topics
-;;          :associate (TopicC in-topicmaps)
-;;          :documentation "list of topics that explicitly belong to this TM")
-;;   (associations :accessor associations
-;;                 :associate (AssociationC in-topicmaps)
-;;                 :documentation "list of associations that belong to this TM"))
-;;  (:documentation "Topic Map"))
-;;
-;;(defmethod equivalent-constructs ((tm1 TopicMapC) (tm2 TopicMapC))
-;;  "Topic Map items are equal if one of their identifiers is equal"
-;;  ;Note: TMDM does not make any statement to this effect, but it's the
-;;  ;one logical assumption
-;;  (intersection
-;;   (item-identifiers tm1)
-;;   (item-identifiers tm2)
-;;   :test  #'equivalent-constructs))
-;;
-;;(defmethod find-all-equivalent ((construct TopicMapC))
-;;  (let 
-;;      ((tms (elephant:get-instances-by-class 'd:TopicMapC)))
-;;    (delete-if-not 
-;;     (lambda(tm)
-;;         (strictly-equivalent-constructs construct tm))
-;;     tms)))
-;;
-;;(defgeneric add-to-topicmap (tm top)
-;;  (:documentation "add a topic or an association to a topic
-;;  map. Return the added construct"))
-;;
-;;(defmethod add-to-topicmap ((tm TopicMapC) (top TopicC))
-;;  ;TODO: add logic not to add pure topic stubs unless they don't exist yet in the store
-;;;  (elephant:add-association tm 'topics top) ;by adding the elephant association in this order, there will be missing one site of this association
-;;  (elephant:add-association top 'in-topicmaps tm)
-;;  top)
-;;
-;;(defmethod add-to-topicmap ((tm TopicMapC) (ass AssociationC))
-;;   ;(elephant:add-association tm 'associations ass)
-;;  (elephant:add-association ass 'in-topicmaps tm)
-;;  ass)
-;;
-;;(defgeneric in-topicmap (tm constr &key revision)
-;;  (:documentation "Is a given construct (topic or assiciation) in this topic map?"))
-;;
-;;(defmethod in-topicmap ((tm TopicMapC) (top TopicC) &key (revision 0))
-;;  (when (find-item-by-revision top revision)
-;;    (find (d:internal-id top) (d:topics tm) :test #'= :key #'d:internal-id)))
-;;
-;;
-;;(defmethod in-topicmap ((tm TopicMapC) (ass AssociationC) &key (revision 0))
-;;  (when (find-item-by-revision ass revision)
-;;    (find (d:internal-id ass) (d:associations tm)  :test #'= :key #'d:internal-id)))
-;;
-;;;;;;;;;;;;;;;;;;;
-;;;; reification
-;;
-;;(defgeneric add-reifier (construct reifier-topic)
-;;  (:method ((construct ReifiableConstructC) reifier-topic)
-;;    (let ((err "From add-reifier(): "))
-;;      (declare (TopicC reifier-topic))
-;;      (cond
-;;	((and (not (reifier construct))
-;;	      (not (reified reifier-topic)))
-;;	 (setf (reifier construct) reifier-topic)
-;;	 (setf (reified reifier-topic) construct))
-;;	((and (not (reified reifier-topic))
-;;	      (reifier construct))
-;;	 (merge-reifier-topics (reifier construct) reifier-topic))
-;;	((and (not (reifier construct))
-;;	      (reified reifier-topic))
-;;	 (error "~a~a ~a reifies already another object ~a"
-;;		err (psis reifier-topic) (item-identifiers reifier-topic)
-;;		(reified reifier-topic)))
-;;	(t
-;;	 (when (not (eql (reified reifier-topic) construct))
-;;	   (error "~a~a ~a reifies already another object ~a"
-;;		  err (psis reifier-topic) (item-identifiers reifier-topic)
-;;		  (reified reifier-topic)))
-;;	 (merge-reifier-topics (reifier construct) reifier-topic)))
-;;      construct)))
-;;
-;;
-;;(defgeneric remove-reifier (construct)
-;;  (:method ((construct ReifiableConstructC))
-;;    (let ((reifier-topic (reifier construct)))
-;;      (when reifier-topic
-;;	(elephant:remove-association construct 'reifier reifier-topic)
-;;	(elephant:remove-association reifier-topic 'reified construct)))))
-;;
-;;
-;;(defgeneric merge-reifier-topics (old-topic new-topic)
-;;  ;;the reifier topics are not only merged but also bound to the reified-construct
-;;  (:method ((old-topic TopicC) (new-topic TopicC))
-;;    (unless (eql old-topic new-topic)
-;;      ;merges all identifiers
-;;      (move-identifiers old-topic new-topic)
-;;      (move-identifiers old-topic new-topic :what 'locators)
-;;      (move-identifiers old-topic new-topic :what 'psis)
-;;      (move-identifiers old-topic new-topic :what 'topic-identifiers)
-;;      ;merges all typed-object-associations
-;;      (dolist (typed-construct (used-as-type new-topic))
-;;	(remove-association typed-construct 'instance-of new-topic)
-;;	(add-association typed-construct 'instance-of old-topic))
-;;      ;merges all scope-object-associations
-;;      (dolist (scoped-construct (used-as-theme new-topic))
-;;	(remove-association scoped-construct 'themes new-topic)
-;;	(add-association scoped-construct 'themes old-topic))
-;;      ;merges all topic-maps
-;;      (dolist (tm (in-topicmaps new-topic))
-;;	(add-association tm 'topics old-topic)) ;the new-topic is removed from this tm by deleting it
-;;      ;merges all role-players
-;;      (dolist (a-role (player-in-roles new-topic))
-;;	(remove-association a-role 'player new-topic)
-;;	(add-association a-role 'player old-topic))
-;;      ;merges all names
-;;      (dolist (name (names new-topic))
-;;	(remove-association name 'topic new-topic)
-;;	(add-association name 'topic old-topic))
-;;      ;merges all occurrences
-;;      (dolist (occurrence (occurrences new-topic))
-;;	(remove-association occurrence 'topic new-topic)
-;;	(add-association occurrence 'topic old-topic))
-;;      ;merges all version-infos
-;;      (let ((versions-to-move
-;;	     (loop for vrs in (versions new-topic)
-;;		when (not (find-if #'(lambda(x)
-;;				       (and (= (start-revision x) (start-revision vrs))
-;;					    (= (end-revision x) (end-revision vrs))))
-;;				   (versions old-topic)))
-;;		collect vrs)))
-;;	(dolist (vrs versions-to-move)
-;;	  (remove-association vrs 'versioned-construct new-topic)
-;;	  (add-association vrs 'versioned-construct old-topic)))
-;;      (delete-construct new-topic))
-;;    ;TODO: order/repair all version-infos of the topic itself and add all new
-;;    ;      versions to the original existing objects of the topic
-;;    old-topic))
\ No newline at end of file




More information about the Isidorus-cvs mailing list